aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoris2016-06-03 20:27:16 +0200
committerJoris2016-06-03 20:27:16 +0200
commit8e3a7bf1cb83bbb6e3dcd54308eefa52a29cd679 (patch)
treed6ba0985a534a0e2e317b1edb0d4c999119d87ff
parent3a88115d118f8256f3ff034dc359df42a9e4051c (diff)
Migrate to elm 0.17
-rw-r--r--elm-package.json20
-rw-r--r--sharedCost.cabal1
-rw-r--r--src/client/elm/Action.elm26
-rw-r--r--src/client/elm/Init.elm27
-rw-r--r--src/client/elm/LoggedData.elm6
-rw-r--r--src/client/elm/LoggedIn/Home/Account/View.elm10
-rw-r--r--src/client/elm/LoggedIn/Home/Action.elm15
-rw-r--r--src/client/elm/LoggedIn/Home/AddPayment/Model.elm4
-rw-r--r--src/client/elm/LoggedIn/Home/AddPayment/Msg.elm (renamed from src/client/elm/LoggedIn/Home/AddPayment/Action.elm)8
-rw-r--r--src/client/elm/LoggedIn/Home/AddPayment/Update.elm26
-rw-r--r--src/client/elm/LoggedIn/Home/AddPayment/View.elm36
-rw-r--r--src/client/elm/LoggedIn/Home/Model.elm4
-rw-r--r--src/client/elm/LoggedIn/Home/Msg.elm15
-rw-r--r--src/client/elm/LoggedIn/Home/Update.elm34
-rw-r--r--src/client/elm/LoggedIn/Home/View.elm10
-rw-r--r--src/client/elm/LoggedIn/Home/View/Expand.elm8
-rw-r--r--src/client/elm/LoggedIn/Home/View/Monthly.elm27
-rw-r--r--src/client/elm/LoggedIn/Home/View/Paging.elm45
-rw-r--r--src/client/elm/LoggedIn/Home/View/Table.elm24
-rw-r--r--src/client/elm/LoggedIn/Income/Action.elm9
-rw-r--r--src/client/elm/LoggedIn/Income/Model.elm6
-rw-r--r--src/client/elm/LoggedIn/Income/Msg.elm9
-rw-r--r--src/client/elm/LoggedIn/Income/Update.elm19
-rw-r--r--src/client/elm/LoggedIn/Income/View.elm38
-rw-r--r--src/client/elm/LoggedIn/Model.elm4
-rw-r--r--src/client/elm/LoggedIn/Msg.elm (renamed from src/client/elm/LoggedIn/Action.elm)16
-rw-r--r--src/client/elm/LoggedIn/Stat/View.elm14
-rw-r--r--src/client/elm/LoggedIn/Update.elm134
-rw-r--r--src/client/elm/LoggedIn/View.elm20
-rw-r--r--src/client/elm/LoggedIn/View/Date.elm4
-rw-r--r--src/client/elm/LoggedIn/View/Format.elm4
-rw-r--r--src/client/elm/Mailbox.elm17
-rw-r--r--src/client/elm/Main.elm79
-rw-r--r--src/client/elm/Model.elm64
-rw-r--r--src/client/elm/Model/Conf.elm4
-rw-r--r--src/client/elm/Model/Date.elm4
-rw-r--r--src/client/elm/Model/Income.elm4
-rw-r--r--src/client/elm/Model/Init.elm4
-rw-r--r--src/client/elm/Model/InitResult.elm4
-rw-r--r--src/client/elm/Model/Payer.elm4
-rw-r--r--src/client/elm/Model/Payment.elm4
-rw-r--r--src/client/elm/Model/Translations.elm4
-rw-r--r--src/client/elm/Model/User.elm4
-rw-r--r--src/client/elm/Model/View.elm4
-rw-r--r--src/client/elm/Msg.elm22
-rw-r--r--src/client/elm/Page.elm32
-rw-r--r--src/client/elm/Route.elm31
-rw-r--r--src/client/elm/Server.elm17
-rw-r--r--src/client/elm/SignIn/Model.elm4
-rw-r--r--src/client/elm/SignIn/Msg.elm (renamed from src/client/elm/SignIn/Action.elm)8
-rw-r--r--src/client/elm/SignIn/Update.elm8
-rw-r--r--src/client/elm/SignIn/View.elm19
-rw-r--r--src/client/elm/Update.elm92
-rw-r--r--src/client/elm/Utils/Cmd.elm18
-rw-r--r--src/client/elm/Utils/Date.elm4
-rw-r--r--src/client/elm/Utils/Dict.elm4
-rw-r--r--src/client/elm/Utils/Effects.elm10
-rw-r--r--src/client/elm/Utils/Either.elm4
-rw-r--r--src/client/elm/Utils/Http.elm4
-rw-r--r--src/client/elm/Utils/List.elm4
-rw-r--r--src/client/elm/Utils/Maybe.elm4
-rw-r--r--src/client/elm/Utils/Tuple.elm4
-rw-r--r--src/client/elm/View.elm21
-rw-r--r--src/client/elm/View/Click.elm24
-rw-r--r--src/client/elm/View/Events.elm16
-rw-r--r--src/client/elm/View/Header.elm34
-rw-r--r--src/client/elm/View/Icon.elm10
-rw-r--r--src/client/elm/View/Plural.elm4
-rw-r--r--src/client/js/main.js20
-rw-r--r--src/server/Controller/Index.hs2
-rw-r--r--src/server/Cookie.hs6
-rw-r--r--src/server/Design/Color.hs33
-rw-r--r--src/server/Design/Global.hs4
-rw-r--r--src/server/Design/Header.hs8
-rw-r--r--src/server/Design/Helper.hs4
-rw-r--r--src/server/Design/LoggedIn/Home/Add.hs26
-rw-r--r--src/server/Design/LoggedIn/Home/Expandables.hs4
-rw-r--r--src/server/Design/LoggedIn/Home/Pages.hs8
-rw-r--r--src/server/Design/LoggedIn/Home/Table.hs14
-rw-r--r--src/server/Design/SignIn.hs6
-rw-r--r--src/server/Main.hs61
-rw-r--r--src/server/View/Page.hs4
82 files changed, 676 insertions, 745 deletions
diff --git a/elm-package.json b/elm-package.json
index 91ac937..737386d 100644
--- a/elm-package.json
+++ b/elm-package.json
@@ -3,18 +3,16 @@
"summary": "SharedCost",
"repository": "https://github.com/guyonvarch/sharedcost.git",
"license": "GPL-3",
- "source-directories": ["src/client/elm"],
+ "source-directories": [ "src/client/elm" ],
"exposed-modules": [],
- "elm-version": "0.16.0 <= v < 0.17.0",
+ "elm-version": "0.17.0 <= v < 0.18.0",
"dependencies": {
- "elm-lang/core": "3.0.0 <= v < 4.0.0",
- "evancz/elm-html": "4.0.2 <= v < 5.0.0",
- "evancz/elm-http": "3.0.0 <= v < 4.0.0",
- "evancz/start-app": "2.0.2 <= v < 3.0.0",
- "evancz/elm-effects": "2.0.1 <= v < 3.0.0",
- "etaque/elm-transit-router": "1.0.1 <= v < 2.0.0",
- "etaque/elm-route-parser": "2.2.0 <= v < 3.0.0",
- "etaque/elm-simple-form": "2.0.1 <= v < 3.0.0",
- "rluiten/elm-date-extra": "3.0.0 <= v < 4.0.0"
+ "elm-lang/core": "4.0.1 <= v < 5.0.0",
+ "elm-lang/html": "1.0.0 <= v < 2.0.0",
+ "elm-lang/navigation": "1.0.0 <= v < 2.0.0",
+ "evancz/elm-http": "3.0.1 <= v < 4.0.0",
+ "evancz/url-parser": "1.0.0 <= v < 2.0.0",
+ "etaque/elm-simple-form": "3.0.0 <= v < 4.0.0",
+ "rluiten/elm-date-extra": "6.0.1 <= v < 7.0.0"
}
}
diff --git a/sharedCost.cabal b/sharedCost.cabal
index d61ea7c..679bb47 100644
--- a/sharedCost.cabal
+++ b/sharedCost.cabal
@@ -27,7 +27,6 @@ executable sharedCost
, persistent
, persistent-sqlite
, persistent-template
- , esqueleto
, monad-logger
, resourcet
, transformers
diff --git a/src/client/elm/Action.elm b/src/client/elm/Action.elm
deleted file mode 100644
index 38c0def..0000000
--- a/src/client/elm/Action.elm
+++ /dev/null
@@ -1,26 +0,0 @@
-module Action
- ( Action(..)
- ) where
-
-import Time exposing (Time)
-import Signal exposing (Address)
-
-import TransitRouter
-
-import Route exposing (Route)
-
-import Model.Init exposing (Init)
-
-import SignIn.Action as SignInAction
-import LoggedIn.Action as LoggedInAction
-
-type Action =
- NoOp
- | SignIn String
- | UpdateTime Time
- | GoLoggedInView Init
- | UpdateSignIn SignInAction.Action
- | UpdateLoggedIn LoggedInAction.Action
- | GoSignInView
- | RouterAction (TransitRouter.Action Route)
- | SignOut
diff --git a/src/client/elm/Init.elm b/src/client/elm/Init.elm
new file mode 100644
index 0000000..8c148c0
--- /dev/null
+++ b/src/client/elm/Init.elm
@@ -0,0 +1,27 @@
+module Init exposing
+ ( Init
+ , decoder
+ )
+
+import Time exposing (..)
+
+import Json.Decode as Json exposing ((:=))
+
+import Model.Translations exposing (..)
+import Model.Conf exposing (..)
+import Model.InitResult exposing (..)
+
+type alias Init =
+ { time : Time
+ , translations : Translations
+ , conf : Conf
+ , result : InitResult
+ }
+
+decoder : Json.Decoder Init
+decoder =
+ Json.object4 Init
+ ("time" := Json.float)
+ ("translations" := translationsDecoder)
+ ("conf" := confDecoder)
+ ("result" := initResultDecoder)
diff --git a/src/client/elm/LoggedData.elm b/src/client/elm/LoggedData.elm
index a3cbec6..d4c31f1 100644
--- a/src/client/elm/LoggedData.elm
+++ b/src/client/elm/LoggedData.elm
@@ -1,11 +1,11 @@
-module LoggedData
+module LoggedData exposing
( LoggedData
, build
- ) where
+ )
import Time exposing (Time)
-import Action exposing (Action)
+import Msg exposing (Msg)
import Model exposing (Model)
import Model.Translations exposing (..)
diff --git a/src/client/elm/LoggedIn/Home/Account/View.elm b/src/client/elm/LoggedIn/Home/Account/View.elm
index dc72791..fdc1941 100644
--- a/src/client/elm/LoggedIn/Home/Account/View.elm
+++ b/src/client/elm/LoggedIn/Home/Account/View.elm
@@ -1,10 +1,12 @@
-module LoggedIn.Home.Account.View
+module LoggedIn.Home.Account.View exposing
( view
- ) where
+ )
import Html exposing (..)
import Html.Attributes exposing (..)
+import Msg exposing (Msg)
+
import LoggedData exposing (LoggedData)
import LoggedIn.Home.Model as HomeModel
@@ -14,7 +16,7 @@ import Model exposing (Model)
import Model.User exposing (getUserName)
import Model.Payer exposing (..)
-view : LoggedData -> HomeModel.Model -> Html
+view : LoggedData -> HomeModel.Model -> Html Msg
view loggedData homeModel =
div
[ class "account" ]
@@ -23,7 +25,7 @@ view loggedData homeModel =
(List.map (exceedingPayer loggedData homeModel) (getOrderedExceedingPayers loggedData.currentTime loggedData.users loggedData.incomes loggedData.payments))
]
-exceedingPayer : LoggedData -> HomeModel.Model -> ExceedingPayer -> Html
+exceedingPayer : LoggedData -> HomeModel.Model -> ExceedingPayer -> Html Msg
exceedingPayer loggedData homeModel payer =
div
[ class "exceedingPayer" ]
diff --git a/src/client/elm/LoggedIn/Home/Action.elm b/src/client/elm/LoggedIn/Home/Action.elm
deleted file mode 100644
index 1590fb8..0000000
--- a/src/client/elm/LoggedIn/Home/Action.elm
+++ /dev/null
@@ -1,15 +0,0 @@
-module LoggedIn.Home.Action
- ( Action(..)
- ) where
-
-import Model.Payment exposing (PaymentId)
-
-import LoggedIn.Home.AddPayment.Action as AddPaymentAction
-
-type Action =
- NoOp
- | UpdateAdd AddPaymentAction.Action
- | ToggleEdit PaymentId
- | UpdatePage Int
- | ShowMonthlyDetail
- | ToggleMonthlyDetail
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Model.elm b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm
index 19933fd..b656077 100644
--- a/src/client/elm/LoggedIn/Home/AddPayment/Model.elm
+++ b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm
@@ -1,7 +1,7 @@
-module LoggedIn.Home.AddPayment.Model
+module LoggedIn.Home.AddPayment.Model exposing
( Model
, init
- ) where
+ )
import Result as Result exposing (Result(..))
import Json.Decode exposing ((:=))
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Action.elm b/src/client/elm/LoggedIn/Home/AddPayment/Msg.elm
index a692b15..53e6e26 100644
--- a/src/client/elm/LoggedIn/Home/AddPayment/Action.elm
+++ b/src/client/elm/LoggedIn/Home/AddPayment/Msg.elm
@@ -1,10 +1,10 @@
-module LoggedIn.Home.AddPayment.Action
- ( Action(..)
- ) where
+module LoggedIn.Home.AddPayment.Msg exposing
+ ( Msg(..)
+ )
import Model.Payment exposing (Frequency)
-type Action =
+type Msg =
NoOp
| Init Frequency
| UpdateName String
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Update.elm b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm
index 7f5fb0a..46b3786 100644
--- a/src/client/elm/LoggedIn/Home/AddPayment/Update.elm
+++ b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm
@@ -1,49 +1,49 @@
-module LoggedIn.Home.AddPayment.Update
+module LoggedIn.Home.AddPayment.Update exposing
( update
, addPaymentError
- ) where
+ )
import Maybe
import Json.Decode as Json exposing ((:=))
-import LoggedIn.Home.AddPayment.Action as AddPaymentAction
+import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
import LoggedIn.Home.AddPayment.Model as AddPaymentModel
import Model.Translations exposing (Translations, getMessage)
import Model.Payment exposing (Frequency(..))
-update : AddPaymentAction.Action -> AddPaymentModel.Model -> AddPaymentModel.Model
+update : AddPaymentMsg.Msg -> AddPaymentModel.Model -> AddPaymentModel.Model
update action addPayment =
case action of
- AddPaymentAction.NoOp ->
+ AddPaymentMsg.NoOp ->
addPayment
- AddPaymentAction.Init frequency ->
+ AddPaymentMsg.Init frequency ->
AddPaymentModel.init frequency
- AddPaymentAction.UpdateName name ->
+ AddPaymentMsg.UpdateName name ->
{ addPayment | name = name }
- AddPaymentAction.UpdateCost cost ->
+ AddPaymentMsg.UpdateCost cost ->
{ addPayment | cost = cost }
- AddPaymentAction.AddError nameError costError ->
+ AddPaymentMsg.AddError nameError costError ->
{ addPayment
| nameError = nameError
, costError = costError
, waitingServer = False
}
- AddPaymentAction.ToggleFrequency ->
+ AddPaymentMsg.ToggleFrequency ->
{ addPayment
| frequency = if addPayment.frequency == Punctual then Monthly else Punctual
}
- AddPaymentAction.WaitingServer ->
+ AddPaymentMsg.WaitingServer ->
{ addPayment | waitingServer = True }
-addPaymentError : Translations -> String -> Maybe AddPaymentAction.Action
+addPaymentError : Translations -> String -> Maybe AddPaymentMsg.Msg
addPaymentError translations jsonErr =
let decoder =
Json.object2 (,)
@@ -53,6 +53,6 @@ addPaymentError translations jsonErr =
Err _ ->
Nothing
Ok (mbNameKey, mbCostKey) ->
- Just <| AddPaymentAction.AddError
+ Just <| AddPaymentMsg.AddError
(Maybe.map (flip getMessage translations) mbNameKey)
(Maybe.map (flip getMessage translations) mbCostKey)
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/View.elm b/src/client/elm/LoggedIn/Home/AddPayment/View.elm
index 96f3a6a..d97f3ca 100644
--- a/src/client/elm/LoggedIn/Home/AddPayment/View.elm
+++ b/src/client/elm/LoggedIn/Home/AddPayment/View.elm
@@ -1,44 +1,44 @@
-module LoggedIn.Home.AddPayment.View
+module LoggedIn.Home.AddPayment.View exposing
( view
- ) where
+ )
import Result exposing (..)
+import Json.Decode as Json
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
-import LoggedIn.Action as LoggedInAction
+import Msg exposing (Msg)
-import LoggedIn.Home.Action as HomeAction
+import LoggedIn.Msg as LoggedInMsg
+
+import LoggedIn.Home.Msg as HomeMsg
import LoggedIn.Home.Model as HomeModel
-import LoggedIn.Home.AddPayment.Action as AddPaymentAction
+import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
import LoggedIn.Home.AddPayment.Model as AddPaymentModel
import Model.Payment exposing (Frequency(..))
import Model.Translations exposing (getMessage)
import LoggedData exposing (LoggedData)
-import Action
-import Mailbox
-
import View.Events exposing (onSubmitPrevDefault)
import View.Icon exposing (..)
import Utils.Maybe exposing (isJust)
import Utils.Either exposing (toMaybeError)
-view : LoggedData -> HomeModel.Model -> Html
+view : LoggedData -> HomeModel.Model -> Html Msg
view loggedData homeModel =
Html.form
[ let update =
if homeModel.add.waitingServer
then
- Action.NoOp
+ Msg.NoOp
else
- Action.UpdateLoggedIn <| LoggedInAction.AddPayment homeModel.add.name homeModel.add.cost homeModel.add.frequency
- in onSubmitPrevDefault Mailbox.address update
+ Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment homeModel.add.name homeModel.add.cost homeModel.add.frequency
+ in onSubmitPrevDefault update
, class "addPayment"
]
[ addPaymentName loggedData homeModel.add
@@ -56,7 +56,7 @@ view loggedData homeModel =
]
]
-addPaymentName : LoggedData -> AddPaymentModel.Model -> Html
+addPaymentName : LoggedData -> AddPaymentModel.Model -> Html Msg
addPaymentName loggedData addPayment =
div
[ classList
@@ -67,7 +67,7 @@ addPaymentName loggedData addPayment =
[ input
[ id "nameInput"
, value addPayment.name
- , on "input" targetValue (Signal.message Mailbox.address << Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd << AddPaymentAction.UpdateName)
+ , on "input" (targetValue |> (Json.map <| Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd << AddPaymentMsg.UpdateName))
, maxlength 20
]
[]
@@ -81,7 +81,7 @@ addPaymentName loggedData addPayment =
text ""
]
-addPaymentCost : LoggedData -> AddPaymentModel.Model -> Html
+addPaymentCost : LoggedData -> AddPaymentModel.Model -> Html Msg
addPaymentCost loggedData addPayment =
div
[ classList
@@ -92,7 +92,7 @@ addPaymentCost loggedData addPayment =
[ input
[ id "costInput"
, value addPayment.cost
- , on "input" targetValue (Signal.message Mailbox.address << Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd << AddPaymentAction.UpdateCost)
+ , on "input" (targetValue |> (Json.map <| Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd << AddPaymentMsg.UpdateCost))
, maxlength 7
]
[]
@@ -106,12 +106,12 @@ addPaymentCost loggedData addPayment =
text ""
]
-paymentFrequency : LoggedData -> AddPaymentModel.Model -> Html
+paymentFrequency : LoggedData -> AddPaymentModel.Model -> Html Msg
paymentFrequency loggedData addPayment =
button
[ type' "button"
, class "frequency"
- , onClick Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd <| AddPaymentAction.ToggleFrequency)
+ , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd <| AddPaymentMsg.ToggleFrequency)
]
[ div
[ classList
diff --git a/src/client/elm/LoggedIn/Home/Model.elm b/src/client/elm/LoggedIn/Home/Model.elm
index 217a851..e448b66 100644
--- a/src/client/elm/LoggedIn/Home/Model.elm
+++ b/src/client/elm/LoggedIn/Home/Model.elm
@@ -1,7 +1,7 @@
-module LoggedIn.Home.Model
+module LoggedIn.Home.Model exposing
( Model
, init
- ) where
+ )
import Model.User exposing (Users, UserId)
import Model.Payment exposing (PaymentId, Payments, Frequency(..))
diff --git a/src/client/elm/LoggedIn/Home/Msg.elm b/src/client/elm/LoggedIn/Home/Msg.elm
new file mode 100644
index 0000000..bb17a91
--- /dev/null
+++ b/src/client/elm/LoggedIn/Home/Msg.elm
@@ -0,0 +1,15 @@
+module LoggedIn.Home.Msg exposing
+ ( Msg(..)
+ )
+
+import Model.Payment exposing (PaymentId)
+
+import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
+
+type Msg =
+ NoOp
+ | UpdateAdd AddPaymentMsg.Msg
+ | ToggleEdit PaymentId
+ | UpdatePage Int
+ | ShowMonthlyDetail
+ | ToggleMonthlyDetail
diff --git a/src/client/elm/LoggedIn/Home/Update.elm b/src/client/elm/LoggedIn/Home/Update.elm
index cebdc70..6de341d 100644
--- a/src/client/elm/LoggedIn/Home/Update.elm
+++ b/src/client/elm/LoggedIn/Home/Update.elm
@@ -1,43 +1,41 @@
-module LoggedIn.Home.Update
+module LoggedIn.Home.Update exposing
( update
- ) where
-
-import Effects exposing (Effects)
+ )
import LoggedData exposing (LoggedData)
-import LoggedIn.Home.Action as HomeAction
+import LoggedIn.Home.Msg as HomeMsg
import LoggedIn.Home.Model as HomeModel
import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate
-update : LoggedData -> HomeAction.Action -> HomeModel.Model -> (HomeModel.Model, Effects HomeAction.Action)
+update : LoggedData -> HomeMsg.Msg -> HomeModel.Model -> (HomeModel.Model, Cmd HomeMsg.Msg)
update loggedData action homeModel =
case action of
- HomeAction.NoOp -> (homeModel, Effects.none)
+ HomeMsg.NoOp -> (homeModel, Cmd.none)
- HomeAction.UpdateAdd addPaymentAction ->
- ( { homeModel | add = AddPaymentUpdate.update addPaymentAction homeModel.add }
- , Effects.none
+ HomeMsg.UpdateAdd addPaymentMsg ->
+ ( { homeModel | add = AddPaymentUpdate.update addPaymentMsg homeModel.add }
+ , Cmd.none
)
- HomeAction.ToggleEdit id ->
+ HomeMsg.ToggleEdit id ->
( { homeModel | paymentEdition = if homeModel.paymentEdition == Just id then Nothing else Just id }
- , Effects.none
+ , Cmd.none
)
- HomeAction.UpdatePage page ->
+ HomeMsg.UpdatePage page ->
( { homeModel | currentPage = page }
- , Effects.none
+ , Cmd.none
)
- HomeAction.ShowMonthlyDetail ->
+ HomeMsg.ShowMonthlyDetail ->
( { homeModel | monthlyDetail = True }
- , Effects.none
+ , Cmd.none
)
- HomeAction.ToggleMonthlyDetail ->
+ HomeMsg.ToggleMonthlyDetail ->
( { homeModel | monthlyDetail = not homeModel.monthlyDetail }
- , Effects.none
+ , Cmd.none
)
diff --git a/src/client/elm/LoggedIn/Home/View.elm b/src/client/elm/LoggedIn/Home/View.elm
index 4c5e330..097e730 100644
--- a/src/client/elm/LoggedIn/Home/View.elm
+++ b/src/client/elm/LoggedIn/Home/View.elm
@@ -1,10 +1,12 @@
-module LoggedIn.Home.View
+module LoggedIn.Home.View exposing
( view
- ) where
+ )
import Html exposing (..)
import Html.Attributes exposing (..)
+import Msg exposing (Msg)
+
import LoggedData exposing (LoggedData)
import LoggedIn.Home.Model as LoggedInModel
@@ -15,9 +17,7 @@ import LoggedIn.Home.View.Monthly as MonthlyView
import LoggedIn.Home.View.Table exposing (paymentsTable)
import LoggedIn.Home.View.Paging exposing (paymentsPaging)
-import Mailbox
-
-view : LoggedData -> LoggedInModel.Model -> Html
+view : LoggedData -> LoggedInModel.Model -> Html Msg
view loggedData loggedIn =
div
[ class "home" ]
diff --git a/src/client/elm/LoggedIn/Home/View/Expand.elm b/src/client/elm/LoggedIn/Home/View/Expand.elm
index 514bf93..a50ebfe 100644
--- a/src/client/elm/LoggedIn/Home/View/Expand.elm
+++ b/src/client/elm/LoggedIn/Home/View/Expand.elm
@@ -1,16 +1,18 @@
-module LoggedIn.Home.View.Expand
+module LoggedIn.Home.View.Expand exposing
( expand
, ExpandType(..)
- ) where
+ )
import Html exposing (..)
import Html.Attributes exposing (..)
+import Msg exposing (Msg)
+
import View.Icon exposing (renderIcon)
type ExpandType = ExpandUp | ExpandDown
-expand : ExpandType -> Bool -> Html
+expand : ExpandType -> Bool -> Html Msg
expand expandType isExpanded =
div
[ class "expand" ]
diff --git a/src/client/elm/LoggedIn/Home/View/Monthly.elm b/src/client/elm/LoggedIn/Home/View/Monthly.elm
index 237b551..26dbe98 100644
--- a/src/client/elm/LoggedIn/Home/View/Monthly.elm
+++ b/src/client/elm/LoggedIn/Home/View/Monthly.elm
@@ -1,6 +1,6 @@
-module LoggedIn.Home.View.Monthly
+module LoggedIn.Home.View.Monthly exposing
( view
- ) where
+ )
import String
@@ -8,9 +8,11 @@ import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
-import LoggedIn.Action as LoggedInAction
+import Msg exposing (Msg)
-import LoggedIn.Home.Action as HomeAction
+import LoggedIn.Msg as LoggedInMsg
+
+import LoggedIn.Home.Msg as HomeMsg
import LoggedIn.Home.Model as HomeModel
import LoggedIn.View.Format as Format
import LoggedIn.Home.View.Expand exposing (..)
@@ -19,12 +21,9 @@ import Model.Payment as Payment exposing (Payments, Payment, monthly)
import Model.Translations exposing (getMessage, getParamMessage)
import LoggedData exposing (LoggedData)
-import Action
-import Mailbox
-
import View.Icon exposing (renderIcon)
-view : LoggedData -> HomeModel.Model -> Html
+view : LoggedData -> HomeModel.Model -> Html Msg
view loggedData homeModel =
let monthlyPayments = Payment.monthly loggedData.me loggedData.payments
in if List.length monthlyPayments == 0
@@ -43,20 +42,20 @@ view loggedData homeModel =
else text ""
]
-monthlyCount : LoggedData -> Payments -> HomeModel.Model -> Html
+monthlyCount : LoggedData -> Payments -> HomeModel.Model -> Html Msg
monthlyCount loggedData monthlyPayments homeModel =
let count = List.length monthlyPayments
total = List.sum << List.map .cost <| monthlyPayments
key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount"
in button
[ class "header"
- , onClick Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.ToggleMonthlyDetail)
+ , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg <| HomeMsg.ToggleMonthlyDetail)
]
[ text (getParamMessage [toString count, Format.price loggedData.conf total] key loggedData.translations)
, expand ExpandDown homeModel.monthlyDetail
]
-paymentsTable : LoggedData -> Payments -> HomeModel.Model -> Html
+paymentsTable : LoggedData -> Payments -> HomeModel.Model -> Html Msg
paymentsTable loggedData monthlyPayments homeModel =
div
[ class "table" ]
@@ -65,14 +64,14 @@ paymentsTable loggedData monthlyPayments homeModel =
|> List.map (paymentLine loggedData homeModel)
)
-paymentLine : LoggedData -> HomeModel.Model -> Payment -> Html
+paymentLine : LoggedData -> HomeModel.Model -> Payment -> Html Msg
paymentLine loggedData homeModel payment =
a
[ classList
[ ("row", True)
, ("edition", homeModel.paymentEdition == Just payment.id)
]
- , onClick Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.ToggleEdit payment.id)
+ , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg <| HomeMsg.ToggleEdit payment.id)
]
[ div [ class "cell category" ] [ text (payment.name) ]
, div
@@ -84,7 +83,7 @@ paymentLine loggedData homeModel payment =
[ text (Format.price loggedData.conf payment.cost) ]
, div
[ class "cell delete"
- , onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.DeletePayment payment.id)
+ , onClick (Msg.UpdateLoggedIn <| LoggedInMsg.DeletePayment payment.id)
]
[ button [] [ renderIcon "times" ]
]
diff --git a/src/client/elm/LoggedIn/Home/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm
index 939ee55..15bb5a1 100644
--- a/src/client/elm/LoggedIn/Home/View/Paging.elm
+++ b/src/client/elm/LoggedIn/Home/View/Paging.elm
@@ -1,18 +1,17 @@
-module LoggedIn.Home.View.Paging
+module LoggedIn.Home.View.Paging exposing
( paymentsPaging
- ) where
+ )
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
-import LoggedIn.Action as LoggedInAction
+import LoggedIn.Msg as LoggedInMsg
-import LoggedIn.Home.Action as HomeAction
+import LoggedIn.Home.Msg as HomeMsg
import LoggedIn.Home.Model as HomeModel
-import Action exposing (Action)
-import Mailbox
+import Msg exposing (Msg)
import LoggedData exposing (LoggedData)
import Model.Payment as Payment exposing (Payments, perPage)
@@ -21,7 +20,7 @@ import View.Icon exposing (renderIcon)
showedPages : Int
showedPages = 5
-paymentsPaging : Payments -> HomeModel.Model -> Html
+paymentsPaging : Payments -> HomeModel.Model -> Html Msg
paymentsPaging payments homeModel =
let maxPage = ceiling (toFloat (List.length (Payment.punctual payments)) / toFloat perPage)
pages = truncatePages homeModel.currentPage [1..maxPage]
@@ -50,48 +49,48 @@ truncatePages currentPage pages =
[(currentPage - showedLeftPages)..(currentPage + showedRightPages)]
in List.filter (flip List.member pages) truncatedPages
-firstPage : HomeModel.Model -> Html
+firstPage : HomeModel.Model -> Html Msg
firstPage homeModel =
button
[ classList
[ ("page", True)
, ("disable", homeModel.currentPage <= 1)
]
- , onClick Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| 1)
+ , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| 1)
]
[ renderIcon "fast-backward" ]
-previousPage : HomeModel.Model -> Html
+previousPage : HomeModel.Model -> Html Msg
previousPage homeModel =
button
[ class "page"
- , onClick Mailbox.address <|
+ , onClick <|
if homeModel.currentPage > 1
- then (Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| homeModel.currentPage - 1)
- else Action.NoOp
+ then (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| homeModel.currentPage - 1)
+ else Msg.NoOp
]
[ renderIcon "backward" ]
-nextPage : HomeModel.Model -> Int -> Html
+nextPage : HomeModel.Model -> Int -> Html Msg
nextPage homeModel maxPage =
button
[ class "page"
- , onClick Mailbox.address <|
+ , onClick <|
if homeModel.currentPage < maxPage
- then (Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| homeModel.currentPage + 1)
- else Action.NoOp
+ then (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| homeModel.currentPage + 1)
+ else Msg.NoOp
]
[ renderIcon "forward" ]
-lastPage : HomeModel.Model -> Int -> Html
+lastPage : HomeModel.Model -> Int -> Html Msg
lastPage homeModel maxPage =
button
[ class "page"
- , onClick Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| maxPage)
+ , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| maxPage)
]
[ renderIcon "fast-forward" ]
-paymentsPage : HomeModel.Model -> Int -> Html
+paymentsPage : HomeModel.Model -> Int -> Html Msg
paymentsPage homeModel page =
let onCurrentPage = page == homeModel.currentPage
in button
@@ -99,9 +98,9 @@ paymentsPage homeModel page =
[ ("page", True)
, ("current", onCurrentPage)
]
- , onClick Mailbox.address <|
+ , onClick <|
if onCurrentPage
- then Action.NoOp
- else Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| page
+ then Msg.NoOp
+ else Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| page
]
[ text (toString page) ]
diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm
index 5ac740c..6631af7 100644
--- a/src/client/elm/LoggedIn/Home/View/Table.elm
+++ b/src/client/elm/LoggedIn/Home/View/Table.elm
@@ -1,6 +1,6 @@
-module LoggedIn.Home.View.Table
+module LoggedIn.Home.View.Table exposing
( paymentsTable
- ) where
+ )
import Dict exposing (..)
import Date exposing (Date)
@@ -10,29 +10,29 @@ import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
+import Msg exposing (Msg)
+
import LoggedData exposing (LoggedData)
-import LoggedIn.Action as LoggedInAction
+import LoggedIn.Msg as LoggedInMsg
-import LoggedIn.Home.Action as HomeAction
+import LoggedIn.Home.Msg as HomeMsg
import LoggedIn.Home.Model as HomeModel
import LoggedIn.View.Date exposing (..)
import LoggedIn.View.Format as Format
import Model.User exposing (getUserName)
import Model.Payment as Payment exposing (..)
-import Action
-import Mailbox
import View.Icon exposing (renderIcon)
-paymentsTable : LoggedData -> HomeModel.Model -> Html
+paymentsTable : LoggedData -> HomeModel.Model -> Html Msg
paymentsTable loggedData homeModel =
div
[ class "table" ]
( headerLine loggedData :: paymentLines loggedData homeModel)
-headerLine : LoggedData -> Html
+headerLine : LoggedData -> Html Msg
headerLine loggedData =
div
[ class "header" ]
@@ -43,7 +43,7 @@ headerLine loggedData =
, div [ class "cell" ] []
]
-paymentLines : LoggedData -> HomeModel.Model -> List Html
+paymentLines : LoggedData -> HomeModel.Model -> List (Html Msg)
paymentLines loggedData homeModel =
Payment.punctual loggedData.payments
|> List.sortBy (Date.toTime << .creation)
@@ -52,14 +52,14 @@ paymentLines loggedData homeModel =
|> List.take perPage
|> List.map (paymentLine loggedData homeModel)
-paymentLine : LoggedData -> HomeModel.Model -> Payment -> Html
+paymentLine : LoggedData -> HomeModel.Model -> Payment -> Html Msg
paymentLine loggedData homeModel payment =
a
[ classList
[ ("row", True)
, ("edition", homeModel.paymentEdition == Just payment.id)
]
- , onClick Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.ToggleEdit <| payment.id)
+ , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.ToggleEdit <| payment.id)
]
[ div [ class "cell category" ] [ text payment.name ]
, div
@@ -90,7 +90,7 @@ paymentLine loggedData homeModel payment =
div
[ class "cell delete" ]
[ button
- [ onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.DeletePayment payment.id)]
+ [ onClick (Msg.UpdateLoggedIn <| LoggedInMsg.DeletePayment payment.id)]
[ renderIcon "times" ]
]
else
diff --git a/src/client/elm/LoggedIn/Income/Action.elm b/src/client/elm/LoggedIn/Income/Action.elm
deleted file mode 100644
index 68b343a..0000000
--- a/src/client/elm/LoggedIn/Income/Action.elm
+++ /dev/null
@@ -1,9 +0,0 @@
-module LoggedIn.Income.Action
- ( Action(..)
- ) where
-
-import Form exposing (Form)
-
-type Action =
- NoOp
- | AddIncomeAction Form.Action
diff --git a/src/client/elm/LoggedIn/Income/Model.elm b/src/client/elm/LoggedIn/Income/Model.elm
index fdfb964..bc09f0e 100644
--- a/src/client/elm/LoggedIn/Income/Model.elm
+++ b/src/client/elm/LoggedIn/Income/Model.elm
@@ -1,12 +1,12 @@
-module LoggedIn.Income.Model
+module LoggedIn.Income.Model exposing
( Model
, AddIncome
, init
- ) where
+ )
import String exposing (toInt, split)
import Date exposing (Date)
-import Date.Utils exposing (dateFromFields)
+import Date.Extra.Create exposing (dateFromFields)
import Utils.Date exposing (numToMonth)
import Form exposing (Form)
diff --git a/src/client/elm/LoggedIn/Income/Msg.elm b/src/client/elm/LoggedIn/Income/Msg.elm
new file mode 100644
index 0000000..0a09dad
--- /dev/null
+++ b/src/client/elm/LoggedIn/Income/Msg.elm
@@ -0,0 +1,9 @@
+module LoggedIn.Income.Msg exposing
+ ( Msg(..)
+ )
+
+import Form exposing (Form)
+
+type Msg =
+ NoOp
+ | AddIncomeMsg Form.Msg
diff --git a/src/client/elm/LoggedIn/Income/Update.elm b/src/client/elm/LoggedIn/Income/Update.elm
index 4e673fa..74920f3 100644
--- a/src/client/elm/LoggedIn/Income/Update.elm
+++ b/src/client/elm/LoggedIn/Income/Update.elm
@@ -1,25 +1,24 @@
-module LoggedIn.Income.Update
+module LoggedIn.Income.Update exposing
( update
- ) where
+ )
-import Effects exposing (Effects)
import Form exposing (Form)
import LoggedData exposing (LoggedData)
import LoggedIn.Income.Model as IncomeModel
-import LoggedIn.Income.Action as IncomeAction
+import LoggedIn.Income.Msg as IncomeMsg
-update : LoggedData -> IncomeAction.Action -> IncomeModel.Model -> (IncomeModel.Model, Effects IncomeAction.Action)
+update : LoggedData -> IncomeMsg.Msg -> IncomeModel.Model -> (IncomeModel.Model, Cmd IncomeMsg.Msg)
update loggedData action model =
case action of
- IncomeAction.NoOp ->
+ IncomeMsg.NoOp ->
( model
- , Effects.none
+ , Cmd.none
)
- IncomeAction.AddIncomeAction formAction ->
- ( { model | addIncome = Form.update formAction model.addIncome }
- , Effects.none
+ IncomeMsg.AddIncomeMsg formMsg ->
+ ( { model | addIncome = Form.update formMsg model.addIncome }
+ , Cmd.none
)
diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm
index 0d6e02d..39f16f4 100644
--- a/src/client/elm/LoggedIn/Income/View.elm
+++ b/src/client/elm/LoggedIn/Income/View.elm
@@ -1,17 +1,20 @@
-module LoggedIn.Income.View
+module LoggedIn.Income.View exposing
( view
- ) where
+ )
import Dict
import Date
import Time exposing (Time)
+import Html.App as Html
import Html exposing (..)
import Html.Events exposing (..)
import Html.Attributes exposing (..)
import Form exposing (Form)
import Form.Input as Input
+import Msg exposing (Msg)
+
import LoggedData exposing (LoggedData)
import Model.Income exposing (IncomeId, Income, userCumulativeIncomeSince)
@@ -20,11 +23,8 @@ import Model.Payer exposing (useIncomesFrom)
import Model.User exposing (UserId, User)
import LoggedIn.Income.Model as IncomeModel
-import Mailbox
-
-import Action
-import LoggedIn.Action as LoggedInAction
-import LoggedIn.Income.Action as IncomeAction
+import LoggedIn.Msg as LoggedInMsg
+import LoggedIn.Income.Msg as IncomeMsg
import LoggedIn.View.Date exposing (renderShortDate)
import LoggedIn.View.Format as Format
@@ -34,7 +34,7 @@ import Utils.Maybe exposing (isJust)
import LoggedIn.View.Date exposing (renderLongDate)
import View.Events exposing (onSubmitPrevDefault)
-view : LoggedData -> IncomeModel.Model -> Html
+view : LoggedData -> IncomeModel.Model -> Html Msg
view loggedData incomeModel =
div
[ class "income" ]
@@ -47,7 +47,7 @@ view loggedData incomeModel =
, incomesView loggedData
]
-cumulativeIncomesView : LoggedData -> Time -> Html
+cumulativeIncomesView : LoggedData -> Time -> Html Msg
cumulativeIncomesView loggedData since =
let longDate = renderLongDate (Date.fromTime since) loggedData.translations
in div
@@ -71,38 +71,38 @@ cumulativeIncomesView loggedData since =
)
]
-addIncomeView : LoggedData -> Form () IncomeModel.AddIncome -> Html
+addIncomeView : LoggedData -> Form () IncomeModel.AddIncome -> Html Msg
addIncomeView loggedData addIncome =
let
- formAddress = Signal.forwardTo Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.IncomeAction << IncomeAction.AddIncomeAction)
errorFor error field =
if isJust field.liveError
then div [ class "error" ] [ text (getMessage error loggedData.translations) ]
else text ""
creation = Form.getFieldAsString "creation" addIncome
amount = Form.getFieldAsString "amount" addIncome
+ htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.IncomeMsg << IncomeMsg.AddIncomeMsg)
in
Html.form
- [ onSubmitPrevDefault Mailbox.address Action.NoOp ]
+ [ onSubmitPrevDefault Msg.NoOp ]
[ label [] [ text "Creation" ]
- , Input.textInput creation formAddress []
+ , htmlMap <| Input.textInput creation []
, errorFor "DateValidationError" creation
, label [] [ text "amount" ]
- , Input.textInput amount formAddress []
+ , htmlMap <| Input.textInput amount []
, errorFor "IncomeValidationError" amount
, button
[ case Form.getOutput addIncome of
Just data ->
- onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.AddIncome data.creation data.amount)
+ onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.creation data.amount)
Nothing ->
- onClick formAddress Form.Submit
+ onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit)
]
[ text (getMessage "Add" loggedData.translations) ]
]
-incomesView : LoggedData -> Html
+incomesView : LoggedData -> Html Msg
incomesView loggedData =
ul
[]
@@ -114,7 +114,7 @@ incomesView loggedData =
|> List.map (incomeView loggedData)
)
-incomeView : LoggedData -> (IncomeId, Income) -> Html
+incomeView : LoggedData -> (IncomeId, Income) -> Html Msg
incomeView loggedData (incomeId, income) =
li
[]
@@ -123,6 +123,6 @@ incomeView loggedData (incomeId, income) =
, text <| Format.price loggedData.conf income.amount
, text " − "
, button
- [ onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.DeleteIncome incomeId) ]
+ [ onClick (Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId) ]
[ text "x" ]
]
diff --git a/src/client/elm/LoggedIn/Model.elm b/src/client/elm/LoggedIn/Model.elm
index 8309528..11386d5 100644
--- a/src/client/elm/LoggedIn/Model.elm
+++ b/src/client/elm/LoggedIn/Model.elm
@@ -1,7 +1,7 @@
-module LoggedIn.Model
+module LoggedIn.Model exposing
( Model
, init
- ) where
+ )
import Time exposing (Time)
diff --git a/src/client/elm/LoggedIn/Action.elm b/src/client/elm/LoggedIn/Msg.elm
index b33ab09..b83d486 100644
--- a/src/client/elm/LoggedIn/Action.elm
+++ b/src/client/elm/LoggedIn/Msg.elm
@@ -1,19 +1,19 @@
-module LoggedIn.Action
- ( Action(..)
- ) where
+module LoggedIn.Msg exposing
+ ( Msg(..)
+ )
import Date exposing (Date)
import Model.Payment exposing (Payment, PaymentId, Frequency)
import Model.Income exposing (IncomeId)
-import LoggedIn.Home.Action as HomeAction
-import LoggedIn.Income.Action as IncomeAction
+import LoggedIn.Home.Msg as HomeMsg
+import LoggedIn.Income.Msg as IncomeMsg
-type Action =
+type Msg =
NoOp
- | HomeAction HomeAction.Action
- | IncomeAction IncomeAction.Action
+ | HomeMsg HomeMsg.Msg
+ | IncomeMsg IncomeMsg.Msg
| AddPayment String String Frequency
| ValidateAddPayment PaymentId String Int Frequency
diff --git a/src/client/elm/LoggedIn/Stat/View.elm b/src/client/elm/LoggedIn/Stat/View.elm
index 573d5bc..77a32a0 100644
--- a/src/client/elm/LoggedIn/Stat/View.elm
+++ b/src/client/elm/LoggedIn/Stat/View.elm
@@ -1,6 +1,6 @@
-module LoggedIn.Stat.View
+module LoggedIn.Stat.View exposing
( view
- ) where
+ )
import Date exposing (Month)
import Dict
@@ -11,6 +11,8 @@ import Html.Attributes exposing (..)
import LoggedData exposing (LoggedData)
+import Msg exposing (Msg)
+
import Model.Payment as Payment exposing (Payments)
import Model.Conf exposing (Conf)
import Model.Translations exposing (getMessage)
@@ -23,7 +25,7 @@ import LoggedIn.View.Format as Format
import Utils.Tuple as Tuple
-view : LoggedData -> Html
+view : LoggedData -> Html Msg
view loggedData =
div
[ class "stat" ]
@@ -33,7 +35,7 @@ view loggedData =
, monthsDetail loggedData
]
-paymentsDetail : LoggedData -> Payments -> Html
+paymentsDetail : LoggedData -> Payments -> Html Msg
paymentsDetail loggedData payments =
ul
[]
@@ -70,7 +72,7 @@ totalPayments loggedData =
)
)
-monthsDetail : LoggedData -> Html
+monthsDetail : LoggedData -> Html Msg
monthsDetail loggedData =
ul
[]
@@ -79,7 +81,7 @@ monthsDetail loggedData =
|> List.map (monthDetail loggedData)
)
-monthDetail : LoggedData -> ((Month, Int), Payments) -> Html
+monthDetail : LoggedData -> ((Month, Int), Payments) -> Html Msg
monthDetail loggedData ((month, year), payments) =
li
[]
diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm
index 8330310..564d6fc 100644
--- a/src/client/elm/LoggedIn/Update.elm
+++ b/src/client/elm/LoggedIn/Update.elm
@@ -1,14 +1,14 @@
-module LoggedIn.Update
+module LoggedIn.Update exposing
( update
- ) where
+ )
import Dict
import String
import Task
-import Effects exposing (Effects)
import Http exposing (Error(..))
import Date exposing (Date)
+import Platform.Cmd exposing (Cmd)
import Model exposing (Model)
import Model.Translations exposing (getMessage)
@@ -17,118 +17,118 @@ import Model.Payment exposing (Payment, Frequency(..), deletePayment)
import Server
import LoggedData
-import LoggedIn.Action as LoggedInAction
+import LoggedIn.Msg as LoggedInMsg
import LoggedIn.Model as LoggedInModel
-import LoggedIn.Home.Action as HomeAction
+import LoggedIn.Home.Msg as HomeMsg
import LoggedIn.Home.Update as HomeUpdate
-import LoggedIn.Income.Action as IncomeAction
+import LoggedIn.Income.Msg as IncomeMsg
import LoggedIn.Income.Update as IncomeUpdate
-import LoggedIn.Home.AddPayment.Action as AddPaymentAction
+import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate
import Utils.Tuple as Tuple
-import Utils.Effects as Effects
+import Utils.Cmd exposing ((:>))
-update : Model -> LoggedInAction.Action -> LoggedInModel.Model -> (LoggedInModel.Model, Effects LoggedInAction.Action)
+update : Model -> LoggedInMsg.Msg -> LoggedInModel.Model -> (LoggedInModel.Model, Cmd LoggedInMsg.Msg)
update model action loggedIn =
let loggedData = LoggedData.build model loggedIn
in case action of
- LoggedInAction.NoOp ->
- (loggedIn, Effects.none)
+ LoggedInMsg.NoOp ->
+ (loggedIn, Cmd.none)
- LoggedInAction.HomeAction homeAction ->
- case HomeUpdate.update loggedData homeAction loggedIn.home of
+ LoggedInMsg.HomeMsg homeMsg ->
+ case HomeUpdate.update loggedData homeMsg loggedIn.home of
(home, effects) ->
( { loggedIn | home = home }
- , Effects.map LoggedInAction.HomeAction effects
+ , Cmd.map LoggedInMsg.HomeMsg effects
)
- LoggedInAction.IncomeAction incomeAction ->
- case IncomeUpdate.update loggedData incomeAction loggedIn.income of
- (income, effects) ->
+ LoggedInMsg.IncomeMsg incomeMsg ->
+ case IncomeUpdate.update loggedData incomeMsg loggedIn.income of
+ (income, cmd) ->
( { loggedIn | income = income }
- , Effects.map LoggedInAction.IncomeAction effects
+ , Cmd.map LoggedInMsg.IncomeMsg cmd
)
- LoggedInAction.AddPayment name cost frequency ->
- update model (LoggedInAction.HomeAction <| HomeAction.UpdateAdd <| AddPaymentAction.WaitingServer) loggedIn
- |> Tuple.mapSnd (\effect ->
+ LoggedInMsg.AddPayment name cost frequency ->
+ update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd <| AddPaymentMsg.WaitingServer) loggedIn
+ :> \loggedIn ->
Server.addPayment name cost frequency
- |> Task.map (\paymentId ->
- case String.toInt cost of
- Err _ ->
- LoggedInAction.HomeAction <| HomeAction.UpdateAdd (AddPaymentAction.AddError Nothing (Just (getMessage "CostRequired" loggedData.translations)))
- Ok costNumber ->
- LoggedInAction.ValidateAddPayment paymentId name costNumber frequency
- )
- |> flip Task.onError (\err ->
- case err of
- BadResponse 400 jsonErr ->
- case AddPaymentUpdate.addPaymentError model.translations jsonErr of
- Just addPaymentAction -> Task.succeed (LoggedInAction.HomeAction <| HomeAction.UpdateAdd addPaymentAction)
- Nothing -> Task.succeed LoggedInAction.NoOp
- _ ->
- Task.succeed LoggedInAction.NoOp
- )
- |> Effects.task
- |> \effect2 -> [effect, effect2]
- |> Effects.batch
- )
-
- LoggedInAction.ValidateAddPayment paymentId name cost frequency ->
- update model (LoggedInAction.HomeAction <| HomeAction.UpdateAdd <| AddPaymentAction.Init frequency) loggedIn
- |> flip Effects.andThen (\loggedIn ->
+ |> Task.perform
+ (\err ->
+ case err of
+ BadResponse 400 jsonErr ->
+ case AddPaymentUpdate.addPaymentError model.translations jsonErr of
+ Just addPaymentMsg -> (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd addPaymentMsg)
+ Nothing -> LoggedInMsg.NoOp
+ _ ->
+ LoggedInMsg.NoOp
+ )
+ (\paymentId ->
+ case String.toInt cost of
+ Err _ ->
+ LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd (AddPaymentMsg.AddError Nothing (Just (getMessage "CostRequired" loggedData.translations)))
+ Ok costNumber ->
+ LoggedInMsg.ValidateAddPayment paymentId name costNumber frequency
+ )
+ |> \cmd -> (loggedIn, cmd)
+
+ LoggedInMsg.ValidateAddPayment paymentId name cost frequency ->
+ update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd <| AddPaymentMsg.Init frequency) loggedIn
+ :> (\loggedIn ->
case frequency of
Punctual ->
- update model (LoggedInAction.HomeAction <| HomeAction.UpdatePage 1) loggedIn
+ update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1) loggedIn
Monthly ->
- update model (LoggedInAction.HomeAction <| HomeAction.ShowMonthlyDetail) loggedIn
+ update model (LoggedInMsg.HomeMsg <| HomeMsg.ShowMonthlyDetail) loggedIn
)
- |> Tuple.mapFst (\loggedIn ->
+ :> (\loggedIn ->
let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedIn.me frequency
- in { loggedIn | payments = newPayment :: loggedIn.payments }
+ in ( { loggedIn | payments = newPayment :: loggedIn.payments }
+ , Cmd.none
+ )
)
- LoggedInAction.DeletePayment paymentId ->
+ LoggedInMsg.DeletePayment paymentId ->
( loggedIn
, Server.deletePayment paymentId
- |> Task.map (always (LoggedInAction.ValidateDeletePayment paymentId))
- |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp)
- |> Effects.task
+ |> Task.perform
+ (always LoggedInMsg.NoOp)
+ (always (LoggedInMsg.ValidateDeletePayment paymentId))
)
- LoggedInAction.ValidateDeletePayment paymentId ->
+ LoggedInMsg.ValidateDeletePayment paymentId ->
( { loggedIn | payments = deletePayment paymentId loggedIn.payments }
- , Effects.none
+ , Cmd.none
)
- LoggedInAction.AddIncome creation amount ->
+ LoggedInMsg.AddIncome creation amount ->
( loggedIn
, Server.addIncome creation amount
- |> Task.map (\incomeId -> (LoggedInAction.ValidateAddIncome incomeId creation amount))
- |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp)
- |> Effects.task
+ |> Task.perform
+ (always LoggedInMsg.NoOp)
+ (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId creation amount))
)
- LoggedInAction.ValidateAddIncome incomeId creation amount ->
+ LoggedInMsg.ValidateAddIncome incomeId creation amount ->
let newIncome = { userId = loggedIn.me, creation = (Date.toTime creation), amount = amount }
in ( { loggedIn | incomes = Dict.insert incomeId newIncome loggedIn.incomes }
- , Effects.none
+ , Cmd.none
)
- LoggedInAction.DeleteIncome incomeId ->
+ LoggedInMsg.DeleteIncome incomeId ->
( loggedIn
, Server.deleteIncome incomeId
- |> Task.map (always <| LoggedInAction.ValidateDeleteIncome incomeId)
- |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp)
- |> Effects.task
+ |> Task.perform
+ (always LoggedInMsg.NoOp)
+ (always <| LoggedInMsg.ValidateDeleteIncome incomeId)
)
- LoggedInAction.ValidateDeleteIncome incomeId ->
+ LoggedInMsg.ValidateDeleteIncome incomeId ->
( { loggedIn | incomes = Dict.remove incomeId loggedIn.incomes }
- , Effects.none
+ , Cmd.none
)
diff --git a/src/client/elm/LoggedIn/View.elm b/src/client/elm/LoggedIn/View.elm
index dbbab33..a1fa3f0 100644
--- a/src/client/elm/LoggedIn/View.elm
+++ b/src/client/elm/LoggedIn/View.elm
@@ -1,14 +1,13 @@
-module LoggedIn.View
+module LoggedIn.View exposing
( view
- ) where
+ )
import Html exposing (..)
import Html.Attributes exposing (..)
-import TransitRouter
-import Route exposing (..)
+import Page
-import Action exposing (Action)
+import Msg exposing (Msg)
import Model exposing (Model)
import LoggedData
@@ -18,14 +17,13 @@ import LoggedIn.Home.View as HomeView
import LoggedIn.Income.View as UserView
import LoggedIn.Stat.View as StatView
-view : Model -> LoggedInModel.Model -> Html
+view : Model -> LoggedInModel.Model -> Html Msg
view model loggedIn =
div
[ class "loggedIn" ]
[ let loggedData = LoggedData.build model loggedIn
- in case TransitRouter.getRoute model of
- Empty -> text ""
- Home -> HomeView.view loggedData loggedIn.home
- Income -> UserView.view loggedData loggedIn.income
- Stat -> StatView.view loggedData
+ in case model.page of
+ Page.Home -> HomeView.view loggedData loggedIn.home
+ Page.Income -> UserView.view loggedData loggedIn.income
+ Page.Statistics -> StatView.view loggedData
]
diff --git a/src/client/elm/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/View/Date.elm
index c9d44ab..783f10c 100644
--- a/src/client/elm/LoggedIn/View/Date.elm
+++ b/src/client/elm/LoggedIn/View/Date.elm
@@ -1,8 +1,8 @@
-module LoggedIn.View.Date
+module LoggedIn.View.Date exposing
( renderShortDate
, renderLongDate
, renderMonth
- ) where
+ )
import Date exposing (..)
import Utils.Date exposing (monthToNum)
diff --git a/src/client/elm/LoggedIn/View/Format.elm b/src/client/elm/LoggedIn/View/Format.elm
index 7925a5c..f41e2cd 100644
--- a/src/client/elm/LoggedIn/View/Format.elm
+++ b/src/client/elm/LoggedIn/View/Format.elm
@@ -1,6 +1,6 @@
-module LoggedIn.View.Format
+module LoggedIn.View.Format exposing
( price
- ) where
+ )
import String exposing (..)
diff --git a/src/client/elm/Mailbox.elm b/src/client/elm/Mailbox.elm
deleted file mode 100644
index 5337f58..0000000
--- a/src/client/elm/Mailbox.elm
+++ /dev/null
@@ -1,17 +0,0 @@
-module Mailbox
- ( address
- , signal
- ) where
-
-import Signal exposing (Mailbox, Address)
-
-import Action exposing (Action)
-
-mailbox : Mailbox Action
-mailbox = Signal.mailbox Action.NoOp
-
-address : Address Action
-address = mailbox.address
-
-signal : Signal Action
-signal = mailbox.signal
diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm
index 0813573..d15813d 100644
--- a/src/client/elm/Main.elm
+++ b/src/client/elm/Main.elm
@@ -1,66 +1,21 @@
-module Main
+module Main exposing
( main
- ) where
+ )
-import Graphics.Element exposing (..)
-import Json.Decode as Json
+import Navigation
+import Time
+import Msg
-import Html exposing (Html)
-import StartApp exposing (App)
-import Effects exposing (Effects, Never)
-import TransitRouter
-
-import Task exposing (..)
-import Time exposing (..)
-
-import Server
-import Mailbox
-import Action exposing (..)
-import Model exposing (Model, initialModel)
-import Model.InitResult as InitResult exposing (initResultDecoder)
-import Update exposing (update, routerConfig)
+import Model exposing (init)
+import Update exposing (update, urlUpdate)
import View exposing (view)
-
-import Utils.Maybe exposing (isJust)
-import Utils.Effects as Effects
-
-main : Signal Html
-main = app.html
-
-app : App Model
-app = StartApp.start
- { init = (initData, Effects.none) `Effects.andThen` initRouter
- , view = view
- , update = update
- , inputs =
- [ Signal.map UpdateTime (Time.every 1000)
- , Signal.map RouterAction TransitRouter.actions
- , Mailbox.signal
- ]
- }
-
--- Init
-
-initData : Model
-initData =
- case Json.decodeString initResultDecoder initResult of
- Ok init ->
- initialModel initialTime translations conf init
- Err _ ->
- initialModel initialTime translations conf InitResult.InitEmpty
-
-initRouter : Model -> (Model, Effects Action)
-initRouter model = TransitRouter.init routerConfig location model
-
--- Output ports
-
-port tasks : Signal (Task.Task Never ())
-port tasks = app.tasks
-
--- Input ports
-
-port initialTime : Time
-port translations : String
-port conf : String
-port initResult : String
-port location : String
+import Page
+
+main =
+ Navigation.programWithFlags (Navigation.makeParser Page.fromHash)
+ { init = init
+ , view = view
+ , update = update
+ , urlUpdate = urlUpdate
+ , subscriptions = \_ -> Time.every 1000 Msg.UpdateTime
+ }
diff --git a/src/client/elm/Model.elm b/src/client/elm/Model.elm
index b4213d5..9e9cdbb 100644
--- a/src/client/elm/Model.elm
+++ b/src/client/elm/Model.elm
@@ -1,13 +1,14 @@
-module Model
+module Model exposing
( Model
- , initialModel
- ) where
+ , init
+ )
import Time exposing (Time)
import Json.Decode as Json
-import TransitRouter
-import Route exposing (Route)
+import Page exposing (Page)
+import Init as Init exposing (Init)
+import Msg exposing (Msg)
import Model.View exposing (..)
import Model.Translations exposing (..)
@@ -24,27 +25,36 @@ type alias Model =
, currentTime : Time
, translations : Translations
, conf : Conf
- , transitRouter : TransitRouter.TransitRouter Route
+ , page : Page
}
-initialModel : Time -> String -> String -> InitResult -> Model
-initialModel initialTime translations conf initResult =
- { view =
- case initResult of
- InitEmpty ->
- SignInView (SignInModel.init Nothing)
- InitSuccess init ->
- LoggedInView (LoggedInModel.init init)
- InitError error ->
- SignInView (SignInModel.init (Just error))
- , currentTime = initialTime
- , translations =
- case Json.decodeString translationsDecoder translations of
- Ok translations -> translations
- Err _ -> []
- , conf =
- case Json.decodeString confDecoder conf of
- Ok conf -> conf
- Err _ -> { currency = "" }
- , transitRouter = TransitRouter.empty Route.Empty
- }
+init : Json.Value -> Result String Page -> (Model, Cmd Msg)
+init payload result =
+ let page =
+ case result of
+ Err _ -> Page.Home
+ Ok page -> page
+ model =
+ case Json.decodeValue Init.decoder payload of
+ Ok { time, translations, conf, result } ->
+ { view =
+ case result of
+ InitEmpty ->
+ SignInView (SignInModel.init Nothing)
+ InitSuccess init ->
+ LoggedInView (LoggedInModel.init init)
+ InitError error ->
+ SignInView (SignInModel.init (Just error))
+ , currentTime = time
+ , translations = translations
+ , conf = conf
+ , page = page
+ }
+ Err error ->
+ { view = SignInView (SignInModel.init (Just error))
+ , currentTime = 0
+ , translations = []
+ , conf = { currency = "" }
+ , page = page
+ }
+ in (model, Cmd.none)
diff --git a/src/client/elm/Model/Conf.elm b/src/client/elm/Model/Conf.elm
index ad71d83..ec04622 100644
--- a/src/client/elm/Model/Conf.elm
+++ b/src/client/elm/Model/Conf.elm
@@ -1,7 +1,7 @@
-module Model.Conf
+module Model.Conf exposing
( Conf
, confDecoder
- ) where
+ )
import Json.Decode exposing (..)
diff --git a/src/client/elm/Model/Date.elm b/src/client/elm/Model/Date.elm
index 1c56de4..f3c9b91 100644
--- a/src/client/elm/Model/Date.elm
+++ b/src/client/elm/Model/Date.elm
@@ -1,7 +1,7 @@
-module Model.Date
+module Model.Date exposing
( timeDecoder
, dateDecoder
- ) where
+ )
import Date as Date exposing (Date)
import Time exposing (Time)
diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm
index ea990e2..c0039e9 100644
--- a/src/client/elm/Model/Income.elm
+++ b/src/client/elm/Model/Income.elm
@@ -1,4 +1,4 @@
-module Model.Income
+module Model.Income exposing
( Incomes
, Income
, IncomeId
@@ -7,7 +7,7 @@ module Model.Income
, incomeDefinedForAll
, userCumulativeIncomeSince
, cumulativeIncomesSince
- ) where
+ )
import Json.Decode as Json exposing ((:=))
import Time exposing (Time, hour)
diff --git a/src/client/elm/Model/Init.elm b/src/client/elm/Model/Init.elm
index 5db038d..3a86dba 100644
--- a/src/client/elm/Model/Init.elm
+++ b/src/client/elm/Model/Init.elm
@@ -1,7 +1,7 @@
-module Model.Init
+module Model.Init exposing
( Init
, initDecoder
- ) where
+ )
import Json.Decode as Json exposing ((:=))
diff --git a/src/client/elm/Model/InitResult.elm b/src/client/elm/Model/InitResult.elm
index d1f1348..c8da533 100644
--- a/src/client/elm/Model/InitResult.elm
+++ b/src/client/elm/Model/InitResult.elm
@@ -1,7 +1,7 @@
-module Model.InitResult
+module Model.InitResult exposing
( InitResult(..)
, initResultDecoder
- ) where
+ )
import Json.Decode as Json exposing ((:=))
diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm
index 72f13b1..2c067bc 100644
--- a/src/client/elm/Model/Payer.elm
+++ b/src/client/elm/Model/Payer.elm
@@ -1,10 +1,10 @@
-module Model.Payer
+module Model.Payer exposing
( Payers
, Payer
, ExceedingPayer
, getOrderedExceedingPayers
, useIncomesFrom
- ) where
+ )
import Json.Decode as Json exposing (..)
import Dict exposing (..)
diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm
index 013fc95..4f0f85a 100644
--- a/src/client/elm/Model/Payment.elm
+++ b/src/client/elm/Model/Payment.elm
@@ -1,4 +1,4 @@
-module Model.Payment
+module Model.Payment exposing
( perPage
, Payments
, Payment
@@ -11,7 +11,7 @@ module Model.Payment
, punctual
, monthly
, groupAndSortByMonth
- ) where
+ )
import Date exposing (..)
import Json.Decode as Json exposing ((:=))
diff --git a/src/client/elm/Model/Translations.elm b/src/client/elm/Model/Translations.elm
index dbf378c..705cb66 100644
--- a/src/client/elm/Model/Translations.elm
+++ b/src/client/elm/Model/Translations.elm
@@ -1,10 +1,10 @@
-module Model.Translations
+module Model.Translations exposing
( translationsDecoder
, Translations
, Translation
, getMessage
, getParamMessage
- ) where
+ )
import Maybe exposing (withDefault)
import Json.Decode as Json exposing ((:=))
diff --git a/src/client/elm/Model/User.elm b/src/client/elm/Model/User.elm
index aac5dd5..02f2cea 100644
--- a/src/client/elm/Model/User.elm
+++ b/src/client/elm/Model/User.elm
@@ -1,4 +1,4 @@
-module Model.User
+module Model.User exposing
( Users
, usersDecoder
, User
@@ -6,7 +6,7 @@ module Model.User
, UserId
, userIdDecoder
, getUserName
- ) where
+ )
import Json.Decode as Json exposing ((:=))
import Dict exposing (Dict)
diff --git a/src/client/elm/Model/View.elm b/src/client/elm/Model/View.elm
index 475e826..61d42a7 100644
--- a/src/client/elm/Model/View.elm
+++ b/src/client/elm/Model/View.elm
@@ -1,6 +1,6 @@
-module Model.View
+module Model.View exposing
( View(..)
- ) where
+ )
import Model.Payment exposing (Payments)
diff --git a/src/client/elm/Msg.elm b/src/client/elm/Msg.elm
new file mode 100644
index 0000000..6143a37
--- /dev/null
+++ b/src/client/elm/Msg.elm
@@ -0,0 +1,22 @@
+module Msg exposing
+ ( Msg(..)
+ )
+
+import Time exposing (Time)
+
+import Page exposing (Page)
+
+import Model.Init exposing (Init)
+
+import SignIn.Msg as SignInMsg
+import LoggedIn.Msg as LoggedInMsg
+
+type Msg =
+ NoOp
+ | SignIn String
+ | UpdateTime Time
+ | GoLoggedInView Init
+ | UpdateSignIn SignInMsg.Msg
+ | UpdateLoggedIn LoggedInMsg.Msg
+ | GoSignInView
+ | SignOut
diff --git a/src/client/elm/Page.elm b/src/client/elm/Page.elm
new file mode 100644
index 0000000..7cfbbc7
--- /dev/null
+++ b/src/client/elm/Page.elm
@@ -0,0 +1,32 @@
+module Page exposing
+ ( Page(..)
+ , toHash
+ , fromHash
+ )
+
+import Navigation
+import UrlParser exposing (..)
+import String
+
+type Page =
+ Home
+ | Income
+ | Statistics
+
+toHash : Page -> String
+toHash page =
+ case page of
+ Home -> "#"
+ Income -> "#income"
+ Statistics -> "#statistics"
+
+fromHash : Navigation.Location -> Result String Page
+fromHash location = UrlParser.parse identity pageParser (String.dropLeft 1 location.hash)
+
+pageParser : Parser (Page -> a) a
+pageParser =
+ oneOf
+ [ format Home (s "")
+ , format Income (s "income")
+ , format Statistics (s "statistics")
+ ]
diff --git a/src/client/elm/Route.elm b/src/client/elm/Route.elm
deleted file mode 100644
index 0ed4203..0000000
--- a/src/client/elm/Route.elm
+++ /dev/null
@@ -1,31 +0,0 @@
-module Route
- ( Route(..)
- , matchers
- , toPath
- ) where
-
-import Effects exposing (Effects)
-
-import RouteParser exposing (..)
-
-type Route =
- Empty
- | Home
- | Income
- | Stat
-
-matchers : List (Matcher Route)
-matchers =
- [ static Empty ""
- , static Home "/"
- , static Income "/income"
- , static Stat "/statistics"
- ]
-
-toPath : Route -> String
-toPath route =
- case route of
- Empty -> ""
- Home -> "/"
- Income -> "/income"
- Stat -> "/statistics"
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index 36adb33..d56bc48 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -1,13 +1,12 @@
-module Server
+module Server exposing
( signIn
, addPayment
, deletePayment
, addIncome
, deleteIncome
, signOut
- ) where
+ )
-import Signal
import Task as Task exposing (Task)
import Http
import Json.Decode as Json exposing ((:=))
@@ -22,30 +21,30 @@ import Model.Init exposing (Init)
signIn : String -> Task Http.Error ()
signIn email =
- post ("/api/signIn?email=" ++ email)
+ post ("/signIn?email=" ++ email)
|> Task.map (always ())
addPayment : String -> String -> Frequency -> Task Http.Error PaymentId
addPayment name cost frequency =
- post ("/api/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency))
+ post ("/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency))
|> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
deletePayment : PaymentId -> Task Http.Error ()
deletePayment paymentId =
- delete ("/api/payment/delete?id=" ++ (toString paymentId))
+ delete ("/payment?id=" ++ (toString paymentId))
|> Task.map (always ())
addIncome : Date -> Int -> Task Http.Error IncomeId
addIncome creation amount =
- post ("/api/income?creation=" ++ (toString << Date.toTime <| creation) ++ "&amount=" ++ (toString amount))
+ post ("/income?creation=" ++ (toString << Date.toTime <| creation) ++ "&amount=" ++ (toString amount))
|> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder)
deleteIncome : IncomeId -> Task Http.Error ()
deleteIncome incomeId =
- delete ("/api/income/delete?id=" ++ (toString incomeId))
+ delete ("/income?id=" ++ (toString incomeId))
|> Task.map (always ())
signOut : Task Http.Error ()
signOut =
- post "/api/signOut"
+ post "/signOut"
|> Task.map (always ())
diff --git a/src/client/elm/SignIn/Model.elm b/src/client/elm/SignIn/Model.elm
index e01de12..19d4305 100644
--- a/src/client/elm/SignIn/Model.elm
+++ b/src/client/elm/SignIn/Model.elm
@@ -1,7 +1,7 @@
-module SignIn.Model
+module SignIn.Model exposing
( Model
, init
- ) where
+ )
type alias Model =
{ login : String
diff --git a/src/client/elm/SignIn/Action.elm b/src/client/elm/SignIn/Msg.elm
index 1f93f4e..f753ebd 100644
--- a/src/client/elm/SignIn/Action.elm
+++ b/src/client/elm/SignIn/Msg.elm
@@ -1,8 +1,8 @@
-module SignIn.Action
- ( Action(..)
- ) where
+module SignIn.Msg exposing
+ ( Msg(..)
+ )
-type Action =
+type Msg =
UpdateLogin String
| WaitingServer
| ValidLogin
diff --git a/src/client/elm/SignIn/Update.elm b/src/client/elm/SignIn/Update.elm
index f4152a6..28307e4 100644
--- a/src/client/elm/SignIn/Update.elm
+++ b/src/client/elm/SignIn/Update.elm
@@ -1,13 +1,13 @@
-module SignIn.Update
+module SignIn.Update exposing
( update
- ) where
+ )
import SignIn.Model exposing (..)
-import SignIn.Action exposing (..)
+import SignIn.Msg exposing (..)
import Model.Translations exposing (getMessage, Translations)
-update : Translations -> Action -> Model -> Model
+update : Translations -> Msg -> Model -> Model
update translations action signInView =
case action of
UpdateLogin login ->
diff --git a/src/client/elm/SignIn/View.elm b/src/client/elm/SignIn/View.elm
index d81d63a..2cec586 100644
--- a/src/client/elm/SignIn/View.elm
+++ b/src/client/elm/SignIn/View.elm
@@ -1,34 +1,33 @@
-module SignIn.View
+module SignIn.View exposing
( view
- ) where
+ )
import Html as H exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
-import Signal exposing (Address)
import Json.Decode as Json
-import SignIn.Action as SignInAction
+import SignIn.Msg as SignInMsg
import SignIn.Model as SignInModel
import Update exposing (..)
import Model exposing (Model)
-import Action exposing (..)
+import Msg exposing (..)
import Model.Translations exposing (getMessage)
import View.Events exposing (onSubmitPrevDefault)
import View.Icon exposing (renderSpinIcon)
-view : Address Action -> Model -> SignInModel.Model -> Html
-view address model signInModel =
+view : Model -> SignInModel.Model -> Html Msg
+view model signInModel =
div
[ class "signIn" ]
[ H.form
- [ onSubmitPrevDefault address (SignIn signInModel.login) ]
+ [ onSubmitPrevDefault (SignIn signInModel.login) ]
[ input
[ value signInModel.login
- , on "input" targetValue (Signal.message address << UpdateSignIn << SignInAction.UpdateLogin)
+ , on "input" (targetValue |> (Json.map <| (UpdateSignIn << SignInMsg.UpdateLogin)))
, name "email"
]
[]
@@ -44,7 +43,7 @@ view address model signInModel =
[ signInResult model signInModel ]
]
-signInResult : Model -> SignInModel.Model -> Html
+signInResult : Model -> SignInModel.Model -> Html Msg
signInResult model signInModel =
case signInModel.result of
Just result ->
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index 5c89d0a..bcbfb6c 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -1,105 +1,93 @@
-module Update
- ( routerConfig
- , update
- ) where
+module Update exposing
+ ( update
+ , urlUpdate
+ )
import Task
+import Platform.Cmd exposing (Cmd)
+import Navigation
-import Effects exposing (Effects)
-import TransitRouter
-import RouteParser
-
-import Route exposing (Route)
+import Page exposing (Page)
import Server
-import Action exposing (..)
+import Msg exposing (..)
import Model exposing (Model)
import Model.Translations exposing (getMessage)
import Model.View as V
import LoggedIn.Model as LoggedInModel
-import LoggedIn.Action as LoggedInAction
+import LoggedIn.Msg as LoggedInMsg
import LoggedIn.Update as LoggedInUpdate
import SignIn.Model as SignInModel
-import SignIn.Action as SignInAction
+import SignIn.Msg as SignInMsg
import SignIn.Update as SignInUpdate
import Utils.Http exposing (errorKey)
-routerConfig : TransitRouter.Config Route Action Model
-routerConfig =
- { mountRoute = \_ _ model -> (model, Effects.none)
- , getDurations = \_ _ _ -> (50, 200)
- , actionWrapper = RouterAction
- , routeDecoder = Maybe.withDefault Route.Home << RouteParser.match Route.matchers
- }
-
-update : Action -> Model -> (Model, Effects Action)
+update : Msg -> Model -> (Model, Cmd Msg)
update action model =
case action of
NoOp ->
- (model, Effects.none)
+ (model, Cmd.none)
SignIn email ->
- ( applySignIn model (SignInAction.WaitingServer)
+ ( applySignIn model (SignInMsg.WaitingServer)
, Server.signIn email
- |> Task.map (always (UpdateSignIn SignInAction.ValidLogin))
- |> flip Task.onError (\error ->
- Task.succeed (UpdateSignIn (SignInAction.ErrorLogin (errorKey error)))
- )
- |> Effects.task
+ |> Task.perform
+ (\error -> UpdateSignIn (SignInMsg.ErrorLogin (errorKey error)))
+ (\() -> UpdateSignIn SignInMsg.ValidLogin)
)
GoLoggedInView init ->
( { model | view = V.LoggedInView (LoggedInModel.init init) }
- , Effects.none
+ , Cmd.none
)
UpdateTime time ->
- ({ model | currentTime = time }, Effects.none)
+ ({ model | currentTime = time }, Cmd.none)
GoSignInView ->
- ({ model | view = V.SignInView (SignInModel.init Nothing) }, Effects.none)
-
- UpdateSignIn signInAction ->
- (applySignIn model signInAction, Effects.none)
+ ({ model | view = V.SignInView (SignInModel.init Nothing) }, Cmd.none)
- UpdateLoggedIn loggedInAction ->
- applyLoggedIn model loggedInAction
+ UpdateSignIn signInMsg ->
+ (applySignIn model signInMsg, Cmd.none)
- RouterAction routeAction ->
- TransitRouter.update
- routerConfig
- routeAction
- model
+ UpdateLoggedIn loggedInMsg ->
+ applyLoggedIn model loggedInMsg
SignOut ->
( model
, Server.signOut
- |> Task.map (always GoSignInView)
- |> flip Task.onError (always <| Task.succeed NoOp)
- |> Effects.task
+ |> Task.perform (always NoOp) (always GoSignInView)
)
-applySignIn : Model -> SignInAction.Action -> Model
-applySignIn model signInAction =
+applySignIn : Model -> SignInMsg.Msg -> Model
+applySignIn model signInMsg =
case model.view of
V.SignInView signInView ->
- { model | view = V.SignInView (SignInUpdate.update model.translations signInAction signInView) }
+ { model | view = V.SignInView (SignInUpdate.update model.translations signInMsg signInView) }
_ ->
model
-applyLoggedIn : Model -> LoggedInAction.Action -> (Model, Effects Action)
-applyLoggedIn model loggedInAction =
+applyLoggedIn : Model -> LoggedInMsg.Msg -> (Model, Cmd Msg)
+applyLoggedIn model loggedInMsg =
case model.view of
V.LoggedInView loggedInView ->
- let (loggedInView, effects) = LoggedInUpdate.update model loggedInAction loggedInView
+ let (loggedInView, cmd) = LoggedInUpdate.update model loggedInMsg loggedInView
in ( { model | view = V.LoggedInView loggedInView }
- , Effects.map UpdateLoggedIn effects
+ , Cmd.map UpdateLoggedIn cmd
)
_ ->
- (model, Effects.none)
+ (model, Cmd.none)
+
+urlUpdate : Result String Page -> Model -> (Model, Cmd Msg)
+urlUpdate result model =
+ case Debug.log "urlUpdate" result of
+ Err _ ->
+ (model, Navigation.modifyUrl (Page.toHash model.page))
+ Ok page ->
+ ({ model | page = page }, Cmd.none)
diff --git a/src/client/elm/Utils/Cmd.elm b/src/client/elm/Utils/Cmd.elm
new file mode 100644
index 0000000..1eee6f3
--- /dev/null
+++ b/src/client/elm/Utils/Cmd.elm
@@ -0,0 +1,18 @@
+module Utils.Cmd exposing
+ ( pipeUpdate
+ , (:>)
+ )
+
+import Platform.Cmd as Cmd
+
+pipeUpdate : (model, Cmd msg) -> (model -> (model, Cmd msg)) -> (model, Cmd msg)
+pipeUpdate (model, cmd) f =
+ let
+ (model', cmd') = f model
+ in
+ (model', Cmd.batch [ cmd, cmd' ])
+
+(:>) : (m, Cmd a) -> (m -> (m, Cmd a)) -> (m, Cmd a)
+(:>) = pipeUpdate
+
+infixl 0 :>
diff --git a/src/client/elm/Utils/Date.elm b/src/client/elm/Utils/Date.elm
index 7a245bc..352e4ce 100644
--- a/src/client/elm/Utils/Date.elm
+++ b/src/client/elm/Utils/Date.elm
@@ -1,7 +1,7 @@
-module Utils.Date
+module Utils.Date exposing
( monthToNum
, numToMonth
- ) where
+ )
import Date exposing (..)
diff --git a/src/client/elm/Utils/Dict.elm b/src/client/elm/Utils/Dict.elm
index dc01b17..7d708e2 100644
--- a/src/client/elm/Utils/Dict.elm
+++ b/src/client/elm/Utils/Dict.elm
@@ -1,6 +1,6 @@
-module Utils.Dict
+module Utils.Dict exposing
( mapValues
- ) where
+ )
import Dict as Dict exposing (..)
diff --git a/src/client/elm/Utils/Effects.elm b/src/client/elm/Utils/Effects.elm
deleted file mode 100644
index 544352f..0000000
--- a/src/client/elm/Utils/Effects.elm
+++ /dev/null
@@ -1,10 +0,0 @@
-module Utils.Effects
- ( andThen
- ) where
-
-import Effects exposing (Effects)
-
-andThen : (a, Effects b) -> (a -> (a, Effects b)) -> (a, Effects b)
-andThen a b = case a of
- (ma, ea) -> case b ma of
- (mb, eb) -> (mb, Effects.batch [ea, eb])
diff --git a/src/client/elm/Utils/Either.elm b/src/client/elm/Utils/Either.elm
index 10c40e3..275fc8c 100644
--- a/src/client/elm/Utils/Either.elm
+++ b/src/client/elm/Utils/Either.elm
@@ -1,6 +1,6 @@
-module Utils.Either
+module Utils.Either exposing
( toMaybeError
- ) where
+ )
toMaybeError : Result a b -> Maybe a
toMaybeError result =
diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm
index b394af4..97db053 100644
--- a/src/client/elm/Utils/Http.elm
+++ b/src/client/elm/Utils/Http.elm
@@ -1,9 +1,9 @@
-module Utils.Http
+module Utils.Http exposing
( post
, delete
, decodeHttpValue
, errorKey
- ) where
+ )
import Http exposing (..)
import Task exposing (..)
diff --git a/src/client/elm/Utils/List.elm b/src/client/elm/Utils/List.elm
index 85cdc24..4886418 100644
--- a/src/client/elm/Utils/List.elm
+++ b/src/client/elm/Utils/List.elm
@@ -1,6 +1,6 @@
-module Utils.List
+module Utils.List exposing
( groupBy
- ) where
+ )
import Dict
diff --git a/src/client/elm/Utils/Maybe.elm b/src/client/elm/Utils/Maybe.elm
index d954ae0..4a94aa5 100644
--- a/src/client/elm/Utils/Maybe.elm
+++ b/src/client/elm/Utils/Maybe.elm
@@ -1,8 +1,8 @@
-module Utils.Maybe
+module Utils.Maybe exposing
( isJust
, catMaybes
, maybeToList
- ) where
+ )
isJust : Maybe a -> Bool
isJust maybe =
diff --git a/src/client/elm/Utils/Tuple.elm b/src/client/elm/Utils/Tuple.elm
index d9246f6..f9391a0 100644
--- a/src/client/elm/Utils/Tuple.elm
+++ b/src/client/elm/Utils/Tuple.elm
@@ -1,8 +1,8 @@
-module Utils.Tuple
+module Utils.Tuple exposing
( mapFst
, mapSnd
, mapBoth
- ) where
+ )
mapFst : (a -> x) -> (a, b) -> (x, b)
mapFst f (a, b) = (f a, b)
diff --git a/src/client/elm/View.elm b/src/client/elm/View.elm
index 90808aa..38734bc 100644
--- a/src/client/elm/View.elm
+++ b/src/client/elm/View.elm
@@ -1,12 +1,11 @@
-module View
+module View exposing
( view
- ) where
+ )
import Html exposing (..)
-import Signal exposing (Address)
import Model exposing (Model)
-import Action exposing (Action)
+import Msg exposing (Msg)
import Model.View exposing (..)
import LoggedData
@@ -15,18 +14,18 @@ import View.Header exposing (renderHeader)
import SignIn.View as SignInView
import LoggedIn.View as LoggedInView
-view : Address Action -> Model -> Html
-view address model =
+view : Model -> Html Msg
+view model =
div
[]
- [ renderHeader address model
- , renderMain address model
+ [ renderHeader model
+ , renderMain model
]
-renderMain : Address Action -> Model -> Html
-renderMain address model =
+renderMain : Model -> Html Msg
+renderMain model =
case model.view of
SignInView signIn ->
- SignInView.view address model signIn
+ SignInView.view model signIn
LoggedInView loggedIn ->
LoggedInView.view model loggedIn
diff --git a/src/client/elm/View/Click.elm b/src/client/elm/View/Click.elm
deleted file mode 100644
index a722cac..0000000
--- a/src/client/elm/View/Click.elm
+++ /dev/null
@@ -1,24 +0,0 @@
-module View.Click
- ( clickTo
- ) where
-
-import Signal
-import Json.Decode as Json
-
-import Html exposing (..)
-import Html.Attributes exposing (..)
-import Html.Events exposing (..)
-
-import TransitRouter
-import Route exposing (Route, toPath)
-
-clickTo : Route -> List Attribute
-clickTo route =
- let path = toPath route
- in [ href path
- , onWithOptions
- "click"
- { stopPropagation = True, preventDefault = True }
- Json.value
- (\_ -> Signal.message TransitRouter.pushPathAddress path)
- ]
diff --git a/src/client/elm/View/Events.elm b/src/client/elm/View/Events.elm
index c9dff9f..2802709 100644
--- a/src/client/elm/View/Events.elm
+++ b/src/client/elm/View/Events.elm
@@ -1,19 +1,17 @@
-module View.Events
+module View.Events exposing
( 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 =
+import Msg exposing (Msg)
+
+onSubmitPrevDefault : Msg -> Attribute Msg
+onSubmitPrevDefault value =
onWithOptions
"submit"
{ defaultOptions | preventDefault = True }
- Json.value
- (\_ ->
- Signal.message address value
- )
+ (Json.succeed value)
diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm
index 74fc2cc..5597429 100644
--- a/src/client/elm/View/Header.elm
+++ b/src/client/elm/View/Header.elm
@@ -1,13 +1,10 @@
-module View.Header
+module View.Header exposing
( renderHeader
- ) where
+ )
-import Signal exposing (Address)
import Dict
-import TransitRouter
-
-import Route exposing (..)
+import Page exposing (..)
import Html exposing (..)
import Html.Attributes exposing (..)
@@ -15,32 +12,31 @@ import Html.Events exposing (..)
import Model exposing (Model)
import Model.Translations exposing (getMessage)
-import Action exposing (..)
+import Msg exposing (..)
import Model.View exposing (..)
import View.Icon exposing (renderIcon)
-import View.Click exposing (clickTo)
-renderHeader : Address Action -> Model -> Html
-renderHeader address model =
+renderHeader : Model -> Html Msg
+renderHeader model =
header
[]
( [ div [ class "title" ] [ text (getMessage "SharedCost" model.translations) ] ]
- ++ let item route name =
+ ++ let item page name =
a
- ( [ classList
- [ ("item", True)
- , ("current", TransitRouter.getRoute model == route)
- ]
- ] ++ clickTo route
- )
+ [ href (Page.toHash page)
+ , classList
+ [ ("item", True)
+ , ("current", model.page == page)
+ ]
+ ]
[ text (getMessage name model.translations)
]
in case model.view of
LoggedInView { me, users } ->
[ item Home "PaymentsTitle"
, item Income "Income"
- , item Stat "Statistics"
+ , item Statistics "Statistics"
, div
[ class "nameSignOut" ]
[ div
@@ -52,7 +48,7 @@ renderHeader address model =
]
, button
[ class "signOut item"
- , onClick address SignOut
+ , onClick SignOut
]
[ renderIcon "power-off" ]
]
diff --git a/src/client/elm/View/Icon.elm b/src/client/elm/View/Icon.elm
index 468265f..8a5e383 100644
--- a/src/client/elm/View/Icon.elm
+++ b/src/client/elm/View/Icon.elm
@@ -1,18 +1,20 @@
-module View.Icon
+module View.Icon exposing
( renderIcon
, renderSpinIcon
- ) where
+ )
import Html exposing (..)
import Html.Attributes exposing (..)
-renderIcon : String -> Html
+import Msg exposing (Msg)
+
+renderIcon : String -> Html Msg
renderIcon iconClass =
i
[ class <| "fa fa-fw fa-" ++ iconClass ]
[]
-renderSpinIcon : Html
+renderSpinIcon : Html Msg
renderSpinIcon =
i
[ class <| "fa fa-fw fa-spin fa-spinner" ]
diff --git a/src/client/elm/View/Plural.elm b/src/client/elm/View/Plural.elm
index 6e480fd..727189c 100644
--- a/src/client/elm/View/Plural.elm
+++ b/src/client/elm/View/Plural.elm
@@ -1,6 +1,6 @@
-module View.Plural
+module View.Plural exposing
( plural
- ) where
+ )
plural : Int -> String -> String -> String
plural n single multiple =
diff --git a/src/client/js/main.js b/src/client/js/main.js
index 296600e..839c33a 100644
--- a/src/client/js/main.js
+++ b/src/client/js/main.js
@@ -1,10 +1,16 @@
// Remove query params
-window.history.pushState({html: document.documentElement.innerHTML, pageTitle: document.title}, '', location.pathname);
+window.history.pushState(
+ {
+ html: document.documentElement.innerHTML,
+ pageTitle: document.title
+ },
+ '',
+ document.location.pathname
+);
-Elm.fullscreen(Elm.Main, {
- initialTime: new Date().getTime(),
- translations: document.getElementById('messages').innerHTML,
- conf: document.getElementById('conf').innerHTML,
- initResult: document.getElementById('initResult').innerHTML,
- location: location.pathname
+var app = Elm.Main.fullscreen({
+ time: new Date().getTime(),
+ translations: JSON.parse(document.getElementById('translations').innerHTML),
+ conf: JSON.parse(document.getElementById('conf').innerHTML),
+ result: JSON.parse(document.getElementById('result').innerHTML)
});
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index 1e1f942..abb3b17 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -18,7 +18,7 @@ import Conf (Conf(..))
import qualified LoginSession
import Secure (getUserFromToken)
-import Model.Database
+import Model.Database hiding (Key)
import qualified Model.Json.Conf as M
import Model.User (getUser)
import Model.Message.Key
diff --git a/src/server/Cookie.hs b/src/server/Cookie.hs
index 1495fc1..96d45da 100644
--- a/src/server/Cookie.hs
+++ b/src/server/Cookie.hs
@@ -38,10 +38,10 @@ makeSimpleCookie conf name value =
, setCookieSecure = Conf.https conf
}
-setCookie :: (Monad m, ScottyError e) => SetCookie -> ActionT e m ()
+setCookie :: (Monad m) => SetCookie -> ActionT e m ()
setCookie name = addHeader "Set-Cookie" (TL.decodeUtf8 . toLazyByteString $ renderSetCookie name)
-setSimpleCookie :: (Monad m, ScottyError e) => Conf -> TS.Text -> TS.Text -> ActionT e m ()
+setSimpleCookie :: (Monad m) => Conf -> TS.Text -> TS.Text -> ActionT e m ()
setSimpleCookie conf name value = setCookie $ makeSimpleCookie conf name value
getCookie :: (Monad m, ScottyError e) => TS.Text -> ActionT e m (Maybe TS.Text)
@@ -52,5 +52,5 @@ getCookies =
liftM (Map.fromList . maybe [] parse) $ header "Cookie"
where parse = parseCookiesText . BSL.toStrict . TL.encodeUtf8
-deleteCookie :: (Monad m, ScottyError e) => Conf -> TS.Text -> ActionT e m ()
+deleteCookie :: (Monad m) => Conf -> TS.Text -> ActionT e m ()
deleteCookie conf name = setCookie $ (makeSimpleCookie conf name "") { setCookieExpires = Just $ posixSecondsToUTCTime 0 }
diff --git a/src/server/Design/Color.hs b/src/server/Design/Color.hs
index b59f738..7520e4e 100644
--- a/src/server/Design/Color.hs
+++ b/src/server/Design/Color.hs
@@ -2,29 +2,28 @@ module Design.Color where
import qualified Clay.Color as C
+-- http://chir.ag/projects/name-that-color/#969696
+
white :: C.Color
white = C.white
-redError :: C.Color
-redError = C.red
-
-red :: C.Color
-red = C.rgb 207 92 86
+chestnutRose :: C.Color
+chestnutRose = C.rgb 207 92 86
-green :: C.Color
-green = C.rgb 159 210 165
+mossGreen :: C.Color
+mossGreen = C.rgb 159 210 165
-blue :: C.Color
-blue = C.rgb 108 162 164
+gothic :: C.Color
+gothic = C.rgb 108 162 164
-paymentFocus :: C.Color
-paymentFocus = C.rgb 255 223 196
+negroni :: C.Color
+negroni = C.rgb 255 223 196
-mercury :: C.Color
-mercury = C.rgb 245 245 245
+wildSand :: C.Color
+wildSand = C.rgb 245 245 245
-pumice :: C.Color
-pumice = C.rgb 200 200 200
+silver :: C.Color
+silver = C.rgb 200 200 200
-mountainMist :: C.Color
-mountainMist = C.rgb 150 150 150
+dustyGray :: C.Color
+dustyGray = C.rgb 150 150 150
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index f27859b..12e20b9 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -36,7 +36,7 @@ global = do
h1 ? do
fontSize (px 24)
- color Color.red
+ color Color.chestnutRose
"margin-bottom" -: "3vh"
ul ? do
@@ -46,7 +46,7 @@ global = do
"margin-bottom" -: "2vh"
before & do
content (stringContent "• ")
- color Color.red
+ color Color.chestnutRose
"margin-right" -: "0.3vw"
ul <? do
"margin-left" -: "3vh"
diff --git a/src/server/Design/Header.hs b/src/server/Design/Header.hs
index 94334c6..6f0f48e 100644
--- a/src/server/Design/Header.hs
+++ b/src/server/Design/Header.hs
@@ -20,7 +20,7 @@ design = do
lineHeightMedia
marginBottom blockMarginBottom
position relative
- backgroundColor Color.red
+ backgroundColor Color.chestnutRose
color Color.white
".title" <> ".item" ? headerPadding
@@ -38,11 +38,11 @@ design = do
".item" ? do
display inlineBlock
transition "background-color" (ms 50) easeIn (sec 0)
- ".current" & backgroundColor (Color.red -. 20)
+ ".current" & backgroundColor (Color.chestnutRose -. 20)
Media.mobile $ fontSize (px 13)
- (".item" # hover) <> (".item" # focus) ? backgroundColor (Color.red +. 10)
- (".item.current" # hover) <> (".item.current" # focus) ? backgroundColor (Color.red -. 10)
+ (".item" # hover) <> (".item" # focus) ? backgroundColor (Color.chestnutRose +. 10)
+ (".item.current" # hover) <> (".item.current" # focus) ? backgroundColor (Color.chestnutRose -. 10)
".nameSignOut" ? do
display flex
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index 2f0aceb..766fbdb 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -58,8 +58,8 @@ defaultInput h = do
height (px h)
padding (px 10) (px 10) (px 10) (px 10)
borderRadius radius radius radius radius
- border solid (px 1) Color.mountainMist
- focus & borderColor Color.pumice
+ border solid (px 1) Color.dustyGray
+ focus & borderColor Color.silver
verticalAlign middle
centeredWithMargin :: Css
diff --git a/src/server/Design/LoggedIn/Home/Add.hs b/src/server/Design/LoggedIn/Home/Add.hs
index 1a8b499..f4e001f 100644
--- a/src/server/Design/LoggedIn/Home/Add.hs
+++ b/src/server/Design/LoggedIn/Home/Add.hs
@@ -28,7 +28,7 @@ design = do
display inlineBlock
width (px 50)
textAlign (alignSide sideCenter)
- backgroundColor Color.mountainMist
+ backgroundColor Color.dustyGray
color Color.white
height (px inputHeight)
lineHeight (px inputHeight)
@@ -40,10 +40,10 @@ design = do
defaultInput inputHeight
borderRadius radius (px 0) (px 0) radius
"width" -: "calc(100% - 40px)"
- "input:focus + label" ? backgroundColor Color.pumice
+ "input:focus + label" ? backgroundColor Color.silver
hover & do
- input ? borderColor Color.pumice
- label ? backgroundColor Color.pumice
+ input ? borderColor Color.silver
+ label ? backgroundColor Color.silver
".name" ? minWidth (px 150)
@@ -52,36 +52,36 @@ design = do
marginRight (pct blockPercentMargin)
(".punctual" <> ".monthly") ? do
- defaultButton Color.mercury Color.mountainMist (px $ inputHeight `Prelude.div` 2) focusLighten
+ defaultButton Color.wildSand Color.dustyGray (px $ inputHeight `Prelude.div` 2) focusLighten
paddingLeft (px 15)
paddingRight (px 15)
".selected" & do
- backgroundColor Color.blue
+ backgroundColor Color.gothic
color Color.white
hover & (".punctual" <> ".monthly") ?
- ".selected" & backgroundColor (focusLighten Color.blue)
+ ".selected" & backgroundColor (focusLighten Color.gothic)
focus & (".punctual" <> ".monthly") ?
- ".selected" & backgroundColor (focusLighten Color.blue)
+ ".selected" & backgroundColor (focusLighten Color.gothic)
".punctual" ? borderRadius radius radius 0 0
".monthly" ? borderRadius 0 0 radius radius
button # ".add" ? do
- defaultButton Color.red Color.white (px inputHeight) focusLighten
+ defaultButton Color.chestnutRose Color.white (px inputHeight) focusLighten
paddingLeft (px 15)
paddingRight (px 15)
i ? marginLeft (px 10)
".waitingServer" & ("cursor" -: "not-allowed")
".name.error" <> ".cost.error" ? do
- input ? borderColor Color.redError
- label ? backgroundColor Color.redError
- "input:focus + label" ? backgroundColor Color.redError
+ input ? borderColor Color.chestnutRose
+ label ? backgroundColor Color.chestnutRose
+ "input:focus + label" ? backgroundColor Color.chestnutRose
".errorMessage" ? do
position absolute
- color Color.redError
+ color Color.chestnutRose
top (px (inputHeight + 10))
left (px 0)
diff --git a/src/server/Design/LoggedIn/Home/Expandables.hs b/src/server/Design/LoggedIn/Home/Expandables.hs
index dc36392..635a4a7 100644
--- a/src/server/Design/LoggedIn/Home/Expandables.hs
+++ b/src/server/Design/LoggedIn/Home/Expandables.hs
@@ -18,10 +18,10 @@ design = do
right blockPadding
bottom (px 2)
- ".monthlyPayments" ? expandBlock Color.blue Color.white (px inputHeight)
+ ".monthlyPayments" ? expandBlock Color.gothic Color.white (px inputHeight)
".account" ? do
- expandBlock Color.green Color.white (px inputHeight)
+ expandBlock Color.mossGreen Color.white (px inputHeight)
".userName" ? marginRight (px 10)
".detail" |> ".header" ? borderRadius radius radius 0 0
diff --git a/src/server/Design/LoggedIn/Home/Pages.hs b/src/server/Design/LoggedIn/Home/Pages.hs
index f95a925..1d5899f 100644
--- a/src/server/Design/LoggedIn/Home/Pages.hs
+++ b/src/server/Design/LoggedIn/Home/Pages.hs
@@ -17,9 +17,9 @@ design = do
clearFix
".page" ? do
- defaultButton Color.white Color.mountainMist (px 50) focusDarken
+ defaultButton Color.white Color.dustyGray (px 50) focusDarken
display inlineBlock
- border solid (px 2) Color.mountainMist
+ border solid (px 2) Color.dustyGray
marginRight (px 10)
paddingLeft (px 10)
paddingRight (px 10)
@@ -28,5 +28,5 @@ design = do
":not(.current)" & cursor pointer
".current" & do
- borderColor Color.red
- color Color.red
+ borderColor Color.chestnutRose
+ color Color.chestnutRose
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs
index e7a00d1..d13ab85 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/LoggedIn/Home/Table.hs
@@ -26,7 +26,7 @@ design = do
".header" ? do
fontWeight bold
- backgroundColor Color.blue
+ backgroundColor Color.gothic
color Color.white
fontSize iconFontSize
lineHeight headerHeight
@@ -46,7 +46,7 @@ design = do
width (px borderW)
height (px rowHeightPx)
- backgroundColor Color.green
+ backgroundColor Color.mossGreen
".cell:first-child::after" ? do
display block
@@ -59,12 +59,12 @@ design = do
height (px 0)
borderTop solid (px triangleH) transparent
borderBottom solid (px triangleH) transparent
- borderLeft solid (px triangleW) Color.green
+ borderLeft solid (px triangleW) Color.mossGreen
nthChild "odd" & do
- backgroundColor Color.mercury
+ backgroundColor Color.wildSand
".edition" & do
- backgroundColor Color.paymentFocus
+ backgroundColor Color.negroni
".delete" |> button ? visibility visible
".cell" ? do
@@ -73,7 +73,7 @@ design = do
".category" & width (pct 40)
".cost" & do
width (pct 17)
- ".refund" & color Color.green
+ ".refund" & color Color.mossGreen
".user" & width (pct 20)
".date" & do
width (pct 20)
@@ -88,7 +88,7 @@ design = do
width (pct 3)
textAlign (alignSide sideCenter)
button ? do
- defaultButton Color.red Color.white (px rowHeightPx) focusLighten
+ defaultButton Color.chestnutRose Color.white (px rowHeightPx) focusLighten
borderRadius (px 0) (px 0) (px 0) (px 0)
position absolute
top (px 0)
diff --git a/src/server/Design/SignIn.hs b/src/server/Design/SignIn.hs
index 479008a..2856016 100644
--- a/src/server/Design/SignIn.hs
+++ b/src/server/Design/SignIn.hs
@@ -27,7 +27,7 @@ design = do
marginBottom (px 10)
button ? do
- iconButton Color.blue Color.white (px inputHeight) focusLighten
+ iconButton Color.gothic Color.white (px inputHeight) focusLighten
display block
width (pct 100)
fontSize (em 1.2)
@@ -36,5 +36,5 @@ design = do
".result" ? do
marginTop (px 40)
textAlign (alignSide sideCenter)
- ".success" ? color Color.green
- ".error" ? color Color.redError
+ ".success" ? color Color.mossGreen
+ ".error" ? color Color.chestnutRose
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 0642288..5524ba7 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -22,7 +22,6 @@ import Controller.Income
import Model.Database (runMigrations)
import Model.Frequency
-import Conf (Conf)
import qualified Conf
main :: IO ()
@@ -38,9 +37,7 @@ main = do
middleware $
staticPolicy (noDots >-> addBase "public")
- api conf
-
- notFound $
+ get "/" $
( do
signInToken <- param "signInToken" :: ActionM Text
status ok200
@@ -50,45 +47,41 @@ main = do
getIndex conf Nothing
)
-api :: Conf -> ScottyM ()
-api conf = do
- -- Sign
-
- post "/api/signIn" $ do
- email <- param "email" :: ActionM Text
- signIn conf email
+ post "/signIn" $ do
+ email <- param "email" :: ActionM Text
+ signIn conf email
- post "/api/signOut" (signOut conf)
+ post "/signOut" (signOut conf)
- -- Users
+ -- Users
- get "/api/users" getUsers
+ get "/users" getUsers
- get "/api/whoAmI" whoAmI
+ get "/whoAmI" whoAmI
- -- Incomes
+ -- Incomes
- get "/api/incomes" getIncomes
+ get "/incomes" getIncomes
- post "/api/income" $ do
- creation <- param "creation" :: ActionM Int
- amount <- param "amount" :: ActionM Int
- addIncome (posixSecondsToUTCTime $ (fromIntegral creation) / 1000) amount
+ post "/income" $ do
+ creation <- param "creation" :: ActionM Int
+ amount <- param "amount" :: ActionM Int
+ addIncome (posixSecondsToUTCTime $ (fromIntegral creation) / 1000) amount
- delete "/api/income/delete" $ do
- incomeId <- param "id" :: ActionM Text
- deleteOwnIncome incomeId
+ delete "/income" $ do
+ incomeId <- param "id" :: ActionM Text
+ deleteOwnIncome incomeId
- -- Payments
+ -- Payments
- get "/api/payments" getPayments
+ get "/payments" getPayments
- post "/api/payment/add" $ do
- name <- param "name" :: ActionM Text
- cost <- param "cost" :: ActionM Text
- frequency <- param "frequency" :: ActionM Frequency
- createPayment name cost frequency
+ post "/payment/add" $ do
+ name <- param "name" :: ActionM Text
+ cost <- param "cost" :: ActionM Text
+ frequency <- param "frequency" :: ActionM Frequency
+ createPayment name cost frequency
- post "/api/payment/delete" $ do
- paymentId <- param "id" :: ActionM Text
- deleteOwnPayment paymentId
+ delete "/payment" $ do
+ paymentId <- param "id" :: ActionM Text
+ deleteOwnPayment paymentId
diff --git a/src/server/View/Page.hs b/src/server/View/Page.hs
index 33e32f7..17c59c0 100644
--- a/src/server/View/Page.hs
+++ b/src/server/View/Page.hs
@@ -31,9 +31,9 @@ page conf initResult =
meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0"
H.title (toHtml $ getMessage SharedCost)
script ! src "javascripts/client.js" $ ""
- jsonScript "messages" getTranslations
+ jsonScript "translations" getTranslations
jsonScript "conf" conf
- jsonScript "initResult" initResult
+ jsonScript "result" initResult
link ! rel "stylesheet" ! type_ "text/css" ! href "css/reset.css"
link ! rel "stylesheet" ! href "css/font-awesome-4.5.0/css/font-awesome.min.css"
link ! rel "icon" ! type_ "image/png" ! href "images/icon.png"