diff options
Diffstat (limited to 'src')
| -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" | 
