Show payment stats

5 files changed, 49 insertions, 26 deletions

diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs
index b778a8f..9b60a16 100644
--- a/common/src/Common/Message/Key.hs
+++ b/common/src/Common/Message/Key.hs
@@ -122,9 +122,9 @@ data Key =
   | SignIn_EmailLabel
   | SignIn_PasswordLabel
 
-  | Statistic_Title
-  | Statistic_ByMonthsAndMean Text
-  | Statistic_Total
+  | Statistics_Title
+  | Statistics_ByMonthsAndMean Text
+  | Statistics_Total
 
   | WeeklyReport_Empty
   | WeeklyReport_IncomesCreated Int
diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs
index e74c801..2640da3 100644
--- a/common/src/Common/Message/Translation.hs
+++ b/common/src/Common/Message/Translation.hs
@@ -532,19 +532,19 @@ m l SignIn_PasswordLabel =
     English -> "Password"
     French  -> "Mot de passe"
 
-m l (Statistic_ByMonthsAndMean amount) =
+m l (Statistics_ByMonthsAndMean amount) =
   case l of
     English ->
       T.concat [ "Payments by category by month months (", amount, "on average)" ]
     French  ->
       T.concat [ "Paiements par catégorie par mois (en moyenne ", amount, ")" ]
 
-m l Statistic_Title =
+m l Statistics_Title =
   case l of
     English -> "Statistics"
     French  -> "Statistiques"
 
-m l Statistic_Total =
+m l Statistics_Total =
   case l of
     English -> "Total"
     French  -> "Total"
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index c11d6ef..319d109 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -21,5 +21,6 @@ import           Common.Model.Password           as X
 import           Common.Model.Payment            as X
 import           Common.Model.PaymentHeader      as X
 import           Common.Model.PaymentPage        as X
+import           Common.Model.PaymentStats       as X
 import           Common.Model.SignInForm         as X
 import           Common.Model.User               as X
diff --git a/common/src/Common/Model/PaymentStats.hs b/common/src/Common/Model/PaymentStats.hs
new file mode 100644
index 0000000..2dea640
--- /dev/null
+++ b/common/src/Common/Model/PaymentStats.hs
@@ -0,0 +1,10 @@
+module Common.Model.PaymentStats
+  ( PaymentStats
+  ) where
+
+import           Data.Map              (Map)
+import           Data.Time.Calendar    (Day)
+
+import           Common.Model.Category (CategoryId)
+
+type PaymentStats = [(Day, Map CategoryId Int)]
diff --git a/common/src/Common/View/Format.hs b/common/src/Common/View/Format.hs
index 0597d17..5d879fa 100644
--- a/common/src/Common/View/Format.hs
+++ b/common/src/Common/View/Format.hs
@@ -3,15 +3,18 @@ module Common.View.Format
   , longDay
   , price
   , number
+  , monthAndYear
   ) where
 
-import           Data.List          (intersperse)
-import           Data.Maybe         (fromMaybe)
+import qualified Data.List          as L
+import qualified Data.Maybe         as Maybe
 import           Data.Text          (Text)
 import qualified Data.Text          as T
-import           Data.Time.Calendar (Day, toGregorian)
+import           Data.Time.Calendar (Day)
+import qualified Data.Time.Calendar as Calendar
 
 import           Common.Model       (Currency (..))
+import           Common.Msg         (Key)
 import qualified Common.Msg         as Msg
 
 shortDay :: Day -> Text
@@ -20,29 +23,38 @@ shortDay date =
     day
     month
     (fromIntegral year)
-  where (year, month, day) = toGregorian date
+  where (year, month, day) = Calendar.toGregorian date
 
 longDay :: Day -> Text
 longDay date =
   Msg.get $ Msg.Date_Long
     day
-    (fromMaybe "−" . fmap Msg.get . monthToKey $ month)
+    (Maybe.fromMaybe "−" . fmap Msg.get . monthToKey $ month)
     (fromIntegral year)
-  where (year, month, day) = toGregorian date
+  where (year, month, day) = Calendar.toGregorian date
 
-        monthToKey 1  = Just Msg.Month_January
-        monthToKey 2  = Just Msg.Month_February
-        monthToKey 3  = Just Msg.Month_March
-        monthToKey 4  = Just Msg.Month_April
-        monthToKey 5  = Just Msg.Month_May
-        monthToKey 6  = Just Msg.Month_June
-        monthToKey 7  = Just Msg.Month_July
-        monthToKey 8  = Just Msg.Month_August
-        monthToKey 9  = Just Msg.Month_September
-        monthToKey 10 = Just Msg.Month_October
-        monthToKey 11 = Just Msg.Month_November
-        monthToKey 12 = Just Msg.Month_December
-        monthToKey _  = Nothing
+monthAndYear :: Day -> Text
+monthAndYear date =
+  T.intercalate " "
+    [ Maybe.fromMaybe "" . fmap ((\t -> T.concat [t, " "]) . Msg.get) . monthToKey $ month
+    , T.pack . show $ year
+    ]
+  where (year, month, _) = Calendar.toGregorian date
+
+monthToKey :: Int -> Maybe Key
+monthToKey 1  = Just Msg.Month_January
+monthToKey 2  = Just Msg.Month_February
+monthToKey 3  = Just Msg.Month_March
+monthToKey 4  = Just Msg.Month_April
+monthToKey 5  = Just Msg.Month_May
+monthToKey 6  = Just Msg.Month_June
+monthToKey 7  = Just Msg.Month_July
+monthToKey 8  = Just Msg.Month_August
+monthToKey 9  = Just Msg.Month_September
+monthToKey 10 = Just Msg.Month_October
+monthToKey 11 = Just Msg.Month_November
+monthToKey 12 = Just Msg.Month_December
+monthToKey _  = Nothing
 
 price :: Currency -> Int -> Text
 price (Currency currency) amount = T.concat [ number amount, " ", currency ]
@@ -53,7 +65,7 @@ number n =
   . (++) (if n < 0 then "-" else "")
   . reverse
   . concat
-  . intersperse " "
+  . L.intersperse " "
   . group 3
   . reverse
   . show