WIP

5 files changed, 209 insertions, 29 deletions

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
new file mode 100644
index 0000000..2eaec0f
--- /dev/null
+++ b/client/src/View/Payment/Add.hs
@@ -0,0 +1,104 @@
+module View.Payment.Add
+  ( view
+  , AddIn(..)
+  , AddOut(..)
+  ) where
+
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Map               as M
+import qualified Data.Maybe             as Maybe
+import qualified Data.Text              as T
+import qualified Data.Time.Clock        as Time
+import           Reflex.Dom             (Event, MonadWidget)
+import qualified Reflex.Dom             as R
+import qualified Text.Read              as T
+
+import           Common.Model           (Category (..), CreatePayment (..),
+                                         Frequency (..))
+import qualified Common.Msg             as Msg
+import qualified Common.Util.Time       as Time
+import qualified Common.View.Format     as Format
+import           Component              (ButtonIn (..), InputIn (..),
+                                         InputOut (..), SelectIn (..),
+                                         SelectOut (..))
+import qualified Component              as Component
+import qualified Util.Ajax              as Ajax
+import qualified Util.WaitFor           as Util
+
+data AddIn = AddIn
+  { _addIn_categories :: [Category]
+  }
+
+data AddOut t = AddOut
+  { _addOut_cancel :: Event t ()
+  }
+
+view :: forall t m. MonadWidget t m => AddIn -> m (AddOut t)
+view addIn = do
+  R.divClass "add" $ do
+    R.divClass "addHeader" $ R.text $ Msg.get Msg.Payment_Add
+
+    R.divClass "addContent" $ do
+      name <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+
+      cost <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+
+      currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
+
+      date <- _inputOut_value <$> (Component.input $
+        Component.defaultInputIn
+          { _inputIn_label = Msg.get Msg.Payment_Cost
+          , _inputIn_initialValue = Format.shortDay currentDay
+          })
+
+      frequency <- _selectOut_value <$> (Component.select $ SelectIn
+        { _selectIn_label = Msg.get Msg.Payment_Frequency
+        , _selectIn_initialValue = Punctual
+        , _selectIn_values = R.constDyn frequencies
+        })
+
+      category <- _selectOut_value <$> (Component.select $ SelectIn
+        { _selectIn_label = Msg.get Msg.Payment_Category
+        , _selectIn_initialValue = 0
+        , _selectIn_values = R.constDyn categories
+        })
+
+      let payment = CreatePayment
+            <$> name
+            <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost
+            <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date
+            <*> category
+            <*> frequency
+
+      cancel <- R.divClass "buttons" $ do
+        rec
+          validate <- Component._buttonOut_clic <$> (Component.button $
+            (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
+              { _buttonIn_class = R.constDyn "confirm"
+              , _buttonIn_waiting = waiting
+              , _buttonIn_submit = True
+              })
+
+          (_, waiting) <- Util.waitFor
+            (Ajax.post "/payment")
+            validate
+            payment
+
+        Component._buttonOut_clic <$> (Component.button $
+          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+            { _buttonIn_class = R.constDyn "undo" })
+
+      return AddOut
+        { _addOut_cancel = cancel
+        }
+
+  where
+    frequencies = M.fromList
+      [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+      , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+      ]
+
+    categories = M.fromList . flip map (_addIn_categories addIn) $ \c ->
+      (_category_id c, _category_name c)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
new file mode 100644
index 0000000..a1be16d
--- /dev/null
+++ b/client/src/View/Payment/Delete.hs
@@ -0,0 +1,51 @@
+module View.Payment.Delete
+  ( view
+  , DeleteIn(..)
+  , DeleteOut(..)
+  ) where
+
+import           Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+import qualified Common.Msg as Msg
+import           Component  (ButtonIn (..), ButtonOut (..))
+import qualified Component  as Component
+-- import qualified Util.Ajax              as Ajax
+-- import qualified Util.WaitFor           as Util
+
+data DeleteIn = DeleteIn
+  {}
+
+data DeleteOut t = DeleteOut
+  { _deleteOut_cancel :: Event t ()
+  }
+
+view :: forall t m. MonadWidget t m => DeleteIn -> m (DeleteOut t)
+view _ =
+  R.divClass "delete" $ do
+    R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm
+
+    R.divClass "deleteContent" $ do
+
+      cancel <- R.divClass "buttons" $ do
+        rec
+          _ <- Component._buttonOut_clic <$> (Component.button $
+            (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
+              { _buttonIn_class = R.constDyn "confirm"
+              , _buttonIn_submit = True
+              })
+
+          -- (_, waiting) <- Util.waitFor
+          --   (Ajax.post "/payment")
+          --   validate
+          --   payment
+
+        cancel <- Component._buttonOut_clic <$> (Component.button $
+          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+            { _buttonIn_class = R.constDyn "undo" })
+
+        return cancel
+
+      return DeleteOut
+        { _deleteOut_cancel = cancel
+        }
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index a694136..d01dec6 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -16,9 +16,10 @@ import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Currency, ExceedingPayer (..),
-                                         Frequency (..), Income (..), Init (..),
-                                         Payment (..), User (..))
+import           Common.Model           (Category, Currency,
+                                         ExceedingPayer (..), Frequency (..),
+                                         Income (..), Init (..), Payment (..),
+                                         User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.Util.Text       as T
@@ -26,9 +27,11 @@ import qualified Common.View.Format     as Format
 
 import           Component              (ButtonIn (..), ButtonOut (..),
                                          InputIn (..), InputOut (..),
-                                         ModalIn (..))
+                                         ModalIn (..), ModalOut (..))
 import qualified Component              as Component
 import qualified Util.List              as L
+import           View.Payment.Add       (AddIn (..), AddOut (..))
+import qualified View.Payment.Add       as Add
 
 data HeaderIn t = HeaderIn
   { _headerIn_init :: Init
@@ -42,7 +45,7 @@ data HeaderOut t = HeaderOut
 widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 widget headerIn =
   R.divClass "header" $ do
-    payerAndAdd incomes punctualPayments users currency
+    payerAndAdd incomes punctualPayments users categories currency
     (searchName, searchFrequency)  <- searchLine
     let searchPayments = getSearchPayments searchName searchFrequency payments
     infos searchPayments users currency
@@ -56,6 +59,7 @@ widget headerIn =
     payments = _init_payments init
     punctualPayments = filter ((==) Punctual . _payment_frequency) payments
     users = _init_users init
+    categories = _init_categories init
     currency = _init_currency init
 
 getSearchPayments :: forall t. (Reflex t) => Dynamic t Text -> Dynamic t Frequency -> [Payment] -> Dynamic t [Payment]
@@ -63,12 +67,12 @@ getSearchPayments name frequency payments = do
   n <- name
   f <- frequency
   pure $ flip filter payments (\p ->
-    (  T.search n (_payment_name p)
+    (  (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
     && (_payment_frequency p == f)
     ))
 
-payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m ()
-payerAndAdd incomes payments users currency = do
+payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> [Category] -> Currency -> m ()
+payerAndAdd incomes payments users categories currency = do
   time <- liftIO Time.getCurrentTime
   R.divClass "payerAndAdd" $ do
     R.divClass "exceedingPayers" $
@@ -86,11 +90,15 @@ payerAndAdd incomes payments users currency = do
       { _buttonIn_class = R.constDyn "addPayment"
       , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
       , _buttonIn_waiting = R.never
+      , _buttonIn_tabIndex = Nothing
+      , _buttonIn_submit = False
       })
-    _ <- Component.modal $ ModalIn
-      { _modalIn_show    = addPayment
-      , _modalIn_content = R.el "h1" $ R.text "Ajouter un paiement"
-      }
+    rec
+      modalOut <- Component.modal $ ModalIn
+        { _modalIn_show    = addPayment
+        , _modalIn_hide = _addOut_cancel . _modalOut_content $ modalOut
+        , _modalIn_content = Add.view $ AddIn { _addIn_categories = categories }
+        }
     return ()
 
 searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
@@ -99,6 +107,7 @@ searchLine = do
     searchName <- _inputOut_value <$> (Component.input $ InputIn
       { _inputIn_reset = R.never
       , _inputIn_label = Msg.get Msg.Search_Name
+      , _inputIn_initialValue = ""
       })
 
     let frequencies = M.fromList
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 55ceb9f..d14b640 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -82,5 +82,7 @@ pageButton currentPage page content = do
         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/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index a49be5c..23d7225 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -4,23 +4,28 @@ module View.Payment.Table
   , TableOut(..)
   ) where
 
-import qualified Data.List          as L
-import qualified Data.Map           as M
-import           Data.Text          (Text)
-import qualified Data.Text          as T
-import           Prelude            hiding (init)
-import           Reflex.Dom         (Dynamic, MonadWidget)
-import qualified Reflex.Dom         as R
-
-import           Common.Model       (Category (..), Init (..), Payment (..),
-                                     PaymentCategory (..), User (..))
-import qualified Common.Model       as CM
-import qualified Common.Msg         as Msg
-import qualified Common.Util.Text   as T
-import qualified Common.View.Format as Format
+import qualified Data.List           as L
+import qualified Data.Map            as M
+import           Data.Text           (Text)
+import qualified Data.Text           as T
+import           Prelude             hiding (init)
+import           Reflex.Dom          (Dynamic, MonadWidget)
+import qualified Reflex.Dom          as R
+
+import           Common.Model        (Category (..), Init (..), Payment (..),
+                                      PaymentCategory (..), User (..))
+import qualified Common.Model        as CM
+import qualified Common.Msg          as Msg
+import qualified Common.Util.Text    as T
+import qualified Common.View.Format  as Format
+import           Component           (ButtonIn (..), ButtonOut (..),
+                                      ModalIn (..), ModalOut (..))
+import qualified Component           as Component
+import           View.Payment.Delete (DeleteIn (..), DeleteOut (..))
+import qualified View.Payment.Delete as Delete
 
 import qualified Icon
-import qualified Util.Dom           as Dom
+import qualified Util.Dom            as Dom
 
 data TableIn t = TableIn
   { _tableIn_init        :: Init
@@ -105,8 +110,17 @@ paymentRow init payment =
           M.fromList [("class", "cell button"), ("display", if _payment_user p == _init_currentUser init then "block" else "none")]
     R.elDynAttr "div" modifyAttrs $
       R.el "button" $ Icon.edit
-    R.elDynAttr "div" modifyAttrs $
-      R.el "button" $ Icon.delete
+    deletePayment <- R.elDynAttr "div" modifyAttrs $
+      _buttonOut_clic <$> (Component.button $
+        (Component.defaultButtonIn Icon.delete)
+          { _buttonIn_class = R.constDyn "deletePayment" })
+    rec
+      modalOut <- Component.modal $ ModalIn
+        { _modalIn_show    = deletePayment
+        , _modalIn_hide = _deleteOut_cancel . _modalOut_content $ modalOut
+        , _modalIn_content = Delete.view (DeleteIn {})
+        }
+    return ()
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do