This moves the various projects from "type-based" folders (such as "services" or "tools") into more appropriate semantic folders (such as "nix", "ops" or "web"). Deprecated projects (nixcon-demo & gotest) which only existed for testing/demonstration purposes have been removed. (Note: *all* builds are broken with this commit)
		
			
				
	
	
		
			221 lines
		
	
	
	
		
			4.6 KiB
		
	
	
	
		
			Elm
		
	
	
	
	
	
			
		
		
	
	
			221 lines
		
	
	
	
		
			4.6 KiB
		
	
	
	
		
			Elm
		
	
	
	
	
	
-- 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
 | 
						|
            }
 |