diff options
Diffstat (limited to 'services/gemma/frontend/Main.elm')
| -rw-r--r-- | services/gemma/frontend/Main.elm | 221 |
1 files changed, 0 insertions, 221 deletions
diff --git a/services/gemma/frontend/Main.elm b/services/gemma/frontend/Main.elm deleted file mode 100644 index e449908e499c..000000000000 --- a/services/gemma/frontend/Main.elm +++ /dev/null @@ -1,221 +0,0 @@ --- 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 - } |