diff options
-rw-r--r-- | src/client/Main.elm | 39 | ||||
-rw-r--r-- | src/client/Model.elm | 17 | ||||
-rw-r--r-- | src/client/Model/Payment.elm | 31 | ||||
-rw-r--r-- | src/client/Update.elm | 23 | ||||
-rw-r--r-- | src/client/View/Page.elm | 44 | ||||
-rw-r--r-- | src/server/Design/Global.hs | 10 |
6 files changed, 136 insertions, 28 deletions
diff --git a/src/client/Main.elm b/src/client/Main.elm index dd87b8c..18a4aba 100644 --- a/src/client/Main.elm +++ b/src/client/Main.elm @@ -7,37 +7,26 @@ import Graphics.Element exposing (..) import Html exposing (Html) import Http -import Json.Decode as Json exposing ((:=)) import Task exposing (..) -import Date exposing (..) -import View.Page exposing (renderPage) +import Model exposing (Model, initialModel) +import Model.Payment exposing (Payments, paymentsDecoder) -main : Html -main = renderPage +import Update exposing (Action(..), actions, updateModel) -getPayments : Task Http.Error (List Payment) -getPayments = Http.get paymentsDecoder "/payments" +import View.Page exposing (renderPage) -type alias Payments = List Payment +main : Signal Html +main = Signal.map renderPage model -type alias Payment = - { creation : Date - , name : String - , cost : Int - , userName : String - } +model : Signal Model +model = Signal.foldp updateModel initialModel actions.signal -paymentsDecoder : Json.Decoder Payments -paymentsDecoder = Json.list paymentDecoder +port fetchPayments : Task Http.Error () +port fetchPayments = getPayments `Task.andThen` report -paymentDecoder : Json.Decoder Payment -paymentDecoder = - Json.object4 Payment - ("creation" := dateDecoder) - ("name" := Json.string) - ("cost" := Json.int) - ("userName" := Json.string) +report : Payments -> Task x () +report payments = Signal.send actions.address (UpdatePayments payments) -dateDecoder : Json.Decoder Date -dateDecoder = Json.customDecoder Json.string Date.fromString +getPayments : Task Http.Error Payments +getPayments = Http.get paymentsDecoder "/payments" diff --git a/src/client/Model.elm b/src/client/Model.elm new file mode 100644 index 0000000..50d0c06 --- /dev/null +++ b/src/client/Model.elm @@ -0,0 +1,17 @@ +module Model + ( Model + , initialModel + ) where + +import List + +import Model.Payment exposing (Payments) + +type alias Model = + { payments : Payments + } + +initialModel : Model +initialModel = + { payments = [] + } diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm new file mode 100644 index 0000000..4a08027 --- /dev/null +++ b/src/client/Model/Payment.elm @@ -0,0 +1,31 @@ +module Model.Payment + ( Payments + , Payment + , paymentsDecoder + ) where + +import Date exposing (..) +import Json.Decode as Json exposing ((:=)) + +type alias Payments = List Payment + +type alias Payment = + { creation : Date + , name : String + , cost : Int + , userName : String + } + +paymentsDecoder : Json.Decoder Payments +paymentsDecoder = Json.list paymentDecoder + +paymentDecoder : Json.Decoder Payment +paymentDecoder = + Json.object4 Payment + ("creation" := dateDecoder) + ("name" := Json.string) + ("cost" := Json.int) + ("userName" := Json.string) + +dateDecoder : Json.Decoder Date +dateDecoder = Json.customDecoder Json.string Date.fromString diff --git a/src/client/Update.elm b/src/client/Update.elm new file mode 100644 index 0000000..6eedb7f --- /dev/null +++ b/src/client/Update.elm @@ -0,0 +1,23 @@ +module Update + ( Action(..) + , actions + , updateModel + ) where + +import Model exposing (Model) +import Model.Payment exposing (Payments) + +type Action = + NoOp + | UpdatePayments Payments + +actions : Signal.Mailbox Action +actions = Signal.mailbox NoOp + +updateModel : Action -> Model -> Model +updateModel action model = + case action of + NoOp -> + model + UpdatePayments payments -> + { model | payments <- payments } diff --git a/src/client/View/Page.elm b/src/client/View/Page.elm index 47e0c1c..ca8efc9 100644 --- a/src/client/View/Page.elm +++ b/src/client/View/Page.elm @@ -8,11 +8,51 @@ import Html.Attributes exposing (..) import Html.Attributes as A import Html.Events exposing (..) -renderPage : Html -renderPage = +import Date +import Date exposing (Date) + +import String exposing (append) + +import Model exposing (Model) +import Model.Payment exposing (Payments, Payment) + +renderPage : Model -> Html +renderPage model = header [] [ h1 [] [ text "Payments" ] + , table + [] + ([ tr + [] + [ td [] [ text "Utilisateur" ] + , td [] [ text "Nom" ] + , td [] [ text "Prix" ] + , td [] [ text "Date" ] + ] + ] ++ (List.map renderPayment model.payments)) ] + +renderPayments : Payments -> List Html +renderPayments = + List.map renderPayment + << List.reverse + << List.sortBy (Date.toTime << .creation) + +renderPayment : Payment -> Html +renderPayment payment = + tr + [] + [ td [] [ text payment.name ] + , td [] [ text payment.userName ] + , td [] [ text (toString payment.cost) ] + , td [] [ text (renderDate payment.creation) ] + ] + +renderDate : Date -> String +renderDate date = + toString (Date.day date) + |> flip append (" " ++ (toString (Date.month date))) + |> flip append (" " ++ (toString (Date.year date))) diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs index cc16e2e..3408b22 100644 --- a/src/server/Design/Global.hs +++ b/src/server/Design/Global.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Design.Global ( globalDesign ) where @@ -12,10 +14,16 @@ globalDesign :: Text globalDesign = renderWith compact [] global global :: Css -global = +global = do + header ? h1 ? do fontSize (px 40) textAlign (alignSide sideCenter) margin (px 30) (px 0) (px 30) (px 0) color C.brown + + table ? do + width (pct 50) + textAlign (alignSide (sideCenter)) + "border-spacing" -: "10 px" |