Clone incomes

9 files changed, 99 insertions, 49 deletions

diff --git a/ISSUES.md b/ISSUES.md
index 95b435a..db60794 100644
--- a/ISSUES.md
+++ b/ISSUES.md
@@ -1,9 +1,12 @@
 ## Income view
 
-- Clone an income
 - Edit an income
 - Remove an income
 
+## Payment
+
+- Use income table factorizations
+
 ## Category view
 
 - Show the category table
@@ -12,9 +15,9 @@
 - Edit a category
 - Remove a category
 
-## Mobile
+## Slow
 
-- Slow, consider native ? consider doing more work on the server ?
+- Implement server side paging
 
 # Additional features
 
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 =
diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs
index f8f107f..d07bd45 100644
--- a/client/src/View/Income/Add.hs
+++ b/client/src/View/Income/Add.hs
@@ -1,13 +1,16 @@
 module View.Income.Add
   ( view
+  , In(..)
   ) where
 
 import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Maybe             as Maybe
+import qualified Data.Text              as T
 import qualified Data.Time.Clock        as Time
-import           Reflex.Dom             (MonadWidget)
+import           Reflex.Dom             (Dynamic, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (CreateIncomeForm (..), Income)
+import           Common.Model           (CreateIncomeForm (..), Income (..))
 import qualified Common.Msg             as Msg
 import qualified Common.Util.Time       as TimeUtil
 import qualified Component.Modal        as Modal
@@ -15,16 +18,21 @@ import qualified Util.Ajax              as Ajax
 import qualified Util.Reflex            as ReflexUtil
 import qualified View.Income.Form       as Form
 
-view :: forall t m. MonadWidget t m => Modal.Content t m Income
-view cancel = do
+data In t = In
+  { _in_income :: Dynamic t (Maybe Income)
+  }
+
+view :: forall t m. MonadWidget t m => In t -> Modal.Content t m Income
+view input cancel = do
 
   currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
 
-  form <- R.dyn $
+  form <- R.dyn $ do
+    income <- _in_income input
     return $ Form.view $ Form.In
       { Form._in_cancel = cancel
       , Form._in_headerLabel = Msg.get Msg.Income_AddLong
-      , Form._in_amount = ""
+      , Form._in_amount = Maybe.fromMaybe "" ((T.pack . show . _income_amount) <$> income)
       , Form._in_date = currentDay
       , Form._in_mkPayload = CreateIncomeForm
       , Form._in_ajax = Ajax.post
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index ae1174a..0360d1f 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -72,7 +72,7 @@ view input =
 
       addIncome <- Modal.view $ Modal.In
         { Modal._in_show    = addIncome
-        , Modal._in_content = Add.view
+        , Modal._in_content = Add.view $ Add.In { Add._in_income = R.constDyn Nothing }
         }
 
       return $ Out
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index f8359bb..b97613d 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -41,11 +41,14 @@ view input = do
     R.elClass "main" "income" $ do
 
       rec
-
+        let addIncome = R.leftmost
+              [ Header._out_addIncome header
+              , Table._out_addIncome table
+              ]
         incomes <- R.foldDyn
           (:)
           (_init_incomes init)
-          (Header._out_addIncome header)
+          addIncome
 
         header <- Header.view $ Header.In
           { Header._in_init = init
@@ -53,11 +56,11 @@ view input = do
           , Header._in_incomes = incomes
           }
 
-      Table.view $ Table.In
-        { Table._in_init = init
-        , Table._in_currency = _in_currency input
-        , Table._in_incomes = incomes
-        }
+        table <- Table.view $ Table.In
+          { Table._in_init = init
+          , Table._in_currency = _in_currency input
+          , Table._in_incomes = incomes
+          }
 
       return ()
 
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index 9cb705f..358cb17 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -1,12 +1,13 @@
 module View.Income.Table
   ( view
   , In(..)
+  , Out(..)
   ) where
 
 import qualified Data.List          as L
 import qualified Data.Maybe         as Maybe
 import           Data.Text          (Text)
-import           Reflex.Dom         (Dynamic, MonadWidget)
+import           Reflex.Dom         (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom         as R
 
 import           Common.Model       (Currency, Income (..), User (..))
@@ -15,6 +16,7 @@ import qualified Common.Msg         as Msg
 import qualified Common.View.Format as Format
 
 import qualified Component.Table    as Table
+import qualified View.Income.Add    as Add
 import           View.Income.Init   (Init (..))
 
 data In t = In
@@ -23,18 +25,28 @@ data In t = In
   , _in_incomes  :: Dynamic t [Income]
   }
 
-view :: forall t m. MonadWidget t m => In t -> m ()
+data Out t = Out
+  { _out_addIncome :: Event t Income
+  }
+
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
 view input = do
 
-    Table.view $ Table.In
-      { Table._in_headerLabel = headerLabel
-      , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date
-      , Table._in_cell = cell (_in_init input) (_in_currency input)
-      , Table._in_perPage = 7
-      , Table._in_resetPage = R.never
-      }
+  table <- Table.view $ Table.In
+    { Table._in_headerLabel = headerLabel
+    , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date
+    , Table._in_cell = cell (_in_init input) (_in_currency input)
+    , Table._in_perPage = 7
+    , Table._in_resetPage = R.never
+    , Table._in_cloneModal = \income ->
+      Add.view $ Add.In
+        { Add._in_income = Just <$> income
+        }
+    }
 
-    return ()
+  return $ Out
+    { _out_addIncome = Table._out_add table
+    }
 
 data Header
   = UserHeader
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 56a33d9..82b0c27 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -34,7 +34,7 @@ view input cancel = do
 
   currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
 
-  formOutput <- R.dyn $ do
+  form <- R.dyn $ do
     paymentCategories <- _in_paymentCategories input
     payment <- _in_payment input
     category <- _in_category input
@@ -52,8 +52,8 @@ view input cancel = do
       , Form._in_ajax = Ajax.post
       }
 
-  hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
-  clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> formOutput)
+  hide <- ReflexUtil.flatten (Form._output_hide <$> form)
+  clonePayment <- ReflexUtil.flatten (Form._output_addPayment <$> form)
 
   return $
     ( hide
diff --git a/server/src/Design/View/Payment/Table.hs b/server/src/Design/View/Payment/Table.hs
index 26dc9ed..67828c9 100644
--- a/server/src/Design/View/Payment/Table.hs
+++ b/server/src/Design/View/Payment/Table.hs
@@ -4,7 +4,6 @@ module Design.View.Payment.Table
 
 import           Clay
 
-import qualified Design.Color as Color
 import qualified Design.Media as Media
 
 design :: Css
@@ -34,7 +33,3 @@ design = do
         ".shortDate" ? display none
         ".longDate" ? display inline
         marginBottom (em 0.5)
-
-    ".button" & svg ? do
-      "path" ? ("fill" -: Color.toString Color.chestnutRose)
-      width (px 18)
diff --git a/server/src/Design/View/Table.hs b/server/src/Design/View/Table.hs
index cd406fc..1c4e806 100644
--- a/server/src/Design/View/Table.hs
+++ b/server/src/Design/View/Table.hs
@@ -72,6 +72,9 @@ design = do
         textAlign (alignSide sideCenter)
         button ? do
           padding (px 10) (px 10) (px 10) (px 10)
+          svg ? do
+            "path" ? ("fill" -: Color.toString Color.chestnutRose)
+            width (px 18)
           hover & "svg path" ? do
             "fill" -: "rgb(237, 122, 116)"