1 files changed, 221 insertions, 0 deletions
diff --git a/fun/gemma/frontend/Main.elm b/fun/gemma/frontend/Main.elm
new file mode 100644
index 000000000000..e449908e499c
--- /dev/null
+++ b/fun/gemma/frontend/Main.elm
@@ -0,0 +1,221 @@
+-- Copyright (C) 2016-2017  Vincent Ambo <mail@tazj.in>
+--
+-- This file is part of Gemma.
+--
+-- Gemma is free software: you can redistribute it and/or modify it
+-- under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+
+
+module Main exposing (..)
+
+import Html exposing (Html, text, div, span)
+import Html.Attributes exposing (style)
+import Json.Decode exposing (..)
+import Http
+import Time
+
+
+--  Material design imports
+
+import Material
+import Material.Card as Card
+import Material.Color as Color
+import Material.Grid exposing (grid, cell, size, Device(..))
+import Material.Layout as Layout
+import Material.Scheme as Scheme
+import Material.Options as Options
+import Material.Elevation as Elevation
+import Material.Button as Button
+
+
+-- API interface to Gemma
+
+
+type alias Task =
+    { name : String
+    , description : Maybe String
+    , remaining : Int
+    }
+
+
+emptyStringFilter s =
+    if s == "" then
+        Nothing
+    else
+        Just s
+
+
+decodeEmptyString : Decoder (Maybe String)
+decodeEmptyString =
+    map emptyStringFilter string
+
+
+decodeTask : Decoder Task
+decodeTask =
+    map3 Task
+        (field "name" string)
+        (field "description" decodeEmptyString)
+        (field "remaining" int)
+
+
+loadTasks : Cmd Msg
+loadTasks =
+    let
+        request =
+            Http.get "/tasks" (list decodeTask)
+    in
+        Http.send NewTasks request
+
+
+completeTask : Task -> Cmd Msg
+completeTask task =
+    let
+        request =
+            Http.getString
+                (String.concat
+                    [ "/complete?task="
+                    , task.name
+                    ]
+                )
+    in
+        Http.send (\_ -> LoadTasks) request
+
+
+
+-- Elm architecture implementation
+
+
+type Msg
+    = None
+    | LoadTasks
+    | NewTasks (Result Http.Error (List Task))
+    | Mdl (Material.Msg Msg)
+    | Complete Task
+
+
+type alias Model =
+    { tasks : List Task
+    , error : Maybe String
+    , mdl : Material.Model
+    }
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        LoadTasks ->
+            ( model, loadTasks )
+
+        Complete task ->
+            ( model, completeTask task )
+
+        NewTasks (Ok tasks) ->
+            ( { model | tasks = tasks, error = Nothing }, Cmd.none )
+
+        NewTasks (Err err) ->
+            ( { model | error = Just (toString err) }, Cmd.none )
+
+        _ ->
+            ( model, Cmd.none )
+
+
+
+-- View implementation
+
+
+white =
+    Color.text Color.white
+
+
+taskColor : Task -> Color.Hue
+taskColor task =
+    if task.remaining > 2 then
+        Color.Green
+    else if task.remaining < 0 then
+        Color.Red
+    else
+        Color.Yellow
+
+
+within : Task -> String
+within task =
+    if task.remaining < 0 then
+        "This task is overdue!"
+    else if task.remaining > 2 then
+        String.concat
+            [ "Relax, this task has "
+            , toString task.remaining
+            , " days left before it is due."
+            ]
+    else
+        String.concat
+            [ "This task should be completed within "
+            , toString task.remaining
+            , " days. Consider doing it now!"
+            ]
+
+
+renderTask : Model -> Task -> Html Msg
+renderTask model task =
+    Card.view
+        [ Color.background (Color.color (taskColor task) Color.S800)
+        , Elevation.e3
+        ]
+        [ Card.title [] [ Card.head [ white ] [ text task.name ] ]
+        , Card.text [ white ]
+            [ text (Maybe.withDefault "" task.description)
+            , Html.br [] []
+            , text (within task)
+            ]
+        , Card.actions
+            [ Card.border ]
+            [ Button.render Mdl
+                [ 0 ]
+                model.mdl
+                [ white, Button.ripple, Button.accent, Options.onClick (Complete task) ]
+                [ text "Completed" ]
+            ]
+        ]
+
+
+gemmaView : Model -> Html Msg
+gemmaView model =
+    grid []
+        (List.map (\t -> cell [ size All 4 ] [ renderTask model t ])
+            model.tasks
+        )
+
+
+view : Model -> Html Msg
+view model =
+    gemmaView model |> Scheme.top
+
+
+
+-- subscriptions : Model -> Sub Msg
+
+
+subscriptions model =
+    Sub.batch
+        [ Material.subscriptions Mdl model
+        , Time.every (15 * Time.second) (\_ -> LoadTasks)
+        ]
+
+
+main : Program Never Model Msg
+main =
+    let
+        model =
+            { tasks = []
+            , error = Nothing
+            , mdl = Material.model
+            }
+    in
+        Html.program
+            { init = ( model, Cmd.batch [ loadTasks, Material.init Mdl ] )
+            , view = view
+            , update = update
+            , subscriptions = subscriptions
+            }