blob: 2b9008a1fc54773f61b69b2c1c14f318385bbbc7 (
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
|
module Loadable
( Loadable (..)
, fromEvent
, view
) where
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
|
