diff options
Diffstat (limited to 'src/client/elm')
66 files changed, 568 insertions, 632 deletions
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 = |