aboutsummaryrefslogtreecommitdiff
path: root/client/src/Model/Loadable.hs
blob: 3076b462fd834a7e28660379045f9fb37ab9e729 (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
module Model.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

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. MonadWidget t m => (a -> m ()) -> Loadable a -> m ()
view _ (Loading)  = R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank
view _ (Error e)  = R.text e
view f (Loaded x) = f x