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/client.cabal | 6 ++-- client/src/Component/Button.hs | 2 +- client/src/Component/Input.hs | 2 +- client/src/Component/Pages.hs | 2 +- client/src/Icon.hs | 71 -------------------------------------- client/src/Loadable.hs | 51 +++++++++++++++++++++++++++ client/src/Model/Loadable.hs | 51 --------------------------- client/src/Util/Ajax.hs | 11 +++++- client/src/View/Header.hs | 2 +- client/src/View/Icon.hs | 71 ++++++++++++++++++++++++++++++++++++++ client/src/View/Income/Income.hs | 19 ++++------ client/src/View/Payment/Pages.hs | 2 +- client/src/View/Payment/Payment.hs | 27 +++++---------- client/src/View/Payment/Table.hs | 2 +- 14 files changed, 155 insertions(+), 164 deletions(-) delete mode 100644 client/src/Icon.hs create mode 100644 client/src/Loadable.hs delete mode 100644 client/src/Model/Loadable.hs create mode 100644 client/src/View/Icon.hs diff --git a/client/client.cabal b/client/client.cabal index 9a0d24e..9e0a47e 100644 --- a/client/client.cabal +++ b/client/client.cabal @@ -51,10 +51,9 @@ Executable client Component.Link Component.Modal Component.Pages - Component.Table Component.Select - Icon - Model.Loadable + Component.Table + Loadable Model.Route Util.Ajax Util.Css @@ -67,6 +66,7 @@ Executable client Util.WaitFor View.App View.Header + View.Icon View.Income.Add View.Income.Form View.Income.Header diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs index 46c0afa..b1175d7 100644 --- a/client/src/Component/Button.hs +++ b/client/src/Component/Button.hs @@ -12,7 +12,7 @@ import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import qualified Icon +import qualified View.Icon as Icon data ButtonIn t m = ButtonIn { _buttonIn_class :: Dynamic t Text diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs index 0c84754..9ab4d58 100644 --- a/client/src/Component/Input.hs +++ b/client/src/Component/Input.hs @@ -19,7 +19,7 @@ import qualified Reflex.Dom as R import qualified Common.Util.Validation as ValidationUtil import Component.Button (ButtonIn (..), ButtonOut (..)) import qualified Component.Button as Button -import qualified Icon +import qualified View.Icon as Icon data InputIn a = InputIn { _inputIn_hasResetButton :: Bool diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs index 5611cb7..7843ef6 100644 --- a/client/src/Component/Pages.hs +++ b/client/src/Component/Pages.hs @@ -11,8 +11,8 @@ import qualified Reflex.Dom as R import Component.Button (ButtonIn (..), ButtonOut (..)) import qualified Component.Button as Button -import qualified Icon import qualified Util.Reflex as ReflexUtil +import qualified View.Icon as Icon data PagesIn t = PagesIn { _pagesIn_total :: Dynamic t Int diff --git a/client/src/Icon.hs b/client/src/Icon.hs deleted file mode 100644 index 1a45933..0000000 --- a/client/src/Icon.hs +++ /dev/null @@ -1,71 +0,0 @@ -module Icon - ( clone - , cross - , delete - , edit - , loading - , doubleLeft - , doubleLeftBar - , doubleRight - , doubleRightBar - , signOut - ) where - -import Data.Map (Map) -import qualified Data.Map as M -import Data.Text (Text) -import Reflex.Dom (MonadWidget) -import qualified Reflex.Dom as R - -clone :: forall t m. MonadWidget t m => m () -clone = - svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $ - svgAttr "path" (M.fromList [("d", "M15.143 13.244l.837-2.244 2.698 5.641-5.678 2.502.805-2.23s-8.055-3.538-7.708-10.913c2.715 5.938 9.046 7.244 9.046 7.244zm8.857-7.244v18h-18v-6h-6v-18h18v6h6zm-2 2h-12.112c-.562-.578-1.08-1.243-1.521-2h7.633v-4h-14v14h4v-3.124c.6.961 1.287 1.823 2 2.576v6.548h14v-14z")]) $ R.blank - -cross :: forall t m. MonadWidget t m => m () -cross = - svgAttr "svg" (M.fromList [ ("width", "15"), ("height", "15"), ("viewBox", "0 0 1792 1792") ]) $ - svgAttr "path" (M.fromList [("d", "M1490 1322q0 40-28 68l-136 136q-28 28-68 28t-68-28l-294-294-294 294q-28 28-68 28t-68-28l-136-136q-28-28-28-68t28-68l294-294-294-294q-28-28-28-68t28-68l136-136q28-28 68-28t68 28l294 294 294-294q28-28 68-28t68 28l136 136q28 28 28 68t-28 68l-294 294 294 294q28 28 28 68z")]) $ R.blank - -delete :: forall t m. MonadWidget t m => m () -delete = - svgAttr "svg" (M.fromList [ ("width", "18"), ("height", "18"), ("viewBox", "0 0 1792 1792") ]) $ - svgAttr "path" (M.fromList [("d", "M704 1376v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm256 0v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm256 0v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm-544-992h448l-48-117q-7-9-17-11h-317q-10 2-17 11zm928 32v64q0 14-9 23t-23 9h-96v948q0 83-47 143.5t-113 60.5h-832q-66 0-113-58.5t-47-141.5v-952h-96q-14 0-23-9t-9-23v-64q0-14 9-23t23-9h309l70-167q15-37 54-63t79-26h320q40 0 79 26t54 63l70 167h309q14 0 23 9t9 23z")]) $ R.blank - -doubleLeft :: forall t m. MonadWidget t m => m () -doubleLeft = - svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $ - svgAttr "path" (M.fromList [("d", "M1683 141q19-19 32-13t13 32v1472q0 26-13 32t-32-13l-710-710q-8-9-13-19v710q0 26-13 32t-32-13l-710-710q-19-19-19-45t19-45l710-710q19-19 32-13t13 32v710q5-11 13-19z")]) $ R.blank - -doubleLeftBar :: forall t m. MonadWidget t m => m () -doubleLeftBar = - svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $ - svgAttr "path" (M.fromList [("d", "M1747 141q19-19 32-13t13 32v1472q0 26-13 32t-32-13l-710-710q-9-9-13-19v710q0 26-13 32t-32-13l-710-710q-9-9-13-19v678q0 26-19 45t-45 19h-128q-26 0-45-19t-19-45v-1408q0-26 19-45t45-19h128q26 0 45 19t19 45v678q4-11 13-19l710-710q19-19 32-13t13 32v710q4-11 13-19z")]) $ R.blank - -doubleRight :: forall t m. MonadWidget t m => m () -doubleRight = - svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $ - svgAttr "path" (M.fromList [("d", "M109 1651q-19 19-32 13t-13-32v-1472q0-26 13-32t32 13l710 710q8 8 13 19v-710q0-26 13-32t32 13l710 710q19 19 19 45t-19 45l-710 710q-19 19-32 13t-13-32v-710q-5 10-13 19z")]) $ R.blank - -doubleRightBar :: forall t m. MonadWidget t m => m () -doubleRightBar = - svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $ - svgAttr "path" (M.fromList [("d", "M45 1651q-19 19-32 13t-13-32v-1472q0-26 13-32t32 13l710 710q8 8 13 19v-710q0-26 13-32t32 13l710 710q8 8 13 19v-678q0-26 19-45t45-19h128q26 0 45 19t19 45v1408q0 26-19 45t-45 19h-128q-26 0-45-19t-19-45v-678q-5 10-13 19l-710 710q-19 19-32 13t-13-32v-710q-5 10-13 19z")]) $ R.blank - -edit :: forall t m. MonadWidget t m => m () -edit = - svgAttr "svg" (M.fromList [ ("width", "18"), ("height", "18"), ("viewBox", "0 0 1792 1792") ]) $ - svgAttr "path" (M.fromList [("d", "M491 1536l91-91-235-235-91 91v107h128v128h107zm523-928q0-22-22-22-10 0-17 7l-542 542q-7 7-7 17 0 22 22 22 10 0 17-7l542-542q7-7 7-17zm-54-192l416 416-832 832h-416v-416zm683 96q0 53-37 90l-166 166-416-416 166-165q36-38 90-38 53 0 91 38l235 234q37 39 37 91z")]) $ R.blank - -loading :: forall t m. MonadWidget t m => m () -loading = - svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24"), ("class", "loader"), ("fill", "currentColor") ]) $ - svgAttr "path" (M.fromList [("d", "M13.75 22c0 .966-.783 1.75-1.75 1.75s-1.75-.784-1.75-1.75.783-1.75 1.75-1.75 1.75.784 1.75 1.75zm-1.75-22c-1.104 0-2 .896-2 2s.896 2 2 2 2-.896 2-2-.896-2-2-2zm10 10.75c.689 0 1.249.561 1.249 1.25 0 .69-.56 1.25-1.249 1.25-.69 0-1.249-.559-1.249-1.25 0-.689.559-1.25 1.249-1.25zm-22 1.25c0 1.105.896 2 2 2s2-.895 2-2c0-1.104-.896-2-2-2s-2 .896-2 2zm19-8c.551 0 1 .449 1 1 0 .553-.449 1.002-1 1-.551 0-1-.447-1-.998 0-.553.449-1.002 1-1.002zm0 13.5c.828 0 1.5.672 1.5 1.5s-.672 1.501-1.502 1.5c-.826 0-1.498-.671-1.498-1.499 0-.829.672-1.501 1.5-1.501zm-14-14.5c1.104 0 2 .896 2 2s-.896 2-2.001 2c-1.103 0-1.999-.895-1.999-2s.896-2 2-2zm0 14c1.104 0 2 .896 2 2s-.896 2-2.001 2c-1.103 0-1.999-.895-1.999-2s.896-2 2-2z")]) $ R.blank - -signOut :: forall t m. MonadWidget t m => m () -signOut = - svgAttr "svg" (M.fromList [ ("width", "30"), ("height", "30"), ("viewBox", "0 0 1792 1792") ]) $ - svgAttr "path" (M.fromList [("d", "M1664 896q0 156-61 298t-164 245-245 164-298 61-298-61-245-164-164-245-61-298q0-182 80.5-343t226.5-270q43-32 95.5-25t83.5 50q32 42 24.5 94.5t-49.5 84.5q-98 74-151.5 181t-53.5 228q0 104 40.5 198.5t109.5 163.5 163.5 109.5 198.5 40.5 198.5-40.5 163.5-109.5 109.5-163.5 40.5-198.5q0-121-53.5-228t-151.5-181q-42-32-49.5-84.5t24.5-94.5q31-43 84-50t95 25q146 109 226.5 270t80.5 343zm-640-768v640q0 52-38 90t-90 38-90-38-38-90v-640q0-52 38-90t90-38 90 38 38 90z")]) $ R.blank - -svgAttr :: forall t m a. MonadWidget t m => Text -> Map Text Text -> m a -> m a -svgAttr elementTag attrs child = R.elWith elementTag (R.ElConfig (Just "http://www.w3.org/2000/svg") attrs) child 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 diff --git a/client/src/Model/Loadable.hs b/client/src/Model/Loadable.hs deleted file mode 100644 index 3076b46..0000000 --- a/client/src/Model/Loadable.hs +++ /dev/null @@ -1,51 +0,0 @@ -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 diff --git a/client/src/Util/Ajax.hs b/client/src/Util/Ajax.hs index 9cd5105..47f4f3c 100644 --- a/client/src/Util/Ajax.hs +++ b/client/src/Util/Ajax.hs @@ -1,5 +1,6 @@ module Util.Ajax - ( get + ( getNow + , get , post , put , delete @@ -21,6 +22,14 @@ import Reflex.Dom (Dynamic, Event, IsXhrPayload, XhrResponseHeaders (..)) import qualified Reflex.Dom as R +import Loadable (Loadable) +import qualified Loadable + +getNow :: forall t m a. (MonadWidget t m, FromJSON a) => Text -> m (Dynamic t (Loadable a)) +getNow url = do + postBuild <- R.getPostBuild + get (R.tag (R.constant url) postBuild) >>= Loadable.fromEvent + get :: forall t m a. (MonadWidget t m, FromJSON a) => Event t Text diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index bd69e47..68329eb 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -18,10 +18,10 @@ import qualified Common.Model as CM import qualified Common.Msg as Msg import Component (ButtonIn (..)) import qualified Component as Component -import qualified Icon import Model.Route (Route (..)) import qualified Util.Css as CssUtil import qualified Util.Reflex as ReflexUtil +import qualified View.Icon as Icon data HeaderIn t = HeaderIn { _headerIn_initResult :: InitResult diff --git a/client/src/View/Icon.hs b/client/src/View/Icon.hs new file mode 100644 index 0000000..cc2ef3f --- /dev/null +++ b/client/src/View/Icon.hs @@ -0,0 +1,71 @@ +module View.Icon + ( clone + , cross + , delete + , edit + , loading + , doubleLeft + , doubleLeftBar + , doubleRight + , doubleRightBar + , signOut + ) where + +import Data.Map (Map) +import qualified Data.Map as M +import Data.Text (Text) +import Reflex.Dom (MonadWidget) +import qualified Reflex.Dom as R + +clone :: forall t m. MonadWidget t m => m () +clone = + svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $ + svgAttr "path" (M.fromList [("d", "M15.143 13.244l.837-2.244 2.698 5.641-5.678 2.502.805-2.23s-8.055-3.538-7.708-10.913c2.715 5.938 9.046 7.244 9.046 7.244zm8.857-7.244v18h-18v-6h-6v-18h18v6h6zm-2 2h-12.112c-.562-.578-1.08-1.243-1.521-2h7.633v-4h-14v14h4v-3.124c.6.961 1.287 1.823 2 2.576v6.548h14v-14z")]) $ R.blank + +cross :: forall t m. MonadWidget t m => m () +cross = + svgAttr "svg" (M.fromList [ ("width", "15"), ("height", "15"), ("viewBox", "0 0 1792 1792") ]) $ + svgAttr "path" (M.fromList [("d", "M1490 1322q0 40-28 68l-136 136q-28 28-68 28t-68-28l-294-294-294 294q-28 28-68 28t-68-28l-136-136q-28-28-28-68t28-68l294-294-294-294q-28-28-28-68t28-68l136-136q28-28 68-28t68 28l294 294 294-294q28-28 68-28t68 28l136 136q28 28 28 68t-28 68l-294 294 294 294q28 28 28 68z")]) $ R.blank + +delete :: forall t m. MonadWidget t m => m () +delete = + svgAttr "svg" (M.fromList [ ("width", "18"), ("height", "18"), ("viewBox", "0 0 1792 1792") ]) $ + svgAttr "path" (M.fromList [("d", "M704 1376v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm256 0v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm256 0v-704q0-14-9-23t-23-9h-64q-14 0-23 9t-9 23v704q0 14 9 23t23 9h64q14 0 23-9t9-23zm-544-992h448l-48-117q-7-9-17-11h-317q-10 2-17 11zm928 32v64q0 14-9 23t-23 9h-96v948q0 83-47 143.5t-113 60.5h-832q-66 0-113-58.5t-47-141.5v-952h-96q-14 0-23-9t-9-23v-64q0-14 9-23t23-9h309l70-167q15-37 54-63t79-26h320q40 0 79 26t54 63l70 167h309q14 0 23 9t9 23z")]) $ R.blank + +doubleLeft :: forall t m. MonadWidget t m => m () +doubleLeft = + svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $ + svgAttr "path" (M.fromList [("d", "M1683 141q19-19 32-13t13 32v1472q0 26-13 32t-32-13l-710-710q-8-9-13-19v710q0 26-13 32t-32-13l-710-710q-19-19-19-45t19-45l710-710q19-19 32-13t13 32v710q5-11 13-19z")]) $ R.blank + +doubleLeftBar :: forall t m. MonadWidget t m => m () +doubleLeftBar = + svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $ + svgAttr "path" (M.fromList [("d", "M1747 141q19-19 32-13t13 32v1472q0 26-13 32t-32-13l-710-710q-9-9-13-19v710q0 26-13 32t-32-13l-710-710q-9-9-13-19v678q0 26-19 45t-45 19h-128q-26 0-45-19t-19-45v-1408q0-26 19-45t45-19h128q26 0 45 19t19 45v678q4-11 13-19l710-710q19-19 32-13t13 32v710q4-11 13-19z")]) $ R.blank + +doubleRight :: forall t m. MonadWidget t m => m () +doubleRight = + svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $ + svgAttr "path" (M.fromList [("d", "M109 1651q-19 19-32 13t-13-32v-1472q0-26 13-32t32 13l710 710q8 8 13 19v-710q0-26 13-32t32 13l710 710q19 19 19 45t-19 45l-710 710q-19 19-32 13t-13-32v-710q-5 10-13 19z")]) $ R.blank + +doubleRightBar :: forall t m. MonadWidget t m => m () +doubleRightBar = + svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $ + svgAttr "path" (M.fromList [("d", "M45 1651q-19 19-32 13t-13-32v-1472q0-26 13-32t32 13l710 710q8 8 13 19v-710q0-26 13-32t32 13l710 710q8 8 13 19v-678q0-26 19-45t45-19h128q26 0 45 19t19 45v1408q0 26-19 45t-45 19h-128q-26 0-45-19t-19-45v-678q-5 10-13 19l-710 710q-19 19-32 13t-13-32v-710q-5 10-13 19z")]) $ R.blank + +edit :: forall t m. MonadWidget t m => m () +edit = + svgAttr "svg" (M.fromList [ ("width", "18"), ("height", "18"), ("viewBox", "0 0 1792 1792") ]) $ + svgAttr "path" (M.fromList [("d", "M491 1536l91-91-235-235-91 91v107h128v128h107zm523-928q0-22-22-22-10 0-17 7l-542 542q-7 7-7 17 0 22 22 22 10 0 17-7l542-542q7-7 7-17zm-54-192l416 416-832 832h-416v-416zm683 96q0 53-37 90l-166 166-416-416 166-165q36-38 90-38 53 0 91 38l235 234q37 39 37 91z")]) $ R.blank + +loading :: forall t m. MonadWidget t m => m () +loading = + svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24"), ("class", "loader"), ("fill", "currentColor") ]) $ + svgAttr "path" (M.fromList [("d", "M13.75 22c0 .966-.783 1.75-1.75 1.75s-1.75-.784-1.75-1.75.783-1.75 1.75-1.75 1.75.784 1.75 1.75zm-1.75-22c-1.104 0-2 .896-2 2s.896 2 2 2 2-.896 2-2-.896-2-2-2zm10 10.75c.689 0 1.249.561 1.249 1.25 0 .69-.56 1.25-1.249 1.25-.69 0-1.249-.559-1.249-1.25 0-.689.559-1.25 1.249-1.25zm-22 1.25c0 1.105.896 2 2 2s2-.895 2-2c0-1.104-.896-2-2-2s-2 .896-2 2zm19-8c.551 0 1 .449 1 1 0 .553-.449 1.002-1 1-.551 0-1-.447-1-.998 0-.553.449-1.002 1-1.002zm0 13.5c.828 0 1.5.672 1.5 1.5s-.672 1.501-1.502 1.5c-.826 0-1.498-.671-1.498-1.499 0-.829.672-1.501 1.5-1.501zm-14-14.5c1.104 0 2 .896 2 2s-.896 2-2.001 2c-1.103 0-1.999-.895-1.999-2s.896-2 2-2zm0 14c1.104 0 2 .896 2 2s-.896 2-2.001 2c-1.103 0-1.999-.895-1.999-2s.896-2 2-2z")]) $ R.blank + +signOut :: forall t m. MonadWidget t m => m () +signOut = + svgAttr "svg" (M.fromList [ ("width", "30"), ("height", "30"), ("viewBox", "0 0 1792 1792") ]) $ + svgAttr "path" (M.fromList [("d", "M1664 896q0 156-61 298t-164 245-245 164-298 61-298-61-245-164-164-245-61-298q0-182 80.5-343t226.5-270q43-32 95.5-25t83.5 50q32 42 24.5 94.5t-49.5 84.5q-98 74-151.5 181t-53.5 228q0 104 40.5 198.5t109.5 163.5 163.5 109.5 198.5 40.5 198.5-40.5 163.5-109.5 109.5-163.5 40.5-198.5q0-121-53.5-228t-151.5-181q-42-32-49.5-84.5t24.5-94.5q31-43 84-50t95 25q146 109 226.5 270t80.5 343zm-640-768v640q0 52-38 90t-90 38-90-38-38-90v-640q0-52 38-90t90-38 90 38 38 90z")]) $ R.blank + +svgAttr :: forall t m a. MonadWidget t m => Text -> Map Text Text -> m a -> m a +svgAttr elementTag attrs child = R.elWith elementTag (R.ElConfig (Just "http://www.w3.org/2000/svg") attrs) child diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index 91682a0..18ebe7c 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -4,14 +4,15 @@ module View.Income.Income , IncomeIn(..) ) where +import Data.Aeson (FromJSON) import Prelude hiding (init) import Reflex.Dom (Dynamic, MonadWidget) import qualified Reflex.Dom as R import Common.Model (Currency) -import Model.Loadable (Loadable (..)) -import qualified Model.Loadable as Loadable +import Loadable (Loadable (..)) +import qualified Loadable import qualified Util.Ajax as AjaxUtil import View.Income.Header (HeaderIn (..), HeaderOut (..)) import qualified View.Income.Header as Header @@ -26,17 +27,9 @@ data IncomeIn t = IncomeIn init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init)) init = do - postBuild <- R.getPostBuild - - usersEvent <- AjaxUtil.get (R.tag (R.constant "api/users") postBuild) - users <- Loadable.fromEvent usersEvent - - incomesEvent <- AjaxUtil.get (R.tag (R.constant "api/incomes") postBuild) - incomes <- Loadable.fromEvent incomesEvent - - paymentsEvent <- AjaxUtil.get (R.tag (R.constant "api/payments") postBuild) - payments <- Loadable.fromEvent paymentsEvent - + users <- AjaxUtil.getNow "api/users" + incomes <- AjaxUtil.getNow "api/incomes" + payments <- AjaxUtil.getNow "api/payments" return $ do us <- users is <- incomes diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs index 9247143..5681935 100644 --- a/client/src/View/Payment/Pages.hs +++ b/client/src/View/Payment/Pages.hs @@ -11,8 +11,8 @@ import qualified Reflex.Dom as R import Component (ButtonIn (..), ButtonOut (..)) import qualified Component as Component -import qualified Icon import qualified Util.Reflex as ReflexUtil +import qualified View.Icon as Icon data PagesIn t = PagesIn { _pagesIn_total :: Dynamic t Int diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs index ec350e2..5f0d03c 100644 --- a/client/src/View/Payment/Payment.hs +++ b/client/src/View/Payment/Payment.hs @@ -17,8 +17,8 @@ import Common.Model (Currency, Frequency, Income (..), UserId) import qualified Common.Util.Text as T -import Model.Loadable (Loadable (..)) -import qualified Model.Loadable as Loadable +import Loadable (Loadable (..)) +import qualified Loadable import qualified Util.Ajax as AjaxUtil import View.Payment.Header (HeaderIn (..), HeaderOut (..)) import qualified View.Payment.Header as Header @@ -30,23 +30,11 @@ import qualified View.Payment.Table as Table init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init)) init = do - postBuild <- R.getPostBuild - - incomesEvent <- AjaxUtil.get (R.tag (R.constant "api/incomes") postBuild) - incomes <- Loadable.fromEvent incomesEvent - - usersEvent <- AjaxUtil.get (R.tag (R.constant "api/users") postBuild) - users <- Loadable.fromEvent usersEvent - - paymentsEvent <- AjaxUtil.get (R.tag (R.constant "api/payments") postBuild) - payments <- Loadable.fromEvent paymentsEvent - - paymentCategoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/paymentCategories") postBuild) - paymentCategories <- Loadable.fromEvent paymentCategoriesEvent - - categoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/categories") postBuild) - categories <- Loadable.fromEvent categoriesEvent - + users <- AjaxUtil.getNow "api/users" + payments <- AjaxUtil.getNow "api/payments" + incomes <- AjaxUtil.getNow "api/incomes" + categories <- AjaxUtil.getNow "api/categories" + paymentCategories <- AjaxUtil.getNow "api/paymentCategories" return $ do us <- users ps <- payments @@ -55,6 +43,7 @@ init = do pcs <- paymentCategories return $ Init <$> us <*> ps <*> is <*> cs <*> pcs + data PaymentIn t = PaymentIn { _paymentIn_currentUser :: UserId , _paymentIn_currency :: Currency diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs index 5ffa037..3a0a4bf 100644 --- a/client/src/View/Payment/Table.hs +++ b/client/src/View/Payment/Table.hs @@ -28,8 +28,8 @@ import qualified View.Payment.Delete as Delete import qualified View.Payment.Edit as Edit import View.Payment.Init (Init (..)) -import qualified Icon import qualified Util.Reflex as ReflexUtil +import qualified View.Icon as Icon data TableIn t = TableIn { _tableIn_init :: Init -- cgit v1.2.3