chore: Significantly restructure folder layout
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)
This commit is contained in:
parent
e52eed3cd4
commit
03bfe08e1d
110 changed files with 1 additions and 998 deletions
221
fun/gemma/frontend/Main.elm
Normal file
221
fun/gemma/frontend/Main.elm
Normal file
|
@ -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
|
||||
}
|
Loading…
Add table
Add a link
Reference in a new issue