Fetching payments and showing them in a table

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"