From 47c2a4d6b68c54eed5f7b45671b1ccaf8c0db200 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 20 Jan 2020 19:47:23 +0100
Subject: Show payment stats

---
 client/src/View/Statistics/Statistics.hs | 67 ++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 client/src/View/Statistics/Statistics.hs

(limited to 'client/src/View/Statistics/Statistics.hs')

diff --git a/client/src/View/Statistics/Statistics.hs b/client/src/View/Statistics/Statistics.hs
new file mode 100644
index 0000000..71f93d4
--- /dev/null
+++ b/client/src/View/Statistics/Statistics.hs
@@ -0,0 +1,67 @@
+module View.Statistics.Statistics
+  ( view
+  , In(..)
+  ) where
+
+import           Control.Monad         (void)
+import           Data.Map              (Map)
+import qualified Data.Map              as M
+import qualified Data.Text             as T
+import           Data.Time.Calendar    (Day)
+import qualified Data.Time.Calendar    as Calendar
+import           Loadable              (Loadable)
+import qualified Loadable
+import           Reflex.Dom            (Dynamic, MonadWidget)
+import qualified Reflex.Dom            as R
+import qualified Util.Ajax             as AjaxUtil
+import qualified View.Statistics.Chart as Chart
+
+import           Common.Model          (Category (..), Currency, PaymentStats)
+import qualified Common.Msg            as Msg
+import qualified Common.View.Format    as Format
+
+data In = In
+  { _in_currency    :: Currency
+  }
+
+view :: forall t m. MonadWidget t m => In -> m ()
+view input = do
+
+  categories <- AjaxUtil.getNow "api/allCategories"
+  statistics <- AjaxUtil.getNow "api/statistics"
+  let categoriesAndStatistics = (\c s -> (,) <$> c <*> s) <$> categories <*> statistics
+
+  R.divClass "withMargin" $
+    R.divClass "titleButton" $
+      R.el "h1" $
+        R.text $ Msg.get Msg.Statistics_Title
+
+  void . R.dyn . R.ffor categoriesAndStatistics . Loadable.viewHideValueWhileLoading $
+    stats (_in_currency input)
+
+stats :: forall t m. MonadWidget t m => Currency -> ([Category], PaymentStats) -> m ()
+stats currency (categories, stats) =
+  Chart.view $ Chart.In
+    { Chart._in_title = Msg.get (Msg.Statistics_ByMonthsAndMean averageEachMonth)
+    , Chart._in_labels = map (Format.monthAndYear . fst) stats
+    , Chart._in_datasets =
+      Chart.Dataset
+        { Chart._dataset_label = Msg.get Msg.Statistics_Total
+        , Chart._dataset_data  = totalSeries
+        , Chart._dataset_color = "#555555"
+        } : (map categoryDataset categories)
+    }
+
+  where
+    averageEachMonth =
+      Format.price currency $ sum totalSeries `div` length stats
+
+    totalSeries =
+      map (sum . map snd . M.toList . snd) stats
+
+    categoryDataset category =
+      Chart.Dataset
+        { Chart._dataset_label = _category_name category
+        , Chart._dataset_data  = map (M.findWithDefault 0 (_category_id category) . snd) stats
+        , Chart._dataset_color = _category_color category
+        }
-- 
cgit v1.2.3