Merge branch 'with-ghcjs' into 'master'

Use Haskell on the frontend

See merge request guyonvarch/shared-cost!2

1 files changed, 78 insertions, 0 deletions

diff --git a/common/src/Common/View/Format.hs b/common/src/Common/View/Format.hs
new file mode 100644
index 0000000..5d879fa
--- /dev/null
+++ b/common/src/Common/View/Format.hs
@@ -0,0 +1,78 @@
+module Common.View.Format
+  ( shortDay
+  , longDay
+  , price
+  , number
+  , monthAndYear
+  ) where
+
+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)
+import qualified Data.Time.Calendar as Calendar
+
+import           Common.Model       (Currency (..))
+import           Common.Msg         (Key)
+import qualified Common.Msg         as Msg
+
+shortDay :: Day -> Text
+shortDay date =
+  Msg.get $ Msg.Date_Short
+    day
+    month
+    (fromIntegral year)
+  where (year, month, day) = Calendar.toGregorian date
+
+longDay :: Day -> Text
+longDay date =
+  Msg.get $ Msg.Date_Long
+    day
+    (Maybe.fromMaybe "−" . fmap Msg.get . monthToKey $ month)
+    (fromIntegral year)
+  where (year, month, day) = Calendar.toGregorian date
+
+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 ]
+
+number :: Int -> Text
+number n =
+  T.pack
+  . (++) (if n < 0 then "-" else "")
+  . reverse
+  . concat
+  . L.intersperse " "
+  . group 3
+  . reverse
+  . show
+  . abs $ n
+
+group :: Int -> [a] -> [[a]]
+group n xs =
+  if length xs <= n
+    then [xs]
+    else (take n xs) : (group n (drop n xs))