diff options
Diffstat (limited to 'src/server/Model')
-rw-r--r-- | src/server/Model/Json/Message.hs | 16 | ||||
-rw-r--r-- | src/server/Model/Json/Translation.hs | 18 | ||||
-rw-r--r-- | src/server/Model/Json/Translations.hs | 17 | ||||
-rw-r--r-- | src/server/Model/Message.hs | 33 | ||||
-rw-r--r-- | src/server/Model/Message/Key.hs | 22 | ||||
-rw-r--r-- | src/server/Model/Message/Lang.hs | 11 | ||||
-rw-r--r-- | src/server/Model/Message/Parts.hs | 38 | ||||
-rw-r--r-- | src/server/Model/Message/Translations.hs | 80 |
8 files changed, 225 insertions, 10 deletions
diff --git a/src/server/Model/Json/Message.hs b/src/server/Model/Json/Message.hs new file mode 100644 index 0000000..354dd8f --- /dev/null +++ b/src/server/Model/Json/Message.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Model.Json.Message + ( Message(..) + ) where + +import Data.Aeson +import Data.Text (Text) +import GHC.Generics + +data Message = Message + { message :: Text + } deriving (Show, Generic) + +instance FromJSON Message +instance ToJSON Message diff --git a/src/server/Model/Json/Translation.hs b/src/server/Model/Json/Translation.hs new file mode 100644 index 0000000..7291157 --- /dev/null +++ b/src/server/Model/Json/Translation.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Model.Json.Translation + ( Translation(..) + ) where + +import GHC.Generics + +import Data.Aeson +import Data.Text + +data Translation = Translation + { key :: Text + , message :: Text + } deriving (Show, Generic) + +instance FromJSON Translation +instance ToJSON Translation diff --git a/src/server/Model/Json/Translations.hs b/src/server/Model/Json/Translations.hs new file mode 100644 index 0000000..21b188a --- /dev/null +++ b/src/server/Model/Json/Translations.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Model.Json.Translations + ( Translations(..) + ) where + +import Data.Aeson +import GHC.Generics + +import Model.Json.Translation + +data Translations = Translations + { translations :: [Translation] + } deriving (Show, Generic) + +instance FromJSON Translations +instance ToJSON Translations diff --git a/src/server/Model/Message.hs b/src/server/Model/Message.hs index d84aaa9..8475740 100644 --- a/src/server/Model/Message.hs +++ b/src/server/Model/Message.hs @@ -1,16 +1,29 @@ -{-# LANGUAGE DeriveGeneric #-} - module Model.Message - ( Message(..) + ( getMessage + , getVarMessage + , getTranslations ) where -import Data.Aeson import Data.Text (Text) -import GHC.Generics +import qualified Data.Text as T + +import Model.Message.Key (Key) +import Model.Message.Lang +import Model.Message.Translations (getNonFormattedMessage) +import Model.Message.Parts + +import Model.Json.Translations +import Model.Json.Translation + +getMessage :: Key -> Text +getMessage = getVarMessage [] + +getVarMessage :: [Text] -> Key -> Text +getVarMessage values key = + replaceParts values (getParts (getNonFormattedMessage lang key)) -data Message = Message - { message :: Text - } deriving (Show, Generic) +getTranslations :: Translations +getTranslations = Translations (map getTranslation [minBound..]) -instance FromJSON Message -instance ToJSON Message +getTranslation :: Key -> Translation +getTranslation key = Translation (T.pack . show $ key) (getNonFormattedMessage lang key) diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs new file mode 100644 index 0000000..59a5dbc --- /dev/null +++ b/src/server/Model/Message/Key.hs @@ -0,0 +1,22 @@ +module Model.Message.Key + ( Key(..) + ) where + +data Key = + + January + | February + | March + | April + | May + | June + | July + | August + | September + | October + | November + | December + + | Date + + deriving (Enum, Bounded, Show) diff --git a/src/server/Model/Message/Lang.hs b/src/server/Model/Message/Lang.hs new file mode 100644 index 0000000..f515c96 --- /dev/null +++ b/src/server/Model/Message/Lang.hs @@ -0,0 +1,11 @@ +module Model.Message.Lang + ( Lang(..) + , lang + ) where + +data Lang = + English + | French + +lang :: Lang +lang = French diff --git a/src/server/Model/Message/Parts.hs b/src/server/Model/Message/Parts.hs new file mode 100644 index 0000000..b7855f8 --- /dev/null +++ b/src/server/Model/Message/Parts.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.Message.Parts + ( replaceParts + , getParts + ) where + +import Data.Maybe (listToMaybe, fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T + +import Text.ParserCombinators.Parsec + +replaceParts :: [Text] -> [Part] -> Text +replaceParts values = T.concat . map (replacePart values) + +replacePart :: [Text] -> Part -> Text +replacePart _ (Str str) = str +replacePart values (Num n) = + fromMaybe (T.concat ["{", T.pack (show n), "}"]) . listToMaybe . drop (n - 1) $ values + +data Part = + Num Int + | Str Text + +getParts :: Text -> [Part] +getParts str = + case parse partsParser "" (T.unpack 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 <- T.pack <$> many1 (noneOf "{"); return (Str str)) diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs new file mode 100644 index 0000000..289b714 --- /dev/null +++ b/src/server/Model/Message/Translations.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.Message.Translations + ( getNonFormattedMessage + ) where + +import Data.Text (Text) + +import Model.Message.Key +import Model.Message.Lang + +getNonFormattedMessage :: Lang -> Key -> Text +getNonFormattedMessage = m + +m :: Lang -> Key -> Text + +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}" |