Adding a message structure server side

5 files changed, 150 insertions, 4 deletions

diff --git a/src/server/Main.hs b/src/server/Main.hs
index e7e759b..14e69fa 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -16,10 +16,10 @@ import Config
 
 main :: IO ()
 main = do
-  config <- getConfig "config.txt"
-  case config of
-    Left error ->
-      putStrLn error
+  eitherConfig <- getConfig "config.txt"
+  case eitherConfig of
+    Left errorMessage ->
+      putStrLn errorMessage
     Right config -> do
       runMigrations
       scotty (port config) $ do
diff --git a/src/server/Message.hs b/src/server/Message.hs
new file mode 100644
index 0000000..1673b22
--- /dev/null
+++ b/src/server/Message.hs
@@ -0,0 +1,45 @@
+module Message
+  ( getMessage
+  , getVarMessage
+  ) where
+
+import Data.Maybe (listToMaybe, fromMaybe)
+
+import Text.ParserCombinators.Parsec
+
+import Message.Key (Key)
+import Message.Lang
+import Message.Translations (getNonFormattedMessage)
+
+getMessage :: Key -> String
+getMessage = getVarMessage []
+
+getVarMessage :: [String] -> Key -> String
+getVarMessage values key =
+  replaceParts values (getParts (getNonFormattedMessage French key))
+
+replaceParts :: [String] -> [Part] -> String
+replaceParts values = concatMap (replacePart values)
+
+replacePart :: [String] -> Part -> String
+replacePart _ (Str str) = str
+replacePart values (Num n) =
+  fromMaybe ("{" ++ show n ++ "}") . listToMaybe . drop (n - 1) $ values
+
+data Part =
+  Num Int
+  | Str String
+
+getParts :: String -> [Part]
+getParts str =
+  case parse partsParser "" str of
+    Right parts -> parts
+    Left _ -> []
+
+partsParser :: Parser [Part]
+partsParser = many partParser
+
+partParser :: Parser Part
+partParser =
+  (do _ <- string "{"; n <- read <$> many1 digit; _ <- string "}"; return (Num n))
+  <|> (do str <- many1 (noneOf "{"); return (Str str))
diff --git a/src/server/Message/Key.hs b/src/server/Message/Key.hs
new file mode 100644
index 0000000..407ba34
--- /dev/null
+++ b/src/server/Message/Key.hs
@@ -0,0 +1,20 @@
+module Message.Key
+  ( Key(..)
+  ) where
+
+data Key =
+
+  January
+  | February
+  | March
+  | April
+  | May
+  | June
+  | July
+  | August
+  | September
+  | October
+  | November
+  | December
+
+  | Date
diff --git a/src/server/Message/Lang.hs b/src/server/Message/Lang.hs
new file mode 100644
index 0000000..e9519f1
--- /dev/null
+++ b/src/server/Message/Lang.hs
@@ -0,0 +1,5 @@
+module Message.Lang
+  ( Lang(..)
+  ) where
+
+data Lang = English | French
diff --git a/src/server/Message/Translations.hs b/src/server/Message/Translations.hs
new file mode 100644
index 0000000..f16ffe1
--- /dev/null
+++ b/src/server/Message/Translations.hs
@@ -0,0 +1,76 @@
+module Message.Translations
+  ( getNonFormattedMessage
+  ) where
+
+import Message.Key
+import Message.Lang
+
+getNonFormattedMessage :: Lang -> Key -> String
+getNonFormattedMessage = m
+
+m :: Lang -> Key -> String
+
+m l January =
+  case l of
+    English -> "January"
+    French  -> "Janvier"
+
+m l February =
+  case l of
+    English -> "February"
+    French -> "Février"
+
+m l March =
+  case l of
+    English -> "March"
+    French -> "Mars"
+
+m l April =
+  case l of
+    English -> "April"
+    French -> "Avril"
+
+m l May =
+  case l of
+    English -> "May"
+    French -> "Mai"
+
+m l June =
+  case l of
+    English -> "June"
+    French -> "Juin"
+
+m l July =
+  case l of
+    English -> "July"
+    French -> "Juillet"
+
+m l August =
+  case l of
+    English -> "August"
+    French -> "Août"
+
+m l September =
+  case l of
+    English -> "September"
+    French -> "Septembre"
+
+m l October =
+  case l of
+    English -> "October"
+    French -> "Octoble"
+
+m l November =
+  case l of
+    English -> "November"
+    French -> "Novembre"
+
+m l December =
+  case l of
+    English -> "December"
+    French -> "Décembre"
+
+m l Date =
+  case l of
+    English -> "{2} {1}, {3}"
+    French -> "{1} {2} {3}"