aboutsummaryrefslogtreecommitdiff
path: root/client/src/Loadable.hs
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Loadable.hs')
-rw-r--r--client/src/Loadable.hs37
1 files changed, 37 insertions, 0 deletions
diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index 2b9008a..9a14b3f 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -1,9 +1,12 @@
module Loadable
( Loadable (..)
+ , Loadable2 (..)
, fromEvent
, view
+ , view2
) where
+import qualified Data.Map as M
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
@@ -50,3 +53,37 @@ view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe
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 "")