aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm')
-rw-r--r--src/client/elm/InitViewAction.elm25
-rw-r--r--src/client/elm/Main.elm89
-rw-r--r--src/client/elm/Model.elm32
-rw-r--r--src/client/elm/Model/Config.elm18
-rw-r--r--src/client/elm/Model/Date.elm15
-rw-r--r--src/client/elm/Model/Income.elm76
-rw-r--r--src/client/elm/Model/Payer.elm132
-rw-r--r--src/client/elm/Model/Payment.elm44
-rw-r--r--src/client/elm/Model/Translations.elm69
-rw-r--r--src/client/elm/Model/User.elm44
-rw-r--r--src/client/elm/Model/View.elm12
-rw-r--r--src/client/elm/Model/View/LoggedIn/Account.elm67
-rw-r--r--src/client/elm/Model/View/LoggedIn/Add.elm43
-rw-r--r--src/client/elm/Model/View/LoggedIn/Edition.elm7
-rw-r--r--src/client/elm/Model/View/LoggedIn/Monthly.elm17
-rw-r--r--src/client/elm/Model/View/LoggedInView.elm35
-rw-r--r--src/client/elm/Model/View/SignInView.elm15
-rw-r--r--src/client/elm/Native/Reads.js22
-rw-r--r--src/client/elm/Persona.elm28
-rw-r--r--src/client/elm/Reads.elm10
-rw-r--r--src/client/elm/ServerCommunication.elm95
-rw-r--r--src/client/elm/Sign.elm43
-rw-r--r--src/client/elm/SimpleHTTP.elm41
-rw-r--r--src/client/elm/Update.elm57
-rw-r--r--src/client/elm/Update/LoggedIn.elm68
-rw-r--r--src/client/elm/Update/LoggedIn/Account.elm64
-rw-r--r--src/client/elm/Update/LoggedIn/Add.elm29
-rw-r--r--src/client/elm/Update/LoggedIn/Monthly.elm27
-rw-r--r--src/client/elm/Update/SignIn.elm15
-rw-r--r--src/client/elm/Utils/Dict.elm11
-rw-r--r--src/client/elm/Utils/Either.elm9
-rw-r--r--src/client/elm/Utils/Maybe.elm27
-rw-r--r--src/client/elm/Utils/Validation.elm23
-rw-r--r--src/client/elm/View/Date.elm59
-rw-r--r--src/client/elm/View/Events.elm19
-rw-r--r--src/client/elm/View/Expand.elm25
-rw-r--r--src/client/elm/View/Header.elm39
-rw-r--r--src/client/elm/View/Icon.elm12
-rw-r--r--src/client/elm/View/Loading.elm8
-rw-r--r--src/client/elm/View/LoggedIn.elm30
-rw-r--r--src/client/elm/View/LoggedIn/Account.elm130
-rw-r--r--src/client/elm/View/LoggedIn/Add.elm122
-rw-r--r--src/client/elm/View/LoggedIn/Monthly.elm89
-rw-r--r--src/client/elm/View/LoggedIn/Paging.elm100
-rw-r--r--src/client/elm/View/LoggedIn/Table.elm97
-rw-r--r--src/client/elm/View/Page.elm31
-rw-r--r--src/client/elm/View/Price.elm38
-rw-r--r--src/client/elm/View/SignIn.elm46
48 files changed, 2154 insertions, 0 deletions
diff --git a/src/client/elm/InitViewAction.elm b/src/client/elm/InitViewAction.elm
new file mode 100644
index 0000000..7c353a7
--- /dev/null
+++ b/src/client/elm/InitViewAction.elm
@@ -0,0 +1,25 @@
+module InitViewAction
+ ( initViewAction
+ ) where
+
+import Task exposing (..)
+import Http
+import Json.Decode as Json exposing ((:=))
+
+import Update exposing (Action(GoLoggedInView, GoSignInView))
+
+import Model.Payment exposing (Payments, paymentsDecoder, perPage)
+import Model.Payer exposing (Payers, payersDecoder)
+import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder)
+
+initViewAction : Task Http.Error Action
+initViewAction = Task.onError loggedInView (always <| Task.succeed GoSignInView)
+
+loggedInView : Task Http.Error Action
+loggedInView =
+ Task.map GoLoggedInView (Http.get usersDecoder "/users")
+ `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI")
+ `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments")
+ `Task.andMap` (Http.get paymentsDecoder ("/payments?page=1&perPage=" ++ toString perPage))
+ `Task.andMap` (Http.get ("number" := Json.int) "/payments/count")
+ `Task.andMap` (Http.get payersDecoder "/payers")
diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm
new file mode 100644
index 0000000..f79d6a0
--- /dev/null
+++ b/src/client/elm/Main.elm
@@ -0,0 +1,89 @@
+module Main
+ ( main
+ ) where
+
+import Graphics.Element exposing (..)
+
+import Html exposing (Html)
+
+import Http
+import Task exposing (..)
+import Time exposing (..)
+import Json.Decode as Json
+import Dict
+import String
+
+import Model exposing (Model, initialModel)
+import Model.Translations exposing (..)
+import Model.Config exposing (..)
+
+import Update exposing (Action(..), actions, updateModel)
+import Update.SignIn exposing (..)
+
+import View.Page exposing (renderPage)
+
+import ServerCommunication as SC exposing (serverCommunications, sendRequest)
+
+import Persona as Persona exposing (operations)
+
+import InitViewAction exposing (initViewAction)
+
+import Sign
+
+main : Signal Html
+main = Signal.map renderPage model
+
+model : Signal Model
+model = Signal.foldp updateModel (initialModel initialTime translations config) update
+
+update : Signal Action
+update = Signal.mergeMany
+ [ Signal.map UpdateTime (Time.every 1000)
+ , actions.signal
+ ]
+
+---------------------------------------
+
+port initialTime : Time
+
+---------------------------------------
+
+port translations : String
+
+---------------------------------------
+
+port config : String
+
+---------------------------------------
+
+port ready : Signal String
+port ready = Signal.constant "ready"
+
+---------------------------------------
+
+port initView : Task Http.Error ()
+port initView = initViewAction `Task.andThen` (Signal.send actions.address)
+
+---------------------------------------
+
+port serverCommunicationsPort : Signal (Task Http.Error ())
+port serverCommunicationsPort =
+ Signal.map
+ (\comm ->
+ sendRequest comm
+ |> flip Task.andThen (\action -> Signal.send actions.address action)
+ )
+ (Signal.merge signCommunication serverCommunications.signal)
+
+---------------------------------------
+
+port persona : Signal String
+port persona = Signal.map Persona.toString operations.signal
+
+---------------------------------------
+
+port sign : Signal Json.Value
+
+signCommunication : Signal SC.Communication
+signCommunication =
+ Signal.map (Sign.toServerCommunication << Sign.decodeOperation) sign
diff --git a/src/client/elm/Model.elm b/src/client/elm/Model.elm
new file mode 100644
index 0000000..43a19c5
--- /dev/null
+++ b/src/client/elm/Model.elm
@@ -0,0 +1,32 @@
+module Model
+ ( Model
+ , initialModel
+ ) where
+
+import Time exposing (Time)
+import Json.Decode as Json
+
+import Model.View exposing (..)
+import Model.Translations exposing (..)
+import Model.Config exposing (..)
+
+type alias Model =
+ { view : View
+ , currentTime : Time
+ , translations : Translations
+ , config : Config
+ }
+
+initialModel : Time -> String -> String -> Model
+initialModel initialTime translationsValue configValue =
+ { view = LoadingView
+ , currentTime = initialTime
+ , translations =
+ case Json.decodeString translationsDecoder translationsValue of
+ Ok translations -> translations
+ Err err -> []
+ , config =
+ case Json.decodeString configDecoder configValue of
+ Ok config -> config
+ Err err -> { currency = "" }
+ }
diff --git a/src/client/elm/Model/Config.elm b/src/client/elm/Model/Config.elm
new file mode 100644
index 0000000..e47b032
--- /dev/null
+++ b/src/client/elm/Model/Config.elm
@@ -0,0 +1,18 @@
+module Model.Config
+ ( Config
+ , configDecoder
+ ) where
+
+import Json.Decode exposing (..)
+
+type alias Config =
+ { currency : String
+ }
+
+configDecoder : Decoder Config
+configDecoder = object1 Config ("currency" := string)
+
+defaultConfig : Config
+defaultConfig =
+ { currency = "€"
+ }
diff --git a/src/client/elm/Model/Date.elm b/src/client/elm/Model/Date.elm
new file mode 100644
index 0000000..1c56de4
--- /dev/null
+++ b/src/client/elm/Model/Date.elm
@@ -0,0 +1,15 @@
+module Model.Date
+ ( timeDecoder
+ , dateDecoder
+ ) where
+
+import Date as Date exposing (Date)
+import Time exposing (Time)
+
+import Json.Decode as Json exposing (..)
+
+timeDecoder : Decoder Time
+timeDecoder = Json.map Date.toTime dateDecoder
+
+dateDecoder : Decoder Date
+dateDecoder = customDecoder string Date.fromString
diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm
new file mode 100644
index 0000000..97a5652
--- /dev/null
+++ b/src/client/elm/Model/Income.elm
@@ -0,0 +1,76 @@
+module Model.Income
+ ( Income
+ , incomeDecoder
+ , incomeDefinedForAll
+ , cumulativeIncomesSince
+ ) where
+
+import Json.Decode as Json exposing ((:=))
+import Time exposing (Time, hour)
+import List exposing (..)
+
+import Model.Date exposing (timeDecoder)
+import Model.User exposing (UserId)
+
+import Utils.Maybe exposing (isJust, catMaybes, maybeToList)
+
+type alias Income =
+ { creation : Time
+ , amount : Int
+ }
+
+incomeDecoder : Json.Decoder Income
+incomeDecoder =
+ Json.object2 Income
+ ("creation" := timeDecoder)
+ ("amount" := Json.int)
+
+incomeDefinedForAll : List (List Income) -> Maybe Time
+incomeDefinedForAll usersIncomes =
+ let firstIncomes = map (head << sortBy .creation) usersIncomes
+ in if all isJust firstIncomes
+ then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes
+ else Nothing
+
+cumulativeIncomesSince : Time -> Time -> (List Income) -> Int
+cumulativeIncomesSince currentTime since incomes =
+ cumulativeIncome currentTime (getOrderedIncomesSince since incomes)
+
+getOrderedIncomesSince : Time -> List Income -> List Income
+getOrderedIncomesSince time incomes =
+ let mbStarterIncome = getIncomesAt time incomes
+ orderedIncomesSince = filter (\income -> income.creation >= time) incomes
+ in (maybeToList mbStarterIncome) ++ orderedIncomesSince
+
+getIncomesAt : Time -> List Income -> Maybe Income
+getIncomesAt time incomes =
+ case incomes of
+ [x] ->
+ if x.creation < time
+ then Just { creation = time, amount = x.amount }
+ else Nothing
+ x1 :: x2 :: xs ->
+ if x1.creation < time && x2.creation > time
+ then Just { creation = time, amount = x2.amount }
+ else getIncomesAt time (x2 :: xs)
+ [] ->
+ Nothing
+
+cumulativeIncome : Time -> List Income -> Int
+cumulativeIncome currentTime incomes =
+ getIncomesWithDuration (incomes ++ [{ creation = currentTime, amount = 0 }])
+ |> map durationIncome
+ |> sum
+
+getIncomesWithDuration : List Income -> List (Float, Int)
+getIncomesWithDuration incomes =
+ case incomes of
+ (income1 :: income2 :: xs) ->
+ (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration (income2 :: xs))
+ _ ->
+ []
+
+durationIncome : (Float, Int) -> Int
+durationIncome (duration, income) =
+ duration * toFloat income / (hour * 24 * 365 / 12)
+ |> truncate
diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm
new file mode 100644
index 0000000..9fd1bb5
--- /dev/null
+++ b/src/client/elm/Model/Payer.elm
@@ -0,0 +1,132 @@
+module Model.Payer
+ ( Payers
+ , Payer
+ , ExceedingPayer
+ , payersDecoder
+ , updatePayers
+ , getOrderedExceedingPayers
+ ) where
+
+import Json.Decode as Json exposing (..)
+import Dict exposing (..)
+import List
+import Maybe
+import Time exposing (Time)
+
+import Model.User exposing (UserId, userIdDecoder)
+import Model.Income exposing (..)
+
+import Utils.Dict exposing (mapValues)
+import Utils.Maybe exposing (isJust)
+
+type alias Payers = Dict UserId Payer
+
+type alias Payer =
+ { preIncomePaymentSum : Int
+ , postIncomePaymentSum : Int
+ , incomes : List Income
+ }
+
+payersDecoder : Decoder Payers
+payersDecoder = Json.map Dict.fromList (list payerDecoder)
+
+payerDecoder : Decoder (UserId, Payer)
+payerDecoder =
+ object2 (,)
+ ("userId" := userIdDecoder)
+ (object3 Payer
+ ("preIncomePaymentSum" := int)
+ ("postIncomePaymentSum" := int)
+ ("incomes" := list incomeDecoder))
+
+updatePayers : Payers -> UserId -> Time -> Int -> Payers
+updatePayers payers userId creation amountDiff =
+ payers
+ |> Dict.update userId (\mbPayer ->
+ case mbPayer of
+ Just payer ->
+ let postIncome =
+ payersIncomeDefinedForAll payers
+ |> Maybe.map (\date -> creation > date)
+ |> Maybe.withDefault False
+ in if postIncome
+ then
+ Just { payer | postIncomePaymentSum <- payer.postIncomePaymentSum + amountDiff }
+ else
+ Just { payer | preIncomePaymentSum <- payer.preIncomePaymentSum + amountDiff }
+ Nothing ->
+ Nothing
+ )
+
+type alias ExceedingPayer =
+ { userId : UserId
+ , amount : Int
+ }
+
+getOrderedExceedingPayers : Time -> Payers -> List ExceedingPayer
+getOrderedExceedingPayers currentTime payers =
+ let exceedingPayersOnPreIncome =
+ payers
+ |> mapValues .preIncomePaymentSum
+ |> Dict.toList
+ |> exceedingPayersFromAmounts
+ in case payersIncomeDefinedForAll payers of
+ Just since ->
+ let postPaymentPayers =
+ payers
+ |> mapValues (getPostPaymentPayer currentTime since)
+ mbMaxRatio =
+ postPaymentPayers
+ |> Dict.toList
+ |> List.map (.ratio << snd)
+ |> List.maximum
+ in case mbMaxRatio of
+ Just maxRatio ->
+ postPaymentPayers
+ |> mapValues (getFinalDiff maxRatio)
+ |> Dict.toList
+ |> exceedingPayersFromAmounts
+ Nothing ->
+ exceedingPayersOnPreIncome
+ Nothing ->
+ exceedingPayersOnPreIncome
+
+payersIncomeDefinedForAll : Payers -> Maybe Time
+payersIncomeDefinedForAll payers =
+ incomeDefinedForAll (List.map (.incomes << snd) << Dict.toList <| payers)
+
+exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer
+exceedingPayersFromAmounts userAmounts =
+ let mbMinAmount = List.minimum << List.map snd <| userAmounts
+ in case mbMinAmount of
+ Nothing ->
+ []
+ Just minAmount ->
+ userAmounts
+ |> List.map (\userAmount ->
+ { userId = fst userAmount
+ , amount = snd userAmount - minAmount
+ }
+ )
+ |> List.filter (\payer -> payer.amount > 0)
+
+type alias PostPaymentPayer =
+ { preIncomePaymentSum : Int
+ , cumulativeIncome : Int
+ , ratio : Float
+ }
+
+getPostPaymentPayer : Time -> Time -> Payer -> PostPaymentPayer
+getPostPaymentPayer currentTime since payer =
+ let cumulativeIncome = cumulativeIncomesSince currentTime since payer.incomes
+ in { preIncomePaymentSum = payer.preIncomePaymentSum
+ , cumulativeIncome = cumulativeIncome
+ , ratio = toFloat payer.postIncomePaymentSum / toFloat cumulativeIncome
+ }
+
+getFinalDiff : Float -> PostPaymentPayer -> Int
+getFinalDiff maxRatio payer =
+ let postIncomeDiff =
+ -1 * (maxRatio - payer.ratio) * toFloat payer.cumulativeIncome
+ |> truncate
+ in postIncomeDiff + payer.preIncomePaymentSum
diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm
new file mode 100644
index 0000000..c4a8963
--- /dev/null
+++ b/src/client/elm/Model/Payment.elm
@@ -0,0 +1,44 @@
+module Model.Payment
+ ( perPage
+ , Payments
+ , Payment
+ , PaymentId
+ , paymentsDecoder
+ , paymentIdDecoder
+ ) where
+
+import Date exposing (..)
+import Json.Decode as Json exposing ((:=))
+
+import Model.User exposing (UserId, userIdDecoder)
+import Model.Date exposing (dateDecoder)
+
+perPage : Int
+perPage = 8
+
+type alias Payments = List Payment
+
+type alias Payment =
+ { id : PaymentId
+ , creation : Date
+ , name : String
+ , cost : Int
+ , userId : UserId
+ }
+
+type alias PaymentId = Int
+
+paymentsDecoder : Json.Decoder Payments
+paymentsDecoder = Json.list paymentDecoder
+
+paymentDecoder : Json.Decoder Payment
+paymentDecoder =
+ Json.object5 Payment
+ ("id" := paymentIdDecoder)
+ ("creation" := dateDecoder)
+ ("name" := Json.string)
+ ("cost" := Json.int)
+ ("userId" := userIdDecoder)
+
+paymentIdDecoder : Json.Decoder PaymentId
+paymentIdDecoder = Json.int
diff --git a/src/client/elm/Model/Translations.elm b/src/client/elm/Model/Translations.elm
new file mode 100644
index 0000000..bec8c9b
--- /dev/null
+++ b/src/client/elm/Model/Translations.elm
@@ -0,0 +1,69 @@
+module Model.Translations
+ ( translationsDecoder
+ , Translations
+ , Translation
+ , getMessage
+ , getParamMessage
+ ) where
+
+import Maybe exposing (withDefault)
+import Json.Decode as Json exposing ((:=))
+import String
+
+type alias Translations = List Translation
+
+translationsDecoder : Json.Decoder Translations
+translationsDecoder = 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 = getParamMessage []
+
+getParamMessage : List String -> String -> Translations -> String
+getParamMessage 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/elm/Model/User.elm b/src/client/elm/Model/User.elm
new file mode 100644
index 0000000..1412913
--- /dev/null
+++ b/src/client/elm/Model/User.elm
@@ -0,0 +1,44 @@
+module Model.User
+ ( Users
+ , usersDecoder
+ , User
+ , userDecoder
+ , UserId
+ , userIdDecoder
+ , getUserName
+ ) where
+
+import Json.Decode as Json exposing ((:=))
+import Dict exposing (Dict)
+
+type alias Users = Dict UserId User
+
+type alias UserId = Int
+
+type alias User =
+ { name : String
+ , email : String
+ }
+
+usersDecoder : Json.Decoder Users
+usersDecoder = Json.map Dict.fromList (Json.list userWithIdDecoder)
+
+userWithIdDecoder : Json.Decoder (UserId, User)
+userWithIdDecoder =
+ Json.object2 (,)
+ ("id" := userIdDecoder)
+ userDecoder
+
+userDecoder : Json.Decoder User
+userDecoder =
+ Json.object2 User
+ ("name" := Json.string)
+ ("email" := Json.string)
+
+userIdDecoder : Json.Decoder UserId
+userIdDecoder = Json.int
+
+getUserName : Users -> UserId -> Maybe String
+getUserName users userId =
+ Dict.get userId users
+ |> Maybe.map .name
diff --git a/src/client/elm/Model/View.elm b/src/client/elm/Model/View.elm
new file mode 100644
index 0000000..90c0e53
--- /dev/null
+++ b/src/client/elm/Model/View.elm
@@ -0,0 +1,12 @@
+module Model.View
+ ( View(..)
+ ) where
+
+import Model.Payment exposing (Payments)
+import Model.View.SignInView exposing (..)
+import Model.View.LoggedInView exposing (..)
+
+type View =
+ LoadingView
+ | SignInView SignInView
+ | LoggedInView LoggedInView
diff --git a/src/client/elm/Model/View/LoggedIn/Account.elm b/src/client/elm/Model/View/LoggedIn/Account.elm
new file mode 100644
index 0000000..2bb3ae7
--- /dev/null
+++ b/src/client/elm/Model/View/LoggedIn/Account.elm
@@ -0,0 +1,67 @@
+module Model.View.LoggedIn.Account
+ ( Account
+ , IncomeEdition
+ , initAccount
+ , initIncomeEdition
+ , getCurrentIncome
+ , validateIncome
+ ) where
+
+import Result as Result exposing (Result(..))
+import Dict
+
+import Utils.Validation exposing (..)
+import Utils.Dict exposing (mapValues)
+
+import Model.Translations exposing (..)
+import Model.Payer exposing (..)
+import Model.User exposing (UserId)
+
+type alias Account =
+ { me : UserId
+ , payers : Payers
+ , visibleDetail : Bool
+ , incomeEdition : Maybe IncomeEdition
+ }
+
+initAccount : UserId -> Payers -> Account
+initAccount me payers =
+ { me = me
+ , payers =
+ payers
+ |> mapValues
+ (\payer ->
+ { payer | incomes <- List.sortBy .creation payer.incomes }
+ )
+ , visibleDetail = False
+ , incomeEdition = Nothing
+ }
+
+getCurrentIncome : Account -> Maybe Int
+getCurrentIncome account =
+ case Dict.get account.me account.payers of
+ Just payer ->
+ payer.incomes
+ |> List.sortBy .creation
+ |> List.reverse
+ |> List.head
+ |> Maybe.map .amount
+ Nothing ->
+ Nothing
+
+type alias IncomeEdition =
+ { income : String
+ , error : Maybe String
+ }
+
+initIncomeEdition : Int -> IncomeEdition
+initIncomeEdition income =
+ { income = toString income
+ , error = Nothing
+ }
+
+validateIncome : String -> Translations -> Result String Int
+validateIncome amount translations =
+ amount
+ |> validateNonEmpty (getMessage "IncomeRequired" translations)
+ |> flip Result.andThen (validateNumber (getMessage "IncomeMustBePositiveNumber" translations) (\number -> number > 0))
diff --git a/src/client/elm/Model/View/LoggedIn/Add.elm b/src/client/elm/Model/View/LoggedIn/Add.elm
new file mode 100644
index 0000000..5598084
--- /dev/null
+++ b/src/client/elm/Model/View/LoggedIn/Add.elm
@@ -0,0 +1,43 @@
+module Model.View.LoggedIn.Add
+ ( AddPayment
+ , Frequency(..)
+ , initAddPayment
+ , validateName
+ , validateCost
+ ) where
+
+import Result as Result exposing (Result(..))
+
+import Utils.Validation exposing (..)
+
+import Model.Translations exposing (..)
+
+type alias AddPayment =
+ { name : String
+ , nameError : Maybe String
+ , cost : String
+ , costError : Maybe String
+ , frequency : Frequency
+ }
+
+initAddPayment : Frequency -> AddPayment
+initAddPayment frequency =
+ { name = ""
+ , nameError = Nothing
+ , cost = ""
+ , costError = Nothing
+ , frequency = frequency
+ }
+
+validateName : String -> Translations -> Result String String
+validateName name translations =
+ name
+ |> validateNonEmpty (getMessage "CategoryRequired" translations)
+
+validateCost : String -> Translations -> Result String Int
+validateCost cost translations =
+ cost
+ |> validateNonEmpty (getMessage "CostRequired" translations)
+ |> flip Result.andThen (validateNumber (getMessage "CostMustBeNonNullNumber" translations) ((/=) 0))
+
+type Frequency = Punctual | Monthly
diff --git a/src/client/elm/Model/View/LoggedIn/Edition.elm b/src/client/elm/Model/View/LoggedIn/Edition.elm
new file mode 100644
index 0000000..da6d7b0
--- /dev/null
+++ b/src/client/elm/Model/View/LoggedIn/Edition.elm
@@ -0,0 +1,7 @@
+module Model.View.LoggedIn.Edition
+ ( Edition
+ ) where
+
+import Model.Payment exposing (PaymentId)
+
+type alias Edition = PaymentId
diff --git a/src/client/elm/Model/View/LoggedIn/Monthly.elm b/src/client/elm/Model/View/LoggedIn/Monthly.elm
new file mode 100644
index 0000000..3c6f66a
--- /dev/null
+++ b/src/client/elm/Model/View/LoggedIn/Monthly.elm
@@ -0,0 +1,17 @@
+module Model.View.LoggedIn.Monthly
+ ( Monthly
+ , initMonthly
+ ) where
+
+import Model.Payment exposing (Payments)
+
+type alias Monthly =
+ { payments : Payments
+ , visibleDetail : Bool
+ }
+
+initMonthly : Payments -> Monthly
+initMonthly payments =
+ { payments = payments
+ , visibleDetail = False
+ }
diff --git a/src/client/elm/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm
new file mode 100644
index 0000000..122c4be
--- /dev/null
+++ b/src/client/elm/Model/View/LoggedInView.elm
@@ -0,0 +1,35 @@
+module Model.View.LoggedInView
+ ( LoggedInView
+ , initLoggedInView
+ ) where
+
+import Model.User exposing (Users, UserId)
+import Model.Payment exposing (Payments)
+import Model.Payer exposing (Payers)
+import Model.View.LoggedIn.Add exposing (..)
+import Model.View.LoggedIn.Edition exposing (..)
+import Model.View.LoggedIn.Monthly exposing (..)
+import Model.View.LoggedIn.Account exposing (..)
+
+type alias LoggedInView =
+ { users : Users
+ , add : AddPayment
+ , monthly : Monthly
+ , account : Account
+ , payments : Payments
+ , paymentsCount : Int
+ , paymentEdition : Maybe Edition
+ , currentPage : Int
+ }
+
+initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> LoggedInView
+initLoggedInView users me monthlyPayments payments paymentsCount payers =
+ { users = users
+ , add = initAddPayment Punctual
+ , monthly = initMonthly monthlyPayments
+ , account = initAccount me payers
+ , payments = payments
+ , paymentsCount = paymentsCount
+ , paymentEdition = Nothing
+ , currentPage = 1
+ }
diff --git a/src/client/elm/Model/View/SignInView.elm b/src/client/elm/Model/View/SignInView.elm
new file mode 100644
index 0000000..0fbce39
--- /dev/null
+++ b/src/client/elm/Model/View/SignInView.elm
@@ -0,0 +1,15 @@
+module Model.View.SignInView
+ ( SignInView
+ , initSignInView
+ ) where
+
+type alias SignInView =
+ { login : String
+ , result : Maybe (Result String String)
+ }
+
+initSignInView : SignInView
+initSignInView =
+ { login = ""
+ , result = Nothing
+ }
diff --git a/src/client/elm/Native/Reads.js b/src/client/elm/Native/Reads.js
new file mode 100644
index 0000000..5785aed
--- /dev/null
+++ b/src/client/elm/Native/Reads.js
@@ -0,0 +1,22 @@
+Elm.Native.Reads = {};
+Elm.Native.Reads.make = function(localRuntime) {
+
+ localRuntime.Native = localRuntime.Native || {};
+ localRuntime.Native.Reads = localRuntime.Native.Reads || {};
+ if(localRuntime.Native.Reads.values) {
+ return localRuntime.Native.Reads.values;
+ }
+
+ var Maybe = Elm.Maybe.make(localRuntime);
+
+ function readInt(str) {
+ var number = Number(str);
+ return isNaN(number) || str === ''
+ ? Maybe.Nothing
+ : Maybe.Just(number);
+ }
+
+ return localRuntime.Native.Reads.values = {
+ readInt: readInt
+ };
+};
diff --git a/src/client/elm/Persona.elm b/src/client/elm/Persona.elm
new file mode 100644
index 0000000..51b5fc6
--- /dev/null
+++ b/src/client/elm/Persona.elm
@@ -0,0 +1,28 @@
+module Persona
+ ( Operation(..)
+ , operations
+ , fromString
+ , toString
+ ) where
+
+type Operation =
+ NoOp
+ | SignIn
+ | SignOut
+
+operations : Signal.Mailbox Operation
+operations = Signal.mailbox NoOp
+
+fromString : String -> Operation
+fromString str =
+ case str of
+ "SignIn" -> SignIn
+ "SignOut" -> SignOut
+ _ -> NoOp
+
+toString : Operation -> String
+toString operation =
+ case operation of
+ SignIn -> "SignIn"
+ SignOut -> "SignOut"
+ _ -> "NoOp"
diff --git a/src/client/elm/Reads.elm b/src/client/elm/Reads.elm
new file mode 100644
index 0000000..f855802
--- /dev/null
+++ b/src/client/elm/Reads.elm
@@ -0,0 +1,10 @@
+module Reads
+ ( readInt
+ ) where
+
+
+import Native.Reads
+import Result exposing (Result)
+
+readInt : String -> Maybe Int
+readInt = Native.Reads.readInt
diff --git a/src/client/elm/ServerCommunication.elm b/src/client/elm/ServerCommunication.elm
new file mode 100644
index 0000000..70612cb
--- /dev/null
+++ b/src/client/elm/ServerCommunication.elm
@@ -0,0 +1,95 @@
+module ServerCommunication
+ ( Communication(..)
+ , sendRequest
+ , serverCommunications
+ ) where
+
+import Signal
+import Task as Task exposing (Task)
+import Http
+import Json.Decode exposing (..)
+import Date
+import Time exposing (Time)
+import Debug
+
+import SimpleHTTP exposing (..)
+
+import Model.User exposing (UserId)
+import Model.Payment exposing (..)
+import Model.View.LoggedIn.Add exposing (Frequency(..))
+
+import Update as U
+import Update.SignIn exposing (..)
+import Update.LoggedIn as UL
+import Update.LoggedIn.Monthly as UM
+import Update.LoggedIn.Account as UA
+
+import InitViewAction exposing (initViewAction)
+
+type Communication =
+ NoCommunication
+ | SignIn String
+ | AddPayment UserId String Int
+ | AddMonthlyPayment String Int
+ | SetIncome Time Int
+ | DeletePayment Payment Int
+ | DeleteMonthlyPayment PaymentId
+ | UpdatePage Int
+ | SignOut
+
+serverCommunications : Signal.Mailbox Communication
+serverCommunications = Signal.mailbox NoCommunication
+
+sendRequest : Communication -> Task Http.Error U.Action
+sendRequest communication =
+ case communication of
+
+ NoCommunication ->
+ Task.succeed U.NoOp
+
+ SignIn assertion ->
+ post ("/signIn?assertion=" ++ assertion)
+ |> flip Task.andThen (always initViewAction)
+
+ AddPayment userId name cost ->
+ post (addPaymentURL name cost Punctual)
+ |> flip Task.andThen (always (getPaymentsAtPage 1))
+ |> Task.map (\payments -> U.UpdateLoggedIn (UL.AddPayment userId name cost payments))
+
+ AddMonthlyPayment name cost ->
+ post (addPaymentURL name cost Monthly)
+ |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
+ |> Task.map (\id -> U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost))
+
+ DeletePayment payment currentPage ->
+ post (deletePaymentURL payment.id)
+ |> flip Task.andThen (always (getPaymentsAtPage currentPage))
+ |> Task.map (\payments -> U.UpdateLoggedIn (UL.DeletePayment payment payments))
+
+ DeleteMonthlyPayment id ->
+ post (deletePaymentURL id)
+ |> Task.map (always (U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id))))
+
+ UpdatePage page ->
+ getPaymentsAtPage page
+ |> flip Task.andThen (Task.succeed << U.UpdateLoggedIn << UL.UpdatePage page)
+
+ SetIncome currentTime amount ->
+ post ("/income?amount=" ++ (toString amount))
+ |> Task.map (always (U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount))))
+
+ SignOut ->
+ post "/signOut"
+ |> Task.map (always U.GoSignInView)
+
+getPaymentsAtPage : Int -> Task Http.Error Payments
+getPaymentsAtPage page =
+ Http.get paymentsDecoder ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage)
+
+addPaymentURL : String -> Int -> Frequency -> String
+addPaymentURL name cost frequency =
+ "/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)
+
+deletePaymentURL : PaymentId -> String
+deletePaymentURL id =
+ "payment/delete?id=" ++ (toString id)
diff --git a/src/client/elm/Sign.elm b/src/client/elm/Sign.elm
new file mode 100644
index 0000000..44f23b8
--- /dev/null
+++ b/src/client/elm/Sign.elm
@@ -0,0 +1,43 @@
+module Sign
+ ( Operation(..)
+ , decodeOperation
+ , toServerCommunication
+ ) where
+
+import Json.Decode as Json
+import Json.Decode exposing (Value, Decoder, (:=))
+import Maybe
+
+import ServerCommunication as SC
+
+type Operation =
+ NoOp
+ | SignIn String
+ | SignOut
+
+decodeOperation : Value -> Operation
+decodeOperation value =
+ Json.decodeValue operationDecoder value
+ |> Result.toMaybe
+ |> Maybe.withDefault NoOp
+
+toServerCommunication : Operation -> SC.Communication
+toServerCommunication operation =
+ case operation of
+ NoOp -> SC.NoCommunication
+ SignIn assertion -> SC.SignIn assertion
+ SignOut -> SC.SignOut
+
+operationDecoder : Decoder Operation
+operationDecoder =
+ ("operation" := Json.string) `Json.andThen` operationDecoderWithTag
+
+operationDecoderWithTag : String -> Decoder Operation
+operationDecoderWithTag operation =
+ case operation of
+ "SignIn" ->
+ Json.map SignIn ("assertion" := Json.string)
+ "SignOut" ->
+ Json.succeed SignOut
+ _ ->
+ Json.succeed NoOp
diff --git a/src/client/elm/SimpleHTTP.elm b/src/client/elm/SimpleHTTP.elm
new file mode 100644
index 0000000..99a7056
--- /dev/null
+++ b/src/client/elm/SimpleHTTP.elm
@@ -0,0 +1,41 @@
+module SimpleHTTP
+ ( post
+ , decodeHttpValue
+ ) where
+
+import Http exposing (..)
+import Task exposing (..)
+import Json.Decode as Json exposing (Decoder)
+
+post : String -> Task Error Value
+post url =
+ { verb = "POST"
+ , headers = []
+ , url = url
+ , body = empty
+ }
+ |> Http.send defaultSettings
+ |> mapError promoteError
+ |> flip Task.andThen handleResponse
+
+handleResponse : Response -> Task Error Value
+handleResponse response =
+ if 200 <= response.status && response.status < 300
+ then Task.succeed response.value
+ else fail (BadResponse response.status response.statusText)
+
+promoteError : RawError -> Error
+promoteError rawError =
+ case rawError of
+ RawTimeout -> Timeout
+ RawNetworkError -> NetworkError
+
+decodeHttpValue : Decoder a -> Value -> Task Error a
+decodeHttpValue decoder value =
+ case value of
+ Text str ->
+ case Json.decodeString decoder str of
+ Ok v -> succeed v
+ Err msg -> fail (UnexpectedPayload msg)
+ _ ->
+ fail (UnexpectedPayload "Response body is a blob, expecting a string.")
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
new file mode 100644
index 0000000..3c4614a
--- /dev/null
+++ b/src/client/elm/Update.elm
@@ -0,0 +1,57 @@
+module Update
+ ( Action(..)
+ , actions
+ , updateModel
+ ) where
+
+import Time exposing (Time)
+
+import Model exposing (Model)
+import Model.User exposing (Users, UserId)
+import Model.Payment exposing (Payments)
+import Model.Payer exposing (Payers)
+import Model.View as V
+import Model.View.SignInView exposing (..)
+import Model.View.LoggedInView exposing (..)
+
+import Update.SignIn exposing (..)
+import Update.LoggedIn exposing (..)
+
+type Action =
+ NoOp
+ | UpdateTime Time
+ | GoSignInView
+ | SignInError String
+ | UpdateSignIn SignInAction
+ | GoLoggedInView Users UserId Payments Payments Int Payers
+ | UpdateLoggedIn LoggedAction
+
+actions : Signal.Mailbox Action
+actions = Signal.mailbox NoOp
+
+updateModel : Action -> Model -> Model
+updateModel action model =
+ case action of
+ NoOp ->
+ model
+ UpdateTime time ->
+ { model | currentTime <- time }
+ GoSignInView ->
+ { model | view <- V.SignInView initSignInView }
+ GoLoggedInView users me monthlyPayments payments paymentsCount payers ->
+ { model | view <- V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers) }
+ SignInError msg ->
+ let signInView = { initSignInView | result <- Just (Err msg) }
+ in { model | view <- V.SignInView signInView }
+ UpdateSignIn signInAction ->
+ case model.view of
+ V.SignInView signInView ->
+ { model | view <- V.SignInView (updateSignIn signInAction signInView) }
+ _ ->
+ model
+ UpdateLoggedIn loggedAction ->
+ case model.view of
+ V.LoggedInView loggedInView ->
+ { model | view <- V.LoggedInView (updateLoggedIn model loggedAction loggedInView) }
+ _ ->
+ model
diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm
new file mode 100644
index 0000000..e477094
--- /dev/null
+++ b/src/client/elm/Update/LoggedIn.elm
@@ -0,0 +1,68 @@
+module Update.LoggedIn
+ ( LoggedAction(..)
+ , updateLoggedIn
+ ) where
+
+import Date
+import Dict
+
+import Model exposing (Model)
+import Model.User exposing (UserId)
+import Model.Payment exposing (..)
+import Model.View.LoggedInView exposing (..)
+import Model.View.LoggedIn.Add exposing (..)
+
+import Update.LoggedIn.Add exposing (..)
+import Update.LoggedIn.Monthly as UM
+import Update.LoggedIn.Account as UA
+
+type LoggedAction =
+ UpdateAdd AddPaymentAction
+ | UpdatePayments Payments
+ | AddPayment UserId String Int Payments
+ | AddMonthlyPayment PaymentId String Int
+ | ToggleEdit PaymentId
+ | DeletePayment Payment Payments
+ | UpdatePage Int Payments
+ | UpdateMonthly UM.MonthlyAction
+ | UpdateAccount UA.AccountAction
+
+updateLoggedIn : Model -> LoggedAction -> LoggedInView -> LoggedInView
+updateLoggedIn model action loggedInView =
+ case action of
+ UpdateAdd addPaymentAction ->
+ { loggedInView | add <- updateAddPayment addPaymentAction loggedInView.add }
+ UpdatePayments payments ->
+ { loggedInView | payments <- payments }
+ AddPayment userId name cost payments ->
+ { loggedInView
+ | payments <- payments
+ , currentPage <- 1
+ , add <- initAddPayment Punctual
+ , account <- UA.updateAccount (UA.UpdatePayer userId model.currentTime cost) loggedInView.account
+ , paymentsCount <- loggedInView.paymentsCount + 1
+ }
+ AddMonthlyPayment id name cost ->
+ { loggedInView
+ | add <- initAddPayment Monthly
+ , monthly <-
+ let payment = Payment id (Date.fromTime model.currentTime) name cost loggedInView.account.me
+ in UM.updateMonthly (UM.AddPayment payment) loggedInView.monthly
+ }
+ ToggleEdit id ->
+ { loggedInView | paymentEdition <- if loggedInView.paymentEdition == Just id then Nothing else Just id }
+ DeletePayment payment payments ->
+ { loggedInView
+ | payments <- payments
+ , account <- UA.updateAccount (UA.UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account
+ , paymentsCount <- loggedInView.paymentsCount - 1
+ }
+ UpdatePage page payments ->
+ { loggedInView
+ | currentPage <- page
+ , payments <- payments
+ }
+ UpdateMonthly monthlyAction ->
+ { loggedInView | monthly <- UM.updateMonthly monthlyAction loggedInView.monthly }
+ UpdateAccount accountAction ->
+ { loggedInView | account <- UA.updateAccount accountAction loggedInView.account }
diff --git a/src/client/elm/Update/LoggedIn/Account.elm b/src/client/elm/Update/LoggedIn/Account.elm
new file mode 100644
index 0000000..cf4c834
--- /dev/null
+++ b/src/client/elm/Update/LoggedIn/Account.elm
@@ -0,0 +1,64 @@
+module Update.LoggedIn.Account
+ ( AccountAction(..)
+ , updateAccount
+ ) where
+
+import Maybe
+import Time exposing (Time)
+import Dict
+
+import Model.User exposing (UserId)
+import Model.Payer exposing (..)
+import Model.View.LoggedIn.Account exposing (..)
+
+import Utils.Maybe exposing (isJust)
+
+type AccountAction =
+ ToggleDetail
+ | UpdatePayer UserId Time Int
+ | ToggleIncomeEdition
+ | UpdateIncomeEdition String
+ | UpdateEditionError String
+ | UpdateIncome Time Int
+
+updateAccount : AccountAction -> Account -> Account
+updateAccount action account =
+ case action of
+ ToggleDetail ->
+ { account | visibleDetail <- not account.visibleDetail }
+ UpdatePayer userId creation amountDiff ->
+ { account | payers <- updatePayers account.payers userId creation amountDiff }
+ ToggleIncomeEdition ->
+ { account | incomeEdition <-
+ if isJust account.incomeEdition
+ then Nothing
+ else Just (initIncomeEdition (Maybe.withDefault 0 (getCurrentIncome account)))
+ }
+ UpdateIncomeEdition income ->
+ case account.incomeEdition of
+ Just incomeEdition ->
+ { account | incomeEdition <- Just { incomeEdition | income <- income } }
+ Nothing ->
+ account
+ UpdateEditionError error ->
+ case account.incomeEdition of
+ Just incomeEdition ->
+ { account | incomeEdition <- Just { incomeEdition | error <- Just error } }
+ Nothing ->
+ account
+ UpdateIncome currentTime amount ->
+ { account
+ | payers <-
+ account.payers
+ |> Dict.update account.me (\mbPayer ->
+ case mbPayer of
+ Just payer ->
+ Just
+ { payer
+ | incomes <- payer.incomes ++ [{ creation = currentTime, amount = amount }]
+ }
+ Nothing ->
+ Nothing
+ )
+ , incomeEdition <- Nothing
+ }
diff --git a/src/client/elm/Update/LoggedIn/Add.elm b/src/client/elm/Update/LoggedIn/Add.elm
new file mode 100644
index 0000000..1f28997
--- /dev/null
+++ b/src/client/elm/Update/LoggedIn/Add.elm
@@ -0,0 +1,29 @@
+module Update.LoggedIn.Add
+ ( AddPaymentAction(..)
+ , updateAddPayment
+ ) where
+
+import Model.View.LoggedIn.Add exposing (..)
+
+type AddPaymentAction =
+ UpdateName String
+ | UpdateCost String
+ | AddError (Maybe String) (Maybe String)
+ | ToggleFrequency
+
+updateAddPayment : AddPaymentAction -> AddPayment -> AddPayment
+updateAddPayment action addPayment =
+ case action of
+ UpdateName name ->
+ { addPayment | name <- name }
+ UpdateCost cost ->
+ { addPayment | cost <- cost }
+ AddError nameError costError ->
+ { addPayment
+ | nameError <- nameError
+ , costError <- costError
+ }
+ ToggleFrequency ->
+ { addPayment
+ | frequency <- if addPayment.frequency == Punctual then Monthly else Punctual
+ }
diff --git a/src/client/elm/Update/LoggedIn/Monthly.elm b/src/client/elm/Update/LoggedIn/Monthly.elm
new file mode 100644
index 0000000..1379323
--- /dev/null
+++ b/src/client/elm/Update/LoggedIn/Monthly.elm
@@ -0,0 +1,27 @@
+module Update.LoggedIn.Monthly
+ ( MonthlyAction(..)
+ , updateMonthly
+ ) where
+
+import Model.Payment exposing (Payment, PaymentId)
+import Model.View.LoggedIn.Monthly exposing (..)
+
+type MonthlyAction =
+ ToggleDetail
+ | AddPayment Payment
+ | DeletePayment PaymentId
+
+updateMonthly : MonthlyAction -> Monthly -> Monthly
+updateMonthly action monthly =
+ case action of
+ ToggleDetail ->
+ { monthly | visibleDetail <- not monthly.visibleDetail }
+ AddPayment payment ->
+ { monthly
+ | payments <- payment :: monthly.payments
+ , visibleDetail <- True
+ }
+ DeletePayment id ->
+ { monthly
+ | payments <- List.filter (\payment -> payment.id /= id) monthly.payments
+ }
diff --git a/src/client/elm/Update/SignIn.elm b/src/client/elm/Update/SignIn.elm
new file mode 100644
index 0000000..cabe4cb
--- /dev/null
+++ b/src/client/elm/Update/SignIn.elm
@@ -0,0 +1,15 @@
+module Update.SignIn
+ ( SignInAction(..)
+ , updateSignIn
+ ) where
+
+import Model.View.SignInView exposing (..)
+
+type SignInAction =
+ ErrorLogin String
+
+updateSignIn : SignInAction -> SignInView -> SignInView
+updateSignIn action signInView =
+ case action of
+ ErrorLogin message ->
+ { signInView | result <- Just (Err message) }
diff --git a/src/client/elm/Utils/Dict.elm b/src/client/elm/Utils/Dict.elm
new file mode 100644
index 0000000..dc01b17
--- /dev/null
+++ b/src/client/elm/Utils/Dict.elm
@@ -0,0 +1,11 @@
+module Utils.Dict
+ ( mapValues
+ ) where
+
+import Dict as Dict exposing (..)
+
+mapValues : (a -> b) -> Dict comparable a -> Dict comparable b
+mapValues f = Dict.fromList << List.map (onSecond f) << Dict.toList
+
+onSecond : (a -> b) -> (comparable, a) -> (comparable, b)
+onSecond f tuple = case tuple of (x, y) -> (x, f y)
diff --git a/src/client/elm/Utils/Either.elm b/src/client/elm/Utils/Either.elm
new file mode 100644
index 0000000..10c40e3
--- /dev/null
+++ b/src/client/elm/Utils/Either.elm
@@ -0,0 +1,9 @@
+module Utils.Either
+ ( toMaybeError
+ ) where
+
+toMaybeError : Result a b -> Maybe a
+toMaybeError result =
+ case result of
+ Ok _ -> Nothing
+ Err x -> Just x
diff --git a/src/client/elm/Utils/Maybe.elm b/src/client/elm/Utils/Maybe.elm
new file mode 100644
index 0000000..d954ae0
--- /dev/null
+++ b/src/client/elm/Utils/Maybe.elm
@@ -0,0 +1,27 @@
+module Utils.Maybe
+ ( isJust
+ , catMaybes
+ , maybeToList
+ ) where
+
+isJust : Maybe a -> Bool
+isJust maybe =
+ case maybe of
+ Just _ -> True
+ Nothing -> False
+
+catMaybes : List (Maybe a) -> List a
+catMaybes =
+ List.foldr
+ (\mb xs ->
+ case mb of
+ Just x -> x :: xs
+ Nothing -> xs
+ )
+ []
+
+maybeToList : Maybe a -> List a
+maybeToList mb =
+ case mb of
+ Just a -> [a]
+ Nothing -> []
diff --git a/src/client/elm/Utils/Validation.elm b/src/client/elm/Utils/Validation.elm
new file mode 100644
index 0000000..b9bccb3
--- /dev/null
+++ b/src/client/elm/Utils/Validation.elm
@@ -0,0 +1,23 @@
+module Utils.Validation
+ ( validateNonEmpty
+ , validateNumber
+ ) where
+
+import String
+import Reads exposing (readInt)
+
+validateNonEmpty : String -> String -> Result String String
+validateNonEmpty message str =
+ if String.isEmpty str
+ then Err message
+ else Ok str
+
+validateNumber : String -> (Int -> Bool) -> String -> Result String Int
+validateNumber message numberForm str =
+ case readInt str of
+ Just number ->
+ if numberForm number
+ then Ok number
+ else Err message
+ Nothing ->
+ Err message
diff --git a/src/client/elm/View/Date.elm b/src/client/elm/View/Date.elm
new file mode 100644
index 0000000..81c5112
--- /dev/null
+++ b/src/client/elm/View/Date.elm
@@ -0,0 +1,59 @@
+module View.Date
+ ( renderShortDate
+ , renderLongDate
+ ) where
+
+import Date exposing (..)
+import String
+
+import Model.Translations exposing (..)
+
+renderShortDate : Date -> Translations -> String
+renderShortDate date translations =
+ let params =
+ [ String.pad 2 '0' (toString (Date.day date))
+ , String.pad 2 '0' (toString (getMonthNumber (Date.month date)))
+ , toString (Date.year date)
+ ]
+ in getParamMessage params "ShortDate" translations
+
+renderLongDate : Date -> Translations -> String
+renderLongDate date translations =
+ let params =
+ [ toString (Date.day date)
+ , (getMessage (getMonthKey (Date.month date)) translations)
+ , toString (Date.year date)
+ ]
+ in getParamMessage params "LongDate" translations
+
+getMonthNumber : Month -> Int
+getMonthNumber month =
+ case month of
+ Jan -> 1
+ Feb -> 2
+ Mar -> 3
+ Apr -> 4
+ May -> 5
+ Jun -> 6
+ Jul -> 7
+ Aug -> 8
+ Sep -> 9
+ Oct -> 10
+ Nov -> 11
+ Dec -> 12
+
+getMonthKey : Month -> String
+getMonthKey month =
+ case month of
+ Jan -> "January"
+ Feb -> "February"
+ Mar -> "March"
+ Apr -> "April"
+ May -> "May"
+ Jun -> "June"
+ Jul -> "July"
+ Aug -> "August"
+ Sep -> "September"
+ Oct -> "October"
+ Nov -> "November"
+ Dec -> "December"
diff --git a/src/client/elm/View/Events.elm b/src/client/elm/View/Events.elm
new file mode 100644
index 0000000..1eb9027
--- /dev/null
+++ b/src/client/elm/View/Events.elm
@@ -0,0 +1,19 @@
+module View.Events
+ ( onSubmitPrevDefault
+ ) where
+
+import Signal
+import Json.Decode as Json
+import Html exposing (..)
+import Html.Events exposing (..)
+import Html.Attributes exposing (..)
+
+onSubmitPrevDefault : Signal.Address a -> a -> Attribute
+onSubmitPrevDefault address value =
+ onWithOptions
+ "submit"
+ { defaultOptions | preventDefault <- True }
+ Json.value
+ (\_ ->
+ Signal.message address value
+ )
diff --git a/src/client/elm/View/Expand.elm b/src/client/elm/View/Expand.elm
new file mode 100644
index 0000000..53b4fe5
--- /dev/null
+++ b/src/client/elm/View/Expand.elm
@@ -0,0 +1,25 @@
+module View.Expand
+ ( expand
+ , ExpandType(..)
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+
+import View.Icon exposing (renderIcon)
+
+type ExpandType = ExpandUp | ExpandDown
+
+expand : ExpandType -> Bool -> Html
+expand expandType isExpanded =
+ div
+ [ class "expand" ]
+ [ renderIcon (chevronIcon expandType isExpanded) ]
+
+chevronIcon : ExpandType -> Bool -> String
+chevronIcon expandType isExpanded =
+ case (expandType, isExpanded) of
+ (ExpandUp, True) -> "chevron-down"
+ (ExpandUp, False) -> "chevron-up"
+ (ExpandDown, True) -> "chevron-up"
+ (ExpandDown, False) -> "chevron-down"
diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm
new file mode 100644
index 0000000..3a6241b
--- /dev/null
+++ b/src/client/elm/View/Header.elm
@@ -0,0 +1,39 @@
+module View.Header
+ ( renderHeader
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Persona exposing (operations)
+
+import Model exposing (Model)
+import Model.View exposing (..)
+import Model.Translations exposing (getMessage)
+
+import View.Icon exposing (renderIcon)
+
+renderHeader : Model -> Html
+renderHeader model =
+ header
+ []
+ [ h1
+ []
+ [ text (getMessage "SharedCost" model.translations) ]
+ , case model.view of
+ LoadingView ->
+ text ""
+ SignInView _ ->
+ button
+ [ class "icon"
+ , onClick operations.address Persona.SignIn
+ ]
+ [ renderIcon "sign-in" ]
+ LoggedInView _ ->
+ button
+ [ class "icon"
+ , onClick operations.address Persona.SignOut
+ ]
+ [ renderIcon "sign-out" ]
+ ]
diff --git a/src/client/elm/View/Icon.elm b/src/client/elm/View/Icon.elm
new file mode 100644
index 0000000..f22c1a2
--- /dev/null
+++ b/src/client/elm/View/Icon.elm
@@ -0,0 +1,12 @@
+module View.Icon
+ ( renderIcon
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+
+renderIcon : String -> Html
+renderIcon iconClass =
+ i
+ [ class <| "fa fa-fw fa-" ++ iconClass ]
+ []
diff --git a/src/client/elm/View/Loading.elm b/src/client/elm/View/Loading.elm
new file mode 100644
index 0000000..f8c6cd6
--- /dev/null
+++ b/src/client/elm/View/Loading.elm
@@ -0,0 +1,8 @@
+module View.Loading
+ ( renderLoading
+ ) where
+
+import Html exposing (..)
+
+renderLoading : Html
+renderLoading = text ""
diff --git a/src/client/elm/View/LoggedIn.elm b/src/client/elm/View/LoggedIn.elm
new file mode 100644
index 0000000..96916e0
--- /dev/null
+++ b/src/client/elm/View/LoggedIn.elm
@@ -0,0 +1,30 @@
+module View.LoggedIn
+ ( renderLoggedIn
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+
+import Model exposing (Model)
+import Model.Payment exposing (Payments)
+import Model.View.LoggedInView exposing (LoggedInView)
+
+import View.LoggedIn.Add exposing (addPayment)
+import View.LoggedIn.Monthly exposing (monthlyPayments)
+import View.LoggedIn.Account exposing (account)
+import View.LoggedIn.Table exposing (paymentsTable)
+import View.LoggedIn.Paging exposing (paymentsPaging)
+
+renderLoggedIn : Model -> LoggedInView -> Html
+renderLoggedIn model loggedInView =
+ div
+ [ class "loggedIn" ]
+ [ addPayment model loggedInView
+ , div
+ [ class "expandables" ]
+ [ account model loggedInView
+ , monthlyPayments model loggedInView
+ ]
+ , paymentsTable model loggedInView
+ , paymentsPaging loggedInView
+ ]
diff --git a/src/client/elm/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm
new file mode 100644
index 0000000..706f7cc
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Account.elm
@@ -0,0 +1,130 @@
+module View.LoggedIn.Account
+ ( account
+ ) where
+
+import Html exposing (..)
+import Html as H exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import List
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+import Update.LoggedIn.Account exposing (..)
+
+import Model exposing (Model)
+import Model.User exposing (getUserName)
+import Model.Payer exposing (..)
+import Model.View.LoggedInView exposing (LoggedInView)
+import Model.Translations exposing (getParamMessage, getMessage)
+import Model.View.LoggedIn.Account exposing (..)
+
+import View.Expand exposing (..)
+import View.Price exposing (price)
+import View.Events exposing (onSubmitPrevDefault)
+
+import Utils.Either exposing (toMaybeError)
+
+account : Model -> LoggedInView -> Html
+account model loggedInView =
+ let account = loggedInView.account
+ in div
+ [ classList
+ [ ("account", True)
+ , ("detail", account.visibleDetail)
+ ]
+ ]
+ [ exceedingPayers model loggedInView
+ , if account.visibleDetail
+ then income model account
+ else text ""
+ ]
+
+exceedingPayers : Model -> LoggedInView -> Html
+exceedingPayers model loggedInView =
+ button
+ [ class "header"
+ , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleDetail)
+ ]
+ ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.account.payers))
+ ++ [ expand ExpandDown loggedInView.account.visibleDetail ]
+ )
+
+exceedingPayer : Model -> LoggedInView -> ExceedingPayer -> Html
+exceedingPayer model loggedInView payer =
+ div
+ [ class "exceedingPayer" ]
+ [ span
+ [ class "userName" ]
+ [ payer.userId
+ |> getUserName loggedInView.users
+ |> Maybe.withDefault "−"
+ |> text
+ ]
+ , span
+ [ class "amount" ]
+ [ text ("+ " ++ (price model payer.amount)) ]
+ ]
+
+income : Model -> Account -> Html
+income model account =
+ case account.incomeEdition of
+ Just edition ->
+ incomeEdition model account edition
+ Nothing ->
+ incomeRead model account
+
+incomeRead : Model -> Account -> Html
+incomeRead model account =
+ div
+ [ class "income" ]
+ [ ( case getCurrentIncome account of
+ Nothing ->
+ text (getMessage "NoIncome" model.translations)
+ Just income ->
+ text (getParamMessage [price model income] "Income" model.translations)
+ )
+ , toggleIncomeEdition "editIncomeEdition" (getMessage "Edit" model.translations)
+ ]
+
+incomeEdition : Model -> Account -> IncomeEdition -> Html
+incomeEdition model account edition =
+ H.form
+ [ case validateIncome edition.income model.translations of
+ Ok validatedAmount ->
+ onSubmitPrevDefault serverCommunications.address (SC.SetIncome model.currentTime validatedAmount)
+ Err error ->
+ onSubmitPrevDefault actions.address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error)
+ , class "income"
+ ]
+ [ label
+ [ for "incomeInput" ]
+ [ text (getMessage "NewIncome" model.translations) ]
+ , input
+ [ id "incomeInput"
+ , value edition.income
+ , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAccount << UpdateIncomeEdition)
+ , maxlength 10
+ ]
+ []
+ , button
+ [ type' "submit"
+ , class "validateIncomeEdition"
+ ]
+ [ text (getMessage "Validate" model.translations) ]
+ , toggleIncomeEdition "undoIncomeEdition" (getMessage "Undo" model.translations)
+ , case edition.error of
+ Just error -> div [ class "error" ] [ text error ]
+ Nothing -> text ""
+ ]
+
+toggleIncomeEdition : String -> String -> Html
+toggleIncomeEdition className name =
+ button
+ [ type' "button"
+ , class className
+ , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleIncomeEdition)
+ ]
+ [ text name ]
diff --git a/src/client/elm/View/LoggedIn/Add.elm b/src/client/elm/View/LoggedIn/Add.elm
new file mode 100644
index 0000000..572bdf6
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Add.elm
@@ -0,0 +1,122 @@
+module View.LoggedIn.Add
+ ( addPayment
+ ) where
+
+import Html as H exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Reads exposing (readInt)
+import Result exposing (..)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+import Update.LoggedIn.Add exposing (..)
+
+import Model exposing (Model)
+import Model.View.LoggedIn.Add exposing (..)
+import Model.Translations exposing (getMessage)
+import Model.View.LoggedInView exposing (LoggedInView)
+
+import View.Events exposing (onSubmitPrevDefault)
+import View.Icon exposing (renderIcon)
+
+import Utils.Maybe exposing (isJust)
+import Utils.Either exposing (toMaybeError)
+
+addPayment : Model -> LoggedInView -> Html
+addPayment model loggedInView =
+ H.form
+ [ case (validateName loggedInView.add.name model.translations, validateCost loggedInView.add.cost model.translations) of
+ (Ok name, Ok cost) ->
+ let action =
+ case loggedInView.add.frequency of
+ Punctual -> SC.AddPayment loggedInView.account.me name cost
+ Monthly -> SC.AddMonthlyPayment name cost
+ in onSubmitPrevDefault serverCommunications.address action
+ (resName, resCost) ->
+ onSubmitPrevDefault actions.address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
+ , class "addPayment"
+ ]
+ [ addPaymentName loggedInView.add
+ , addPaymentCost model loggedInView.add
+ , paymentFrequency model loggedInView.add
+ , button
+ [ type' "submit"
+ , class "add" ]
+ [ text (getMessage "Add" model.translations)]
+ ]
+
+addPaymentName : AddPayment -> Html
+addPaymentName addPayment =
+ div
+ [ classList
+ [ ("name", True)
+ , ("error", isJust addPayment.nameError)
+ ]
+ ]
+ [ input
+ [ id "nameInput"
+ , value addPayment.name
+ , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAdd << UpdateName)
+ , maxlength 20
+ ]
+ []
+ , label
+ [ for "nameInput" ]
+ [ renderIcon "shopping-cart" ]
+ , case addPayment.nameError of
+ Just error ->
+ div [ class "errorMessage" ] [ text error ]
+ Nothing ->
+ text ""
+ ]
+
+addPaymentCost : Model -> AddPayment -> Html
+addPaymentCost model addPayment =
+ div
+ [ classList
+ [ ("cost", True)
+ , ("error", isJust addPayment.costError)
+ ]
+ ]
+ [ input
+ [ id "costInput"
+ , value addPayment.cost
+ , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAdd << UpdateCost)
+ , maxlength 7
+ ]
+ []
+ , label
+ [ for "costInput" ]
+ [ text model.config.currency ]
+ , case addPayment.costError of
+ Just error ->
+ div [ class "errorMessage" ] [ text error ]
+ Nothing ->
+ text ""
+ ]
+
+paymentFrequency : Model -> AddPayment -> Html
+paymentFrequency model addPayment =
+ button
+ [ type' "button"
+ , class "frequency"
+ , onClick actions.address (UpdateLoggedIn << UpdateAdd <| ToggleFrequency)
+ ]
+ [ div
+ [ classList
+ [ ("punctual", True)
+ , ("selected", addPayment.frequency == Punctual)
+ ]
+ ]
+ [ text (getMessage "Punctual" model.translations) ]
+ , div
+ [ classList
+ [ ("monthly", True)
+ , ("selected", addPayment.frequency == Monthly)
+ ]
+ ]
+ [ text (getMessage "Monthly" model.translations) ]
+ ]
diff --git a/src/client/elm/View/LoggedIn/Monthly.elm b/src/client/elm/View/LoggedIn/Monthly.elm
new file mode 100644
index 0000000..a274015
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Monthly.elm
@@ -0,0 +1,89 @@
+module View.LoggedIn.Monthly
+ ( monthlyPayments
+ ) where
+
+import String
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+import Update.LoggedIn.Monthly exposing (..)
+
+import Model exposing (Model)
+import Model.View.LoggedIn.Monthly exposing (Monthly)
+import Model.Payment exposing (Payments, Payment)
+import Model.View.LoggedInView exposing (LoggedInView)
+import Model.Translations exposing (getMessage, getParamMessage)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import View.Icon exposing (renderIcon)
+import View.Expand exposing (..)
+import View.Price exposing (price)
+
+monthlyPayments : Model -> LoggedInView -> Html
+monthlyPayments model loggedInView =
+ let monthly = loggedInView.monthly
+ in if List.length monthly.payments == 0
+ then
+ text ""
+ else
+ div
+ [ classList
+ [ ("monthlyPayments", True)
+ , ("detail", monthly.visibleDetail)
+ ]
+ ]
+ [ monthlyCount model monthly
+ , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text ""
+ ]
+
+monthlyCount : Model -> Monthly -> Html
+monthlyCount model monthly =
+ let count = List.length monthly.payments
+ total = List.sum << List.map .cost <| monthly.payments
+ key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount"
+ in button
+ [ class "header"
+ , onClick actions.address (UpdateLoggedIn << UpdateMonthly <| ToggleDetail)
+ ]
+ [ text (getParamMessage [toString count, price model total] key model.translations)
+ , expand ExpandDown monthly.visibleDetail
+ ]
+
+paymentsTable : Model -> LoggedInView -> Monthly -> Html
+paymentsTable model loggedInView monthly =
+ div
+ [ class "table" ]
+ ( monthly.payments
+ |> List.sortBy (String.toLower << .name)
+ |> List.map (paymentLine model loggedInView)
+ )
+
+paymentLine : Model -> LoggedInView -> Payment -> Html
+paymentLine model loggedInView payment =
+ a
+ [ classList
+ [ ("row", True)
+ , ("edition", loggedInView.paymentEdition == Just payment.id)
+ ]
+ , onClick actions.address (UpdateLoggedIn (ToggleEdit payment.id))
+ ]
+ [ div [ class "cell category" ] [ text (payment.name) ]
+ , div
+ [ classList
+ [ ("cell cost", True)
+ , ("refund", payment.cost < 0)
+ ]
+ ]
+ [ text (price model payment.cost) ]
+ , div
+ [ class "cell delete"
+ , onClick serverCommunications.address (SC.DeleteMonthlyPayment payment.id)
+ ]
+ [ button [] [ renderIcon "times" ]
+ ]
+ ]
diff --git a/src/client/elm/View/LoggedIn/Paging.elm b/src/client/elm/View/LoggedIn/Paging.elm
new file mode 100644
index 0000000..93d7f1d
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Paging.elm
@@ -0,0 +1,100 @@
+module View.LoggedIn.Paging
+ ( paymentsPaging
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Model.View.LoggedInView exposing (..)
+import Model.Payment exposing (perPage)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+
+import View.Icon exposing (renderIcon)
+
+showedPages : Int
+showedPages = 5
+
+paymentsPaging : LoggedInView -> Html
+paymentsPaging loggedInView =
+ let maxPage = ceiling (toFloat loggedInView.paymentsCount / toFloat perPage)
+ pages = truncatePages loggedInView.currentPage [1..maxPage]
+ in if maxPage == 1
+ then
+ text ""
+ else
+ div
+ [ class "pages" ]
+ ( ( if loggedInView.currentPage > 1
+ then [ firstPage, previousPage loggedInView ]
+ else []
+ )
+ ++ ( List.map (paymentsPage loggedInView) pages)
+ ++ ( if loggedInView.currentPage < maxPage
+ then [ nextPage loggedInView, lastPage maxPage ]
+ else []
+ )
+ )
+
+truncatePages : Int -> List Int -> List Int
+truncatePages currentPage pages =
+ let totalPages = List.length pages
+ showedLeftPages = ceiling ((toFloat showedPages - 1) / 2)
+ showedRightPages = floor ((toFloat showedPages - 1) / 2)
+ truncatedPages =
+ if | currentPage < showedLeftPages ->
+ [1..showedPages]
+ | currentPage > totalPages - showedRightPages ->
+ [(totalPages - showedPages)..totalPages]
+ | otherwise ->
+ [(currentPage - showedLeftPages)..(currentPage + showedRightPages)]
+ in List.filter (flip List.member pages) truncatedPages
+
+firstPage : Html
+firstPage =
+ button
+ [ class "page"
+ , onClick serverCommunications.address (SC.UpdatePage 1)
+ ]
+ [ renderIcon "fast-backward" ]
+
+previousPage : LoggedInView -> Html
+previousPage loggedInView =
+ button
+ [ class "page"
+ , onClick serverCommunications.address (SC.UpdatePage (loggedInView.currentPage - 1))
+ ]
+ [ renderIcon "backward" ]
+
+nextPage : LoggedInView -> Html
+nextPage loggedInView =
+ button
+ [ class "page"
+ , onClick serverCommunications.address (SC.UpdatePage (loggedInView.currentPage + 1))
+ ]
+ [ renderIcon "forward" ]
+
+lastPage : Int -> Html
+lastPage maxPage =
+ button
+ [ class "page"
+ , onClick serverCommunications.address (SC.UpdatePage maxPage)
+ ]
+ [ renderIcon "fast-forward" ]
+
+paymentsPage : LoggedInView -> Int -> Html
+paymentsPage loggedInView page =
+ let onCurrentPage = page == loggedInView.currentPage
+ in button
+ [ classList
+ [ ("page", True)
+ , ("current", onCurrentPage)
+ ]
+ , onClick serverCommunications.address <|
+ if onCurrentPage then SC.NoCommunication else SC.UpdatePage page
+ ]
+ [ text (toString page) ]
diff --git a/src/client/elm/View/LoggedIn/Table.elm b/src/client/elm/View/LoggedIn/Table.elm
new file mode 100644
index 0000000..f5a08b5
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Table.elm
@@ -0,0 +1,97 @@
+module View.LoggedIn.Table
+ ( paymentsTable
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Dict exposing (..)
+
+import Date
+import Date exposing (Date)
+
+import String exposing (append)
+
+import Model exposing (Model)
+import Model.User exposing (getUserName)
+import Model.Payment exposing (..)
+import Model.View.LoggedInView exposing (LoggedInView)
+import Model.Translations exposing (getMessage)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+
+import View.Icon exposing (renderIcon)
+import View.Date exposing (..)
+import View.Price exposing (price)
+
+paymentsTable : Model -> LoggedInView -> Html
+paymentsTable model loggedInView =
+ div
+ [ class "table" ]
+ ( headerLine model :: paymentLines model loggedInView)
+
+headerLine : Model -> Html
+headerLine model =
+ div
+ [ class "header" ]
+ [ div [ class "cell category" ] [ renderIcon "shopping-cart" ]
+ , div [ class "cell cost" ] [ text model.config.currency ]
+ , div [ class "cell user" ] [ renderIcon "user" ]
+ , div [ class "cell date" ] [ renderIcon "calendar" ]
+ , div [ class "cell" ] []
+ ]
+
+paymentLines : Model -> LoggedInView -> List Html
+paymentLines model loggedInView =
+ loggedInView.payments
+ |> List.sortBy (Date.toTime << .creation)
+ |> List.reverse
+ |> List.map (paymentLine model loggedInView)
+
+paymentLine : Model -> LoggedInView -> Payment -> Html
+paymentLine model loggedInView payment =
+ a
+ [ classList
+ [ ("row", True)
+ , ("edition", loggedInView.paymentEdition == Just payment.id)
+ ]
+ , onClick actions.address (UpdateLoggedIn (ToggleEdit payment.id))
+ ]
+ [ div [ class "cell category" ] [ text payment.name ]
+ , div
+ [ classList
+ [ ("cell cost", True)
+ , ("refund", payment.cost < 0)
+ ]
+ ]
+ [ text (price model payment.cost) ]
+ , div
+ [ class "cell user" ]
+ [ payment.userId
+ |> getUserName loggedInView.users
+ |> Maybe.withDefault "−"
+ |> text
+ ]
+ , div
+ [ class "cell date" ]
+ [ span
+ [ class "shortDate" ]
+ [ text (renderShortDate payment.creation model.translations) ]
+ , span
+ [ class "longDate" ]
+ [ text (renderLongDate payment.creation model.translations) ]
+ ]
+ , if loggedInView.account.me == payment.userId
+ then
+ div
+ [ class "cell delete" ]
+ [ button
+ [ onClick serverCommunications.address (SC.DeletePayment payment loggedInView.currentPage) ]
+ [ renderIcon "times" ]
+ ]
+ else
+ div [ class "cell" ] []
+ ]
diff --git a/src/client/elm/View/Page.elm b/src/client/elm/View/Page.elm
new file mode 100644
index 0000000..763734d
--- /dev/null
+++ b/src/client/elm/View/Page.elm
@@ -0,0 +1,31 @@
+module View.Page
+ ( renderPage
+ ) where
+
+import Html exposing (..)
+
+import Model exposing (Model)
+import Model.View exposing (..)
+
+import View.Header exposing (renderHeader)
+import View.Loading exposing (renderLoading)
+import View.SignIn exposing (renderSignIn)
+import View.LoggedIn exposing (renderLoggedIn)
+
+renderPage : Model -> Html
+renderPage model =
+ div
+ []
+ [ renderHeader model
+ , renderMain model
+ ]
+
+renderMain : Model -> Html
+renderMain model =
+ case model.view of
+ LoadingView ->
+ renderLoading
+ SignInView signInView ->
+ renderSignIn model signInView
+ LoggedInView loggedInView ->
+ renderLoggedIn model loggedInView
diff --git a/src/client/elm/View/Price.elm b/src/client/elm/View/Price.elm
new file mode 100644
index 0000000..286bcaa
--- /dev/null
+++ b/src/client/elm/View/Price.elm
@@ -0,0 +1,38 @@
+module View.Price
+ ( price
+ ) where
+
+import String exposing (..)
+
+import Model exposing (Model)
+import Model.Translations exposing (getMessage)
+
+price : Model -> Int -> String
+price model amount =
+ ( formatInt amount
+ ++ " "
+ ++ model.config.currency
+ )
+
+formatInt : Int -> String
+formatInt n =
+ abs n
+ |> toString
+ |> toList
+ |> List.reverse
+ |> group 3
+ |> List.intersperse [' ']
+ |> List.concat
+ |> List.reverse
+ |> fromList
+ |> append (if n < 0 then "-" else "")
+
+group : Int -> List a -> List (List a)
+group n xs =
+ if List.length xs <= n
+ then
+ [xs]
+ else
+ let take = List.take n xs
+ drop = List.drop n xs
+ in take :: (group n drop)
diff --git a/src/client/elm/View/SignIn.elm b/src/client/elm/View/SignIn.elm
new file mode 100644
index 0000000..8fcac16
--- /dev/null
+++ b/src/client/elm/View/SignIn.elm
@@ -0,0 +1,46 @@
+module View.SignIn
+ ( renderSignIn
+ ) where
+
+import Html as H exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Json.Decode as Json
+
+import Update exposing (..)
+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 : Model -> SignInView -> Html
+renderSignIn model signInView =
+ div
+ [ class "signIn" ]
+ [ div
+ [ class "result" ]
+ [ signInResult model signInView ]
+ ]
+
+signInResult : Model -> SignInView -> Html
+signInResult model signInView =
+ case signInView.result of
+ Just result ->
+ case result of
+ Ok login ->
+ div
+ [ class "success" ]
+ [ text (getMessage "SignInEmailSent" model.translations) ]
+ Err error ->
+ div
+ [ class "error" ]
+ [ text error ]
+ Nothing ->
+ text ""