Merge branch 'with-ghcjs' into 'master'

Use Haskell on the frontend

See merge request guyonvarch/shared-cost!2

1 files changed, 101 insertions, 0 deletions

diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
new file mode 100644
index 0000000..26444d7
--- /dev/null
+++ b/client/src/View/Payment/Payment.hs
@@ -0,0 +1,101 @@
+module View.Payment.Payment
+  ( view
+  , In(..)
+  ) where
+
+import           Control.Monad.IO.Class   (liftIO)
+import qualified Data.Maybe               as Maybe
+import           Data.Text                (Text)
+import qualified Data.Text                as T
+import           Data.Time.Clock          (NominalDiffTime)
+import           Prelude                  hiding (init)
+import           Reflex.Dom               (Dynamic, Event, MonadWidget, Reflex)
+import qualified Reflex.Dom               as R
+
+import           Common.Model             (Currency, Frequency, Income (..),
+                                           Payment (..), PaymentId,
+                                           PaymentPage (..), User, UserId)
+import qualified Common.Util.Text         as T
+
+import qualified Component.Pages          as Pages
+import           Loadable                 (Loadable (..))
+import qualified Loadable
+import qualified Util.Ajax                as AjaxUtil
+import qualified Util.Reflex              as ReflexUtil
+import qualified View.Payment.HeaderForm  as HeaderForm
+import qualified View.Payment.HeaderInfos as HeaderInfos
+import qualified View.Payment.Reducer     as Reducer
+import qualified View.Payment.Table       as Table
+
+data In t = In
+  { _in_currentUser :: UserId
+  , _in_users       :: [User]
+  , _in_currency    :: Currency
+  }
+
+view :: forall t m. MonadWidget t m => In t -> m ()
+view input = do
+
+  categories <- AjaxUtil.getNow "api/allCategories"
+
+  R.dyn . R.ffor categories . Loadable.viewHideValueWhileLoading $ \categories -> do
+
+    rec
+      paymentPage <- Reducer.reducer $ Reducer.In
+        { Reducer._in_page          = page
+        , Reducer._in_search        = HeaderForm._out_search form
+        , Reducer._in_frequency     = HeaderForm._out_frequency form
+        , Reducer._in_addPayment    = addPayment
+        , Reducer._in_editPayment   = editPayment
+        , Reducer._in_deletePayment = deletePayment
+        }
+
+      let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+          eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
+
+      let addPayment =
+            R.leftmost
+              [ tableAddPayment
+              , HeaderForm._out_addPayment form
+              ]
+
+      page <- eventFromResult $ Pages._out_newPage . snd
+      tableAddPayment <- eventFromResult $ Table._out_add . fst
+      editPayment <- eventFromResult $ Table._out_edit . fst
+      deletePayment <- eventFromResult $ Table._out_delete . fst
+
+      form <- HeaderForm.view $ HeaderForm.In
+        { HeaderForm._in_reset             = () <$ addPayment
+        , HeaderForm._in_categories        = categories
+        }
+
+      result <- Loadable.viewShowValueWhileLoading paymentPage $
+        \(PaymentPage page frequency header payments count) -> do
+
+          HeaderInfos.view $ HeaderInfos.In
+            { HeaderInfos._in_users = _in_users input
+            , HeaderInfos._in_currency = _in_currency input
+            , HeaderInfos._in_header = header
+            , HeaderInfos._in_paymentCount = count
+            }
+
+          table <- Table.view $ Table.In
+            { Table._in_users = _in_users input
+            , Table._in_currentUser = _in_currentUser input
+            , Table._in_categories = categories
+            , Table._in_currency = _in_currency input
+            , Table._in_payments = payments
+            , Table._in_frequency = frequency
+            }
+
+          pages <- Pages.view $ Pages.In
+            { Pages._in_total = R.constDyn count
+            , Pages._in_perPage = Reducer.perPage
+            , Pages._in_page = page
+            }
+
+          return (table, pages)
+
+    return ()
+
+  return ()