aboutsummaryrefslogtreecommitdiff
path: root/client/src/Loadable.hs
diff options
context:
space:
mode:
authorJoris2021-01-03 13:40:40 +0100
committerJoris2021-01-03 13:54:20 +0100
commit11052951b74b9ad4b6a9412ae490086235f9154b (patch)
tree64526ac926c1bf470ea113f6cac8a33158684e8d /client/src/Loadable.hs
parent371449b0e312a03162b78797b83dee9d81706669 (diff)
downloadbudget-11052951b74b9ad4b6a9412ae490086235f9154b.tar.gz
budget-11052951b74b9ad4b6a9412ae490086235f9154b.tar.bz2
budget-11052951b74b9ad4b6a9412ae490086235f9154b.zip
Rewrite in Rust
Diffstat (limited to 'client/src/Loadable.hs')
-rw-r--r--client/src/Loadable.hs109
1 files changed, 0 insertions, 109 deletions
diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
deleted file mode 100644
index 4806b08..0000000
--- a/client/src/Loadable.hs
+++ /dev/null
@@ -1,109 +0,0 @@
-module Loadable
- ( Loadable (..)
- , fromEither
- , fromEvent
- , viewHideValueWhileLoading
- , viewShowValueWhileLoading
- ) 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 (Eq, 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
-
-fromEither :: forall a b. Either Text b -> Loadable b
-fromEither (Left err) = Error err
-fromEither (Right value) = Loaded value
-
-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
-
-viewHideValueWhileLoading :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
-viewHideValueWhileLoading f loadable =
- case loadable of
- Loading ->
- (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing
-
- Error err ->
- R.text err >> return Nothing
-
- Loaded x ->
- Just <$> f x
-
-viewShowValueWhileLoading
- :: forall t m a b. (MonadWidget t m, Eq a)
- => Dynamic t (Loadable a)
- -> (a -> m b)
- -> m (Event t (Maybe b))
-viewShowValueWhileLoading loadable f = do
-
- value <-
- (R.foldDyn
- (\l v1 ->
- case l of
- Loaded v2 -> Just v2
- _ -> v1)
- Nothing
- (R.updated loadable)) >>= R.holdUniqDyn
-
- withLoader (fmap ((==) Loading) loadable) $
- R.dyn . R.ffor value $ \case
- Nothing -> return Nothing
- 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
- res <- R.elDynAttr "div" (blockAttrs <$> isLoading) $
- block
- R.elDynAttr "div" (spinnerAttrs <$> isLoading) $
- R.divClass "spinner" R.blank
- return res
-
- 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 "")