Adding a message structure server side

1 files changed, 45 insertions, 0 deletions

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))