aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--elm-package.json2
-rw-r--r--public/javascripts/elmLauncher.js5
-rw-r--r--src/client/Main.elm8
-rw-r--r--src/client/Model.elm11
-rw-r--r--src/client/Model/Translations.elm70
-rw-r--r--src/client/View/Header.elm3
-rw-r--r--src/client/View/Page.elm2
-rw-r--r--src/client/View/SignIn.elm8
-rw-r--r--src/server/Controller/SignIn.hs8
-rw-r--r--src/server/Model/Json/MessagePart.hs18
-rw-r--r--src/server/Model/Json/Translation.hs4
-rw-r--r--src/server/Model/Message.hs5
-rw-r--r--src/server/Model/Message/Key.hs12
-rw-r--r--src/server/Model/Message/Parts.hs23
-rw-r--r--src/server/Model/Message/Translations.hs25
15 files changed, 172 insertions, 32 deletions
diff --git a/elm-package.json b/elm-package.json
index c1cdb9c..df4dcad 100644
--- a/elm-package.json
+++ b/elm-package.json
@@ -8,7 +8,7 @@
"elm-version": "0.15.1 <= v < 0.16.0",
"dependencies": {
"elm-lang/core": "2.1.0 <= v < 3.0.0",
- "evancz/elm-html": "4.0.0 <= v < 5.0.0",
+ "evancz/elm-html": "4.0.1 <= v < 5.0.0",
"evancz/elm-http": "1.0.0 <= v < 2.0.0"
},
"native-modules": true
diff --git a/public/javascripts/elmLauncher.js b/public/javascripts/elmLauncher.js
index 0d9dc5c..ef5d86d 100644
--- a/public/javascripts/elmLauncher.js
+++ b/public/javascripts/elmLauncher.js
@@ -1,8 +1,7 @@
-var messages = document.getElementById('messages').innerHTML;
-
Elm.fullscreen(Elm.Main, {
signInError: getParameterByName('signInError'),
- initialTime: new Date().getTime()
+ initialTime: new Date().getTime(),
+ translations: document.getElementById('messages').innerHTML
});
function getParameterByName(name) {
diff --git a/src/client/Main.elm b/src/client/Main.elm
index fd0cec7..226ae13 100644
--- a/src/client/Main.elm
+++ b/src/client/Main.elm
@@ -11,10 +11,12 @@ import Html exposing (Html)
import Http
import Task exposing (..)
import Time exposing (..)
+import Json.Decode as Json
import Model exposing (Model, initialModel)
import Model.Payment exposing (Payments, paymentsDecoder)
import Model.Message exposing (messageDecoder)
+import Model.Translations exposing (..)
import Update exposing (Action(..), actions, updateModel)
import Update.SignIn exposing (..)
@@ -29,7 +31,7 @@ main : Signal Html
main = Signal.map renderPage model
model : Signal Model
-model = Signal.foldp updateModel (initialModel initialTime) update
+model = Signal.foldp updateModel (initialModel initialTime translations) update
update : Signal Action
update = Signal.mergeMany
@@ -47,6 +49,10 @@ port initialTime : Time
---------------------------------------
+port translations : String
+
+---------------------------------------
+
port initView : Task Http.Error ()
port initView =
case signInError of
diff --git a/src/client/Model.elm b/src/client/Model.elm
index 45fdf87..72db56a 100644
--- a/src/client/Model.elm
+++ b/src/client/Model.elm
@@ -4,16 +4,23 @@ module Model
) where
import Time exposing (Time)
+import Json.Decode as Json
import Model.View exposing (..)
+import Model.Translations exposing (..)
type alias Model =
{ view : View
, currentTime : Time
+ , translations : Translations
}
-initialModel : Time -> Model
-initialModel initialTime =
+initialModel : Time -> String -> Model
+initialModel initialTime translationsValue =
{ view = LoadingView
, currentTime = initialTime
+ , translations =
+ case Json.decodeString translationsDecoder translationsValue of
+ Ok translations -> translations
+ Err err -> []
}
diff --git a/src/client/Model/Translations.elm b/src/client/Model/Translations.elm
new file mode 100644
index 0000000..2a8a3a7
--- /dev/null
+++ b/src/client/Model/Translations.elm
@@ -0,0 +1,70 @@
+module Model.Translations
+ ( translationsDecoder
+ , Translations
+ , Translation
+ , getMessage
+ , getVarMessage
+ ) where
+
+import Maybe exposing (withDefault)
+import Json.Decode as Json exposing ((:=))
+import String
+
+type alias Translations = List Translation
+
+translationsDecoder : Json.Decoder Translations
+translationsDecoder =
+ ("translations" := Json.list translationDecoder)
+
+type alias Translation =
+ { key : String
+ , message : List MessagePart
+ }
+
+getTranslation : String -> Translations -> Maybe (List MessagePart)
+getTranslation key translations =
+ translations
+ |> List.filter (\translation -> translation.key == key)
+ |> List.head
+ |> Maybe.map .message
+
+translationDecoder : Json.Decoder Translation
+translationDecoder =
+ Json.object2 Translation
+ ("key" := Json.string)
+ ("message" := Json.list partDecoder)
+
+type MessagePart =
+ Order Int
+ | Str String
+
+partDecoder : Json.Decoder MessagePart
+partDecoder =
+ ("tag" := Json.string) `Json.andThen` partDecoderWithTag
+
+partDecoderWithTag : String -> Json.Decoder MessagePart
+partDecoderWithTag tag =
+ case tag of
+ "Order" -> Json.object1 Order ("contents" := Json.int)
+ "Str" -> Json.object1 Str ("contents" := Json.string)
+
+-----
+
+getMessage : String -> Translations -> String
+getMessage = getVarMessage []
+
+getVarMessage : List String -> String -> Translations -> String
+getVarMessage values key translations =
+ getTranslation key translations
+ |> Maybe.map (\parts -> String.concat (List.map (replacePart values) parts))
+ |> withDefault key
+
+replacePart : List String -> MessagePart -> String
+replacePart values part =
+ case part of
+ Str str -> str
+ Order n ->
+ values
+ |> List.drop (n - 1)
+ |> List.head
+ |> withDefault ("{" ++ (toString n) ++ "}")
diff --git a/src/client/View/Header.elm b/src/client/View/Header.elm
index 788a473..1738d71 100644
--- a/src/client/View/Header.elm
+++ b/src/client/View/Header.elm
@@ -11,6 +11,7 @@ import ServerCommunication exposing (serverCommunications)
import Model exposing (Model)
import Model.View exposing (..)
+import Model.Translations exposing (getMessage)
import View.Icon exposing (renderIcon)
@@ -20,7 +21,7 @@ renderHeader model =
[]
[ h1
[]
- [ text "Shared Cost" ]
+ [ text (getMessage "SharedCost" model.translations) ]
, case model.view of
LoadingView ->
text ""
diff --git a/src/client/View/Page.elm b/src/client/View/Page.elm
index 59c21a2..f7292ed 100644
--- a/src/client/View/Page.elm
+++ b/src/client/View/Page.elm
@@ -26,6 +26,6 @@ renderMain model =
LoadingView ->
renderLoading
SignInView signInView ->
- renderSignIn signInView
+ renderSignIn model signInView
PaymentView paymentsView ->
renderPayments paymentsView
diff --git a/src/client/View/SignIn.elm b/src/client/View/SignIn.elm
index a790f0a..6fb809d 100644
--- a/src/client/View/SignIn.elm
+++ b/src/client/View/SignIn.elm
@@ -14,12 +14,14 @@ import Update.SignIn exposing (..)
import ServerCommunication as SC
import ServerCommunication exposing (serverCommunications)
+import Model exposing (Model)
import Model.View.SignInView exposing (..)
+import Model.Translations exposing (getMessage)
import View.Events exposing (onSubmitPrevDefault)
-renderSignIn : SignInView -> Html
-renderSignIn signInView =
+renderSignIn : Model -> SignInView -> Html
+renderSignIn model signInView =
div
[ class "signIn" ]
[ H.form
@@ -31,7 +33,7 @@ renderSignIn signInView =
[]
, button
[]
- [ text "Sign in" ]
+ [ text (getMessage "SignIn" model.translations)]
]
, div
[ class "result" ]
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 1110c72..263e470 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -31,6 +31,8 @@ import Model.Database
import Model.User
import Model.SignIn
import Model.Json.Message
+import Model.Message.Key
+import Model.Message (getMessage)
import qualified View.Mail.SignIn as SignIn
@@ -48,11 +50,11 @@ signInAction config login =
Right _ ->
status ok200
Left _ ->
- errorResponse "Sorry, we failed to send you the sign up email."
+ errorResponse (getMessage SendEmailFail)
Nothing ->
- errorResponse "You are not authorized to sign in."
+ errorResponse (getMessage Unauthorized)
else
- errorResponse "Please enter a valid email address."
+ errorResponse (getMessage EnterValidEmail)
errorResponse :: Text -> ActionM ()
errorResponse msg = do
diff --git a/src/server/Model/Json/MessagePart.hs b/src/server/Model/Json/MessagePart.hs
new file mode 100644
index 0000000..0753d7c
--- /dev/null
+++ b/src/server/Model/Json/MessagePart.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.MessagePart
+ ( MessagePart(..)
+ ) where
+
+import Data.Text (Text)
+
+import Data.Aeson
+import GHC.Generics
+
+data MessagePart =
+ Order Int
+ | Str Text
+ deriving (Eq, Show, Generic)
+
+instance FromJSON MessagePart
+instance ToJSON MessagePart
diff --git a/src/server/Model/Json/Translation.hs b/src/server/Model/Json/Translation.hs
index 7291157..9dcfe80 100644
--- a/src/server/Model/Json/Translation.hs
+++ b/src/server/Model/Json/Translation.hs
@@ -9,9 +9,11 @@ import GHC.Generics
import Data.Aeson
import Data.Text
+import Model.Json.MessagePart
+
data Translation = Translation
{ key :: Text
- , message :: Text
+ , message :: [MessagePart]
} deriving (Show, Generic)
instance FromJSON Translation
diff --git a/src/server/Model/Message.hs b/src/server/Model/Message.hs
index 8475740..12893b8 100644
--- a/src/server/Model/Message.hs
+++ b/src/server/Model/Message.hs
@@ -19,11 +19,10 @@ getMessage :: Key -> Text
getMessage = getVarMessage []
getVarMessage :: [Text] -> Key -> Text
-getVarMessage values key =
- replaceParts values (getParts (getNonFormattedMessage lang key))
+getVarMessage values key = replaceParts values (getNonFormattedMessage lang key)
getTranslations :: Translations
getTranslations = Translations (map getTranslation [minBound..])
getTranslation :: Key -> Translation
-getTranslation key = Translation (T.pack . show $ key) (getNonFormattedMessage lang key)
+getTranslation key = Translation (T.pack . show $ key) (getParts $ getNonFormattedMessage lang key)
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 59a5dbc..e1a382c 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -4,7 +4,17 @@ module Model.Message.Key
data Key =
- January
+ -- Sign in
+
+ SharedCost
+ | SignIn
+ | SendEmailFail
+ | Unauthorized
+ | EnterValidEmail
+
+ -- Dates
+
+ | January
| February
| March
| April
diff --git a/src/server/Model/Message/Parts.hs b/src/server/Model/Message/Parts.hs
index b7855f8..d065cf2 100644
--- a/src/server/Model/Message/Parts.hs
+++ b/src/server/Model/Message/Parts.hs
@@ -11,28 +11,27 @@ import qualified Data.Text as T
import Text.ParserCombinators.Parsec
-replaceParts :: [Text] -> [Part] -> Text
-replaceParts values = T.concat . map (replacePart values)
+import Model.Json.MessagePart
-replacePart :: [Text] -> Part -> Text
+replaceParts :: [Text] -> Text -> Text
+replaceParts values message =
+ T.concat . map (replacePart values) $ getParts message
+
+replacePart :: [Text] -> MessagePart -> Text
replacePart _ (Str str) = str
-replacePart values (Num n) =
+replacePart values (Order n) =
fromMaybe (T.concat ["{", T.pack (show n), "}"]) . listToMaybe . drop (n - 1) $ values
-data Part =
- Num Int
- | Str Text
-
-getParts :: Text -> [Part]
+getParts :: Text -> [MessagePart]
getParts str =
case parse partsParser "" (T.unpack str) of
Right parts -> parts
Left _ -> []
-partsParser :: Parser [Part]
+partsParser :: Parser [MessagePart]
partsParser = many partParser
-partParser :: Parser Part
+partParser :: Parser MessagePart
partParser =
- (do _ <- string "{"; n <- read <$> many1 digit; _ <- string "}"; return (Num n))
+ (do _ <- string "{"; n <- read <$> many1 digit; _ <- string "}"; return (Order 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
index 289b714..2cc1761 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -14,6 +14,31 @@ getNonFormattedMessage = m
m :: Lang -> Key -> Text
+m l SharedCost =
+ case l of
+ English -> "Shared Cost"
+ French -> "Partage des frais"
+
+m l SignIn =
+ case l of
+ English -> "Sign in"
+ French -> "Connexion"
+
+m l SendEmailFail =
+ case l of
+ English -> "Sorry, we failed to send you the sign up email."
+ French -> "Désolé, nous n'avons pas pu vous envoyer le courriel de connexion."
+
+m l Unauthorized =
+ case l of
+ English -> "You are not authorized to sign in."
+ French -> "Vous n'êtes pas authorisé à vous connecter."
+
+m l EnterValidEmail =
+ case l of
+ English -> "Please enter a valid email address."
+ French -> "Entrez s'il vous plait un email valide."
+
m l January =
case l of
English -> "January"
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-06 03:25:09 +0000