From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 8 Nov 2017 23:47:26 +0100 Subject: Use a better project structure --- client/src/View/Header.hs | 86 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 86 insertions(+) create mode 100644 client/src/View/Header.hs (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs new file mode 100644 index 0000000..705e054 --- /dev/null +++ b/client/src/View/Header.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecursiveDo #-} + +module View.Header + ( view + , HeaderIn(..) + , HeaderOut(..) + ) where + +import qualified Data.Map as M +import Data.Time (NominalDiffTime) +import Reflex.Dom (MonadWidget, Event) +import qualified Reflex.Dom as R +import Prelude hiding (init, error) + +import qualified Common.Message as Message +import qualified Common.Message.Key as Key +import Common.Model (InitResult(..), Init(..), User(..)) +import qualified Common.Model as CM + +import Component.Button (ButtonIn(..)) +import qualified Component.Button as Component +import qualified Icon + +data HeaderIn = HeaderIn + { _headerIn_initResult :: InitResult + } + +data HeaderOut t = HeaderOut + { _headerOut_signOut :: Event t () + } + +view :: forall t m. MonadWidget t m => HeaderIn -> m (HeaderOut t) +view headerIn = + R.el "header" $ do + + R.divClass "title" $ + R.text $ Message.get Key.App_Title + + signOut <- nameSignOut $ _headerIn_initResult headerIn + + return $ HeaderOut + { _headerOut_signOut = signOut + } + +nameSignOut :: forall t m. MonadWidget t m => InitResult -> m (Event t ()) +nameSignOut initResult = case initResult of + (InitSuccess init) -> do + rec + attr <- R.holdDyn + (M.singleton "class" "nameSignOut") + (fmap (const $ M.fromList [("style", "visibility: hidden"), ("class", "nameSignOut")]) signOut) + + signOut <- R.elDynAttr "nameSignOut" attr $ do + case CM.findUser (_init_currentUser init) (_init_users init) of + Just user -> R.divClass "name" $ R.text (_user_name user) + Nothing -> R.blank + signOutButton + + return signOut + _ -> + return R.never + +signOutButton :: forall t m. MonadWidget t m => m (Event t ()) +signOutButton = do + rec + signOut <- Component.button $ ButtonIn + { Component._buttonIn_class = "signOut item" + , Component._buttonIn_content = Icon.signOut + , Component._buttonIn_waiting = waiting + } + let signOutClic = Component._buttonOut_clic signOut + waiting = R.leftmost + [ fmap (const True) signOutClic + , fmap (const False) signOutSuccess + ] + signOutSuccess <- askSignOut signOutClic >>= R.debounce (0.5 :: NominalDiffTime) + + return . fmap (const ()) . R.ffilter (== True) $ signOutSuccess + + where askSignOut :: forall t m. MonadWidget t m => Event t () -> m (Event t Bool) + askSignOut signOut = + fmap getResult <$> R.performRequestAsync xhrRequest + where xhrRequest = fmap (const $ R.postJson "/signOut" ()) signOut + getResult = (== 200) . R._xhrResponse_status -- cgit v1.2.3 From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 13 Nov 2017 23:56:40 +0100 Subject: Setup stylish-haskell --- client/src/View/Header.hs | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 705e054..711ba80 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecursiveDo #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecursiveDo #-} module View.Header ( view @@ -8,19 +7,19 @@ module View.Header , HeaderOut(..) ) where -import qualified Data.Map as M -import Data.Time (NominalDiffTime) -import Reflex.Dom (MonadWidget, Event) -import qualified Reflex.Dom as R -import Prelude hiding (init, error) +import qualified Data.Map as M +import Data.Time (NominalDiffTime) +import Prelude hiding (error, init) +import Reflex.Dom (Event, MonadWidget) +import qualified Reflex.Dom as R -import qualified Common.Message as Message +import qualified Common.Message as Message import qualified Common.Message.Key as Key -import Common.Model (InitResult(..), Init(..), User(..)) -import qualified Common.Model as CM +import Common.Model (Init (..), InitResult (..), User (..)) +import qualified Common.Model as CM -import Component.Button (ButtonIn(..)) -import qualified Component.Button as Component +import Component.Button (ButtonIn (..)) +import qualified Component.Button as Component import qualified Icon data HeaderIn = HeaderIn @@ -55,7 +54,7 @@ nameSignOut initResult = case initResult of signOut <- R.elDynAttr "nameSignOut" attr $ do case CM.findUser (_init_currentUser init) (_init_users init) of Just user -> R.divClass "name" $ R.text (_user_name user) - Nothing -> R.blank + Nothing -> R.blank signOutButton return signOut -- cgit v1.2.3 From 42e94a45e26f40edc3ad71b1e77a4bf47c13fd3d Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 15 Nov 2017 23:50:44 +0100 Subject: Add dynamic pages --- client/src/View/Header.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 711ba80..7afd9bd 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -65,7 +65,7 @@ signOutButton :: forall t m. MonadWidget t m => m (Event t ()) signOutButton = do rec signOut <- Component.button $ ButtonIn - { Component._buttonIn_class = "signOut item" + { Component._buttonIn_class = R.constDyn "signOut item" , Component._buttonIn_content = Icon.signOut , Component._buttonIn_waiting = waiting } -- cgit v1.2.3 From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 00:20:25 +0100 Subject: Show payment count and partition - Also fixes exceedingPayer in back by using only punctual payments --- client/src/View/Header.hs | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 7afd9bd..4c74383 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -1,25 +1,21 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecursiveDo #-} - module View.Header ( view , HeaderIn(..) , HeaderOut(..) ) where -import qualified Data.Map as M -import Data.Time (NominalDiffTime) -import Prelude hiding (error, init) -import Reflex.Dom (Event, MonadWidget) -import qualified Reflex.Dom as R +import qualified Data.Map as M +import Data.Time (NominalDiffTime) +import Prelude hiding (error, init) +import Reflex.Dom (Event, MonadWidget) +import qualified Reflex.Dom as R -import qualified Common.Message as Message -import qualified Common.Message.Key as Key -import Common.Model (Init (..), InitResult (..), User (..)) -import qualified Common.Model as CM +import Common.Model (Init (..), InitResult (..), User (..)) +import qualified Common.Model as CM +import qualified Common.Msg as Msg -import Component.Button (ButtonIn (..)) -import qualified Component.Button as Component +import Component.Button (ButtonIn (..)) +import qualified Component.Button as Component import qualified Icon data HeaderIn = HeaderIn @@ -35,7 +31,7 @@ view headerIn = R.el "header" $ do R.divClass "title" $ - R.text $ Message.get Key.App_Title + R.text $ Msg.get Msg.App_Title signOut <- nameSignOut $ _headerIn_initResult headerIn -- cgit v1.2.3 From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- client/src/View/Header.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 4c74383..8f1fb78 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -13,9 +13,8 @@ import qualified Reflex.Dom as R import Common.Model (Init (..), InitResult (..), User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg - +import qualified Component as Component import Component.Button (ButtonIn (..)) -import qualified Component.Button as Component import qualified Icon data HeaderIn = HeaderIn @@ -60,11 +59,11 @@ nameSignOut initResult = case initResult of signOutButton :: forall t m. MonadWidget t m => m (Event t ()) signOutButton = do rec - signOut <- Component.button $ ButtonIn - { Component._buttonIn_class = R.constDyn "signOut item" - , Component._buttonIn_content = Icon.signOut - , Component._buttonIn_waiting = waiting - } + signOut <- Component.button $ + (Component.defaultButtonIn Icon.signOut) + { _buttonIn_class = R.constDyn "signOut item" + , _buttonIn_waiting = waiting + } let signOutClic = Component._buttonOut_clic signOut waiting = R.leftmost [ fmap (const True) signOutClic -- cgit v1.2.3 From 52331eeadce8d250564851c25fc965172640bc55 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 12 Oct 2019 11:23:10 +0200 Subject: Implement client routing --- client/src/View/Header.hs | 65 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 49 insertions(+), 16 deletions(-) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 8f1fb78..9a4de89 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -4,40 +4,73 @@ module View.Header , HeaderOut(..) ) where -import qualified Data.Map as M -import Data.Time (NominalDiffTime) -import Prelude hiding (error, init) -import Reflex.Dom (Event, MonadWidget) -import qualified Reflex.Dom as R - -import Common.Model (Init (..), InitResult (..), User (..)) -import qualified Common.Model as CM -import qualified Common.Msg as Msg -import qualified Component as Component -import Component.Button (ButtonIn (..)) +import Data.Map (Map) +import qualified Data.Map as M +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (NominalDiffTime) +import Prelude hiding (error, init) +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R + +import Common.Model (Init (..), InitResult (..), User (..)) +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 -data HeaderIn = HeaderIn - { _headerIn_initResult :: InitResult +data HeaderIn t = HeaderIn + { _headerIn_initResult :: InitResult + , _headerIn_isInitSuccess :: Bool + , _headerIn_route :: Dynamic t Route } data HeaderOut t = HeaderOut { _headerOut_signOut :: Event t () } -view :: forall t m. MonadWidget t m => HeaderIn -> m (HeaderOut t) +view :: forall t m. MonadWidget t m => (HeaderIn t) -> m (HeaderOut t) view headerIn = R.el "header" $ do R.divClass "title" $ R.text $ Msg.get Msg.App_Title - signOut <- nameSignOut $ _headerIn_initResult headerIn + signOut <- R.el "div" $ do + rec + showLinks <- R.foldDyn const (_headerIn_isInitSuccess headerIn) (False <$ signOut) + ReflexUtil.visibleIfDyn showLinks R.blank (links $ _headerIn_route headerIn) + signOut <- nameSignOut $ _headerIn_initResult headerIn + return signOut return $ HeaderOut { _headerOut_signOut = signOut } +links :: forall t m. MonadWidget t m => Dynamic t Route -> m () +links route = do + Component.link + "/" + (R.ffor route (attrs RootRoute)) + (Msg.get Msg.Payment_Title) + + Component.link + "/income" + (R.ffor route (attrs IncomeRoute)) + (Msg.get Msg.Income_Title) + + where + attrs linkRoute currentRoute = + M.singleton "class" $ + CssUtil.classes + [ ("item", True) + , ("current", linkRoute == currentRoute) + ] + nameSignOut :: forall t m. MonadWidget t m => InitResult -> m (Event t ()) nameSignOut initResult = case initResult of (InitSuccess init) -> do @@ -76,5 +109,5 @@ signOutButton = do where askSignOut :: forall t m. MonadWidget t m => Event t () -> m (Event t Bool) askSignOut signOut = fmap getResult <$> R.performRequestAsync xhrRequest - where xhrRequest = fmap (const $ R.postJson "/signOut" ()) signOut + where xhrRequest = fmap (const $ R.postJson "/api/signOut" ()) signOut getResult = (== 200) . R._xhrResponse_status -- cgit v1.2.3 From 602c52acfcfa494b07fec05c20b317b60ea8a6f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 21:31:57 +0200 Subject: Load init data per page with AJAX --- client/src/View/Header.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 9a4de89..bd69e47 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -73,7 +73,7 @@ links route = do nameSignOut :: forall t m. MonadWidget t m => InitResult -> m (Event t ()) nameSignOut initResult = case initResult of - (InitSuccess init) -> do + InitSuccess init -> do rec attr <- R.holdDyn (M.singleton "class" "nameSignOut") -- cgit v1.2.3 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/View/Header.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'client/src/View/Header.hs') 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 -- cgit v1.2.3 From 613ffccac4b3ab25c6d4c631fab757da0b35acf6 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 22 Oct 2019 22:26:38 +0200 Subject: Harmonize view component code style --- client/src/View/Header.hs | 82 +++++++++++++++++++++++------------------------ 1 file changed, 41 insertions(+), 41 deletions(-) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 68329eb..3f58dd5 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -1,40 +1,40 @@ module View.Header ( view - , HeaderIn(..) - , HeaderOut(..) + , In(..) + , Out(..) ) where -import Data.Map (Map) -import qualified Data.Map as M -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time (NominalDiffTime) -import Prelude hiding (error, init) -import Reflex.Dom (Dynamic, Event, MonadWidget) -import qualified Reflex.Dom as R - -import Common.Model (Init (..), InitResult (..), User (..)) -import qualified Common.Model as CM -import qualified Common.Msg as Msg -import Component (ButtonIn (..)) -import qualified Component as Component -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 - , _headerIn_isInitSuccess :: Bool - , _headerIn_route :: Dynamic t Route +import Data.Map (Map) +import qualified Data.Map as M +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (NominalDiffTime) +import Prelude hiding (error, init) +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R + +import Common.Model (Init (..), InitResult (..), User (..)) +import qualified Common.Model as CM +import qualified Common.Msg as Msg +import qualified Component.Button as Button +import qualified Component.Link as Link +import Model.Route (Route (..)) +import qualified Util.Css as CssUtil +import qualified Util.Reflex as ReflexUtil +import qualified View.Icon as Icon + +data In t = In + { _in_initResult :: InitResult + , _in_isInitSuccess :: Bool + , _in_route :: Dynamic t Route } -data HeaderOut t = HeaderOut - { _headerOut_signOut :: Event t () +data Out t = Out + { _out_signOut :: Event t () } -view :: forall t m. MonadWidget t m => (HeaderIn t) -> m (HeaderOut t) -view headerIn = +view :: forall t m. MonadWidget t m => (In t) -> m (Out t) +view input = R.el "header" $ do R.divClass "title" $ @@ -42,23 +42,23 @@ view headerIn = signOut <- R.el "div" $ do rec - showLinks <- R.foldDyn const (_headerIn_isInitSuccess headerIn) (False <$ signOut) - ReflexUtil.visibleIfDyn showLinks R.blank (links $ _headerIn_route headerIn) - signOut <- nameSignOut $ _headerIn_initResult headerIn + showLinks <- R.foldDyn const (_in_isInitSuccess input) (False <$ signOut) + ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input) + signOut <- nameSignOut $ _in_initResult input return signOut - return $ HeaderOut - { _headerOut_signOut = signOut + return $ Out + { _out_signOut = signOut } links :: forall t m. MonadWidget t m => Dynamic t Route -> m () links route = do - Component.link + Link.view "/" (R.ffor route (attrs RootRoute)) (Msg.get Msg.Payment_Title) - Component.link + Link.view "/income" (R.ffor route (attrs IncomeRoute)) (Msg.get Msg.Income_Title) @@ -92,12 +92,12 @@ nameSignOut initResult = case initResult of signOutButton :: forall t m. MonadWidget t m => m (Event t ()) signOutButton = do rec - signOut <- Component.button $ - (Component.defaultButtonIn Icon.signOut) - { _buttonIn_class = R.constDyn "signOut item" - , _buttonIn_waiting = waiting + signOut <- Button.view $ + (Button.defaultIn Icon.signOut) + { Button._in_class = R.constDyn "signOut item" + , Button._in_waiting = waiting } - let signOutClic = Component._buttonOut_clic signOut + let signOutClic = Button._out_clic signOut waiting = R.leftmost [ fmap (const True) signOutClic , fmap (const False) signOutSuccess -- cgit v1.2.3 From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 8 Dec 2019 11:39:37 +0100 Subject: Add category page --- client/src/View/Header.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 3f58dd5..5910f52 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -63,6 +63,11 @@ links route = do (R.ffor route (attrs IncomeRoute)) (Msg.get Msg.Income_Title) + Link.view + "/category" + (R.ffor route (attrs CategoryRoute)) + (Msg.get Msg.Category_Title) + where attrs linkRoute currentRoute = M.singleton "class" $ -- cgit v1.2.3 From af8353c6164aaaaa836bfed181f883ac86bb76a5 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Jan 2020 14:03:31 +0100 Subject: Sign in with email and password --- client/src/View/Header.hs | 52 +++++++++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 26 deletions(-) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 5910f52..f91c408 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -6,6 +6,7 @@ module View.Header import Data.Map (Map) import qualified Data.Map as M +import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T import Data.Time (NominalDiffTime) @@ -13,7 +14,7 @@ import Prelude hiding (error, init) import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Init (..), InitResult (..), User (..)) +import Common.Model (Init (..), User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Component.Button as Button @@ -24,9 +25,8 @@ import qualified Util.Reflex as ReflexUtil import qualified View.Icon as Icon data In t = In - { _in_initResult :: InitResult - , _in_isInitSuccess :: Bool - , _in_route :: Dynamic t Route + { _in_init :: Dynamic t (Maybe Init) + , _in_route :: Dynamic t Route } data Out t = Out @@ -40,12 +40,11 @@ view input = R.divClass "title" $ R.text $ Msg.get Msg.App_Title + let showLinks = Maybe.isJust <$> _in_init input + signOut <- R.el "div" $ do - rec - showLinks <- R.foldDyn const (_in_isInitSuccess input) (False <$ signOut) - ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input) - signOut <- nameSignOut $ _in_initResult input - return signOut + ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input) + (R.dyn $ nameSignOut <$> _in_init input) >>= ReflexUtil.flatten return $ Out { _out_signOut = signOut @@ -76,23 +75,24 @@ links route = do , ("current", linkRoute == currentRoute) ] -nameSignOut :: forall t m. MonadWidget t m => InitResult -> m (Event t ()) -nameSignOut initResult = case initResult of - InitSuccess init -> do - rec - attr <- R.holdDyn - (M.singleton "class" "nameSignOut") - (fmap (const $ M.fromList [("style", "visibility: hidden"), ("class", "nameSignOut")]) signOut) - - signOut <- R.elDynAttr "nameSignOut" attr $ do - case CM.findUser (_init_currentUser init) (_init_users init) of - Just user -> R.divClass "name" $ R.text (_user_name user) - Nothing -> R.blank - signOutButton - - return signOut - _ -> - return R.never +nameSignOut :: forall t m. MonadWidget t m => Maybe Init -> m (Event t ()) +nameSignOut init = + case init of + Just init -> do + rec + attr <- R.holdDyn + (M.singleton "class" "nameSignOut") + (fmap (const $ M.fromList [("style", "visibility: hidden"), ("class", "nameSignOut")]) signOut) + + signOut <- R.elDynAttr "nameSignOut" attr $ do + case CM.findUser (_init_currentUser init) (_init_users init) of + Just user -> R.divClass "name" $ R.text (_user_name user) + Nothing -> R.blank + signOutButton + + return signOut + _ -> + return R.never signOutButton :: forall t m. MonadWidget t m => m (Event t ()) signOutButton = do -- cgit v1.2.3 From 47c2a4d6b68c54eed5f7b45671b1ccaf8c0db200 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 20 Jan 2020 19:47:23 +0100 Subject: Show payment stats --- client/src/View/Header.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'client/src/View/Header.hs') diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index f91c408..ff9f40a 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -67,6 +67,11 @@ links route = do (R.ffor route (attrs CategoryRoute)) (Msg.get Msg.Category_Title) + Link.view + "/statistics" + (R.ffor route (attrs StatisticsRoute)) + (Msg.get Msg.Statistics_Title) + where attrs linkRoute currentRoute = M.singleton "class" $ -- cgit v1.2.3