blob: 4806b08866e2665ba4fa55c0c34f7f24fac33ffc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
module Loadable
( Loadable (..)
, fromEither
, fromEvent
, viewHideValueWhileLoading
, viewShowValueWhileLoading
) where
import qualified Data.Map as M
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
import Data.Functor (Functor)
import Data.Text (Text)
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
data Loadable t
= Loading
| Error Text
| Loaded t
deriving (Eq, Show)
instance Functor Loadable where
fmap f Loading = Loading
fmap f (Error e) = Error e
fmap f (Loaded x) = Loaded (f x)
instance Applicative Loadable where
pure x = Loaded x
Loading <*> _ = Loading
(Error e) <*> _ = Error e
(Loaded f) <*> Loading = Loading
(Loaded f) <*> (Error e) = Error e
(Loaded f) <*> (Loaded x) = Loaded (f x)
instance Monad Loadable where
Loading >>= f = Loading
(Error e) >>= f = Error e
(Loaded x) >>= f = f x
fromEither :: forall a b. Either Text b -> Loadable b
fromEither (Left err) = Error err
fromEither (Right value) = Loaded value
fromEvent :: forall t m a. MonadWidget t m => Event t (Either Text a) -> m (Dynamic t (Loadable a))
fromEvent =
R.foldDyn
(\res _ -> case res of
Left err -> Error err
Right t -> Loaded t
)
Loading
viewHideValueWhileLoading :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
viewHideValueWhileLoading f loadable =
case loadable of
Loading ->
(R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing
Error err ->
R.text err >> return Nothing
Loaded x ->
Just <$> f x
viewShowValueWhileLoading
:: forall t m a b. (MonadWidget t m, Eq a)
=> Dynamic t (Loadable a)
-> (a -> m b)
-> m (Event t (Maybe b))
viewShowValueWhileLoading loadable f = do
value <-
(R.foldDyn
(\l v1 ->
case l of
Loaded v2 -> Just v2
_ -> v1)
Nothing
(R.updated loadable)) >>= R.holdUniqDyn
withLoader (fmap ((==) Loading) loadable) $
R.dyn . R.ffor value $ \case
Nothing -> return Nothing
Just x -> Just <$> f x
withLoader
:: forall t m a. MonadWidget t m
=> Dynamic t Bool
-> m a
-> m a
withLoader isLoading block =
R.divClass "g-Loadable" $ do
res <- R.elDynAttr "div" (blockAttrs <$> isLoading) $
block
R.elDynAttr "div" (spinnerAttrs <$> isLoading) $
R.divClass "spinner" R.blank
return res
where
spinnerAttrs l = M.singleton "class" $
"g-Loadable__Spinner"
<> (if l then " g-Loadable__Spinner--Loading" else "")
blockAttrs l = M.singleton "class" $
"g-Loadable__Content"
<> (if l then " g-Loadable__Content--Loading" else "")
|
