Add search for payments

7 files changed, 112 insertions, 50 deletions

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
+      }
diff --git a/client/src/Icon.hs b/client/src/Icon.hs
index e04e2a8..555d928 100644
--- a/client/src/Icon.hs
+++ b/client/src/Icon.hs
@@ -1,5 +1,6 @@
 module Icon
   ( clone
+  , cross
   , delete
   , edit
   , loading
@@ -21,6 +22,11 @@ clone =
   svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
     svgAttr "path" (M.fromList [("d", "M15.143 13.244l.837-2.244 2.698 5.641-5.678 2.502.805-2.23s-8.055-3.538-7.708-10.913c2.715 5.938 9.046 7.244 9.046 7.244zm8.857-7.244v18h-18v-6h-6v-18h18v6h6zm-2 2h-12.112c-.562-.578-1.08-1.243-1.521-2h7.633v-4h-14v14h4v-3.124c.6.961 1.287 1.823 2 2.576v6.548h14v-14z")]) $ R.blank
 
+cross :: forall t m. MonadWidget t m => m ()
+cross =
+  svgAttr "svg" (M.fromList [ ("width", "15"), ("height", "15"), ("viewBox", "0 0 1792 1792") ]) $
+    svgAttr "path" (M.fromList [("d", "M1490 1322q0 40-28 68l-136 136q-28 28-68 28t-68-28l-294-294-294 294q-28 28-68 28t-68-28l-136-136q-28-28-28-68t28-68l294-294-294-294q-28-28-28-68t28-68l136-136q28-28 68-28t68 28l294 294 294-294q28-28 68-28t68 28l136 136q28 28 28 68t-28 68l-294 294 294 294q28 28 28 68z")]) $ R.blank
+
 delete :: forall t m. MonadWidget t m => m ()
 delete =
   svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 15892c4..8aa4d38 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -8,9 +8,10 @@ import           Prelude             hiding (init)
 import           Reflex.Dom          (MonadWidget)
 import qualified Reflex.Dom          as R
 
-import           Common.Model        (Init (..))
+import           Common.Model        (Frequency (..), Init (..), Payment (..))
+import           Common.Util.Text    as T
 
-import           View.Payment.Header (HeaderIn (..))
+import           View.Payment.Header (HeaderIn (..), HeaderOut (..))
 import qualified View.Payment.Header as Header
 import           View.Payment.Pages  (PagesIn (..), PagesOut (..))
 import qualified View.Payment.Pages  as Pages
@@ -29,15 +30,26 @@ widget :: forall t m. MonadWidget t m => PaymentIn -> m PaymentOut
 widget paymentIn = do
   R.divClass "payment" $ do
     rec
-      _ <- Header.widget $ HeaderIn
+      let init = _paymentIn_init paymentIn
+
+          filterPayment s p = search s (_payment_name p) && (_payment_frequency p == Punctual)
+
+          payments = fmap
+            (\s -> filter (filterPayment s) (_init_payments init))
+            (_headerOut_search header)
+
+      header <- Header.widget $ HeaderIn
         { _headerIn_init = init
         }
+
       _ <- Table.widget $ TableIn
         { _tableIn_init = init
-        , _tableIn_currentPage = _pagesOut_currentPage pagesOut
+        , _tableIn_currentPage = _pagesOut_currentPage pages
+        , _tableIn_payments = payments
         }
-      pagesOut <- Pages.widget $ PagesIn
-        { _pagesIn_payments = _init_payments init
+
+      pages <- Pages.widget $ PagesIn
+        { _pagesIn_payments = payments
         }
+
     return $ PaymentOut {}
-  where init = _paymentIn_init paymentIn
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 3f2adc3..f64f11d 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -8,10 +8,11 @@ import           Control.Monad          (forM_)
 import           Control.Monad.IO.Class (liftIO)
 import qualified Data.List              as L hiding (groupBy)
 import           Data.Maybe             (fromMaybe)
+import           Data.Text              (Text)
 import qualified Data.Text              as T
 import qualified Data.Time              as Time
 import           Prelude                hiding (init)
-import           Reflex.Dom             (MonadWidget)
+import           Reflex.Dom             (Dynamic, MonadWidget)
 import qualified Reflex.Dom             as R
 
 import           Common.Model           (Currency, ExceedingPayer (..),
@@ -21,7 +22,8 @@ import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
 
-import           Component              (ButtonIn (..))
+import           Component              (ButtonIn (..), InputIn (..),
+                                         InputOut (..))
 import qualified Component              as Component
 import qualified Util.List              as L
 
@@ -29,16 +31,19 @@ data HeaderIn t = HeaderIn
   { _headerIn_init :: Init
   }
 
-data HeaderOut = HeaderOut
-  {
+data HeaderOut t = HeaderOut
+  { _headerOut_search :: Dynamic t Text
   }
 
-widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut
+widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
     payerAndAdd incomes payments users currency
+    search <- searchLine
     infos payments users currency
-    return $ HeaderOut {}
+    return $ HeaderOut
+      { _headerOut_search = search
+      }
   where init = _headerIn_init headerIn
         incomes = _init_incomes init
         payments = filter ((==) Punctual . _payment_frequency) (_init_payments init)
@@ -98,3 +103,11 @@ infos payments users currency =
             . L.groupBy fst
             . map (\p -> (_payment_user p, _payment_cost p))
             $ payments
+
+searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text)
+searchLine =
+  R.divClass "searchLine" $
+    _inputOut_value <$> (Component.input $ InputIn
+      { _inputIn_reset = R.never
+      , _inputIn_label = Msg.get Msg.Search_Name
+      })
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 81555ab..dfd92c0 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -8,7 +8,7 @@ import qualified Data.Text              as T
 import           Reflex.Dom             (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Frequency (..), Payment (..))
+import           Common.Model           (Payment (..))
 
 import           Component              (ButtonIn (..), ButtonOut (..))
 import qualified Component              as Component
@@ -16,52 +16,57 @@ import qualified Component              as Component
 import qualified Icon
 import qualified View.Payment.Constants as Constants
 
-data PagesIn = PagesIn
-  { _pagesIn_payments :: [Payment]
+data PagesIn t = PagesIn
+  { _pagesIn_payments :: Dynamic t [Payment]
   }
 
 data PagesOut t = PagesOut
   { _pagesOut_currentPage :: Dynamic t Int
   }
 
-widget :: forall t m. MonadWidget t m => PagesIn -> m (PagesOut t)
+widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
 widget pagesIn = do
   R.divClass "pages" $ do
     rec
       currentPage <- R.holdDyn 1 . R.leftmost $ [ firstPageClic, previousPageClic, pageClic, nextPageClic, lastPageClic ]
 
-      firstPageClic <- pageButton (R.constDyn 0) (R.constDyn 1) Icon.doubleLeftBar
+      firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
 
-      previousPageClic <- pageButton (R.constDyn 0) (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
+      previousPageClic <- pageButton noCurrentPage (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
 
-      pageClic <- pageEvent <$> (R.simpleList (fmap (range maxPage) currentPage) $ \p ->
-        pageButton currentPage p (R.dynText $ fmap (T.pack . show) p))
+      pageClic <- pageEvent <$> (R.simpleList (range <$> currentPage <*> maxPage) $ \p ->
+        pageButton (Just <$> currentPage) p (R.dynText $ fmap (T.pack . show) p))
 
-      nextPageClic <- pageButton (R.constDyn 0) (fmap (\x -> min (x + 1) maxPage) currentPage) Icon.doubleRight
+      nextPageClic <- pageButton noCurrentPage ((\c m -> min (c + 1) m) <$> currentPage <*> maxPage) Icon.doubleRight
 
-      lastPageClic <- pageButton (R.constDyn 0) (R.constDyn maxPage) Icon.doubleRightBar
+      lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
 
     return $ PagesOut
       { _pagesOut_currentPage = currentPage
       }
 
-    where paymentCount = length . filter ((==) Punctual . _payment_frequency) . _pagesIn_payments $ pagesIn
-          maxPage = ceiling $ toRational paymentCount / toRational Constants.paymentsPerPage
+    where maxPage =
+            R.ffor (_pagesIn_payments pagesIn) (\payments ->
+              ceiling $ toRational (length payments) / toRational Constants.paymentsPerPage
+            )
+
           pageEvent = R.switchPromptlyDyn . fmap R.leftmost
 
+          noCurrentPage = R.constDyn Nothing
+
 range :: Int -> Int -> [Int]
-range maxPage currentPage = [start..end]
+range currentPage maxPage = [start..end]
   where sidePages = 2
-        start = max 1 (currentPage - sidePages)
+        start = max 1 (min (currentPage - sidePages) (maxPage - sidePages * 2))
         end = min maxPage (start + sidePages * 2)
 
-pageButton :: forall t m. MonadWidget t m => Dynamic t Int -> Dynamic t Int -> m () -> m (Event t Int)
+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 <$> (Component.button $ ButtonIn
     { _buttonIn_class   = do
         cp <- currentPage
         p <- page
-        if cp == p then "page current" else "page"
+        if cp == Just p then "page current" else "page"
     , _buttonIn_content = content
     , _buttonIn_waiting = R.never
     })
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index d8093a5..0c3b769 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -12,8 +12,7 @@ import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Category (..), Frequency (..),
-                                         Init (..), Payment (..),
+import           Common.Model           (Category (..), Init (..), Payment (..),
                                          PaymentCategory (..), User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
@@ -26,6 +25,7 @@ import qualified View.Payment.Constants as Constants
 data TableIn t = TableIn
   { _tableIn_init        :: Init
   , _tableIn_currentPage :: Dynamic t Int
+  , _tableIn_payments    :: Dynamic t [Payment]
   }
 
 data TableOut = TableOut
@@ -47,8 +47,8 @@ widget tableIn = do
         R.divClass "cell" $ R.blank
       let init = _tableIn_init tableIn
           currentPage = _tableIn_currentPage tableIn
-          payments = _init_payments init
-          paymentRange = fmap (getPaymentRange payments) currentPage
+          payments = _tableIn_payments tableIn
+          paymentRange = getPaymentRange <$> payments <*> currentPage
       R.simpleList paymentRange (paymentRow init)
   return $ TableOut {}
 
@@ -58,7 +58,6 @@ getPaymentRange payments currentPage =
     . drop ((currentPage - 1) * Constants.paymentsPerPage)
     . reverse
     . L.sortOn _payment_date
-    . filter ((==) Punctual . _payment_frequency)
     $ payments
 
 paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index 69596d8..be6b152 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -23,7 +23,7 @@ view result =
     rec
       input <- Component.input $ InputIn
         { _inputIn_reset = R.ffilter Either.isRight signInResult
-        , _inputIn_placeHolder = Msg.get Msg.SignIn_EmailPlaceholder
+        , _inputIn_label = Msg.get Msg.SignIn_EmailLabel
         }
 
       let userWantsEmailValidation = _inputOut_enter input <> _buttonOut_clic button