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/Component/Button.hs | 53 ++++++++++++++++++++++++++++++++++++++++++
 client/src/Component/Input.hs  | 34 +++++++++++++++++++++++++++
 2 files changed, 87 insertions(+)
 create mode 100644 client/src/Component/Button.hs
 create mode 100644 client/src/Component/Input.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
new file mode 100644
index 0000000..f21798c
--- /dev/null
+++ b/client/src/Component/Button.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings         #-}
+
+module Component.Button
+  ( ButtonIn(..)
+  , buttonInDefault
+  , ButtonOut(..)
+  , button
+  ) where
+
+import qualified Data.Map as M
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Reflex.Dom (MonadWidget, Event)
+import qualified Reflex.Dom as R
+
+import qualified Icon
+
+data ButtonIn t m = ButtonIn
+  { _buttonIn_class :: Text
+  , _buttonIn_content :: m ()
+  , _buttonIn_waiting :: Event t Bool
+  }
+
+buttonInDefault :: forall t m. MonadWidget t m => ButtonIn t m
+buttonInDefault = ButtonIn
+  { _buttonIn_class = ""
+  , _buttonIn_content = R.blank
+  , _buttonIn_waiting = R.never
+  }
+
+data ButtonOut t = ButtonOut
+  { _buttonOut_clic :: Event t ()
+  }
+
+button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t)
+button buttonIn = do
+  attr <- R.holdDyn
+    (M.fromList [("type", "button"), ("class", _buttonIn_class buttonIn)])
+    (fmap
+      (\w -> M.fromList $
+        [ ("type", "button") ]
+        <> if w
+             then [("class", T.concat [ _buttonIn_class buttonIn, " waiting" ])]
+             else [("class", _buttonIn_class buttonIn)])
+      (_buttonIn_waiting buttonIn))
+  (e, _) <- R.elDynAttr' "button" attr $ do
+    Icon.loading
+    R.divClass "content" $ _buttonIn_content buttonIn
+  return $ ButtonOut
+    { _buttonOut_clic = R.domEvent R.Click e
+    }
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
new file mode 100644
index 0000000..7111630
--- /dev/null
+++ b/client/src/Component/Input.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings         #-}
+
+module Component.Input
+  ( InputIn(..)
+  , InputOut(..)
+  , input
+  ) where
+
+import Data.Text (Text)
+import Reflex.Dom (MonadWidget, Dynamic, Event, (&), (.~), (=:))
+import qualified Reflex.Dom as R
+
+data InputIn t a b = InputIn
+  { _inputIn_reset :: Event t a
+  , _inputIn_placeHolder :: Text
+  }
+
+data InputOut t = InputOut
+  { _inputOut_value :: Dynamic t Text
+  , _inputOut_enter :: Event t ()
+  }
+
+input :: forall t m a b. MonadWidget t m => InputIn t a b -> m (InputOut t)
+input inputIn = do
+  let placeHolder = R.constDyn ("placeHolder" =: _inputIn_placeHolder inputIn)
+  let value = fmap (const "") (_inputIn_reset inputIn)
+  textInput <- R.textInput $ R.def & R.attributes .~ placeHolder
+                                   & R.setValue .~ value
+  let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
+  return $ InputOut
+    { _inputOut_value = R._textInput_value textInput
+    , _inputOut_enter = enter
+    }
-- 
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/Component/Button.hs | 17 ++++++++---------
 client/src/Component/Input.hs  |  9 ++++-----
 2 files changed, 12 insertions(+), 14 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index f21798c..9499045 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Component.Button
   ( ButtonIn(..)
@@ -8,17 +7,17 @@ module Component.Button
   , button
   ) where
 
-import qualified Data.Map as M
-import Data.Monoid ((<>))
-import Data.Text (Text)
-import qualified Data.Text as T
-import Reflex.Dom (MonadWidget, Event)
-import qualified Reflex.Dom as R
+import qualified Data.Map    as M
+import           Data.Monoid ((<>))
+import           Data.Text   (Text)
+import qualified Data.Text   as T
+import           Reflex.Dom  (Event, MonadWidget)
+import qualified Reflex.Dom  as R
 
 import qualified Icon
 
 data ButtonIn t m = ButtonIn
-  { _buttonIn_class :: Text
+  { _buttonIn_class   :: Text
   , _buttonIn_content :: m ()
   , _buttonIn_waiting :: Event t Bool
   }
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 7111630..c3864b4 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Component.Input
   ( InputIn(..)
@@ -7,12 +6,12 @@ module Component.Input
   , input
   ) where
 
-import Data.Text (Text)
-import Reflex.Dom (MonadWidget, Dynamic, Event, (&), (.~), (=:))
+import           Data.Text  (Text)
+import           Reflex.Dom (Dynamic, Event, MonadWidget, (&), (.~), (=:))
 import qualified Reflex.Dom as R
 
 data InputIn t a b = InputIn
-  { _inputIn_reset :: Event t a
+  { _inputIn_reset       :: Event t a
   , _inputIn_placeHolder :: Text
   }
 
-- 
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/Component/Button.hs | 40 +++++++++++++++++++++++-----------------
 1 file changed, 23 insertions(+), 17 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index 9499045..c31cdc6 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -7,24 +7,23 @@ module Component.Button
   , button
   ) where
 
-import qualified Data.Map    as M
-import           Data.Monoid ((<>))
-import           Data.Text   (Text)
-import qualified Data.Text   as T
-import           Reflex.Dom  (Event, MonadWidget)
-import qualified Reflex.Dom  as R
+import qualified Data.Map   as M
+import           Data.Text  (Text)
+import qualified Data.Text  as T
+import           Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
 
 import qualified Icon
 
 data ButtonIn t m = ButtonIn
-  { _buttonIn_class   :: Text
+  { _buttonIn_class   :: Dynamic t Text
   , _buttonIn_content :: m ()
   , _buttonIn_waiting :: Event t Bool
   }
 
 buttonInDefault :: forall t m. MonadWidget t m => ButtonIn t m
 buttonInDefault = ButtonIn
-  { _buttonIn_class = ""
+  { _buttonIn_class = R.constDyn ""
   , _buttonIn_content = R.blank
   , _buttonIn_waiting = R.never
   }
@@ -35,18 +34,25 @@ data ButtonOut t = ButtonOut
 
 button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t)
 button buttonIn = do
-  attr <- R.holdDyn
-    (M.fromList [("type", "button"), ("class", _buttonIn_class buttonIn)])
-    (fmap
-      (\w -> M.fromList $
-        [ ("type", "button") ]
-        <> if w
-             then [("class", T.concat [ _buttonIn_class buttonIn, " waiting" ])]
-             else [("class", _buttonIn_class buttonIn)])
-      (_buttonIn_waiting buttonIn))
+  dynWaiting <- R.holdDyn False $ _buttonIn_waiting buttonIn
+
+  let attr = do
+        buttonClass <- _buttonIn_class buttonIn
+        waiting <- dynWaiting
+        return $ if waiting
+          then M.fromList [("type", "button"), ("class", T.intercalate " " [ buttonClass, "waiting" ])]
+          else M.fromList [("type", "button"), ("class", buttonClass)]
+
   (e, _) <- R.elDynAttr' "button" attr $ do
     Icon.loading
     R.divClass "content" $ _buttonIn_content buttonIn
+
   return $ ButtonOut
     { _buttonOut_clic = R.domEvent R.Click e
     }
+
+-- mergeAttr :: Map Text Text -> Map Text Text -> Map Text Text
+-- mergeAttr = M.unionWithKey $ \k a b ->
+--   if k == "class"
+--     then T.intercalate " " [ a, b ]
+--     else b
-- 
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/Component/Button.hs | 2 --
 client/src/Component/Input.hs  | 2 --
 2 files changed, 4 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index c31cdc6..09c93cd 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module Component.Button
   ( ButtonIn(..)
   , buttonInDefault
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index c3864b4..1923463 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module Component.Input
   ( InputIn(..)
   , InputOut(..)
-- 
cgit v1.2.3


From bab2c30addf8aaed85675e2b7f7b15c97c426f74 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 19 Nov 2017 15:00:07 +0100
Subject: Add exceeding payer block

---
 client/src/Component/Button.hs | 6 ------
 1 file changed, 6 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index 09c93cd..754b903 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -48,9 +48,3 @@ button buttonIn = do
   return $ ButtonOut
     { _buttonOut_clic = R.domEvent R.Click e
     }
-
--- mergeAttr :: Map Text Text -> Map Text Text -> Map Text Text
--- mergeAttr = M.unionWithKey $ \k a b ->
---   if k == "class"
---     then T.intercalate " " [ a, b ]
---     else b
-- 
cgit v1.2.3


From 49426740e8e0c59040f4f3721a658f225572582b Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 28 Nov 2017 09:11:19 +0100
Subject: Add search for payments

---
 client/src/Component/Input.hs | 57 +++++++++++++++++++++++++++++++------------
 1 file changed, 42 insertions(+), 15 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 1923463..7eec7d0 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -4,13 +4,19 @@ module Component.Input
   , input
   ) where
 
-import           Data.Text  (Text)
-import           Reflex.Dom (Dynamic, Event, MonadWidget, (&), (.~), (=:))
-import qualified Reflex.Dom as R
+import qualified Data.Map         as M
+import           Data.Text        (Text)
+import qualified Data.Text        as T
+import           Reflex.Dom       (Dynamic, Event, MonadWidget, (&), (.~))
+import qualified Reflex.Dom       as R
+
+import           Component.Button (ButtonIn (..), ButtonOut (..))
+import qualified Component.Button as Button
+import qualified Icon
 
 data InputIn t a b = InputIn
-  { _inputIn_reset       :: Event t a
-  , _inputIn_placeHolder :: Text
+  { _inputIn_reset :: Event t a
+  , _inputIn_label :: Text
   }
 
 data InputOut t = InputOut
@@ -19,13 +25,34 @@ data InputOut t = InputOut
   }
 
 input :: forall t m a b. MonadWidget t m => InputIn t a b -> m (InputOut t)
-input inputIn = do
-  let placeHolder = R.constDyn ("placeHolder" =: _inputIn_placeHolder inputIn)
-  let value = fmap (const "") (_inputIn_reset inputIn)
-  textInput <- R.textInput $ R.def & R.attributes .~ placeHolder
-                                   & R.setValue .~ value
-  let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
-  return $ InputOut
-    { _inputOut_value = R._textInput_value textInput
-    , _inputOut_enter = enter
-    }
+input inputIn =
+  R.divClass "textInput" $ do
+    rec
+      let resetValue = R.leftmost
+            [ fmap (const "") (_inputIn_reset inputIn)
+            , fmap (const "") (_buttonOut_clic reset)
+            ]
+
+          attributes = R.ffor value (\v ->
+            if T.null v then M.empty else M.singleton "class" "filled")
+
+          value =  R._textInput_value textInput
+
+      textInput <- R.textInput $ R.def
+        & R.attributes .~ attributes
+        & R.setValue .~ resetValue
+
+      R.el "label" $ R.text (_inputIn_label inputIn)
+
+      reset <- Button.button $ ButtonIn
+        { _buttonIn_class   = R.constDyn ""
+        , _buttonIn_content = Icon.cross
+        , _buttonIn_waiting = R.never
+        }
+
+    let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
+
+    return $ InputOut
+      { _inputOut_value = value
+      , _inputOut_enter = enter
+      }
-- 
cgit v1.2.3


From a4acc2e84158fa822f88a1d0bdddb470708b5809 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 3 Jan 2018 17:31:20 +0100
Subject: Modify weelky report and payment search interface

- Add payment balance in weekly report
- Show a message and hide pages when the search results in no results
- Go to page 1 when the search is updated / erased
---
 client/src/Component/Input.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 7eec7d0..24aac22 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -45,7 +45,7 @@ input inputIn =
       R.el "label" $ R.text (_inputIn_label inputIn)
 
       reset <- Button.button $ ButtonIn
-        { _buttonIn_class   = R.constDyn ""
+        { _buttonIn_class   = R.constDyn "reset"
         , _buttonIn_content = Icon.cross
         , _buttonIn_waiting = R.never
         }
-- 
cgit v1.2.3


From ab17b6339d16970c3845ec4f153bfeed89eae728 Mon Sep 17 00:00:00 2001
From: Joris
Date: Fri, 5 Jan 2018 14:45:47 +0100
Subject: Add modal component

---
 client/src/Component/Button.hs |  4 ++--
 client/src/Component/Modal.hs  | 38 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 2 deletions(-)
 create mode 100644 client/src/Component/Modal.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index 754b903..3ee9561 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -1,8 +1,8 @@
 module Component.Button
   ( ButtonIn(..)
-  , buttonInDefault
   , ButtonOut(..)
   , button
+  , buttonInDefault
   ) where
 
 import qualified Data.Map   as M
@@ -19,7 +19,7 @@ data ButtonIn t m = ButtonIn
   , _buttonIn_waiting :: Event t Bool
   }
 
-buttonInDefault :: forall t m. MonadWidget t m => ButtonIn t m
+buttonInDefault :: forall t m. (MonadWidget t m) => ButtonIn t m
 buttonInDefault = ButtonIn
   { _buttonIn_class = R.constDyn ""
   , _buttonIn_content = R.blank
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
new file mode 100644
index 0000000..bfb5e02
--- /dev/null
+++ b/client/src/Component/Modal.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Component.Modal
+  ( ModalIn(..)
+  , ModalOut(..)
+  , modal
+  ) where
+
+import qualified Data.Map   as M
+import           Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+data ModalIn t m = ModalIn
+  { _modalIn_show    :: Event t ()
+  , _modalIn_content :: m ()
+  }
+
+data ModalOut = ModalOut {}
+
+modal :: forall t m. MonadWidget t m => ModalIn t m -> m ModalOut
+modal modalIn = do
+  rec
+    showModal <- R.holdDyn False $ R.leftmost
+      [ True <$ _modalIn_show modalIn
+      , False <$ curtainClick
+      ]
+
+    let attr = flip fmap showModal (\s -> M.fromList $
+          [ ("style", if s then "display:block" else "display:none")
+          , ("class", "modal")
+          ])
+
+    curtainClick <- R.elDynAttr "div" attr $ do
+      (curtain, _) <- R.elAttr' "div" (M.singleton "class" "curtain") $ R.blank
+      R.divClass "content" $ _modalIn_content modalIn
+      return $ R.domEvent R.Click curtain
+
+  return $ ModalOut {}
-- 
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/Component/Button.hs | 41 +++++++++++++++++++++++++++++------------
 client/src/Component/Form.hs   | 12 ++++++++++++
 client/src/Component/Input.hs  | 27 +++++++++++++++++++--------
 client/src/Component/Modal.hs  | 24 +++++++++++++++---------
 client/src/Component/Select.hs | 32 ++++++++++++++++++++++++++++++++
 5 files changed, 107 insertions(+), 29 deletions(-)
 create mode 100644 client/src/Component/Form.hs
 create mode 100644 client/src/Component/Select.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index 3ee9561..bf604f1 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -2,10 +2,11 @@ module Component.Button
   ( ButtonIn(..)
   , ButtonOut(..)
   , button
-  , buttonInDefault
+  , defaultButtonIn
   ) where
 
 import qualified Data.Map   as M
+import           Data.Maybe (catMaybes)
 import           Data.Text  (Text)
 import qualified Data.Text  as T
 import           Reflex.Dom (Dynamic, Event, MonadWidget)
@@ -14,22 +15,36 @@ import qualified Reflex.Dom as R
 import qualified Icon
 
 data ButtonIn t m = ButtonIn
-  { _buttonIn_class   :: Dynamic t Text
-  , _buttonIn_content :: m ()
-  , _buttonIn_waiting :: Event t Bool
+  { _buttonIn_class    :: Dynamic t Text
+  , _buttonIn_content  :: m ()
+  , _buttonIn_waiting  :: Event t Bool
+  , _buttonIn_tabIndex :: Maybe Int
+  , _buttonIn_submit   :: Bool
   }
 
-buttonInDefault :: forall t m. (MonadWidget t m) => ButtonIn t m
-buttonInDefault = ButtonIn
-  { _buttonIn_class = R.constDyn ""
-  , _buttonIn_content = R.blank
-  , _buttonIn_waiting = R.never
+defaultButtonIn :: MonadWidget t m => m () -> ButtonIn t m
+defaultButtonIn content = ButtonIn
+  { _buttonIn_class    = R.constDyn ""
+  , _buttonIn_content  = content
+  , _buttonIn_waiting  = R.never
+  , _buttonIn_tabIndex = Nothing
+  , _buttonIn_submit   = False
   }
 
+-- defaultButtonIn :: MonadWidget t m => ButtonIn t m
+-- defaultButtonIn = ButtonIn
+--   { _buttonIn_class    = R.constDyn ""
+--   , _buttonIn_content  = R.blank
+--   , _buttonIn_waiting  = R.never
+--   , _buttonIn_tabIndex = Nothing
+--   , _buttonIn_submit   = False
+--   }
+
 data ButtonOut t = ButtonOut
   { _buttonOut_clic :: Event t ()
   }
 
+
 button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t)
 button buttonIn = do
   dynWaiting <- R.holdDyn False $ _buttonIn_waiting buttonIn
@@ -37,9 +52,11 @@ button buttonIn = do
   let attr = do
         buttonClass <- _buttonIn_class buttonIn
         waiting <- dynWaiting
-        return $ if waiting
-          then M.fromList [("type", "button"), ("class", T.intercalate " " [ buttonClass, "waiting" ])]
-          else M.fromList [("type", "button"), ("class", buttonClass)]
+        return . M.fromList . catMaybes $
+          [ Just ("type", if _buttonIn_submit buttonIn then "submit" else "button")
+          , (\i -> ("tabindex", T.pack . show $ i)) <$> _buttonIn_tabIndex buttonIn
+          , Just ("class", T.intercalate " " [ buttonClass, if waiting then "waiting" else "" ])
+          ]
 
   (e, _) <- R.elDynAttr' "button" attr $ do
     Icon.loading
diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs
new file mode 100644
index 0000000..0a89c6e
--- /dev/null
+++ b/client/src/Component/Form.hs
@@ -0,0 +1,12 @@
+module Component.Form
+  ( form
+  ) where
+
+import qualified Data.Map   as M
+import           Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+form :: forall t m a. (MonadWidget t m) => m a -> m a
+form content =
+  R.elAttr "form" (M.singleton "onsubmit" "event.preventDefault()") $
+    content
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 24aac22..92f8ec9 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -2,12 +2,14 @@ module Component.Input
   ( InputIn(..)
   , InputOut(..)
   , input
+  , defaultInputIn
   ) where
 
 import qualified Data.Map         as M
 import           Data.Text        (Text)
 import qualified Data.Text        as T
-import           Reflex.Dom       (Dynamic, Event, MonadWidget, (&), (.~))
+import           Reflex.Dom       (Dynamic, Event, MonadWidget, Reflex, (&),
+                                   (.~))
 import qualified Reflex.Dom       as R
 
 import           Component.Button (ButtonIn (..), ButtonOut (..))
@@ -15,8 +17,16 @@ import qualified Component.Button as Button
 import qualified Icon
 
 data InputIn t a b = InputIn
-  { _inputIn_reset :: Event t a
-  , _inputIn_label :: Text
+  { _inputIn_reset        :: Event t a
+  , _inputIn_label        :: Text
+  , _inputIn_initialValue :: Text
+  }
+
+defaultInputIn :: (Reflex t) => InputIn t a b
+defaultInputIn = InputIn
+  { _inputIn_reset        = R.never
+  , _inputIn_label        = ""
+  , _inputIn_initialValue = ""
   }
 
 data InputOut t = InputOut
@@ -41,14 +51,15 @@ input inputIn =
       textInput <- R.textInput $ R.def
         & R.attributes .~ attributes
         & R.setValue .~ resetValue
+        & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn)
 
       R.el "label" $ R.text (_inputIn_label inputIn)
 
-      reset <- Button.button $ ButtonIn
-        { _buttonIn_class   = R.constDyn "reset"
-        , _buttonIn_content = Icon.cross
-        , _buttonIn_waiting = R.never
-        }
+      reset <- Button.button $
+        (Button.defaultButtonIn Icon.cross)
+          { _buttonIn_class   = R.constDyn "reset"
+          , _buttonIn_tabIndex = Just (-1)
+          }
 
     let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
 
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index bfb5e02..1d70c90 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -10,18 +10,22 @@ import qualified Data.Map   as M
 import           Reflex.Dom (Event, MonadWidget)
 import qualified Reflex.Dom as R
 
-data ModalIn t m = ModalIn
+data ModalIn t m a = ModalIn
   { _modalIn_show    :: Event t ()
-  , _modalIn_content :: m ()
+  , _modalIn_hide    :: Event t ()
+  , _modalIn_content :: m a
   }
 
-data ModalOut = ModalOut {}
+data ModalOut a = ModalOut
+  { _modalOut_content :: a
+  }
 
-modal :: forall t m. MonadWidget t m => ModalIn t m -> m ModalOut
+modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut a)
 modal modalIn = do
   rec
     showModal <- R.holdDyn False $ R.leftmost
       [ True <$ _modalIn_show modalIn
+      , False <$ _modalIn_hide modalIn
       , False <$ curtainClick
       ]
 
@@ -30,9 +34,11 @@ modal modalIn = do
           , ("class", "modal")
           ])
 
-    curtainClick <- R.elDynAttr "div" attr $ do
-      (curtain, _) <- R.elAttr' "div" (M.singleton "class" "curtain") $ R.blank
-      R.divClass "content" $ _modalIn_content modalIn
-      return $ R.domEvent R.Click curtain
+    (curtainClick, content) <- R.elDynAttr "div" attr $ do
+      (curtain, _) <- R.elAttr' "div" (M.singleton "class" "modalCurtain") $ R.blank
+      cont <- R.divClass "modalContent" $ _modalIn_content modalIn
+      return (R.domEvent R.Click curtain, cont)
 
-  return $ ModalOut {}
+  return $ ModalOut
+    { _modalOut_content = content
+    }
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
new file mode 100644
index 0000000..876548e
--- /dev/null
+++ b/client/src/Component/Select.hs
@@ -0,0 +1,32 @@
+module Component.Select
+  ( SelectIn(..)
+  , SelectOut(..)
+  , select
+  ) where
+
+import           Data.Map   (Map)
+import           Data.Text  (Text)
+import           Reflex.Dom (Dynamic, MonadWidget, Reflex)
+import qualified Reflex.Dom as R
+
+data (Reflex t) => SelectIn t a = SelectIn
+  { _selectIn_label        :: Text
+  , _selectIn_initialValue :: a
+  , _selectIn_values       :: Dynamic t (Map a Text)
+  }
+
+data SelectOut t a = SelectOut
+  { _selectOut_value :: Dynamic t a
+  }
+
+select :: forall t m a. (Ord a) => MonadWidget t m => SelectIn t a -> m (SelectOut t a)
+select selectIn =
+  R.divClass "selectInput" $ do
+    R.el "label" $ R.text (_selectIn_label selectIn)
+
+    value <- R._dropdown_value <$>
+      R.dropdown (_selectIn_initialValue selectIn) (_selectIn_values selectIn) R.def
+
+    return SelectOut
+      { _selectOut_value = value
+      }
-- 
cgit v1.2.3


From df83b634006c699cfa1e921bf74ce951a906a62f Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Jun 2018 22:02:00 +0200
Subject: Use date input type

---
 client/src/Component/Button.hs | 10 ----------
 client/src/Component/Input.hs  | 38 +++++++++++++++++++++++++-------------
 2 files changed, 25 insertions(+), 23 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index bf604f1..46c0afa 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -31,20 +31,10 @@ defaultButtonIn content = ButtonIn
   , _buttonIn_submit   = False
   }
 
--- defaultButtonIn :: MonadWidget t m => ButtonIn t m
--- defaultButtonIn = ButtonIn
---   { _buttonIn_class    = R.constDyn ""
---   , _buttonIn_content  = R.blank
---   , _buttonIn_waiting  = R.never
---   , _buttonIn_tabIndex = Nothing
---   , _buttonIn_submit   = False
---   }
-
 data ButtonOut t = ButtonOut
   { _buttonOut_clic :: Event t ()
   }
 
-
 button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t)
 button buttonIn = do
   dynWaiting <- R.holdDyn False $ _buttonIn_waiting buttonIn
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 92f8ec9..c1eb4e8 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -17,16 +17,20 @@ import qualified Component.Button as Button
 import qualified Icon
 
 data InputIn t a b = InputIn
-  { _inputIn_reset        :: Event t a
-  , _inputIn_label        :: Text
-  , _inputIn_initialValue :: Text
+  { _inputIn_reset          :: Event t a
+  , _inputIn_hasResetButton :: Bool
+  , _inputIn_label          :: Text
+  , _inputIn_initialValue   :: Text
+  , _inputIn_inputType      :: Text
   }
 
 defaultInputIn :: (Reflex t) => InputIn t a b
 defaultInputIn = InputIn
-  { _inputIn_reset        = R.never
-  , _inputIn_label        = ""
-  , _inputIn_initialValue = ""
+  { _inputIn_reset          = R.never
+  , _inputIn_hasResetButton = True
+  , _inputIn_label          = ""
+  , _inputIn_initialValue   = ""
+  , _inputIn_inputType      = "text"
   }
 
 data InputOut t = InputOut
@@ -40,11 +44,13 @@ input inputIn =
     rec
       let resetValue = R.leftmost
             [ fmap (const "") (_inputIn_reset inputIn)
-            , fmap (const "") (_buttonOut_clic reset)
+            , fmap (const "") resetClic
             ]
 
           attributes = R.ffor value (\v ->
-            if T.null v then M.empty else M.singleton "class" "filled")
+            if T.null v && _inputIn_inputType inputIn /= "date"
+              then M.empty
+              else M.singleton "class" "filled")
 
           value =  R._textInput_value textInput
 
@@ -52,14 +58,20 @@ input inputIn =
         & R.attributes .~ attributes
         & R.setValue .~ resetValue
         & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn)
+        & R.textInputConfig_inputType .~ (_inputIn_inputType inputIn)
 
       R.el "label" $ R.text (_inputIn_label inputIn)
 
-      reset <- Button.button $
-        (Button.defaultButtonIn Icon.cross)
-          { _buttonIn_class   = R.constDyn "reset"
-          , _buttonIn_tabIndex = Just (-1)
-          }
+      resetClic <-
+        if _inputIn_hasResetButton inputIn
+          then
+            _buttonOut_clic <$> (Button.button $
+              (Button.defaultButtonIn Icon.cross)
+                { _buttonIn_class   = R.constDyn "reset"
+                , _buttonIn_tabIndex = Just (-1)
+                })
+          else
+            return R.never
 
     let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
 
-- 
cgit v1.2.3


From 40b4994797a797b1fa86cafda789a5c488730c6d Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 28 Oct 2018 17:57:58 +0100
Subject: Delete payment

---
 client/src/Component/Form.hs   |  2 +-
 client/src/Component/Modal.hs  | 33 ++++++++++++++++++++++-----------
 client/src/Component/Select.hs |  2 +-
 3 files changed, 24 insertions(+), 13 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs
index 0a89c6e..6ea02fa 100644
--- a/client/src/Component/Form.hs
+++ b/client/src/Component/Form.hs
@@ -6,7 +6,7 @@ import qualified Data.Map   as M
 import           Reflex.Dom (MonadWidget)
 import qualified Reflex.Dom as R
 
-form :: forall t m a. (MonadWidget t m) => m a -> m a
+form :: forall t m a. MonadWidget t m => m a -> m a
 form content =
   R.elAttr "form" (M.singleton "onsubmit" "event.preventDefault()") $
     content
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index 1d70c90..72091c9 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -1,14 +1,19 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
 module Component.Modal
   ( ModalIn(..)
   , ModalOut(..)
   , modal
   ) where
 
-import qualified Data.Map   as M
-import           Reflex.Dom (Event, MonadWidget)
-import qualified Reflex.Dom as R
+import           Control.Monad    (void)
+import qualified Data.Map         as M
+import qualified Data.Map.Lazy    as LM
+import           Data.Text        (Text)
+import qualified GHCJS.DOM.Node   as Node
+import           Reflex.Dom       (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom       as R
+import qualified Reflex.Dom.Class as R
+
+import qualified Util.Dom         as Dom
 
 data ModalIn t m a = ModalIn
   { _modalIn_show    :: Event t ()
@@ -29,16 +34,22 @@ modal modalIn = do
       , False <$ curtainClick
       ]
 
-    let attr = flip fmap showModal (\s -> M.fromList $
-          [ ("style", if s then "display:block" else "display:none")
-          , ("class", "modal")
-          ])
-
-    (curtainClick, content) <- R.elDynAttr "div" attr $ do
+    (elem, (curtainClick, content)) <- R.buildElement "div" (getAttributes <$> showModal) $ do
       (curtain, _) <- R.elAttr' "div" (M.singleton "class" "modalCurtain") $ R.blank
       cont <- R.divClass "modalContent" $ _modalIn_content modalIn
       return (R.domEvent R.Click curtain, cont)
 
+  body <- Dom.getBody
+  let moveBackdrop = (const $ (Node.appendChild body elem)) `fmap` (_modalIn_show modalIn)
+  R.performEvent_ $ void `fmap` moveBackdrop
+
   return $ ModalOut
     { _modalOut_content = content
     }
+
+getAttributes :: Bool -> LM.Map Text Text
+getAttributes show =
+  M.fromList $
+    [ ("style", if show then "display:block" else "display:none")
+    , ("class", "modal")
+    ]
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 876548e..17a4958 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -19,7 +19,7 @@ data SelectOut t a = SelectOut
   { _selectOut_value :: Dynamic t a
   }
 
-select :: forall t m a. (Ord a) => MonadWidget t m => SelectIn t a -> m (SelectOut t a)
+select :: forall t m a. (Ord a, MonadWidget t m) => SelectIn t a -> m (SelectOut t a)
 select selectIn =
   R.divClass "selectInput" $ do
     R.el "label" $ R.text (_selectIn_label selectIn)
-- 
cgit v1.2.3


From 50fb8fa48d1c4881da20b4ecf6d68a772301e713 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 30 Oct 2018 18:04:58 +0100
Subject: Update table when adding or removing a payment

---
 client/src/Component/Input.hs  | 20 +++++++------
 client/src/Component/Modal.hs  | 66 ++++++++++++++++++++++++++++--------------
 client/src/Component/Select.hs | 10 +++++--
 3 files changed, 64 insertions(+), 32 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index c1eb4e8..57018a6 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -16,18 +16,16 @@ import           Component.Button (ButtonIn (..), ButtonOut (..))
 import qualified Component.Button as Button
 import qualified Icon
 
-data InputIn t a b = InputIn
-  { _inputIn_reset          :: Event t a
-  , _inputIn_hasResetButton :: Bool
+data InputIn = InputIn
+  { _inputIn_hasResetButton :: Bool
   , _inputIn_label          :: Text
   , _inputIn_initialValue   :: Text
   , _inputIn_inputType      :: Text
   }
 
-defaultInputIn :: (Reflex t) => InputIn t a b
+defaultInputIn :: InputIn
 defaultInputIn = InputIn
-  { _inputIn_reset          = R.never
-  , _inputIn_hasResetButton = True
+  { _inputIn_hasResetButton = True
   , _inputIn_label          = ""
   , _inputIn_initialValue   = ""
   , _inputIn_inputType      = "text"
@@ -38,12 +36,16 @@ data InputOut t = InputOut
   , _inputOut_enter :: Event t ()
   }
 
-input :: forall t m a b. MonadWidget t m => InputIn t a b -> m (InputOut t)
-input inputIn =
+input
+  :: forall t m a b. MonadWidget t m
+  => InputIn
+  -> Event t a -- reset
+  -> m (InputOut t)
+input inputIn reset =
   R.divClass "textInput" $ do
     rec
       let resetValue = R.leftmost
-            [ fmap (const "") (_inputIn_reset inputIn)
+            [ fmap (const "") reset
             , fmap (const "") resetClic
             ]
 
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index 72091c9..b86fee0 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -4,16 +4,18 @@ module Component.Modal
   , modal
   ) where
 
-import           Control.Monad    (void)
-import qualified Data.Map         as M
-import qualified Data.Map.Lazy    as LM
-import           Data.Text        (Text)
-import qualified GHCJS.DOM.Node   as Node
-import           Reflex.Dom       (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom       as R
-import qualified Reflex.Dom.Class as R
+import           Control.Monad     (void)
+import qualified Data.Map          as M
+import qualified Data.Map.Lazy     as LM
+import           Data.Text         (Text)
+import qualified GHCJS.DOM.Element as Element
+import qualified GHCJS.DOM.Node    as Node
+import           JSDOM.Types       (JSString)
+import           Reflex.Dom        (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom        as R
+import qualified Reflex.Dom.Class  as R
 
-import qualified Util.Dom         as Dom
+import qualified Util.Dom          as Dom
 
 data ModalIn t m a = ModalIn
   { _modalIn_show    :: Event t ()
@@ -28,20 +30,21 @@ data ModalOut a = ModalOut
 modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut a)
 modal modalIn = do
   rec
-    showModal <- R.holdDyn False $ R.leftmost
-      [ True <$ _modalIn_show modalIn
-      , False <$ _modalIn_hide modalIn
-      , False <$ curtainClick
-      ]
+    let showEvent = R.leftmost
+          [ True <$ _modalIn_show modalIn
+          , False <$ _modalIn_hide modalIn
+          , False <$ curtainClick
+          ]
 
-    (elem, (curtainClick, content)) <- R.buildElement "div" (getAttributes <$> showModal) $ do
-      (curtain, _) <- R.elAttr' "div" (M.singleton "class" "modalCurtain") $ R.blank
-      cont <- R.divClass "modalContent" $ _modalIn_content modalIn
-      return (R.domEvent R.Click curtain, cont)
+    showModal <- R.holdDyn False showEvent
 
-  body <- Dom.getBody
-  let moveBackdrop = (const $ (Node.appendChild body elem)) `fmap` (_modalIn_show modalIn)
-  R.performEvent_ $ void `fmap` moveBackdrop
+    (elem, (curtainClick, content)) <-
+      R.buildElement "div" (getAttributes <$> showModal) $ do
+        (curtain, _) <- R.elAttr' "div" (M.singleton "class" "modalCurtain") $ R.blank
+        cont <- R.divClass "modalContent" $ _modalIn_content modalIn
+        return (R.domEvent R.Click curtain, cont)
+
+  performShowEffects showEvent elem
 
   return $ ModalOut
     { _modalOut_content = content
@@ -53,3 +56,24 @@ getAttributes show =
     [ ("style", if show then "display:block" else "display:none")
     , ("class", "modal")
     ]
+
+performShowEffects
+  :: forall t m a. MonadWidget t m
+  => Event t Bool
+  -> Element.Element
+  -> m ()
+performShowEffects showEvent elem = do
+  body <- Dom.getBody
+
+  let showEffects =
+        flip fmap showEvent (\show -> do
+          if show
+            then
+              do
+                Node.appendChild body elem
+                Element.setClassName body ("modal" :: JSString)
+            else
+              Element.setClassName body ("" :: JSString)
+        )
+
+  R.performEvent_ $ void `fmap` showEffects
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 17a4958..7cb6726 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -6,13 +6,14 @@ module Component.Select
 
 import           Data.Map   (Map)
 import           Data.Text  (Text)
-import           Reflex.Dom (Dynamic, MonadWidget, Reflex)
+import           Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom as R
 
 data (Reflex t) => SelectIn t a = SelectIn
   { _selectIn_label        :: Text
   , _selectIn_initialValue :: a
   , _selectIn_values       :: Dynamic t (Map a Text)
+  , _selectIn_reset        :: Event t ()
   }
 
 data SelectOut t a = SelectOut
@@ -24,8 +25,13 @@ select selectIn =
   R.divClass "selectInput" $ do
     R.el "label" $ R.text (_selectIn_label selectIn)
 
+    let initialValue = _selectIn_initialValue selectIn
+
     value <- R._dropdown_value <$>
-      R.dropdown (_selectIn_initialValue selectIn) (_selectIn_values selectIn) R.def
+      R.dropdown
+        initialValue
+        (_selectIn_values selectIn)
+        (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) })
 
     return SelectOut
       { _selectOut_value = value
-- 
cgit v1.2.3


From 2741f47ef7b87255203bc2f7f7b2b9140c70b8f0 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 1 Nov 2018 13:14:25 +0100
Subject: Implementing client side validation

---
 client/src/Component/Input.hs  | 114 ++++++++++++++++++++++++++++-------------
 client/src/Component/Modal.hs  |  19 ++++---
 client/src/Component/Select.hs |  61 ++++++++++++++++------
 3 files changed, 135 insertions(+), 59 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 57018a6..67f97c0 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -5,59 +5,91 @@ module Component.Input
   , defaultInputIn
   ) where
 
-import qualified Data.Map         as M
-import           Data.Text        (Text)
-import qualified Data.Text        as T
-import           Reflex.Dom       (Dynamic, Event, MonadWidget, Reflex, (&),
-                                   (.~))
-import qualified Reflex.Dom       as R
-
-import           Component.Button (ButtonIn (..), ButtonOut (..))
-import qualified Component.Button as Button
+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)
+import           Data.Validation        (Validation (Failure, Success))
+import qualified Data.Validation        as V
+import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex,
+                                         (&), (.~))
+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
 
-data InputIn = InputIn
+data InputIn a = InputIn
   { _inputIn_hasResetButton :: Bool
   , _inputIn_label          :: Text
   , _inputIn_initialValue   :: Text
   , _inputIn_inputType      :: Text
+  , _inputIn_validation     :: Text -> Validation Text a
   }
 
-defaultInputIn :: InputIn
+defaultInputIn :: InputIn Text
 defaultInputIn = InputIn
   { _inputIn_hasResetButton = True
   , _inputIn_label          = ""
   , _inputIn_initialValue   = ""
   , _inputIn_inputType      = "text"
+  , _inputIn_validation     = V.Success
   }
 
-data InputOut t = InputOut
-  { _inputOut_value :: Dynamic t Text
+data InputOut t a = InputOut
+  { _inputOut_raw   :: Dynamic t Text
+  , _inputOut_value :: Dynamic t (Maybe (Validation Text a))
   , _inputOut_enter :: Event t ()
   }
 
 input
   :: forall t m a b. MonadWidget t m
-  => InputIn
-  -> Event t a -- reset
-  -> m (InputOut t)
-input inputIn reset =
-  R.divClass "textInput" $ do
-    rec
-      let resetValue = R.leftmost
-            [ fmap (const "") reset
-            , fmap (const "") resetClic
-            ]
-
-          attributes = R.ffor value (\v ->
-            if T.null v && _inputIn_inputType inputIn /= "date"
-              then M.empty
-              else M.singleton "class" "filled")
-
-          value =  R._textInput_value textInput
+  => InputIn a
+  -> Event t Text -- reset
+  -> Event t b    -- validate
+  -> m (InputOut t a)
+input inputIn reset validate = do
+  rec
+    let resetValue = R.leftmost
+          [ R.traceEvent "reset" reset
+          , fmap (const "") resetClic
+          ]
+
+        inputAttr = R.ffor value (\v ->
+          if T.null v && _inputIn_inputType inputIn /= "date"
+            then M.empty
+            else M.singleton "class" "filled")
+
+        value =  R._textInput_value textInput
+
+        containerAttr = R.ffor validatedValue (\v ->
+          M.singleton "class" $ T.intercalate " "
+            [ "textInput"
+            , if Maybe.fromMaybe False (ValidationUtil.isFailure <$> v) then "error" else ""
+            ])
+
+    -- Clear validation errors after reset
+    delayedReset <- R.delay (0.1 :: NominalDiffTime) reset
+
+    validatedValue <- R.holdDyn Nothing $ R.attachWith
+      (\v (clearValidation, validateEmpty) ->
+        if clearValidation
+           then Nothing
+           else Just (_inputIn_validation inputIn $ (if validateEmpty then "" else v)))
+      (R.current value)
+      (R.leftmost
+        [ const (False, True) <$> resetClic
+        , (\f -> (f, False)) <$> (R.updated . R._textInput_hasFocus $ textInput)
+        , const (False, False) <$> validate
+        , const (True, False) <$> R.traceEvent "delayedReset" delayedReset
+        ])
+
+    (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
 
       textInput <- R.textInput $ R.def
-        & R.attributes .~ attributes
+        & R.attributes .~ inputAttr
         & R.setValue .~ resetValue
         & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn)
         & R.textInputConfig_inputType .~ (_inputIn_inputType inputIn)
@@ -75,9 +107,19 @@ input inputIn reset =
           else
             return R.never
 
-    let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
+      R.divClass "errorMessage" $
+        R.dynText . fmap validationError $ validatedValue
+
+      return (textInput, resetClic)
+
+  let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
+
+  return $ InputOut
+    { _inputOut_raw = value
+    , _inputOut_value = validatedValue
+    , _inputOut_enter = enter
+    }
 
-    return $ InputOut
-      { _inputOut_value = value
-      , _inputOut_enter = enter
-      }
+validationError :: Maybe (Validation Text a) -> Text
+validationError (Just (Failure e)) = e
+validationError _                  = ""
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index b86fee0..d7943a9 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -23,11 +23,12 @@ data ModalIn t m a = ModalIn
   , _modalIn_content :: m a
   }
 
-data ModalOut a = ModalOut
+data ModalOut t a = ModalOut
   { _modalOut_content :: a
+  , _modalOut_hide    :: Event t ()
   }
 
-modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut a)
+modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut t a)
 modal modalIn = do
   rec
     let showEvent = R.leftmost
@@ -48,6 +49,7 @@ modal modalIn = do
 
   return $ ModalOut
     { _modalOut_content = content
+    , _modalOut_hide = curtainClick
     }
 
 getAttributes :: Bool -> LM.Map Text Text
@@ -67,12 +69,13 @@ performShowEffects showEvent elem = do
 
   let showEffects =
         flip fmap showEvent (\show -> do
-          if show
-            then
-              do
-                Node.appendChild body elem
-                Element.setClassName body ("modal" :: JSString)
-            else
+          if show then
+            do
+              Node.appendChild body elem
+              Element.setClassName body ("modal" :: JSString)
+          else
+            do
+              Node.removeChild body elem
               Element.setClassName body ("" :: JSString)
         )
 
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 7cb6726..9f671d3 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -5,34 +5,65 @@ module Component.Select
   ) where
 
 import           Data.Map   (Map)
+import qualified Data.Map   as M
 import           Data.Text  (Text)
+import qualified Data.Text  as T
 import           Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom as R
 
-data (Reflex t) => SelectIn t a = SelectIn
+import qualified Common.Msg as Msg
+
+data (Reflex t) => SelectIn t a b c = SelectIn
   { _selectIn_label        :: Text
   , _selectIn_initialValue :: a
   , _selectIn_values       :: Dynamic t (Map a Text)
-  , _selectIn_reset        :: Event t ()
+  , _selectIn_reset        :: Event t b
+  , _selectIn_isValid      :: a -> Bool
+  , _selectIn_validate     :: Event t c
   }
 
 data SelectOut t a = SelectOut
   { _selectOut_value :: Dynamic t a
   }
 
-select :: forall t m a. (Ord a, MonadWidget t m) => SelectIn t a -> m (SelectOut t a)
-select selectIn =
-  R.divClass "selectInput" $ do
-    R.el "label" $ R.text (_selectIn_label selectIn)
+select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a)
+select selectIn = do
+  rec
+    let containerAttr = R.ffor hasError (\e ->
+          M.singleton "class" $ T.intercalate " "
+            [ "selectInput"
+            , if e then "error" else ""
+            ])
+
+    hasError <- R.holdDyn False $ R.attachWith
+      (\v clearError -> not clearError && not (_selectIn_isValid selectIn v))
+      (R.current value)
+      (R.leftmost
+        [ const False <$> _selectIn_validate selectIn
+        , const True <$> _selectIn_reset selectIn
+        ])
+
+    value <- R.elDynAttr "div" containerAttr $ do
+      R.el "label" $ R.text (_selectIn_label selectIn)
+
+      let initialValue = _selectIn_initialValue selectIn
+
+      value <- R._dropdown_value <$>
+        R.dropdown
+          initialValue
+          (_selectIn_values selectIn)
+          (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) })
+
+      errorMessage <- R.holdDyn "" $ R.attachWith
+        (\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!")
+        (R.current value)
+        (_selectIn_validate selectIn)
 
-    let initialValue = _selectIn_initialValue selectIn
+      R.divClass "errorMessage" . R.dynText $
+        R.ffor hasError (\e -> if e then Msg.get Msg.Form_NonEmpty else "")
 
-    value <- R._dropdown_value <$>
-      R.dropdown
-        initialValue
-        (_selectIn_values selectIn)
-        (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) })
+      return value
 
-    return SelectOut
-      { _selectOut_value = value
-      }
+  return SelectOut
+    { _selectOut_value = value
+    }
-- 
cgit v1.2.3


From bc81084933f8ec1bfe6c2834defd12243117fdd9 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 5 Aug 2019 21:53:30 +0200
Subject: Use updated payment categories from payment add in payment’s table

---
 client/src/Component/Input.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 67f97c0..d679f9b 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -53,7 +53,7 @@ input
 input inputIn reset validate = do
   rec
     let resetValue = R.leftmost
-          [ R.traceEvent "reset" reset
+          [ reset
           , fmap (const "") resetClic
           ]
 
@@ -83,7 +83,7 @@ input inputIn reset validate = do
         [ const (False, True) <$> resetClic
         , (\f -> (f, False)) <$> (R.updated . R._textInput_hasFocus $ textInput)
         , const (False, False) <$> validate
-        , const (True, False) <$> R.traceEvent "delayedReset" delayedReset
+        , const (True, False) <$> delayedReset
         ])
 
     (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
-- 
cgit v1.2.3


From fc8be14dd0089eb12b78af7aaaecd8ed57896677 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 7 Aug 2019 21:27:59 +0200
Subject: Update category according to payment in add overlay

---
 client/src/Component/Select.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 9f671d3..43a8a6e 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -16,6 +16,7 @@ import qualified Common.Msg as Msg
 data (Reflex t) => SelectIn t a b c = SelectIn
   { _selectIn_label        :: Text
   , _selectIn_initialValue :: a
+  , _selectIn_value        :: Event t a
   , _selectIn_values       :: Dynamic t (Map a Text)
   , _selectIn_reset        :: Event t b
   , _selectIn_isValid      :: a -> Bool
@@ -48,11 +49,16 @@ select selectIn = do
 
       let initialValue = _selectIn_initialValue selectIn
 
+      let setValue = R.leftmost
+            [ const initialValue <$> (_selectIn_reset selectIn)
+            , _selectIn_value selectIn
+            ]
+
       value <- R._dropdown_value <$>
         R.dropdown
           initialValue
           (_selectIn_values selectIn)
-          (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) })
+          (R.def { R._dropdownConfig_setValue = setValue })
 
       errorMessage <- R.holdDyn "" $ R.attachWith
         (\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!")
-- 
cgit v1.2.3


From 7c77e52faa71e43324087903c905f9d493b1dfb7 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 8 Aug 2019 21:28:22 +0200
Subject: Finish payment add modal

---
 client/src/Component/Input.hs  | 69 ++++++++++++++++++++++++++++--------------
 client/src/Component/Select.hs | 54 ++++++++++++++++++---------------
 2 files changed, 76 insertions(+), 47 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index d679f9b..abdc51c 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -40,7 +40,7 @@ defaultInputIn = InputIn
 
 data InputOut t a = InputOut
   { _inputOut_raw   :: Dynamic t Text
-  , _inputOut_value :: Dynamic t (Maybe (Validation Text a))
+  , _inputOut_value :: Dynamic t (Validation Text a)
   , _inputOut_enter :: Event t ()
   }
 
@@ -64,27 +64,14 @@ input inputIn reset validate = do
 
         value =  R._textInput_value textInput
 
-        containerAttr = R.ffor validatedValue (\v ->
+        containerAttr = R.ffor inputError (\e ->
           M.singleton "class" $ T.intercalate " "
             [ "textInput"
-            , if Maybe.fromMaybe False (ValidationUtil.isFailure <$> v) then "error" else ""
+            , if Maybe.isJust e then "error" else ""
             ])
 
-    -- Clear validation errors after reset
-    delayedReset <- R.delay (0.1 :: NominalDiffTime) reset
-
-    validatedValue <- R.holdDyn Nothing $ R.attachWith
-      (\v (clearValidation, validateEmpty) ->
-        if clearValidation
-           then Nothing
-           else Just (_inputIn_validation inputIn $ (if validateEmpty then "" else v)))
-      (R.current value)
-      (R.leftmost
-        [ const (False, True) <$> resetClic
-        , (\f -> (f, False)) <$> (R.updated . R._textInput_hasFocus $ textInput)
-        , const (False, False) <$> validate
-        , const (True, False) <$> delayedReset
-        ])
+    let valueWithValidation = R.ffor value (\v -> (v, _inputIn_validation inputIn $ v))
+    inputError <- getInputError valueWithValidation validate
 
     (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
 
@@ -108,7 +95,7 @@ input inputIn reset validate = do
             return R.never
 
       R.divClass "errorMessage" $
-        R.dynText . fmap validationError $ validatedValue
+        R.dynText . fmap (Maybe.fromMaybe "") $ inputError
 
       return (textInput, resetClic)
 
@@ -116,10 +103,46 @@ input inputIn reset validate = do
 
   return $ InputOut
     { _inputOut_raw = value
-    , _inputOut_value = validatedValue
+    , _inputOut_value = fmap snd valueWithValidation
     , _inputOut_enter = enter
     }
 
-validationError :: Maybe (Validation Text a) -> Text
-validationError (Just (Failure e)) = e
-validationError _                  = ""
+getInputError
+  :: forall t m a b c. MonadWidget t m
+  => Dynamic t (Text, Validation Text a)
+  -> Event t c
+  -> m (Dynamic t (Maybe Text))
+getInputError validatedValue validate = do
+  let errorDynamic = fmap (\(t, v) -> (t, validationError v)) validatedValue
+      errorEvent = R.updated errorDynamic
+  delayedError <- R.debounce (1 :: NominalDiffTime) errorEvent
+  fmap (fmap fst) $ R.foldDyn
+    (\event (err, hasBeenResetted) ->
+      case event of
+        ModifiedEvent t ->
+          (Nothing, T.null t)
+
+        ValidateEvent e ->
+          (e, False)
+
+        DelayEvent e ->
+          if hasBeenResetted then
+            (Nothing, False)
+          else
+            (e, False)
+    )
+    (Nothing, False)
+    (R.leftmost
+      [ fmap (\(t, _) -> ModifiedEvent t) errorEvent
+      , fmap (\(_, e) -> DelayEvent e) delayedError
+      , R.attachWith (\(_, e) _ -> ValidateEvent e) (R.current errorDynamic) validate
+      ])
+
+validationError :: (Validation Text a) -> Maybe Text
+validationError (Failure e) = Just e
+validationError _           = Nothing
+
+data InputEvent
+  = ModifiedEvent Text
+  | DelayEvent (Maybe Text)
+  | ValidateEvent (Maybe Text)
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 43a8a6e..01ed37a 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -4,14 +4,17 @@ module Component.Select
   , select
   ) where
 
-import           Data.Map   (Map)
-import qualified Data.Map   as M
-import           Data.Text  (Text)
-import qualified Data.Text  as T
-import           Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom as R
+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.Validation (Validation (Failure, Success))
+import           Reflex.Dom      (Dynamic, Event, MonadWidget, Reflex)
+import qualified Reflex.Dom      as R
 
-import qualified Common.Msg as Msg
+import qualified Common.Msg      as Msg
+import qualified Util.Validation as ValidationUtil
 
 data (Reflex t) => SelectIn t a b c = SelectIn
   { _selectIn_label        :: Text
@@ -24,25 +27,33 @@ data (Reflex t) => SelectIn t a b c = SelectIn
   }
 
 data SelectOut t a = SelectOut
-  { _selectOut_value :: Dynamic t a
+  { _selectOut_value :: Dynamic t (Validation Text a)
   }
 
 select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a)
 select selectIn = do
   rec
-    let containerAttr = R.ffor hasError (\e ->
+    let containerAttr = R.ffor showedError (\e ->
           M.singleton "class" $ T.intercalate " "
             [ "selectInput"
-            , if e then "error" else ""
+            , if Maybe.isJust e then "error" else ""
             ])
 
-    hasError <- R.holdDyn False $ R.attachWith
-      (\v clearError -> not clearError && not (_selectIn_isValid selectIn v))
-      (R.current value)
-      (R.leftmost
-        [ const False <$> _selectIn_validate selectIn
-        , const True <$> _selectIn_reset selectIn
-        ])
+        validatedValue =
+          R.ffor value (\v ->
+            if _selectIn_isValid selectIn v then
+              Success v
+            else
+              Failure (Msg.get Msg.Form_NonEmpty))
+
+        maybeError =
+          fmap ValidationUtil.maybeError validatedValue
+
+    showedError <- R.holdDyn Nothing $ R.leftmost
+      [ const Nothing <$> _selectIn_reset selectIn
+      , R.updated maybeError
+      , R.attachWith const (R.current maybeError) (_selectIn_validate selectIn)
+      ]
 
     value <- R.elDynAttr "div" containerAttr $ do
       R.el "label" $ R.text (_selectIn_label selectIn)
@@ -60,16 +71,11 @@ select selectIn = do
           (_selectIn_values selectIn)
           (R.def { R._dropdownConfig_setValue = setValue })
 
-      errorMessage <- R.holdDyn "" $ R.attachWith
-        (\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!")
-        (R.current value)
-        (_selectIn_validate selectIn)
-
       R.divClass "errorMessage" . R.dynText $
-        R.ffor hasError (\e -> if e then Msg.get Msg.Form_NonEmpty else "")
+        R.ffor showedError (Maybe.fromMaybe "")
 
       return value
 
   return SelectOut
-    { _selectOut_value = value
+    { _selectOut_value = validatedValue
     }
-- 
cgit v1.2.3


From 234b5b29361734656dc780148309962f932d9907 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 15:07:11 +0200
Subject: Use select component in payment search line

---
 client/src/Component/Select.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 01ed37a..cf62f26 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -27,7 +27,8 @@ data (Reflex t) => SelectIn t a b c = SelectIn
   }
 
 data SelectOut t a = SelectOut
-  { _selectOut_value :: Dynamic t (Validation Text a)
+  { _selectOut_raw   :: Dynamic t a
+  , _selectOut_value :: Dynamic t (Validation Text a)
   }
 
 select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a)
@@ -77,5 +78,6 @@ select selectIn = do
       return value
 
   return SelectOut
-    { _selectOut_value = validatedValue
+    { _selectOut_raw = value
+    , _selectOut_value = validatedValue
     }
-- 
cgit v1.2.3


From c542424b7b41c78a170763f6996c12f56b359860 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 21:31:27 +0200
Subject: Add smooth transitions to modal show and hide

---
 client/src/Component/Modal.hs  | 79 +++++++++++++++++++++++++++---------------
 client/src/Component/Select.hs |  4 +--
 2 files changed, 54 insertions(+), 29 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index d7943a9..fac417e 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -8,6 +8,8 @@ import           Control.Monad     (void)
 import qualified Data.Map          as M
 import qualified Data.Map.Lazy     as LM
 import           Data.Text         (Text)
+import qualified Data.Text         as T
+import           Data.Time.Clock   (NominalDiffTime)
 import qualified GHCJS.DOM.Element as Element
 import qualified GHCJS.DOM.Node    as Node
 import           JSDOM.Types       (JSString)
@@ -31,52 +33,75 @@ data ModalOut t a = ModalOut
 modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut t a)
 modal modalIn = do
   rec
-    let showEvent = R.leftmost
-          [ True <$ _modalIn_show modalIn
-          , False <$ _modalIn_hide modalIn
-          , False <$ curtainClick
-          ]
+    let show = Show <$ (_modalIn_show modalIn)
 
-    showModal <- R.holdDyn False showEvent
+        startHiding =
+          R.attachWithMaybe
+            (\a _ -> if a then Just StartHiding else Nothing)
+            (R.current canBeHidden)
+            (R.leftmost [ _modalIn_hide modalIn, curtainClick ])
+
+    canBeHidden <-
+      R.holdDyn True $ R.leftmost
+        [ False <$ startHiding
+        , True <$ endHiding
+        ]
+
+    endHiding <-
+      R.delay (0.2 :: NominalDiffTime) (EndHiding <$ startHiding)
+
+    let action =
+          R.leftmost [ show, startHiding, endHiding ]
+
+    modalClass <-
+      R.holdDyn "" (fmap getModalClass action)
 
     (elem, (curtainClick, content)) <-
-      R.buildElement "div" (getAttributes <$> showModal) $ do
-        (curtain, _) <- R.elAttr' "div" (M.singleton "class" "modalCurtain") $ R.blank
-        cont <- R.divClass "modalContent" $ _modalIn_content modalIn
-        return (R.domEvent R.Click curtain, cont)
+      R.buildElement "div" (fmap getAttributes modalClass) $ do
+        (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
+        content <- R.divClass "g-Modal__Content" $ _modalIn_content modalIn
+        return (R.domEvent R.Click curtain, content)
 
-  performShowEffects showEvent elem
+  performShowEffects action elem
 
   return $ ModalOut
     { _modalOut_content = content
     , _modalOut_hide = curtainClick
     }
 
-getAttributes :: Bool -> LM.Map Text Text
-getAttributes show =
-  M.fromList $
-    [ ("style", if show then "display:block" else "display:none")
-    , ("class", "modal")
-    ]
+getAttributes :: Text -> LM.Map Text Text
+getAttributes modalClass =
+  M.singleton "class" $
+    T.intercalate " " [ "g-Modal", modalClass]
 
 performShowEffects
   :: forall t m a. MonadWidget t m
-  => Event t Bool
+  => Event t Action
   -> Element.Element
   -> m ()
 performShowEffects showEvent elem = do
   body <- Dom.getBody
 
   let showEffects =
-        flip fmap showEvent (\show -> do
-          if show then
-            do
-              Node.appendChild body elem
-              Element.setClassName body ("modal" :: JSString)
-          else
-            do
-              Node.removeChild body elem
-              Element.setClassName body ("" :: JSString)
+        flip fmap showEvent (\case
+          Show -> do
+            Node.appendChild body elem
+            Element.setClassName body ("g-Body--Modal" :: JSString)
+          StartHiding ->
+            return ()
+          EndHiding -> do
+            Node.removeChild body elem
+            Element.setClassName body ("" :: JSString)
         )
 
   R.performEvent_ $ void `fmap` showEffects
+
+data Action
+  = Show
+  | StartHiding
+  | EndHiding
+
+getModalClass :: Action -> Text
+getModalClass Show        = "g-Modal--Show"
+getModalClass StartHiding = "g-Modal--Hiding"
+getModalClass _           = ""
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index cf62f26..9a37afc 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -51,7 +51,7 @@ select selectIn = do
           fmap ValidationUtil.maybeError validatedValue
 
     showedError <- R.holdDyn Nothing $ R.leftmost
-      [ const Nothing <$> _selectIn_reset selectIn
+      [ Nothing <$ _selectIn_reset selectIn
       , R.updated maybeError
       , R.attachWith const (R.current maybeError) (_selectIn_validate selectIn)
       ]
@@ -62,7 +62,7 @@ select selectIn = do
       let initialValue = _selectIn_initialValue selectIn
 
       let setValue = R.leftmost
-            [ const initialValue <$> (_selectIn_reset selectIn)
+            [ initialValue <$ (_selectIn_reset selectIn)
             , _selectIn_value selectIn
             ]
 
-- 
cgit v1.2.3


From 2d79ab0e0a11f55255fc21a5dfab1598d3beeba3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 11 Aug 2019 22:40:09 +0200
Subject: Add payment clone

---
 client/src/Component/Modal.hs | 63 ++++++++++++++++++++++++-------------------
 1 file changed, 36 insertions(+), 27 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index fac417e..96c2679 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -1,7 +1,7 @@
 module Component.Modal
-  ( ModalIn(..)
-  , ModalOut(..)
-  , modal
+  ( Input(..)
+  , Content
+  , view
   ) where
 
 import           Control.Monad     (void)
@@ -17,29 +17,26 @@ import           Reflex.Dom        (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom        as R
 import qualified Reflex.Dom.Class  as R
 
-import qualified Util.Dom          as Dom
+import qualified Util.Reflex       as ReflexUtil
 
-data ModalIn t m a = ModalIn
-  { _modalIn_show    :: Event t ()
-  , _modalIn_hide    :: Event t ()
-  , _modalIn_content :: m a
-  }
+-- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
+type Content t m a = Event t () -> m (Event t (), Event t a)
 
-data ModalOut t a = ModalOut
-  { _modalOut_content :: a
-  , _modalOut_hide    :: Event t ()
+data Input t m a = Input
+  { _input_show    :: Event t ()
+  , _input_content :: Content t m a
   }
 
-modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut t a)
-modal modalIn = do
+view :: forall t m a. MonadWidget t m => Input t m a -> m (Event t a)
+view input = do
   rec
-    let show = Show <$ (_modalIn_show modalIn)
+    let show = Show <$ (_input_show input)
 
         startHiding =
           R.attachWithMaybe
             (\a _ -> if a then Just StartHiding else Nothing)
             (R.current canBeHidden)
-            (R.leftmost [ _modalIn_hide modalIn, curtainClick ])
+            (R.leftmost [ hide, curtainClick ])
 
     canBeHidden <-
       R.holdDyn True $ R.leftmost
@@ -56,18 +53,25 @@ modal modalIn = do
     modalClass <-
       R.holdDyn "" (fmap getModalClass action)
 
-    (elem, (curtainClick, content)) <-
-      R.buildElement "div" (fmap getAttributes modalClass) $ do
-        (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
-        content <- R.divClass "g-Modal__Content" $ _modalIn_content modalIn
-        return (R.domEvent R.Click curtain, content)
+    (elem, dyn) <-
+      R.buildElement "div" (getAttributes <$> modalClass) $
+        ReflexUtil.visibleIfEvent
+          (isVisible <$> action)
+          (R.blank >> return (R.never, R.never, R.never))
+          (do
+            (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
+            let curtainClick = R.domEvent R.Click curtain
+            (hide, content) <- R.divClass "g-Modal__Content" (_input_content input curtainClick)
+            return (curtainClick, hide, content))
+
 
-  performShowEffects action elem
+    performShowEffects action elem
 
-  return $ ModalOut
-    { _modalOut_content = content
-    , _modalOut_hide = curtainClick
-    }
+    let curtainClick = R.switchDyn $ (\(a, _, _) -> a) <$> dyn
+    let hide = R.switchDyn $ (\(_, b, _) -> b) <$> dyn
+    let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
+
+  return content
 
 getAttributes :: Text -> LM.Map Text Text
 getAttributes modalClass =
@@ -80,7 +84,7 @@ performShowEffects
   -> Element.Element
   -> m ()
 performShowEffects showEvent elem = do
-  body <- Dom.getBody
+  body <- ReflexUtil.getBody
 
   let showEffects =
         flip fmap showEvent (\case
@@ -105,3 +109,8 @@ getModalClass :: Action -> Text
 getModalClass Show        = "g-Modal--Show"
 getModalClass StartHiding = "g-Modal--Hiding"
 getModalClass _           = ""
+
+isVisible :: Action -> Bool
+isVisible Show        = True
+isVisible StartHiding = True
+isVisible EndHiding   = False
-- 
cgit v1.2.3


From 2cbd43c3a0f0640776a4e7c7425b3210d2e6632b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 6 Oct 2019 19:41:17 +0200
Subject: Make input label clickable again

---
 client/src/Component/Input.hs  | 16 ++++++++++------
 client/src/Component/Select.hs | 16 +++++++++-------
 2 files changed, 19 insertions(+), 13 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index abdc51c..0c84754 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -75,13 +75,17 @@ input inputIn reset validate = do
 
     (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
 
-      textInput <- R.textInput $ R.def
-        & R.attributes .~ inputAttr
-        & R.setValue .~ resetValue
-        & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn)
-        & R.textInputConfig_inputType .~ (_inputIn_inputType inputIn)
+      textInput <- R.el "label" $ do
+        textInput <- R.textInput $ R.def
+          & R.attributes .~ inputAttr
+          & R.setValue .~ resetValue
+          & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn)
+          & R.textInputConfig_inputType .~ (_inputIn_inputType inputIn)
 
-      R.el "label" $ R.text (_inputIn_label inputIn)
+        R.divClass "label" $
+          R.text (_inputIn_label inputIn)
+
+        return textInput
 
       resetClic <-
         if _inputIn_hasResetButton inputIn
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 9a37afc..5980ed2 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -57,8 +57,6 @@ select selectIn = do
       ]
 
     value <- R.elDynAttr "div" containerAttr $ do
-      R.el "label" $ R.text (_selectIn_label selectIn)
-
       let initialValue = _selectIn_initialValue selectIn
 
       let setValue = R.leftmost
@@ -66,11 +64,15 @@ select selectIn = do
             , _selectIn_value selectIn
             ]
 
-      value <- R._dropdown_value <$>
-        R.dropdown
-          initialValue
-          (_selectIn_values selectIn)
-          (R.def { R._dropdownConfig_setValue = setValue })
+      value <- R.el "label" $ do
+        R.divClass "label" $
+          R.text (_selectIn_label selectIn)
+
+        R._dropdown_value <$>
+          R.dropdown
+            initialValue
+            (_selectIn_values selectIn)
+            (R.def { R._dropdownConfig_setValue = setValue })
 
       R.divClass "errorMessage" . R.dynText $
         R.ffor showedError (Maybe.fromMaybe "")
-- 
cgit v1.2.3


From 7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 9 Oct 2019 23:16:00 +0200
Subject: Use common payment validation in the backend

Remove deprecated backend validation
---
 client/src/Component/Select.hs | 11 +++--------
 1 file changed, 3 insertions(+), 8 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 5980ed2..102f554 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -9,11 +9,10 @@ import qualified Data.Map        as M
 import qualified Data.Maybe      as Maybe
 import           Data.Text       (Text)
 import qualified Data.Text       as T
-import           Data.Validation (Validation (Failure, Success))
+import           Data.Validation (Validation)
 import           Reflex.Dom      (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom      as R
 
-import qualified Common.Msg      as Msg
 import qualified Util.Validation as ValidationUtil
 
 data (Reflex t) => SelectIn t a b c = SelectIn
@@ -22,7 +21,7 @@ data (Reflex t) => SelectIn t a b c = SelectIn
   , _selectIn_value        :: Event t a
   , _selectIn_values       :: Dynamic t (Map a Text)
   , _selectIn_reset        :: Event t b
-  , _selectIn_isValid      :: a -> Bool
+  , _selectIn_isValid      :: a -> Validation Text a
   , _selectIn_validate     :: Event t c
   }
 
@@ -41,11 +40,7 @@ select selectIn = do
             ])
 
         validatedValue =
-          R.ffor value (\v ->
-            if _selectIn_isValid selectIn v then
-              Success v
-            else
-              Failure (Msg.get Msg.Form_NonEmpty))
+          fmap (_selectIn_isValid selectIn) value
 
         maybeError =
           fmap ValidationUtil.maybeError validatedValue
-- 
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/Component/Link.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)
 create mode 100644 client/src/Component/Link.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/Link.hs b/client/src/Component/Link.hs
new file mode 100644
index 0000000..7e8558b
--- /dev/null
+++ b/client/src/Component/Link.hs
@@ -0,0 +1,33 @@
+module Component.Link
+  ( link
+  ) where
+
+import           Data.Map   (Map)
+import qualified Data.Map   as M
+import           Data.Text  (Text)
+import qualified Data.Text  as T
+import           Reflex.Dom (Dynamic, MonadWidget)
+import qualified Reflex.Dom as R
+
+link :: forall t m a. MonadWidget t m => Text -> Dynamic t (Map Text Text) -> Text -> m ()
+link href inputAttrs content =
+  R.elDynAttr "a" attrs (R.text content)
+  where
+
+    onclickHandler =
+      T.intercalate ";"
+        [ "history.pushState(0, '', event.target.href)"
+        , "dispatchEvent(new PopStateEvent('popstate', {cancelable: true, bubbles: true, view: window}))"
+        , "return false"
+        ]
+
+    attrs =
+      R.ffor inputAttrs (\as ->
+        (M.union
+          (M.fromList
+            [ ("onclick", onclickHandler)
+            , ("href", href)
+            ]
+          )
+          as)
+      )
-- 
cgit v1.2.3


From 04c59f08f100ba6a0658d1f2b357f7d8b1e14218 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 13 Oct 2019 22:38:35 +0200
Subject: Show income table

---
 client/src/Component/Table.hs | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)
 create mode 100644 client/src/Component/Table.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
new file mode 100644
index 0000000..a77a18d
--- /dev/null
+++ b/client/src/Component/Table.hs
@@ -0,0 +1,38 @@
+module Component.Table
+  ( table
+  , TableIn(..)
+  , TableOut(..)
+  ) where
+
+import           Data.Text  (Text)
+import           Reflex.Dom (Dynamic, MonadWidget)
+import qualified Reflex.Dom as R
+
+data TableIn h r t = TableIn
+  { _tableIn_headerLabel :: h -> Text
+  , _tableIn_rows        :: Dynamic t [r]
+  , _tableIn_cell        :: h -> r -> Text
+  }
+
+data TableOut = TableOut
+  {}
+
+table :: forall t m h r. (MonadWidget t m, Bounded h, Enum h)  => TableIn h r t -> m (TableOut)
+table tableIn = do
+  R.divClass "table" $ do
+
+    R.divClass "lines" $ do
+      R.divClass "header" $ do
+        flip mapM_ [minBound..] $ \header ->
+          R.divClass "cell" . R.text $
+            _tableIn_headerLabel tableIn header
+
+      R.simpleList (_tableIn_rows tableIn) $ \r ->
+        R.divClass "row" $
+          flip mapM_ [minBound..] $ \h ->
+            R.divClass "cell name" $
+              R.dynText $
+                R.ffor r (_tableIn_cell tableIn h)
+
+    return $ TableOut
+      {}
-- 
cgit v1.2.3


From 0b40b6b5583b5c437f83e61bf8913f2b4c447b24 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 19 Oct 2019 09:36:03 +0200
Subject: Include pages into table component

---
 client/src/Component/Pages.hs | 88 +++++++++++++++++++++++++++++++++++++++++++
 client/src/Component/Table.hs | 53 ++++++++++++++++++--------
 2 files changed, 126 insertions(+), 15 deletions(-)
 create mode 100644 client/src/Component/Pages.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
new file mode 100644
index 0000000..5611cb7
--- /dev/null
+++ b/client/src/Component/Pages.hs
@@ -0,0 +1,88 @@
+module Component.Pages
+  ( widget
+  , PagesIn(..)
+  , PagesOut(..)
+  ) where
+
+import qualified Data.Text        as T
+import           Reflex.Dom       (Dynamic, Event, MonadWidget)
+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
+
+data PagesIn t = PagesIn
+  { _pagesIn_total   :: Dynamic t Int
+  , _pagesIn_perPage :: Int
+  , _pagesIn_reset   :: Event t ()
+  }
+
+data PagesOut t = PagesOut
+  { _pagesOut_currentPage :: Dynamic t Int
+  }
+
+widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
+widget pagesIn = do
+  currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
+
+  return $ PagesOut
+    { _pagesOut_currentPage = currentPage
+    }
+
+  where
+    total = _pagesIn_total pagesIn
+    perPage = _pagesIn_perPage pagesIn
+    reset = _pagesIn_reset pagesIn
+
+pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
+pageButtons total perPage reset = do
+  R.divClass "pages" $ do
+    rec
+      currentPage <- R.holdDyn 1 . R.leftmost $
+        [ firstPageClic
+        , previousPageClic
+        , pageClic
+        , nextPageClic
+        , lastPageClic
+        , 1 <$ reset
+        ]
+
+      firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
+
+      previousPageClic <- pageButton noCurrentPage (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
+
+      pageClic <- pageEvent <$> (R.simpleList (range <$> currentPage <*> maxPage) $ \p ->
+        pageButton (Just <$> currentPage) p (R.dynText $ fmap (T.pack . show) p))
+
+      nextPageClic <- pageButton noCurrentPage ((\c m -> min (c + 1) m) <$> currentPage <*> maxPage) Icon.doubleRight
+
+      lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
+
+    return currentPage
+
+    where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
+          pageEvent = R.switch . R.current . fmap R.leftmost
+          noCurrentPage = R.constDyn Nothing
+
+range :: Int -> Int -> [Int]
+range currentPage maxPage = [start..end]
+  where sidePages = 2
+        start = max 1 (min (currentPage - sidePages) (maxPage - sidePages * 2))
+        end = min maxPage (start + sidePages * 2)
+
+pageButton :: forall t m. MonadWidget t m => Dynamic t (Maybe Int) -> Dynamic t Int -> m () -> m (Event t Int)
+pageButton currentPage page content = do
+  clic <- _buttonOut_clic <$> (Button.button $ ButtonIn
+    { _buttonIn_class   = do
+        cp <- currentPage
+        p <- page
+        if cp == Just p then "page current" else "page"
+    , _buttonIn_content = content
+    , _buttonIn_waiting = R.never
+    , _buttonIn_tabIndex = Nothing
+    , _buttonIn_submit = False
+    })
+  return . fmap fst $ R.attach (R.current page) clic
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index a77a18d..b431c14 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -4,35 +4,58 @@ module Component.Table
   , TableOut(..)
   ) where
 
-import           Data.Text  (Text)
-import           Reflex.Dom (Dynamic, MonadWidget)
-import qualified Reflex.Dom as R
+import           Data.Text       (Text)
+import           Reflex.Dom      (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom      as R
+
+import           Component.Pages (PagesIn (..), PagesOut (..))
+import qualified Component.Pages as Pages
 
 data TableIn h r t = TableIn
   { _tableIn_headerLabel :: h -> Text
   , _tableIn_rows        :: Dynamic t [r]
   , _tableIn_cell        :: h -> r -> Text
+  , _tableIn_perPage     :: Int
+  , _tableIn_resetPage   :: Event t ()
   }
 
 data TableOut = TableOut
   {}
 
 table :: forall t m h r. (MonadWidget t m, Bounded h, Enum h)  => TableIn h r t -> m (TableOut)
-table tableIn = do
+table tableIn =
   R.divClass "table" $ do
+    rec
+      R.divClass "lines" $ do
+
+        R.divClass "header" $
+          flip mapM_ [minBound..] $ \header ->
+            R.divClass "cell" . R.text $
+              _tableIn_headerLabel tableIn header
+
+        let rows = getRange
+              (_tableIn_perPage tableIn)
+                <$> (_pagesOut_currentPage pages)
+                <*> (_tableIn_rows tableIn)
 
-    R.divClass "lines" $ do
-      R.divClass "header" $ do
-        flip mapM_ [minBound..] $ \header ->
-          R.divClass "cell" . R.text $
-            _tableIn_headerLabel tableIn header
+        R.simpleList rows $ \r ->
+          R.divClass "row" $
+            flip mapM_ [minBound..] $ \h ->
+              R.divClass "cell name" $
+                R.dynText $
+                  R.ffor r (_tableIn_cell tableIn h)
 
-      R.simpleList (_tableIn_rows tableIn) $ \r ->
-        R.divClass "row" $
-          flip mapM_ [minBound..] $ \h ->
-            R.divClass "cell name" $
-              R.dynText $
-                R.ffor r (_tableIn_cell tableIn h)
+      pages <- Pages.widget $ PagesIn
+        { _pagesIn_total = length <$> (_tableIn_rows tableIn)
+        , _pagesIn_perPage = _tableIn_perPage tableIn
+        , _pagesIn_reset = _tableIn_resetPage tableIn
+        }
+
+      return ()
 
     return $ TableOut
       {}
+
+getRange :: forall a. Int -> Int -> [a] -> [a]
+getRange perPage currentPage =
+  take perPage . drop ((currentPage - 1) * perPage)
-- 
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/Component/Button.hs | 2 +-
 client/src/Component/Input.hs  | 2 +-
 client/src/Component/Pages.hs  | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

(limited to 'client/src/Component')

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
-- 
cgit v1.2.3


From 80f09e8b3a5c856e60922a73c9161a8c5392e4d4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 22 Oct 2019 21:35:03 +0200
Subject: Create ModalForm component

---
 client/src/Component/ModalForm.hs | 70 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 client/src/Component/ModalForm.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
new file mode 100644
index 0000000..63cb1d2
--- /dev/null
+++ b/client/src/Component/ModalForm.hs
@@ -0,0 +1,70 @@
+module Component.ModalForm
+  ( modalForm
+  , ModalFormIn(..)
+  , ModalFormOut(..)
+  ) where
+
+import           Data.Aeson         (ToJSON)
+import           Data.Text          (Text)
+import qualified Data.Text          as T
+import           Data.Time.Calendar (Day)
+import           Data.Validation    (Validation)
+import qualified Data.Validation    as V
+import           Reflex.Dom         (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom         as R
+
+import qualified Common.Msg         as Msg
+import           Component.Button   (ButtonIn (..))
+import qualified Component.Button   as Button
+import qualified Util.Either        as EitherUtil
+import qualified Util.Validation    as ValidationUtil
+import qualified Util.WaitFor       as WaitFor
+
+data ModalFormIn m t a b e = ModalFormIn
+  { _modalFormIn_headerLabel :: Text
+  , _modalFormIn_form        :: m (Dynamic t (Validation e a))
+  , _modalFormIn_ajax        :: Event t a -> m (Event t (Either Text b))
+  }
+
+data ModalFormOut t a = ModalFormOut
+  { _modalFormOut_hide     :: Event t ()
+  , _modalFormOut_cancel   :: Event t ()
+  , _modalFormOut_confirm  :: Event t ()
+  , _modalFormOut_validate :: Event t a
+  }
+
+modalForm :: forall t m a b e. (MonadWidget t m, ToJSON a) => ModalFormIn m t a b e -> m (ModalFormOut t b)
+modalForm modalFormIn =
+  R.divClass "form" $ do
+    R.divClass "formHeader" $
+      R.text (_modalFormIn_headerLabel modalFormIn)
+
+    R.divClass "formContent" $ do
+      rec
+        form <- _modalFormIn_form modalFormIn
+
+        (validate, cancel, confirm) <- R.divClass "buttons" $ do
+          rec
+            cancel <- Button._buttonOut_clic <$> (Button.button $
+              (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+                { _buttonIn_class = R.constDyn "undo" })
+
+            confirm <- Button._buttonOut_clic <$> (Button.button $
+              (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
+                { _buttonIn_class = R.constDyn "confirm"
+                , _buttonIn_waiting = waiting
+                , _buttonIn_submit = True
+                })
+
+            (validate, waiting) <- WaitFor.waitFor
+              (_modalFormIn_ajax modalFormIn)
+              (ValidationUtil.fireValidation form confirm)
+
+          return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm)
+
+      return ModalFormOut
+        { _modalFormOut_hide = R.leftmost [ cancel, () <$ validate ]
+        , _modalFormOut_cancel = cancel
+        , _modalFormOut_confirm = confirm
+        , _modalFormOut_validate = validate
+        }
-- 
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/Component/Button.hs    | 56 +++++++++++++--------------
 client/src/Component/Form.hs      |  6 +--
 client/src/Component/Input.hs     | 79 +++++++++++++++++++--------------------
 client/src/Component/Link.hs      |  6 +--
 client/src/Component/Modal.hs     | 14 +++----
 client/src/Component/ModalForm.hs | 61 +++++++++++++++---------------
 client/src/Component/Pages.hs     | 45 +++++++++++-----------
 client/src/Component/Select.hs    | 56 +++++++++++++--------------
 client/src/Component/Table.hs     | 45 +++++++++++-----------
 9 files changed, 182 insertions(+), 186 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index b1175d7..6faecef 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -1,8 +1,8 @@
 module Component.Button
-  ( ButtonIn(..)
-  , ButtonOut(..)
-  , button
-  , defaultButtonIn
+  ( In(..)
+  , Out(..)
+  , view
+  , defaultIn
   ) where
 
 import qualified Data.Map   as M
@@ -14,44 +14,44 @@ import qualified Reflex.Dom as R
 
 import qualified View.Icon  as Icon
 
-data ButtonIn t m = ButtonIn
-  { _buttonIn_class    :: Dynamic t Text
-  , _buttonIn_content  :: m ()
-  , _buttonIn_waiting  :: Event t Bool
-  , _buttonIn_tabIndex :: Maybe Int
-  , _buttonIn_submit   :: Bool
+data In t m = In
+  { _in_class    :: Dynamic t Text
+  , _in_content  :: m ()
+  , _in_waiting  :: Event t Bool
+  , _in_tabIndex :: Maybe Int
+  , _in_submit   :: Bool
   }
 
-defaultButtonIn :: MonadWidget t m => m () -> ButtonIn t m
-defaultButtonIn content = ButtonIn
-  { _buttonIn_class    = R.constDyn ""
-  , _buttonIn_content  = content
-  , _buttonIn_waiting  = R.never
-  , _buttonIn_tabIndex = Nothing
-  , _buttonIn_submit   = False
+defaultIn :: MonadWidget t m => m () -> In t m
+defaultIn content = In
+  { _in_class    = R.constDyn ""
+  , _in_content  = content
+  , _in_waiting  = R.never
+  , _in_tabIndex = Nothing
+  , _in_submit   = False
   }
 
-data ButtonOut t = ButtonOut
-  { _buttonOut_clic :: Event t ()
+data Out t = Out
+  { _out_clic :: Event t ()
   }
 
-button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t)
-button buttonIn = do
-  dynWaiting <- R.holdDyn False $ _buttonIn_waiting buttonIn
+view :: forall t m. MonadWidget t m => In t m -> m (Out t)
+view input = do
+  dynWaiting <- R.holdDyn False $ _in_waiting input
 
   let attr = do
-        buttonClass <- _buttonIn_class buttonIn
+        buttonClass <- _in_class input
         waiting <- dynWaiting
         return . M.fromList . catMaybes $
-          [ Just ("type", if _buttonIn_submit buttonIn then "submit" else "button")
-          , (\i -> ("tabindex", T.pack . show $ i)) <$> _buttonIn_tabIndex buttonIn
+          [ Just ("type", if _in_submit input then "submit" else "button")
+          , (\i -> ("tabindex", T.pack . show $ i)) <$> _in_tabIndex input
           , Just ("class", T.intercalate " " [ buttonClass, if waiting then "waiting" else "" ])
           ]
 
   (e, _) <- R.elDynAttr' "button" attr $ do
     Icon.loading
-    R.divClass "content" $ _buttonIn_content buttonIn
+    R.divClass "content" $ _in_content input
 
-  return $ ButtonOut
-    { _buttonOut_clic = R.domEvent R.Click e
+  return $ Out
+    { _out_clic = R.domEvent R.Click e
     }
diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs
index 6ea02fa..6878e68 100644
--- a/client/src/Component/Form.hs
+++ b/client/src/Component/Form.hs
@@ -1,12 +1,12 @@
 module Component.Form
-  ( form
+  ( view
   ) where
 
 import qualified Data.Map   as M
 import           Reflex.Dom (MonadWidget)
 import qualified Reflex.Dom as R
 
-form :: forall t m a. MonadWidget t m => m a -> m a
-form content =
+view :: forall t m a. MonadWidget t m => m a -> m a
+view content =
   R.elAttr "form" (M.singleton "onsubmit" "event.preventDefault()") $
     content
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 9ab4d58..37020da 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -1,8 +1,8 @@
 module Component.Input
-  ( InputIn(..)
-  , InputOut(..)
-  , input
-  , defaultInputIn
+  ( In(..)
+  , Out(..)
+  , view
+  , defaultIn
   ) where
 
 import qualified Data.Map               as M
@@ -17,40 +17,39 @@ import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex,
 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 View.Icon              as Icon
 
-data InputIn a = InputIn
-  { _inputIn_hasResetButton :: Bool
-  , _inputIn_label          :: Text
-  , _inputIn_initialValue   :: Text
-  , _inputIn_inputType      :: Text
-  , _inputIn_validation     :: Text -> Validation Text a
+data In a = In
+  { _in_hasResetButton :: Bool
+  , _in_label          :: Text
+  , _in_initialValue   :: Text
+  , _in_inputType      :: Text
+  , _in_validation     :: Text -> Validation Text a
   }
 
-defaultInputIn :: InputIn Text
-defaultInputIn = InputIn
-  { _inputIn_hasResetButton = True
-  , _inputIn_label          = ""
-  , _inputIn_initialValue   = ""
-  , _inputIn_inputType      = "text"
-  , _inputIn_validation     = V.Success
+defaultIn :: In Text
+defaultIn = In
+  { _in_hasResetButton = True
+  , _in_label          = ""
+  , _in_initialValue   = ""
+  , _in_inputType      = "text"
+  , _in_validation     = V.Success
   }
 
-data InputOut t a = InputOut
-  { _inputOut_raw   :: Dynamic t Text
-  , _inputOut_value :: Dynamic t (Validation Text a)
-  , _inputOut_enter :: Event t ()
+data Out t a = Out
+  { _out_raw   :: Dynamic t Text
+  , _out_value :: Dynamic t (Validation Text a)
+  , _out_enter :: Event t ()
   }
 
-input
+view
   :: forall t m a b. MonadWidget t m
-  => InputIn a
+  => In a
   -> Event t Text -- reset
   -> Event t b    -- validate
-  -> m (InputOut t a)
-input inputIn reset validate = do
+  -> m (Out t a)
+view input reset validate = do
   rec
     let resetValue = R.leftmost
           [ reset
@@ -58,7 +57,7 @@ input inputIn reset validate = do
           ]
 
         inputAttr = R.ffor value (\v ->
-          if T.null v && _inputIn_inputType inputIn /= "date"
+          if T.null v && _in_inputType input /= "date"
             then M.empty
             else M.singleton "class" "filled")
 
@@ -70,7 +69,7 @@ input inputIn reset validate = do
             , if Maybe.isJust e then "error" else ""
             ])
 
-    let valueWithValidation = R.ffor value (\v -> (v, _inputIn_validation inputIn $ v))
+    let valueWithValidation = R.ffor value (\v -> (v, _in_validation input $ v))
     inputError <- getInputError valueWithValidation validate
 
     (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
@@ -79,21 +78,21 @@ input inputIn reset validate = do
         textInput <- R.textInput $ R.def
           & R.attributes .~ inputAttr
           & R.setValue .~ resetValue
-          & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn)
-          & R.textInputConfig_inputType .~ (_inputIn_inputType inputIn)
+          & R.textInputConfig_initialValue .~ (_in_initialValue input)
+          & R.textInputConfig_inputType .~ (_in_inputType input)
 
         R.divClass "label" $
-          R.text (_inputIn_label inputIn)
+          R.text (_in_label input)
 
         return textInput
 
       resetClic <-
-        if _inputIn_hasResetButton inputIn
+        if _in_hasResetButton input
           then
-            _buttonOut_clic <$> (Button.button $
-              (Button.defaultButtonIn Icon.cross)
-                { _buttonIn_class   = R.constDyn "reset"
-                , _buttonIn_tabIndex = Just (-1)
+            Button._out_clic <$> (Button.view $
+              (Button.defaultIn Icon.cross)
+                { Button._in_class   = R.constDyn "reset"
+                , Button._in_tabIndex = Just (-1)
                 })
           else
             return R.never
@@ -105,10 +104,10 @@ input inputIn reset validate = do
 
   let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
 
-  return $ InputOut
-    { _inputOut_raw = value
-    , _inputOut_value = fmap snd valueWithValidation
-    , _inputOut_enter = enter
+  return $ Out
+    { _out_raw = value
+    , _out_value = fmap snd valueWithValidation
+    , _out_enter = enter
     }
 
 getInputError
diff --git a/client/src/Component/Link.hs b/client/src/Component/Link.hs
index 7e8558b..1fd620e 100644
--- a/client/src/Component/Link.hs
+++ b/client/src/Component/Link.hs
@@ -1,5 +1,5 @@
 module Component.Link
-  ( link
+  ( view
   ) where
 
 import           Data.Map   (Map)
@@ -9,8 +9,8 @@ import qualified Data.Text  as T
 import           Reflex.Dom (Dynamic, MonadWidget)
 import qualified Reflex.Dom as R
 
-link :: forall t m a. MonadWidget t m => Text -> Dynamic t (Map Text Text) -> Text -> m ()
-link href inputAttrs content =
+view :: forall t m a. MonadWidget t m => Text -> Dynamic t (Map Text Text) -> Text -> m ()
+view href inputAttrs content =
   R.elDynAttr "a" attrs (R.text content)
   where
 
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index 96c2679..50af469 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -1,5 +1,5 @@
 module Component.Modal
-  ( Input(..)
+  ( In(..)
   , Content
   , view
   ) where
@@ -22,15 +22,15 @@ import qualified Util.Reflex       as ReflexUtil
 -- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
 type Content t m a = Event t () -> m (Event t (), Event t a)
 
-data Input t m a = Input
-  { _input_show    :: Event t ()
-  , _input_content :: Content t m a
+data In t m a = In
+  { _in_show    :: Event t ()
+  , _in_content :: Content t m a
   }
 
-view :: forall t m a. MonadWidget t m => Input t m a -> m (Event t a)
+view :: forall t m a. MonadWidget t m => In t m a -> m (Event t a)
 view input = do
   rec
-    let show = Show <$ (_input_show input)
+    let show = Show <$ (_in_show input)
 
         startHiding =
           R.attachWithMaybe
@@ -61,7 +61,7 @@ view input = do
           (do
             (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
             let curtainClick = R.domEvent R.Click curtain
-            (hide, content) <- R.divClass "g-Modal__Content" (_input_content input curtainClick)
+            (hide, content) <- R.divClass "g-Modal__Content" (_in_content input curtainClick)
             return (curtainClick, hide, content))
 
 
diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
index 63cb1d2..ea53beb 100644
--- a/client/src/Component/ModalForm.hs
+++ b/client/src/Component/ModalForm.hs
@@ -1,7 +1,7 @@
 module Component.ModalForm
-  ( modalForm
-  , ModalFormIn(..)
-  , ModalFormOut(..)
+  ( view
+  , In(..)
+  , Out(..)
   ) where
 
 import           Data.Aeson         (ToJSON)
@@ -14,57 +14,56 @@ import           Reflex.Dom         (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom         as R
 
 import qualified Common.Msg         as Msg
-import           Component.Button   (ButtonIn (..))
 import qualified Component.Button   as Button
 import qualified Util.Either        as EitherUtil
 import qualified Util.Validation    as ValidationUtil
 import qualified Util.WaitFor       as WaitFor
 
-data ModalFormIn m t a b e = ModalFormIn
-  { _modalFormIn_headerLabel :: Text
-  , _modalFormIn_form        :: m (Dynamic t (Validation e a))
-  , _modalFormIn_ajax        :: Event t a -> m (Event t (Either Text b))
+data In m t a b e = In
+  { _in_headerLabel :: Text
+  , _in_form        :: m (Dynamic t (Validation e a))
+  , _in_ajax        :: Event t a -> m (Event t (Either Text b))
   }
 
-data ModalFormOut t a = ModalFormOut
-  { _modalFormOut_hide     :: Event t ()
-  , _modalFormOut_cancel   :: Event t ()
-  , _modalFormOut_confirm  :: Event t ()
-  , _modalFormOut_validate :: Event t a
+data Out t a = Out
+  { _out_hide     :: Event t ()
+  , _out_cancel   :: Event t ()
+  , _out_confirm  :: Event t ()
+  , _out_validate :: Event t a
   }
 
-modalForm :: forall t m a b e. (MonadWidget t m, ToJSON a) => ModalFormIn m t a b e -> m (ModalFormOut t b)
-modalForm modalFormIn =
+view :: forall t m a b e. (MonadWidget t m, ToJSON a) => In m t a b e -> m (Out t b)
+view input =
   R.divClass "form" $ do
     R.divClass "formHeader" $
-      R.text (_modalFormIn_headerLabel modalFormIn)
+      R.text (_in_headerLabel input)
 
     R.divClass "formContent" $ do
       rec
-        form <- _modalFormIn_form modalFormIn
+        form <- _in_form input
 
         (validate, cancel, confirm) <- R.divClass "buttons" $ do
           rec
-            cancel <- Button._buttonOut_clic <$> (Button.button $
-              (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
-                { _buttonIn_class = R.constDyn "undo" })
+            cancel <- Button._out_clic <$> (Button.view $
+              (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
+                { Button._in_class = R.constDyn "undo" })
 
-            confirm <- Button._buttonOut_clic <$> (Button.button $
-              (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
-                { _buttonIn_class = R.constDyn "confirm"
-                , _buttonIn_waiting = waiting
-                , _buttonIn_submit = True
+            confirm <- Button._out_clic <$> (Button.view $
+              (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
+                { Button._in_class = R.constDyn "confirm"
+                , Button._in_waiting = waiting
+                , Button._in_submit = True
                 })
 
             (validate, waiting) <- WaitFor.waitFor
-              (_modalFormIn_ajax modalFormIn)
+              (_in_ajax input)
               (ValidationUtil.fireValidation form confirm)
 
           return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm)
 
-      return ModalFormOut
-        { _modalFormOut_hide = R.leftmost [ cancel, () <$ validate ]
-        , _modalFormOut_cancel = cancel
-        , _modalFormOut_confirm = confirm
-        , _modalFormOut_validate = validate
+      return Out
+        { _out_hide = R.leftmost [ cancel, () <$ validate ]
+        , _out_cancel = cancel
+        , _out_confirm = confirm
+        , _out_validate = validate
         }
diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
index 7843ef6..7284a36 100644
--- a/client/src/Component/Pages.hs
+++ b/client/src/Component/Pages.hs
@@ -1,41 +1,40 @@
 module Component.Pages
-  ( widget
-  , PagesIn(..)
-  , PagesOut(..)
+  ( view
+  , In(..)
+  , Out(..)
   ) where
 
 import qualified Data.Text        as T
 import           Reflex.Dom       (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom       as R
 
-import           Component.Button (ButtonIn (..), ButtonOut (..))
 import qualified Component.Button as Button
 
 import qualified Util.Reflex      as ReflexUtil
 import qualified View.Icon        as Icon
 
-data PagesIn t = PagesIn
-  { _pagesIn_total   :: Dynamic t Int
-  , _pagesIn_perPage :: Int
-  , _pagesIn_reset   :: Event t ()
+data In t = In
+  { _in_total   :: Dynamic t Int
+  , _in_perPage :: Int
+  , _in_reset   :: Event t ()
   }
 
-data PagesOut t = PagesOut
-  { _pagesOut_currentPage :: Dynamic t Int
+data Out t = Out
+  { _out_currentPage :: Dynamic t Int
   }
 
-widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
-widget pagesIn = do
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input = do
   currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
 
-  return $ PagesOut
-    { _pagesOut_currentPage = currentPage
+  return $ Out
+    { _out_currentPage = currentPage
     }
 
   where
-    total = _pagesIn_total pagesIn
-    perPage = _pagesIn_perPage pagesIn
-    reset = _pagesIn_reset pagesIn
+    total = _in_total input
+    perPage = _in_perPage input
+    reset = _in_reset input
 
 pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
 pageButtons total perPage reset = do
@@ -75,14 +74,14 @@ range currentPage maxPage = [start..end]
 
 pageButton :: forall t m. MonadWidget t m => Dynamic t (Maybe Int) -> Dynamic t Int -> m () -> m (Event t Int)
 pageButton currentPage page content = do
-  clic <- _buttonOut_clic <$> (Button.button $ ButtonIn
-    { _buttonIn_class   = do
+  clic <- Button._out_clic <$> (Button.view $ Button.In
+    { Button._in_class   = do
         cp <- currentPage
         p <- page
         if cp == Just p then "page current" else "page"
-    , _buttonIn_content = content
-    , _buttonIn_waiting = R.never
-    , _buttonIn_tabIndex = Nothing
-    , _buttonIn_submit = False
+    , Button._in_content = content
+    , Button._in_waiting = R.never
+    , Button._in_tabIndex = Nothing
+    , Button._in_submit = False
     })
   return . fmap fst $ R.attach (R.current page) clic
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 102f554..375ae06 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -1,7 +1,7 @@
 module Component.Select
-  ( SelectIn(..)
-  , SelectOut(..)
-  , select
+  ( view
+  , In(..)
+  , Out(..)
   ) where
 
 import           Data.Map        (Map)
@@ -15,58 +15,58 @@ import qualified Reflex.Dom      as R
 
 import qualified Util.Validation as ValidationUtil
 
-data (Reflex t) => SelectIn t a b c = SelectIn
-  { _selectIn_label        :: Text
-  , _selectIn_initialValue :: a
-  , _selectIn_value        :: Event t a
-  , _selectIn_values       :: Dynamic t (Map a Text)
-  , _selectIn_reset        :: Event t b
-  , _selectIn_isValid      :: a -> Validation Text a
-  , _selectIn_validate     :: Event t c
+data (Reflex t) => In t a b c = In
+  { _in_label        :: Text
+  , _in_initialValue :: a
+  , _in_value        :: Event t a
+  , _in_values       :: Dynamic t (Map a Text)
+  , _in_reset        :: Event t b
+  , _in_isValid      :: a -> Validation Text a
+  , _in_validate     :: Event t c
   }
 
-data SelectOut t a = SelectOut
-  { _selectOut_raw   :: Dynamic t a
-  , _selectOut_value :: Dynamic t (Validation Text a)
+data Out t a = Out
+  { _out_raw   :: Dynamic t a
+  , _out_value :: Dynamic t (Validation Text a)
   }
 
-select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a)
-select selectIn = do
+view :: forall t m a b c. (Ord a, MonadWidget t m) => In t a b c -> m (Out t a)
+view input = do
   rec
     let containerAttr = R.ffor showedError (\e ->
           M.singleton "class" $ T.intercalate " "
-            [ "selectInput"
+            [ "input"
             , if Maybe.isJust e then "error" else ""
             ])
 
         validatedValue =
-          fmap (_selectIn_isValid selectIn) value
+          fmap (_in_isValid input) value
 
         maybeError =
           fmap ValidationUtil.maybeError validatedValue
 
     showedError <- R.holdDyn Nothing $ R.leftmost
-      [ Nothing <$ _selectIn_reset selectIn
+      [ Nothing <$ _in_reset input
       , R.updated maybeError
-      , R.attachWith const (R.current maybeError) (_selectIn_validate selectIn)
+      , R.attachWith const (R.current maybeError) (_in_validate input)
       ]
 
     value <- R.elDynAttr "div" containerAttr $ do
-      let initialValue = _selectIn_initialValue selectIn
+      let initialValue = _in_initialValue input
 
       let setValue = R.leftmost
-            [ initialValue <$ (_selectIn_reset selectIn)
-            , _selectIn_value selectIn
+            [ initialValue <$ (_in_reset input)
+            , _in_value input
             ]
 
       value <- R.el "label" $ do
         R.divClass "label" $
-          R.text (_selectIn_label selectIn)
+          R.text (_in_label input)
 
         R._dropdown_value <$>
           R.dropdown
             initialValue
-            (_selectIn_values selectIn)
+            (_in_values input)
             (R.def { R._dropdownConfig_setValue = setValue })
 
       R.divClass "errorMessage" . R.dynText $
@@ -74,7 +74,7 @@ select selectIn = do
 
       return value
 
-  return SelectOut
-    { _selectOut_raw = value
-    , _selectOut_value = validatedValue
+  return Out
+    { _out_raw = value
+    , _out_value = validatedValue
     }
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index b431c14..bf76566 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -1,29 +1,28 @@
 module Component.Table
-  ( table
-  , TableIn(..)
-  , TableOut(..)
+  ( view
+  , In(..)
+  , Out(..)
   ) where
 
 import           Data.Text       (Text)
 import           Reflex.Dom      (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom      as R
 
-import           Component.Pages (PagesIn (..), PagesOut (..))
 import qualified Component.Pages as Pages
 
-data TableIn h r t = TableIn
-  { _tableIn_headerLabel :: h -> Text
-  , _tableIn_rows        :: Dynamic t [r]
-  , _tableIn_cell        :: h -> r -> Text
-  , _tableIn_perPage     :: Int
-  , _tableIn_resetPage   :: Event t ()
+data In h r t = In
+  { _in_headerLabel :: h -> Text
+  , _in_rows        :: Dynamic t [r]
+  , _in_cell        :: h -> r -> Text
+  , _in_perPage     :: Int
+  , _in_resetPage   :: Event t ()
   }
 
-data TableOut = TableOut
+data Out = Out
   {}
 
-table :: forall t m h r. (MonadWidget t m, Bounded h, Enum h)  => TableIn h r t -> m (TableOut)
-table tableIn =
+view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h)  => In h r t -> m (Out)
+view input =
   R.divClass "table" $ do
     rec
       R.divClass "lines" $ do
@@ -31,29 +30,29 @@ table tableIn =
         R.divClass "header" $
           flip mapM_ [minBound..] $ \header ->
             R.divClass "cell" . R.text $
-              _tableIn_headerLabel tableIn header
+              _in_headerLabel input header
 
         let rows = getRange
-              (_tableIn_perPage tableIn)
-                <$> (_pagesOut_currentPage pages)
-                <*> (_tableIn_rows tableIn)
+              (_in_perPage input)
+                <$> (Pages._out_currentPage pages)
+                <*> (_in_rows input)
 
         R.simpleList rows $ \r ->
           R.divClass "row" $
             flip mapM_ [minBound..] $ \h ->
               R.divClass "cell name" $
                 R.dynText $
-                  R.ffor r (_tableIn_cell tableIn h)
+                  R.ffor r (_in_cell input h)
 
-      pages <- Pages.widget $ PagesIn
-        { _pagesIn_total = length <$> (_tableIn_rows tableIn)
-        , _pagesIn_perPage = _tableIn_perPage tableIn
-        , _pagesIn_reset = _tableIn_resetPage tableIn
+      pages <- Pages.view $ Pages.In
+        { Pages._in_total = length <$> (_in_rows input)
+        , Pages._in_perPage = _in_perPage input
+        , Pages._in_reset = _in_resetPage input
         }
 
       return ()
 
-    return $ TableOut
+    return $ Out
       {}
 
 getRange :: forall a. Int -> Int -> [a] -> [a]
-- 
cgit v1.2.3


From 61ff1443c42def5a09f624e3df2e2520e97610d0 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 22 Oct 2019 23:25:05 +0200
Subject: Clone incomes

---
 client/src/Component/Table.hs | 54 ++++++++++++++++++++++++++++++++-----------
 1 file changed, 40 insertions(+), 14 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index bf76566..5819f45 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -4,56 +4,82 @@ module Component.Table
   , Out(..)
   ) where
 
-import           Data.Text       (Text)
-import           Reflex.Dom      (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom      as R
+import           Data.Text        (Text)
+import           Reflex.Dom       (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom       as R
 
-import qualified Component.Pages as Pages
+import qualified Component.Button as Button
+import qualified Component.Modal  as Modal
+import qualified Component.Pages  as Pages
+import qualified Util.Reflex      as ReflexUtil
+import qualified View.Icon        as Icon
 
-data In h r t = In
+data In m t h r a = In
   { _in_headerLabel :: h -> Text
   , _in_rows        :: Dynamic t [r]
   , _in_cell        :: h -> r -> Text
   , _in_perPage     :: Int
   , _in_resetPage   :: Event t ()
+  , _in_cloneModal  :: Dynamic t r -> Modal.Content t m a
   }
 
-data Out = Out
-  {}
+data Out t a = Out
+  { _out_add :: Event t a
+  }
 
-view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h)  => In h r t -> m (Out)
+view :: forall t m h r a. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a -> m (Out t a)
 view input =
   R.divClass "table" $ do
     rec
-      R.divClass "lines" $ do
+      result <- R.divClass "lines" $ do
 
-        R.divClass "header" $
+        R.divClass "header" $ do
           flip mapM_ [minBound..] $ \header ->
             R.divClass "cell" . R.text $
               _in_headerLabel input header
 
+          R.divClass "cell" $ R.blank
+
         let rows = getRange
               (_in_perPage input)
                 <$> (Pages._out_currentPage pages)
                 <*> (_in_rows input)
 
         R.simpleList rows $ \r ->
-          R.divClass "row" $
+          R.divClass "row" $ do
             flip mapM_ [minBound..] $ \h ->
-              R.divClass "cell name" $
+              R.divClass "cell" $
                 R.dynText $
                   R.ffor r (_in_cell input h)
 
+            clone <-
+              R.divClass "cell button" $
+                Button._out_clic <$> (Button.view $
+                  Button.defaultIn Icon.clone)
+
+            cloned <-
+              Modal.view $ Modal.In
+                { Modal._in_show    = clone
+                , Modal._in_content = _in_cloneModal input r
+                }
+
+            return cloned
+
       pages <- Pages.view $ Pages.In
         { Pages._in_total = length <$> (_in_rows input)
         , Pages._in_perPage = _in_perPage input
         , Pages._in_reset = _in_resetPage input
         }
 
-      return ()
+      -- return $
+      --   ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
+      --   , R.switch . R.current . fmap (R.leftmost . map (\(_, b, _) -> b)) $ result
+      --   , R.switch . R.current . fmap (R.leftmost . map (\(_, _, c) -> c)) $ result
+      --   )
 
     return $ Out
-      {}
+      { _out_add = R.switch . R.current . fmap R.leftmost $ result
+      }
 
 getRange :: forall a. Int -> Int -> [a] -> [a]
 getRange perPage currentPage =
-- 
cgit v1.2.3


From f968c8ce63e1aec119b1e6f414cf27e2c0294bcb Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 23 Oct 2019 21:09:54 +0200
Subject: Delete income

---
 client/src/Component/ConfirmDialog.hs | 49 +++++++++++++++++++++++++++++++++++
 client/src/Component/Table.hs         | 42 ++++++++++++++++++++++--------
 2 files changed, 80 insertions(+), 11 deletions(-)
 create mode 100644 client/src/Component/ConfirmDialog.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/ConfirmDialog.hs b/client/src/Component/ConfirmDialog.hs
new file mode 100644
index 0000000..50e30ed
--- /dev/null
+++ b/client/src/Component/ConfirmDialog.hs
@@ -0,0 +1,49 @@
+module Component.ConfirmDialog
+  ( In(..)
+  , view
+  ) where
+
+import           Data.Text        (Text)
+import           Reflex.Dom       (Event, MonadWidget)
+import qualified Reflex.Dom       as R
+
+import qualified Common.Msg       as Msg
+import qualified Component.Button as Button
+import qualified Component.Modal  as Modal
+import qualified Util.Either      as EitherUtil
+import qualified Util.WaitFor     as WaitFor
+
+data In t m a = In
+  { _in_header  :: Text
+  , _in_confirm :: Event t () -> m (Event t a)
+  }
+
+view :: forall t m a. MonadWidget t m => (In t m a) -> Modal.Content t m a
+view input _ =
+  R.divClass "confirm" $ do
+    R.divClass "confirmHeader" $
+      R.text $ _in_header input
+
+    R.divClass "confirmContent" $ do
+      (confirm, cancel) <- R.divClass "buttons" $ do
+
+        cancel <- Button._out_clic <$> (Button.view $
+          (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
+            { Button._in_class = R.constDyn "undo" })
+
+        rec
+          confirm <- Button._out_clic <$> (Button.view $
+            (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
+              { Button._in_class = R.constDyn "confirm"
+              , Button._in_submit = True
+              , Button._in_waiting = waiting
+              })
+
+          (result, waiting) <- WaitFor.waitFor (_in_confirm input) confirm
+
+        return (result, cancel)
+
+      return $
+        ( R.leftmost [ cancel, () <$ confirm ]
+        , confirm
+        )
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index 5819f45..b3c70a0 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -20,11 +20,14 @@ data In m t h r a = In
   , _in_cell        :: h -> r -> Text
   , _in_perPage     :: Int
   , _in_resetPage   :: Event t ()
-  , _in_cloneModal  :: Dynamic t r -> Modal.Content t m a
+  , _in_cloneModal  :: r -> Modal.Content t m a
+  , _in_deleteModal :: r -> Modal.Content t m a
+  , _in_isOwner     :: r -> Bool
   }
 
 data Out t a = Out
-  { _out_add :: Event t a
+  { _out_add    :: Event t a
+  , _out_delete :: Event t a
   }
 
 view :: forall t m h r a. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a -> m (Out t a)
@@ -39,6 +42,7 @@ view input =
               _in_headerLabel input header
 
           R.divClass "cell" $ R.blank
+          R.divClass "cell" $ R.blank
 
         let rows = getRange
               (_in_perPage input)
@@ -60,25 +64,41 @@ view input =
             cloned <-
               Modal.view $ Modal.In
                 { Modal._in_show    = clone
-                , Modal._in_content = _in_cloneModal input r
+                , Modal._in_content = \curtainClick ->
+                  (R.dyn . R.ffor r $ \r2 -> _in_cloneModal input r2 curtainClick)
+                    >>= ReflexUtil.flattenTuple
+                }
+
+            let isOwner = R.ffor r (_in_isOwner input)
+
+            delete <-
+              R.divClass "cell button" $
+                ReflexUtil.divVisibleIf isOwner $
+                  Button._out_clic <$> (Button.view $
+                    Button.defaultIn Icon.delete)
+
+            deleted <-
+              Modal.view $ Modal.In
+                { Modal._in_show    = delete
+                , Modal._in_content = \curtainClick ->
+                  (R.dyn . R.ffor r $ \r2 -> _in_deleteModal input r2 curtainClick)
+                    >>= ReflexUtil.flattenTuple
                 }
 
-            return cloned
+            return (cloned, deleted)
 
       pages <- Pages.view $ Pages.In
-        { Pages._in_total = length <$> (_in_rows input)
+        { Pages._in_total = length <$> _in_rows input
         , Pages._in_perPage = _in_perPage input
         , Pages._in_reset = _in_resetPage input
         }
 
-      -- return $
-      --   ( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
-      --   , R.switch . R.current . fmap (R.leftmost . map (\(_, b, _) -> b)) $ result
-      --   , R.switch . R.current . fmap (R.leftmost . map (\(_, _, c) -> c)) $ result
-      --   )
+    let add = R.switch . R.current . fmap (R.leftmost . map fst) $ result
+        delete = R.switch . R.current . fmap (R.leftmost . map snd) $ result
 
     return $ Out
-      { _out_add = R.switch . R.current . fmap R.leftmost $ result
+      { _out_add = add
+      , _out_delete = delete
       }
 
 getRange :: forall a. Int -> Int -> [a] -> [a]
-- 
cgit v1.2.3


From e4b32ce15f8c92f3b477d3f3d4d301ba08f9b5e3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 23 Oct 2019 22:35:27 +0200
Subject: Edit an income

---
 client/src/Component/ModalForm.hs | 50 ++++++++++++++++++++-------------------
 client/src/Component/Table.hs     | 25 +++++++++++++++++---
 2 files changed, 48 insertions(+), 27 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
index ea53beb..f5bf287 100644
--- a/client/src/Component/ModalForm.hs
+++ b/client/src/Component/ModalForm.hs
@@ -15,6 +15,7 @@ import qualified Reflex.Dom         as R
 
 import qualified Common.Msg         as Msg
 import qualified Component.Button   as Button
+import qualified Component.Form     as Form
 import qualified Util.Either        as EitherUtil
 import qualified Util.Validation    as ValidationUtil
 import qualified Util.WaitFor       as WaitFor
@@ -38,32 +39,33 @@ view input =
     R.divClass "formHeader" $
       R.text (_in_headerLabel input)
 
-    R.divClass "formContent" $ do
-      rec
-        form <- _in_form input
+    Form.view $
+      R.divClass "formContent" $ do
+        rec
+          form <- _in_form input
 
-        (validate, cancel, confirm) <- R.divClass "buttons" $ do
-          rec
-            cancel <- Button._out_clic <$> (Button.view $
-              (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
-                { Button._in_class = R.constDyn "undo" })
+          (validate, cancel, confirm) <- R.divClass "buttons" $ do
+            rec
+              cancel <- Button._out_clic <$> (Button.view $
+                (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
+                  { Button._in_class = R.constDyn "undo" })
 
-            confirm <- Button._out_clic <$> (Button.view $
-              (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
-                { Button._in_class = R.constDyn "confirm"
-                , Button._in_waiting = waiting
-                , Button._in_submit = True
-                })
+              confirm <- Button._out_clic <$> (Button.view $
+                (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
+                  { Button._in_class = R.constDyn "confirm"
+                  , Button._in_waiting = waiting
+                  , Button._in_submit = True
+                  })
 
-            (validate, waiting) <- WaitFor.waitFor
-              (_in_ajax input)
-              (ValidationUtil.fireValidation form confirm)
+              (validate, waiting) <- WaitFor.waitFor
+                (_in_ajax input)
+                (ValidationUtil.fireValidation form confirm)
 
-          return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm)
+            return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm)
 
-      return Out
-        { _out_hide = R.leftmost [ cancel, () <$ validate ]
-        , _out_cancel = cancel
-        , _out_confirm = confirm
-        , _out_validate = validate
-        }
+        return Out
+          { _out_hide = R.leftmost [ cancel, () <$ validate ]
+          , _out_cancel = cancel
+          , _out_confirm = confirm
+          , _out_validate = validate
+          }
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index b3c70a0..a02eaa7 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -21,12 +21,14 @@ data In m t h r a = In
   , _in_perPage     :: Int
   , _in_resetPage   :: Event t ()
   , _in_cloneModal  :: r -> Modal.Content t m a
+  , _in_editModal   :: r -> Modal.Content t m a
   , _in_deleteModal :: r -> Modal.Content t m a
   , _in_isOwner     :: r -> Bool
   }
 
 data Out t a = Out
   { _out_add    :: Event t a
+  , _out_edit   :: Event t a
   , _out_delete :: Event t a
   }
 
@@ -43,6 +45,7 @@ view input =
 
           R.divClass "cell" $ R.blank
           R.divClass "cell" $ R.blank
+          R.divClass "cell" $ R.blank
 
         let rows = getRange
               (_in_perPage input)
@@ -71,6 +74,20 @@ view input =
 
             let isOwner = R.ffor r (_in_isOwner input)
 
+            edit <-
+              R.divClass "cell button" $
+                ReflexUtil.divVisibleIf isOwner $
+                  Button._out_clic <$> (Button.view $
+                    Button.defaultIn Icon.edit)
+
+            edited <-
+              Modal.view $ Modal.In
+                { Modal._in_show    = edit
+                , Modal._in_content = \curtainClick ->
+                  (R.dyn . R.ffor r $ \r2 -> _in_editModal input r2 curtainClick)
+                    >>= ReflexUtil.flattenTuple
+                }
+
             delete <-
               R.divClass "cell button" $
                 ReflexUtil.divVisibleIf isOwner $
@@ -85,7 +102,7 @@ view input =
                     >>= ReflexUtil.flattenTuple
                 }
 
-            return (cloned, deleted)
+            return (cloned, edited, deleted)
 
       pages <- Pages.view $ Pages.In
         { Pages._in_total = length <$> _in_rows input
@@ -93,11 +110,13 @@ view input =
         , Pages._in_reset = _in_resetPage input
         }
 
-    let add = R.switch . R.current . fmap (R.leftmost . map fst) $ result
-        delete = R.switch . R.current . fmap (R.leftmost . map snd) $ result
+    let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
+        edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result
+        delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result
 
     return $ Out
       { _out_add = add
+      , _out_edit = edit
       , _out_delete = delete
       }
 
-- 
cgit v1.2.3


From b97ad942495352c3fc1e0c820cfba82a9693ac7a Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 27 Oct 2019 20:26:29 +0100
Subject: WIP Set up server side paging for incomes

---
 client/src/Component/Pages.hs | 37 +++++++++++++++++++++----------------
 client/src/Component/Table.hs | 20 +-------------------
 2 files changed, 22 insertions(+), 35 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
index 7284a36..a297222 100644
--- a/client/src/Component/Pages.hs
+++ b/client/src/Component/Pages.hs
@@ -16,38 +16,43 @@ import qualified View.Icon        as Icon
 data In t = In
   { _in_total   :: Dynamic t Int
   , _in_perPage :: Int
-  , _in_reset   :: Event t ()
   }
 
 data Out t = Out
-  { _out_currentPage :: Dynamic t Int
+  { _out_newPage     :: Event t Int
+  , _out_currentPage :: Dynamic t Int
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
 view input = do
-  currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
+  (newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage
 
   return $ Out
-    { _out_currentPage = currentPage
+    { _out_newPage = newPage
+    , _out_currentPage = currentPage
     }
 
   where
     total = _in_total input
     perPage = _in_perPage input
-    reset = _in_reset input
 
-pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
-pageButtons total perPage reset = do
+pageButtons
+  :: forall t m. MonadWidget t m
+  => Dynamic t Int
+  -> Int
+  -> m (Event t Int, Dynamic t Int)
+pageButtons total perPage = do
   R.divClass "pages" $ do
     rec
-      currentPage <- R.holdDyn 1 . R.leftmost $
-        [ firstPageClic
-        , previousPageClic
-        , pageClic
-        , nextPageClic
-        , lastPageClic
-        , 1 <$ reset
-        ]
+      let newPage = R.leftmost
+            [ firstPageClic
+            , previousPageClic
+            , pageClic
+            , nextPageClic
+            , lastPageClic
+            ]
+
+      currentPage <- R.holdDyn 1 newPage
 
       firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
 
@@ -60,7 +65,7 @@ pageButtons total perPage reset = do
 
       lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
 
-    return currentPage
+    return (newPage, currentPage)
 
     where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
           pageEvent = R.switch . R.current . fmap R.leftmost
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index a02eaa7..7103abd 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -10,7 +10,6 @@ import qualified Reflex.Dom       as R
 
 import qualified Component.Button as Button
 import qualified Component.Modal  as Modal
-import qualified Component.Pages  as Pages
 import qualified Util.Reflex      as ReflexUtil
 import qualified View.Icon        as Icon
 
@@ -18,8 +17,6 @@ data In m t h r a = In
   { _in_headerLabel :: h -> Text
   , _in_rows        :: Dynamic t [r]
   , _in_cell        :: h -> r -> Text
-  , _in_perPage     :: Int
-  , _in_resetPage   :: Event t ()
   , _in_cloneModal  :: r -> Modal.Content t m a
   , _in_editModal   :: r -> Modal.Content t m a
   , _in_deleteModal :: r -> Modal.Content t m a
@@ -47,12 +44,7 @@ view input =
           R.divClass "cell" $ R.blank
           R.divClass "cell" $ R.blank
 
-        let rows = getRange
-              (_in_perPage input)
-                <$> (Pages._out_currentPage pages)
-                <*> (_in_rows input)
-
-        R.simpleList rows $ \r ->
+        R.simpleList (_in_rows input) $ \r ->
           R.divClass "row" $ do
             flip mapM_ [minBound..] $ \h ->
               R.divClass "cell" $
@@ -104,12 +96,6 @@ view input =
 
             return (cloned, edited, deleted)
 
-      pages <- Pages.view $ Pages.In
-        { Pages._in_total = length <$> _in_rows input
-        , Pages._in_perPage = _in_perPage input
-        , Pages._in_reset = _in_resetPage input
-        }
-
     let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
         edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result
         delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result
@@ -119,7 +105,3 @@ view input =
       , _out_edit = edit
       , _out_delete = delete
       }
-
-getRange :: forall a. Int -> Int -> [a] -> [a]
-getRange perPage currentPage =
-  take perPage . drop ((currentPage - 1) * perPage)
-- 
cgit v1.2.3


From 227dcd4435b775d7dbc5ae5d3d81b589897253cc Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 2 Nov 2019 20:52:27 +0100
Subject: Implement incomes server side paging

---
 client/src/Component/Pages.hs | 22 ++++++---------
 client/src/Component/Table.hs | 62 +++++++++++++++++++++----------------------
 2 files changed, 39 insertions(+), 45 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
index a297222..d54cd3d 100644
--- a/client/src/Component/Pages.hs
+++ b/client/src/Component/Pages.hs
@@ -16,32 +16,26 @@ import qualified View.Icon        as Icon
 data In t = In
   { _in_total   :: Dynamic t Int
   , _in_perPage :: Int
+  , _in_page    :: Int
   }
 
 data Out t = Out
   { _out_newPage     :: Event t Int
-  , _out_currentPage :: Dynamic t Int
   }
 
 view :: forall t m. MonadWidget t m => In t -> m (Out t)
 view input = do
-  (newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage
+  newPage <- ReflexUtil.divVisibleIf ((> 0) <$> (_in_total input)) $ pageButtons input
 
   return $ Out
     { _out_newPage = newPage
-    , _out_currentPage = currentPage
     }
 
-  where
-    total = _in_total input
-    perPage = _in_perPage input
-
 pageButtons
   :: forall t m. MonadWidget t m
-  => Dynamic t Int
-  -> Int
-  -> m (Event t Int, Dynamic t Int)
-pageButtons total perPage = do
+  => In t
+  -> m (Event t Int)
+pageButtons input = do
   R.divClass "pages" $ do
     rec
       let newPage = R.leftmost
@@ -52,7 +46,7 @@ pageButtons total perPage = do
             , lastPageClic
             ]
 
-      currentPage <- R.holdDyn 1 newPage
+      currentPage <- R.holdDyn (_in_page input) newPage
 
       firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
 
@@ -65,9 +59,9 @@ pageButtons total perPage = do
 
       lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
 
-    return (newPage, currentPage)
+    return newPage
 
-    where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
+    where maxPage = R.ffor (_in_total input) (\t -> ceiling $ toRational t / toRational (_in_perPage input))
           pageEvent = R.switch . R.current . fmap R.leftmost
           noCurrentPage = R.constDyn Nothing
 
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index 7103abd..3b9ec24 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -4,8 +4,9 @@ module Component.Table
   , Out(..)
   ) where
 
+import qualified Data.Map as M
 import           Data.Text        (Text)
-import           Reflex.Dom       (Dynamic, Event, MonadWidget)
+import           Reflex.Dom       (Event, MonadWidget)
 import qualified Reflex.Dom       as R
 
 import qualified Component.Button as Button
@@ -15,7 +16,7 @@ import qualified View.Icon        as Icon
 
 data In m t h r a = In
   { _in_headerLabel :: h -> Text
-  , _in_rows        :: Dynamic t [r]
+  , _in_rows        :: [r]
   , _in_cell        :: h -> r -> Text
   , _in_cloneModal  :: r -> Modal.Content t m a
   , _in_editModal   :: r -> Modal.Content t m a
@@ -44,61 +45,60 @@ view input =
           R.divClass "cell" $ R.blank
           R.divClass "cell" $ R.blank
 
-        R.simpleList (_in_rows input) $ \r ->
+        flip mapM (_in_rows input) $ \row ->
           R.divClass "row" $ do
-            flip mapM_ [minBound..] $ \h ->
+            flip mapM_ [minBound..] $ \header ->
               R.divClass "cell" $
-                R.dynText $
-                  R.ffor r (_in_cell input h)
+                R.text $
+                  _in_cell input header row
 
-            clone <-
+            cloneButton <-
               R.divClass "cell button" $
                 Button._out_clic <$> (Button.view $
                   Button.defaultIn Icon.clone)
 
-            cloned <-
+            clone <-
               Modal.view $ Modal.In
-                { Modal._in_show    = clone
-                , Modal._in_content = \curtainClick ->
-                  (R.dyn . R.ffor r $ \r2 -> _in_cloneModal input r2 curtainClick)
-                    >>= ReflexUtil.flattenTuple
+                { Modal._in_show    = cloneButton
+                , Modal._in_content = _in_cloneModal input row
                 }
 
-            let isOwner = R.ffor r (_in_isOwner input)
+            let isOwner = _in_isOwner input row
 
-            edit <-
+            let visibleIf cond =
+                  R.elAttr
+                    "div"
+                    (if cond then M.empty else M.singleton "style" "display:none")
+
+            editButton <-
               R.divClass "cell button" $
-                ReflexUtil.divVisibleIf isOwner $
+                visibleIf isOwner $
                   Button._out_clic <$> (Button.view $
                     Button.defaultIn Icon.edit)
 
-            edited <-
+            edit <-
               Modal.view $ Modal.In
-                { Modal._in_show    = edit
-                , Modal._in_content = \curtainClick ->
-                  (R.dyn . R.ffor r $ \r2 -> _in_editModal input r2 curtainClick)
-                    >>= ReflexUtil.flattenTuple
+                { Modal._in_show    = editButton
+                , Modal._in_content = _in_editModal input row
                 }
 
-            delete <-
+            deleteButton <-
               R.divClass "cell button" $
-                ReflexUtil.divVisibleIf isOwner $
+                visibleIf isOwner $
                   Button._out_clic <$> (Button.view $
                     Button.defaultIn Icon.delete)
 
-            deleted <-
+            delete <-
               Modal.view $ Modal.In
-                { Modal._in_show    = delete
-                , Modal._in_content = \curtainClick ->
-                  (R.dyn . R.ffor r $ \r2 -> _in_deleteModal input r2 curtainClick)
-                    >>= ReflexUtil.flattenTuple
+                { Modal._in_show    = deleteButton
+                , Modal._in_content = _in_deleteModal input row
                 }
 
-            return (cloned, edited, deleted)
+            return (clone, edit, delete)
 
-    let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
-        edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result
-        delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result
+    let add = R.leftmost . map (\(a, _, _) -> a) $ result
+        edit = R.leftmost . map (\(_, a, _) -> a) $ result
+        delete = R.leftmost . map (\(_, _, a) -> a) $ result
 
     return $ Out
       { _out_add = add
-- 
cgit v1.2.3


From a267f0bb4566389342c3244d3c082dc2453f4615 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Nov 2019 09:22:12 +0100
Subject: Show users in income table

---
 client/src/Component/Appearing.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)
 create mode 100644 client/src/Component/Appearing.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/Appearing.hs b/client/src/Component/Appearing.hs
new file mode 100644
index 0000000..e0144ca
--- /dev/null
+++ b/client/src/Component/Appearing.hs
@@ -0,0 +1,10 @@
+module Component.Appearing
+  ( view
+  ) where
+
+import           Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+view :: forall t m a. MonadWidget t m => m a -> m a
+view =
+  R.divClass "g-Appearing"
-- 
cgit v1.2.3


From 4c79ca374e030454f62a467fb4f2197d372e9bc1 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Nov 2019 15:53:46 +0100
Subject: Fix select input style

---
 client/src/Component/Select.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 375ae06..70f5f58 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -35,7 +35,7 @@ view input = do
   rec
     let containerAttr = R.ffor showedError (\e ->
           M.singleton "class" $ T.intercalate " "
-            [ "input"
+            [ "input selectInput"
             , if Maybe.isJust e then "error" else ""
             ])
 
-- 
cgit v1.2.3


From 58f6c4e25f5f20f1b608242c83786e2f13947804 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Nov 2019 16:09:30 +0100
Subject: Delay modal event to let time for the modal to disappear

---
 client/src/Component/Modal.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index 50af469..b0533e2 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -71,7 +71,8 @@ view input = do
     let hide = R.switchDyn $ (\(_, b, _) -> b) <$> dyn
     let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
 
-  return content
+  -- Delay the event in order to let time for the modal to disappear
+  R.delay (0.3 :: NominalDiffTime) content
 
 getAttributes :: Text -> LM.Map Text Text
 getAttributes modalClass =
-- 
cgit v1.2.3


From f4f24158a46d8c0975f1b8813bbdbbeebad8c108 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 6 Nov 2019 19:44:15 +0100
Subject: Show the payment table with server side paging

---
 client/src/Component/Modal.hs |  2 +-
 client/src/Component/Table.hs | 21 ++++++++++-----------
 2 files changed, 11 insertions(+), 12 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index b0533e2..08f2e74 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -72,7 +72,7 @@ view input = do
     let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
 
   -- Delay the event in order to let time for the modal to disappear
-  R.delay (0.3 :: NominalDiffTime) content
+  R.delay (0.5 :: NominalDiffTime) content
 
 getAttributes :: Text -> LM.Map Text Text
 getAttributes modalClass =
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index 3b9ec24..2869c2d 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -4,7 +4,7 @@ module Component.Table
   , Out(..)
   ) where
 
-import qualified Data.Map as M
+import qualified Data.Map         as M
 import           Data.Text        (Text)
 import           Reflex.Dom       (Event, MonadWidget)
 import qualified Reflex.Dom       as R
@@ -14,23 +14,23 @@ import qualified Component.Modal  as Modal
 import qualified Util.Reflex      as ReflexUtil
 import qualified View.Icon        as Icon
 
-data In m t h r a = In
+data In m t h r a b c = In
   { _in_headerLabel :: h -> Text
   , _in_rows        :: [r]
-  , _in_cell        :: h -> r -> Text
+  , _in_cell        :: h -> r -> m ()
   , _in_cloneModal  :: r -> Modal.Content t m a
-  , _in_editModal   :: r -> Modal.Content t m a
-  , _in_deleteModal :: r -> Modal.Content t m a
+  , _in_editModal   :: r -> Modal.Content t m b
+  , _in_deleteModal :: r -> Modal.Content t m c
   , _in_isOwner     :: r -> Bool
   }
 
-data Out t a = Out
+data Out t a b c = Out
   { _out_add    :: Event t a
-  , _out_edit   :: Event t a
-  , _out_delete :: Event t a
+  , _out_edit   :: Event t b
+  , _out_delete :: Event t c
   }
 
-view :: forall t m h r a. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a -> m (Out t a)
+view :: forall t m h r a b c. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a b c-> m (Out t a b c)
 view input =
   R.divClass "table" $ do
     rec
@@ -49,8 +49,7 @@ view input =
           R.divClass "row" $ do
             flip mapM_ [minBound..] $ \header ->
               R.divClass "cell" $
-                R.text $
-                  _in_cell input header row
+                _in_cell input header row
 
             cloneButton <-
               R.divClass "cell button" $
-- 
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/Component/ConfirmDialog.hs |  6 +++---
 client/src/Component/Modal.hs         |  8 ++++----
 client/src/Component/ModalForm.hs     | 10 +++++-----
 client/src/Component/Table.hs         | 18 +++++++++---------
 client/src/Component/Tag.hs           | 27 +++++++++++++++++++++++++++
 5 files changed, 48 insertions(+), 21 deletions(-)
 create mode 100644 client/src/Component/Tag.hs

(limited to 'client/src/Component')

diff --git a/client/src/Component/ConfirmDialog.hs b/client/src/Component/ConfirmDialog.hs
index 50e30ed..cf26593 100644
--- a/client/src/Component/ConfirmDialog.hs
+++ b/client/src/Component/ConfirmDialog.hs
@@ -13,12 +13,12 @@ import qualified Component.Modal  as Modal
 import qualified Util.Either      as EitherUtil
 import qualified Util.WaitFor     as WaitFor
 
-data In t m a = In
+data In t m = In
   { _in_header  :: Text
-  , _in_confirm :: Event t () -> m (Event t a)
+  , _in_confirm :: Event t () -> m (Event t ())
   }
 
-view :: forall t m a. MonadWidget t m => (In t m a) -> Modal.Content t m a
+view :: forall t m a. MonadWidget t m => (In t m) -> Modal.Content t m
 view input _ =
   R.divClass "confirm" $ do
     R.divClass "confirmHeader" $
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index 08f2e74..46d3f64 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -20,14 +20,14 @@ import qualified Reflex.Dom.Class  as R
 import qualified Util.Reflex       as ReflexUtil
 
 -- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
-type Content t m a = Event t () -> m (Event t (), Event t a)
+type Content t m = Event t () -> m (Event t (), Event t ())
 
-data In t m a = In
+data In t m = In
   { _in_show    :: Event t ()
-  , _in_content :: Content t m a
+  , _in_content :: Content t m
   }
 
-view :: forall t m a. MonadWidget t m => In t m a -> m (Event t a)
+view :: forall t m a. MonadWidget t m => In t m -> m (Event t ())
 view input = do
   rec
     let show = Show <$ (_in_show input)
diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
index f5bf287..c56ff88 100644
--- a/client/src/Component/ModalForm.hs
+++ b/client/src/Component/ModalForm.hs
@@ -20,20 +20,20 @@ import qualified Util.Either        as EitherUtil
 import qualified Util.Validation    as ValidationUtil
 import qualified Util.WaitFor       as WaitFor
 
-data In m t a b e = In
+data In m t a e = In
   { _in_headerLabel :: Text
   , _in_form        :: m (Dynamic t (Validation e a))
-  , _in_ajax        :: Event t a -> m (Event t (Either Text b))
+  , _in_ajax        :: Event t a -> m (Event t (Either Text ()))
   }
 
-data Out t a = Out
+data Out t = Out
   { _out_hide     :: Event t ()
   , _out_cancel   :: Event t ()
   , _out_confirm  :: Event t ()
-  , _out_validate :: Event t a
+  , _out_validate :: Event t ()
   }
 
-view :: forall t m a b e. (MonadWidget t m, ToJSON a) => In m t a b e -> m (Out t b)
+view :: forall t m a e. (MonadWidget t m, ToJSON a) => In m t a e -> m (Out t)
 view input =
   R.divClass "form" $ do
     R.divClass "formHeader" $
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index 2869c2d..f82cfa6 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -14,23 +14,23 @@ import qualified Component.Modal  as Modal
 import qualified Util.Reflex      as ReflexUtil
 import qualified View.Icon        as Icon
 
-data In m t h r a b c = In
+data In m t h r = In
   { _in_headerLabel :: h -> Text
   , _in_rows        :: [r]
   , _in_cell        :: h -> r -> m ()
-  , _in_cloneModal  :: r -> Modal.Content t m a
-  , _in_editModal   :: r -> Modal.Content t m b
-  , _in_deleteModal :: r -> Modal.Content t m c
+  , _in_cloneModal  :: r -> Modal.Content t m
+  , _in_editModal   :: r -> Modal.Content t m
+  , _in_deleteModal :: r -> Modal.Content t m
   , _in_isOwner     :: r -> Bool
   }
 
-data Out t a b c = Out
-  { _out_add    :: Event t a
-  , _out_edit   :: Event t b
-  , _out_delete :: Event t c
+data Out t = Out
+  { _out_add    :: Event t ()
+  , _out_edit   :: Event t ()
+  , _out_delete :: Event t ()
   }
 
-view :: forall t m h r a b c. (MonadWidget t m, Bounded h, Enum h)  => In m t h r a b c-> m (Out t a b c)
+view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h)  => In m t h r -> m (Out t)
 view input =
   R.divClass "table" $ do
     rec
diff --git a/client/src/Component/Tag.hs b/client/src/Component/Tag.hs
new file mode 100644
index 0000000..f75b8d3
--- /dev/null
+++ b/client/src/Component/Tag.hs
@@ -0,0 +1,27 @@
+module Component.Tag
+  ( In(..)
+  , view
+  ) where
+
+import qualified Data.Map   as M
+import           Data.Text  (Text)
+import qualified Data.Text  as T
+import           Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+data In = In
+  { _in_text  :: Text
+  , _in_color :: Text
+  }
+
+view :: forall t m a. MonadWidget t m => In -> m ()
+view input =
+  R.elAttr "span" attrs $
+    R.text $ _in_text input
+
+  where
+    attrs =
+      M.fromList
+        [ ("class", "tag")
+        , ("style", T.concat [ "background-color: ", _in_color input ])
+        ]
-- 
cgit v1.2.3


From da2a0c13aa89705c65fdb9df2f496fb4eea29654 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 4 Jan 2020 19:22:45 +0100
Subject: Allow to remove only unused categories

---
 client/src/Component/Input.hs | 2 +-
 client/src/Component/Table.hs | 9 ++++-----
 2 files changed, 5 insertions(+), 6 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 37020da..bcff377 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -57,7 +57,7 @@ view input reset validate = do
           ]
 
         inputAttr = R.ffor value (\v ->
-          if T.null v && _in_inputType input /= "date"
+          if T.null v && _in_inputType input /= "date" && _in_inputType input /= "color"
             then M.empty
             else M.singleton "class" "filled")
 
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index f82cfa6..1482f91 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -21,7 +21,8 @@ data In m t h r = In
   , _in_cloneModal  :: r -> Modal.Content t m
   , _in_editModal   :: r -> Modal.Content t m
   , _in_deleteModal :: r -> Modal.Content t m
-  , _in_isOwner     :: r -> Bool
+  , _in_canEdit     :: r -> Bool
+  , _in_canDelete   :: r -> Bool
   }
 
 data Out t = Out
@@ -62,8 +63,6 @@ view input =
                 , Modal._in_content = _in_cloneModal input row
                 }
 
-            let isOwner = _in_isOwner input row
-
             let visibleIf cond =
                   R.elAttr
                     "div"
@@ -71,7 +70,7 @@ view input =
 
             editButton <-
               R.divClass "cell button" $
-                visibleIf isOwner $
+                visibleIf (_in_canEdit input row) $
                   Button._out_clic <$> (Button.view $
                     Button.defaultIn Icon.edit)
 
@@ -83,7 +82,7 @@ view input =
 
             deleteButton <-
               R.divClass "cell button" $
-                visibleIf isOwner $
+                visibleIf (_in_canDelete input row) $
                   Button._out_clic <$> (Button.view $
                     Button.defaultIn Icon.delete)
 
-- 
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/Component/Button.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index 6faecef..153a61b 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -22,7 +22,7 @@ data In t m = In
   , _in_submit   :: Bool
   }
 
-defaultIn :: MonadWidget t m => m () -> In t m
+defaultIn :: forall t m. MonadWidget t m => m () -> In t m
 defaultIn content = In
   { _in_class    = R.constDyn ""
   , _in_content  = content
-- 
cgit v1.2.3