blob: 9a14b3f26c539310c6e30df65358a37c4b0e5f92 (
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
|
module Loadable
( Loadable (..)
, Loadable2 (..)
, fromEvent
, view
, view2
) 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 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
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
view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
view _ Loading = (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing
view _ (Error e) = R.text e >> return Nothing
view f (Loaded x) = Just <$> f x
data Loadable2 t a = Loadable2
{ _loadable_isLoading :: Dynamic t Bool
, _loadable_value :: Dynamic t (Maybe a)
}
view2 :: forall t m a b. MonadWidget t m => Loadable2 t a -> (a -> m b) -> m (Event t (Maybe b))
view2 (Loadable2 isLoading value) f =
withLoader isLoading $
R.dyn . R.ffor value . viewMaybe $ f
where
viewMaybe _ Nothing = return Nothing
viewMaybe f (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
R.elDynAttr "div" (spinnerAttrs <$> isLoading) $
R.divClass "spinner" R.blank
R.elDynAttr "div" (blockAttrs <$> isLoading) $
block
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 "")
|
