diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/client/Main.elm | 12 | ||||
| -rw-r--r-- | src/client/Model.elm | 6 | ||||
| -rw-r--r-- | src/client/Update.elm | 5 | ||||
| -rw-r--r-- | src/client/View/Page.elm | 62 | ||||
| -rw-r--r-- | src/server/Application.hs | 13 | ||||
| -rw-r--r-- | src/server/View/Page.hs | 1 |
6 files changed, 68 insertions, 31 deletions
diff --git a/src/client/Main.elm b/src/client/Main.elm index e112144..bff5f23 100644 --- a/src/client/Main.elm +++ b/src/client/Main.elm @@ -27,10 +27,16 @@ model : Signal Model model = Signal.foldp updateModel initialModel actions.signal port fetchPayments : Task Http.Error () -port fetchPayments = getPayments `Task.andThen` report +port fetchPayments = + getPayments + |> flip Task.andThen reportSuccess + |> flip Task.onError reportError -report : Payments -> Task x () -report payments = Signal.send actions.address (UpdatePayments payments) +reportSuccess : Payments -> Task x () +reportSuccess payments = Signal.send actions.address (UpdatePayments payments) + +reportError : Http.Error -> Task x () +reportError error = Signal.send actions.address Forbidden getPayments : Task Http.Error Payments getPayments = Http.get paymentsDecoder "/payments" diff --git a/src/client/Model.elm b/src/client/Model.elm index 50d0c06..6888676 100644 --- a/src/client/Model.elm +++ b/src/client/Model.elm @@ -8,10 +8,12 @@ import List import Model.Payment exposing (Payments) type alias Model = - { payments : Payments + { payments : Maybe Payments + , forbiddenAccess : Bool } initialModel : Model initialModel = - { payments = [] + { payments = Nothing + , forbiddenAccess = False } diff --git a/src/client/Update.elm b/src/client/Update.elm index 6eedb7f..b96d899 100644 --- a/src/client/Update.elm +++ b/src/client/Update.elm @@ -9,6 +9,7 @@ import Model.Payment exposing (Payments) type Action = NoOp + | Forbidden | UpdatePayments Payments actions : Signal.Mailbox Action @@ -19,5 +20,7 @@ updateModel action model = case action of NoOp -> model + Forbidden -> + { model | forbiddenAccess <- True } UpdatePayments payments -> - { model | payments <- payments } + { model | payments <- Just payments } diff --git a/src/client/View/Page.elm b/src/client/View/Page.elm index 73afed9..777655c 100644 --- a/src/client/View/Page.elm +++ b/src/client/View/Page.elm @@ -18,31 +18,59 @@ import Model.Payment exposing (Payments, Payment) renderPage : Model -> Html renderPage model = + div + [] + [ renderHeader + , renderMain model + ] + +renderHeader : Html +renderHeader = header [] [ h1 [] [ text "Payments" ] - , table - [] - ([ tr - [] - [ th [] [ text "Utilisateur" ] - , th [] [ text "Nom" ] - , th [] [ text "Prix" ] - , th [] [ text "Date" ] - ] - ] ++ (List.map renderPayment model.payments)) ] -renderPayments : Payments -> List Html -renderPayments = - List.map renderPayment - << List.reverse - << List.sortBy (Date.toTime << .creation) +renderMain : Model -> Html +renderMain model = + if model.forbiddenAccess + then + forbiddenAccess + else + model.payments + |> Maybe.map paymentTable + |> Maybe.withDefault loadingTable + +forbiddenAccess : Html +forbiddenAccess = text "Forbidden access" + +loadingTable : Html +loadingTable = text "" + +paymentTable : Payments -> Html +paymentTable payments = + table + [] + ([ tr + [] + [ th [] [ text "Utilisateur" ] + , th [] [ text "Nom" ] + , th [] [ text "Prix" ] + , th [] [ text "Date" ] + ] + ] ++ (paymentLines payments)) + +paymentLines : Payments -> List Html +paymentLines payments = + payments + |> List.sortBy (Date.toTime << .creation) + |> List.reverse + |> List.map paymentLine -renderPayment : Payment -> Html -renderPayment payment = +paymentLine : Payment -> Html +paymentLine payment = tr [] [ td [] [ text payment.name ] diff --git a/src/server/Application.hs b/src/server/Application.hs index b83273f..e480533 100644 --- a/src/server/Application.hs +++ b/src/server/Application.hs @@ -37,10 +37,7 @@ import Model.Payment import View.Page (page) getIndexAction :: ActionM () -getIndexAction = - Secure.loggedAction (\_ -> - html $ page - ) +getIndexAction = html page getUsersAction :: ActionM () getUsersAction = do @@ -48,9 +45,11 @@ getUsersAction = do html . fromString . show $ users getPaymentsAction :: ActionM () -getPaymentsAction = do - payments <- liftIO $ runDb getPayments - json payments +getPaymentsAction = + Secure.loggedAction (\_ -> do + payments <- liftIO $ runDb getPayments + json payments + ) addUserAction :: Text -> Text -> ActionM () addUserAction email name = do diff --git a/src/server/View/Page.hs b/src/server/View/Page.hs index aa4df72..3f4dbf5 100644 --- a/src/server/View/Page.hs +++ b/src/server/View/Page.hs @@ -23,7 +23,6 @@ page = script ! src "/javascripts/client.js" $ "" link ! rel "stylesheet" ! type_ "text/css" ! href "/css/reset.css" link ! rel "stylesheet" ! href "/css/font-awesome/css/font-awesome.min.css" - link ! rel "stylesheet" ! type_ "text/css" ! href "/css/global.css" link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png" H.style $ toHtml globalDesign body $ |