From 33e78f2ebbf5bf7b40e7aa732cc7c019f6df3f12 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 20 Oct 2019 22:08:31 +0200
Subject: Simplify page initialization

---
 client/src/Loadable.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)
 create mode 100644 client/src/Loadable.hs

(limited to 'client/src/Loadable.hs')

diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
new file mode 100644
index 0000000..8714a4d
--- /dev/null
+++ b/client/src/Loadable.hs
@@ -0,0 +1,51 @@
+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
+
+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
-- 
cgit v1.2.3