mirror of
https://github.com/TheAnachronism/docspell.git
synced 2025-06-23 02:48:26 +00:00
Initial version.
Features: - Upload PDF files let them analyze - Manage meta data and items - See processing in webapp
This commit is contained in:
Eike Kettner
129
modules/webapp/src/main/elm/Comp/AddressForm.elm
Normal file
129
modules/webapp/src/main/elm/Comp/AddressForm.elm
Normal file
@ -0,0 +1,129 @@
|
||||
module Comp.AddressForm exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update
|
||||
, getAddress)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Address exposing (Address)
|
||||
import Comp.Dropdown
|
||||
import Util.List
|
||||
|
||||
type alias Model =
|
||||
{ address: Address
|
||||
, street: String
|
||||
, zip: String
|
||||
, city: String
|
||||
, country: Comp.Dropdown.Model Country
|
||||
}
|
||||
|
||||
type alias Country =
|
||||
{ code: String
|
||||
, label: String
|
||||
}
|
||||
|
||||
countries: List Country
|
||||
countries =
|
||||
[ Country "DE" "Germany"
|
||||
, Country "CH" "Switzerland"
|
||||
, Country "GB" "Great Britain"
|
||||
, Country "ES" "Spain"
|
||||
, Country "AU" "Austria"
|
||||
]
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ address = Api.Model.Address.empty
|
||||
, street = ""
|
||||
, zip = ""
|
||||
, city = ""
|
||||
, country = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \c -> { value = c.code, text = c.label }
|
||||
, placeholder = "Select Country"
|
||||
, options = countries
|
||||
, selected = Nothing
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
getAddress: Model -> Address
|
||||
getAddress model =
|
||||
{ street = model.street
|
||||
, zip = model.zip
|
||||
, city = model.city
|
||||
, country = Comp.Dropdown.getSelected model.country |> List.head |> Maybe.map .code |> Maybe.withDefault ""
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetStreet String
|
||||
| SetCity String
|
||||
| SetZip String
|
||||
| SetAddress Address
|
||||
| CountryMsg (Comp.Dropdown.Msg Country)
|
||||
|
||||
update: Msg -> Model -> (Model, Cmd Msg)
|
||||
update msg model =
|
||||
case msg of
|
||||
SetAddress a ->
|
||||
let
|
||||
selection = Util.List.find (\c -> c.code == a.country) countries
|
||||
|> Maybe.map List.singleton
|
||||
|> Maybe.withDefault []
|
||||
(m2, c2) = Comp.Dropdown.update (Comp.Dropdown.SetSelection selection) model.country
|
||||
in
|
||||
({model | address = a, street = a.street, city = a.city, zip = a.zip, country = m2 }, Cmd.map CountryMsg c2)
|
||||
|
||||
SetStreet n ->
|
||||
({model | street = n}, Cmd.none)
|
||||
|
||||
SetCity c ->
|
||||
({model | city = c }, Cmd.none)
|
||||
|
||||
SetZip z ->
|
||||
({model | zip = z }, Cmd.none)
|
||||
|
||||
CountryMsg m ->
|
||||
let
|
||||
(m1, c1) = Comp.Dropdown.update m model.country
|
||||
in
|
||||
({model | country = m1}, Cmd.map CountryMsg c1)
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [class "ui form"]
|
||||
[div [class "field"
|
||||
]
|
||||
[label [][text "Street"]
|
||||
,input [type_ "text"
|
||||
,onInput SetStreet
|
||||
,placeholder "Street"
|
||||
,value model.street
|
||||
][]
|
||||
]
|
||||
,div [class "field"
|
||||
]
|
||||
[label [][text "Zip Code"]
|
||||
,input [type_ "text"
|
||||
,onInput SetZip
|
||||
,placeholder "Zip"
|
||||
,value model.zip
|
||||
][]
|
||||
]
|
||||
,div [class "field"
|
||||
]
|
||||
[label [][text "City"]
|
||||
,input [type_ "text"
|
||||
,onInput SetCity
|
||||
,placeholder "City"
|
||||
,value model.city
|
||||
][]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Country"]
|
||||
,Html.map CountryMsg (Comp.Dropdown.view model.country)
|
||||
]
|
||||
]
|
||||
198
modules/webapp/src/main/elm/Comp/ChangePasswordForm.elm
Normal file
198
modules/webapp/src/main/elm/Comp/ChangePasswordForm.elm
Normal file
@ -0,0 +1,198 @@
|
||||
module Comp.ChangePasswordForm exposing (Model
|
||||
,emptyModel
|
||||
,Msg(..)
|
||||
,update
|
||||
,view
|
||||
)
|
||||
import Http
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput, onClick)
|
||||
|
||||
import Api
|
||||
import Api.Model.PasswordChange exposing (PasswordChange)
|
||||
import Util.Http
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Data.Flags exposing (Flags)
|
||||
|
||||
type alias Model =
|
||||
{ current: String
|
||||
, newPass1: String
|
||||
, newPass2: String
|
||||
, showCurrent: Bool
|
||||
, showPass1: Bool
|
||||
, showPass2: Bool
|
||||
, errors: List String
|
||||
, loading: Bool
|
||||
, successMsg: String
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
validateModel
|
||||
{ current = ""
|
||||
, newPass1 = ""
|
||||
, newPass2 = ""
|
||||
, showCurrent = False
|
||||
, showPass1 = False
|
||||
, showPass2 = False
|
||||
, errors = []
|
||||
, loading = False
|
||||
, successMsg = ""
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetCurrent String
|
||||
| SetNew1 String
|
||||
| SetNew2 String
|
||||
| ToggleShowPass1
|
||||
| ToggleShowPass2
|
||||
| ToggleShowCurrent
|
||||
| Submit
|
||||
| SubmitResp (Result Http.Error BasicResult)
|
||||
|
||||
|
||||
validate: Model -> List String
|
||||
validate model =
|
||||
List.concat
|
||||
[ if model.newPass1 /= "" && model.newPass2 /= "" && model.newPass1 /= model.newPass2
|
||||
then ["New passwords do not match."]
|
||||
else []
|
||||
, if model.newPass1 == "" || model.newPass2 == "" || model.current == ""
|
||||
then ["Please fill in required fields."]
|
||||
else []
|
||||
]
|
||||
|
||||
validateModel: Model -> Model
|
||||
validateModel model =
|
||||
let
|
||||
err = validate model
|
||||
in
|
||||
{model | errors = err, successMsg = if err == [] then model.successMsg else "" }
|
||||
|
||||
-- Update
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetCurrent s ->
|
||||
(validateModel {model | current = s}, Cmd.none)
|
||||
|
||||
SetNew1 s ->
|
||||
(validateModel {model | newPass1 = s}, Cmd.none)
|
||||
|
||||
SetNew2 s ->
|
||||
(validateModel {model | newPass2 = s}, Cmd.none)
|
||||
|
||||
ToggleShowCurrent ->
|
||||
({model | showCurrent = not model.showCurrent}, Cmd.none)
|
||||
|
||||
ToggleShowPass1 ->
|
||||
({model | showPass1 = not model.showPass1}, Cmd.none)
|
||||
|
||||
ToggleShowPass2 ->
|
||||
({model | showPass2 = not model.showPass2}, Cmd.none)
|
||||
|
||||
|
||||
Submit ->
|
||||
let
|
||||
valid = validate model
|
||||
cp = PasswordChange model.current model.newPass1
|
||||
in
|
||||
if List.isEmpty valid then
|
||||
({model | loading = True, errors = [], successMsg = ""}, Api.changePassword flags cp SubmitResp)
|
||||
else
|
||||
(model, Cmd.none)
|
||||
|
||||
SubmitResp (Ok res) ->
|
||||
let
|
||||
em = { emptyModel | errors = [], successMsg = "Password has been changed."}
|
||||
in
|
||||
if res.success then
|
||||
(em, Cmd.none)
|
||||
else
|
||||
({model | errors = [res.message], loading = False, successMsg = ""}, Cmd.none)
|
||||
|
||||
SubmitResp (Err err) ->
|
||||
let
|
||||
str = Util.Http.errorToString err
|
||||
in
|
||||
({model | errors = [str], loading = False, successMsg = ""}, Cmd.none)
|
||||
|
||||
|
||||
-- View
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [classList [("ui form", True)
|
||||
,("error", List.isEmpty model.errors |> not)
|
||||
,("success", model.successMsg /= "")
|
||||
]
|
||||
]
|
||||
[div [classList [("field", True)
|
||||
,("error", model.current == "")
|
||||
]
|
||||
]
|
||||
[label [][text "Current Password*"]
|
||||
,div [class "ui action input"]
|
||||
[input [type_ <| if model.showCurrent then "text" else "password"
|
||||
,onInput SetCurrent
|
||||
,value model.current
|
||||
][]
|
||||
,button [class "ui icon button", onClick ToggleShowCurrent]
|
||||
[i [class "eye icon"][]
|
||||
]
|
||||
]
|
||||
]
|
||||
,div [classList [("field", True)
|
||||
,("error", model.newPass1 == "")
|
||||
]
|
||||
]
|
||||
[label [][text "New Password*"]
|
||||
,div [class "ui action input"]
|
||||
[input [type_ <| if model.showPass1 then "text" else "password"
|
||||
,onInput SetNew1
|
||||
,value model.newPass1
|
||||
][]
|
||||
,button [class "ui icon button", onClick ToggleShowPass1]
|
||||
[i [class "eye icon"][]
|
||||
]
|
||||
]
|
||||
]
|
||||
,div [classList [("field", True)
|
||||
,("error", model.newPass2 == "")
|
||||
]
|
||||
]
|
||||
[label [][text "New Password (repeat)*"]
|
||||
,div [class "ui action input"]
|
||||
[input [type_ <| if model.showPass2 then "text" else "password"
|
||||
,onInput SetNew2
|
||||
,value model.newPass2
|
||||
][]
|
||||
,button [class "ui icon button", onClick ToggleShowPass2]
|
||||
[i [class "eye icon"][]
|
||||
]
|
||||
]
|
||||
]
|
||||
,div [class "ui horizontal divider"][]
|
||||
,div [class "ui success message"]
|
||||
[text model.successMsg
|
||||
]
|
||||
,div [class "ui error message"]
|
||||
[case model.errors of
|
||||
a :: [] ->
|
||||
text a
|
||||
_ ->
|
||||
ul [class "ui list"]
|
||||
(List.map (\em -> li[][text em]) model.errors)
|
||||
]
|
||||
,div [class "ui horizontal divider"][]
|
||||
,button [class "ui primary button", onClick Submit]
|
||||
[text "Submit"
|
||||
]
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
124
modules/webapp/src/main/elm/Comp/ContactField.elm
Normal file
124
modules/webapp/src/main/elm/Comp/ContactField.elm
Normal file
@ -0,0 +1,124 @@
|
||||
module Comp.ContactField exposing (Model
|
||||
,emptyModel
|
||||
,getContacts
|
||||
,Msg(..)
|
||||
,update
|
||||
,view
|
||||
)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput, onClick)
|
||||
import Api.Model.Contact exposing (Contact)
|
||||
import Data.ContactType exposing (ContactType)
|
||||
import Comp.Dropdown
|
||||
|
||||
type alias Model =
|
||||
{ items: List Contact
|
||||
, kind: Comp.Dropdown.Model ContactType
|
||||
, value: String
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ items = []
|
||||
, kind = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \ct -> { value = Data.ContactType.toString ct, text = Data.ContactType.toString ct }
|
||||
, placeholder = ""
|
||||
, options = Data.ContactType.all
|
||||
, selected = List.head Data.ContactType.all
|
||||
}
|
||||
, value = ""
|
||||
}
|
||||
|
||||
makeModel: List Contact -> Model
|
||||
makeModel contacts =
|
||||
let
|
||||
em = emptyModel
|
||||
in
|
||||
{ em | items = contacts }
|
||||
|
||||
getContacts: Model -> List Contact
|
||||
getContacts model =
|
||||
List.filter (\c -> c.value /= "") model.items
|
||||
|
||||
type Msg
|
||||
= SetValue String
|
||||
| TypeMsg (Comp.Dropdown.Msg ContactType)
|
||||
| AddContact
|
||||
| Select Contact
|
||||
| SetItems (List Contact)
|
||||
|
||||
update: Msg -> Model -> (Model, Cmd Msg)
|
||||
update msg model =
|
||||
case msg of
|
||||
SetItems contacts ->
|
||||
({model | items = contacts, value = "" }, Cmd.none)
|
||||
|
||||
SetValue v ->
|
||||
({model | value = v}, Cmd.none)
|
||||
|
||||
TypeMsg m ->
|
||||
let
|
||||
(m1, c1) = Comp.Dropdown.update m model.kind
|
||||
in
|
||||
({model|kind = m1}, Cmd.map TypeMsg c1)
|
||||
|
||||
AddContact ->
|
||||
if model.value == "" then (model, Cmd.none)
|
||||
else
|
||||
let
|
||||
kind = Comp.Dropdown.getSelected model.kind
|
||||
|> List.head
|
||||
|> Maybe.map Data.ContactType.toString
|
||||
|> Maybe.withDefault ""
|
||||
in
|
||||
({model| items = (Contact "" model.value kind) :: model.items, value = ""}, Cmd.none)
|
||||
|
||||
Select contact ->
|
||||
let
|
||||
newItems = List.filter (\c -> c /= contact) model.items
|
||||
(m1, c1) = Data.ContactType.fromString contact.kind
|
||||
|> Maybe.map (\ct -> update (TypeMsg (Comp.Dropdown.SetSelection [ct])) model)
|
||||
|> Maybe.withDefault (model, Cmd.none)
|
||||
in
|
||||
({m1 | value = contact.value, items = newItems}, c1)
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div []
|
||||
[div [class "fields"]
|
||||
[div [class "four wide field"]
|
||||
[Html.map TypeMsg (Comp.Dropdown.view model.kind)
|
||||
]
|
||||
,div [class "twelve wide field"]
|
||||
[div [class "ui action input"]
|
||||
[input [type_ "text"
|
||||
,onInput SetValue
|
||||
,value model.value
|
||||
][]
|
||||
,a [class "ui button", onClick AddContact, href ""]
|
||||
[text "Add"
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
,div [classList [("field", True)
|
||||
,("invisible", List.isEmpty model.items)
|
||||
]
|
||||
]
|
||||
[div [class "ui vertical secondary fluid menu"]
|
||||
(List.map (renderItem model) model.items)
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
renderItem: Model -> Contact -> Html Msg
|
||||
renderItem model contact =
|
||||
div [class "link item", onClick (Select contact) ]
|
||||
[i [class "delete icon"][]
|
||||
,div [class "ui blue label"]
|
||||
[text contact.kind
|
||||
]
|
||||
,text contact.value
|
||||
]
|
||||
65
modules/webapp/src/main/elm/Comp/DatePicker.elm
Normal file
65
modules/webapp/src/main/elm/Comp/DatePicker.elm
Normal file
@ -0,0 +1,65 @@
|
||||
module Comp.DatePicker exposing (..)
|
||||
|
||||
import Html exposing (Html)
|
||||
import DatePicker exposing (DatePicker, DateEvent, Settings)
|
||||
import Date exposing (Date)
|
||||
import Time exposing (Posix, Zone, utc, Month(..))
|
||||
|
||||
type alias Msg = DatePicker.Msg
|
||||
|
||||
init: (DatePicker, Cmd Msg)
|
||||
init =
|
||||
DatePicker.init
|
||||
|
||||
emptyModel: DatePicker
|
||||
emptyModel =
|
||||
DatePicker.initFromDate (Date.fromCalendarDate 2019 Aug 21)
|
||||
|
||||
defaultSettings: Settings
|
||||
defaultSettings =
|
||||
let
|
||||
ds = DatePicker.defaultSettings
|
||||
in
|
||||
{ds | changeYear = DatePicker.from 2010}
|
||||
|
||||
update: Settings -> Msg -> DatePicker -> (DatePicker, DateEvent)
|
||||
update settings msg model =
|
||||
DatePicker.update settings msg model
|
||||
|
||||
updateDefault: Msg -> DatePicker -> (DatePicker, DateEvent)
|
||||
updateDefault msg model =
|
||||
DatePicker.update defaultSettings msg model
|
||||
|
||||
|
||||
view : Maybe Date -> Settings -> DatePicker -> Html Msg
|
||||
view md settings model =
|
||||
DatePicker.view md settings model
|
||||
|
||||
viewTime : Maybe Int -> Settings -> DatePicker -> Html Msg
|
||||
viewTime md settings model =
|
||||
let
|
||||
date = Maybe.map Time.millisToPosix md
|
||||
|> Maybe.map (Date.fromPosix Time.utc)
|
||||
in
|
||||
view date settings model
|
||||
|
||||
viewTimeDefault: Maybe Int -> DatePicker -> Html Msg
|
||||
viewTimeDefault md model =
|
||||
viewTime md defaultSettings model
|
||||
|
||||
|
||||
startOfDay: Date -> Int
|
||||
startOfDay date =
|
||||
let
|
||||
unix0 = Date.fromPosix Time.utc (Time.millisToPosix 0)
|
||||
days = Date.diff Date.Days unix0 date
|
||||
in
|
||||
days * 24 * 60 * 60 * 1000
|
||||
|
||||
endOfDay: Date -> Int
|
||||
endOfDay date =
|
||||
(startOfDay date) + ((24 * 60) - 1) * 60 * 1000
|
||||
|
||||
midOfDay: Date -> Int
|
||||
midOfDay date =
|
||||
(startOfDay date) + (12 * 60 * 60 * 1000)
|
||||
393
modules/webapp/src/main/elm/Comp/Dropdown.elm
Normal file
393
modules/webapp/src/main/elm/Comp/Dropdown.elm
Normal file
@ -0,0 +1,393 @@
|
||||
module Comp.Dropdown exposing ( Model
|
||||
, Option
|
||||
, makeModel
|
||||
, makeSingle
|
||||
, makeSingleList
|
||||
, makeMultiple
|
||||
, update
|
||||
, isDropdownChangeMsg
|
||||
, view
|
||||
, getSelected
|
||||
, Msg(..))
|
||||
|
||||
import Http
|
||||
import Task
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput, onClick, onFocus, onBlur)
|
||||
import Json.Decode as Decode
|
||||
import Simple.Fuzzy
|
||||
import Util.Html exposing (onKeyUp)
|
||||
import Util.List
|
||||
|
||||
type alias Option =
|
||||
{ value: String
|
||||
, text: String
|
||||
}
|
||||
|
||||
type alias Item a =
|
||||
{ value: a
|
||||
, option: Option
|
||||
, visible: Bool
|
||||
, selected: Bool
|
||||
, active: Bool
|
||||
}
|
||||
|
||||
makeItem: Model a -> a -> Item a
|
||||
makeItem model val =
|
||||
{ value = val
|
||||
, option = model.makeOption val
|
||||
, visible = True
|
||||
, selected = False
|
||||
, active = False
|
||||
}
|
||||
|
||||
type alias Model a =
|
||||
{ multiple: Bool
|
||||
, selected: List (Item a)
|
||||
, available: List (Item a)
|
||||
, makeOption: a -> Option
|
||||
, menuOpen: Bool
|
||||
, filterString: String
|
||||
, labelColor: a -> String
|
||||
, searchable: Int -> Bool
|
||||
, placeholder: String
|
||||
}
|
||||
|
||||
makeModel:
|
||||
{ multiple: Bool
|
||||
, searchable: Int -> Bool
|
||||
, makeOption: a -> Option
|
||||
, labelColor: a -> String
|
||||
, placeholder: String
|
||||
} -> Model a
|
||||
makeModel input =
|
||||
{ multiple = input.multiple
|
||||
, searchable = input.searchable
|
||||
, selected = []
|
||||
, available = []
|
||||
, makeOption = input.makeOption
|
||||
, menuOpen = False
|
||||
, filterString = ""
|
||||
, labelColor = input.labelColor
|
||||
, placeholder = input.placeholder
|
||||
}
|
||||
|
||||
makeSingle:
|
||||
{ makeOption: a -> Option
|
||||
, placeholder: String
|
||||
} -> Model a
|
||||
makeSingle opts =
|
||||
makeModel
|
||||
{ multiple = False
|
||||
, searchable = \n -> n > 8
|
||||
, makeOption = opts.makeOption
|
||||
, labelColor = \_ -> ""
|
||||
, placeholder = opts.placeholder
|
||||
}
|
||||
|
||||
makeSingleList:
|
||||
{ makeOption: a -> Option
|
||||
, placeholder: String
|
||||
, options: List a
|
||||
, selected: Maybe a
|
||||
} -> Model a
|
||||
makeSingleList opts =
|
||||
let
|
||||
m = makeSingle {makeOption = opts.makeOption, placeholder = opts.placeholder}
|
||||
m2 = {m | available = List.map (makeItem m) opts.options}
|
||||
m3 = Maybe.map (makeItem m2) opts.selected
|
||||
|> Maybe.map (selectItem m2)
|
||||
|> Maybe.withDefault m2
|
||||
in
|
||||
m3
|
||||
|
||||
makeMultiple:
|
||||
{ makeOption: a -> Option
|
||||
, labelColor: a -> String
|
||||
} -> Model a
|
||||
makeMultiple opts =
|
||||
makeModel
|
||||
{ multiple = True
|
||||
, searchable = \n -> n > 8
|
||||
, makeOption = opts.makeOption
|
||||
, labelColor = opts.labelColor
|
||||
, placeholder = ""
|
||||
}
|
||||
|
||||
getSelected: Model a -> List a
|
||||
getSelected model =
|
||||
List.map .value model.selected
|
||||
|
||||
type Msg a
|
||||
= SetOptions (List a)
|
||||
| SetSelection (List a)
|
||||
| ToggleMenu
|
||||
| AddItem (Item a)
|
||||
| RemoveItem (Item a)
|
||||
| Filter String
|
||||
| ShowMenu Bool
|
||||
| KeyPress Int
|
||||
|
||||
getOptions: Model a -> List (Item a)
|
||||
getOptions model =
|
||||
if not model.multiple && isSearchable model && model.menuOpen
|
||||
then List.filter .visible model.available
|
||||
else List.filter (\e -> e.visible && (not e.selected)) model.available
|
||||
|
||||
isSearchable: Model a -> Bool
|
||||
isSearchable model =
|
||||
List.length model.available |> model.searchable
|
||||
|
||||
-- Update
|
||||
|
||||
deselectItem: Model a -> Item a -> Model a
|
||||
deselectItem model item =
|
||||
let
|
||||
value = item.option.value
|
||||
sel = if model.multiple then List.filter (\e -> e.option.value /= value) model.selected
|
||||
else []
|
||||
|
||||
show e = if e.option.value == value then {e | selected = False } else e
|
||||
avail = List.map show model.available
|
||||
in
|
||||
{ model | selected = sel, available = avail }
|
||||
|
||||
selectItem: Model a -> Item a -> Model a
|
||||
selectItem model item =
|
||||
let
|
||||
value = item.option.value
|
||||
sel = if model.multiple
|
||||
then List.concat [ model.selected, [ item ] ]
|
||||
else [ item ]
|
||||
|
||||
hide e = if e.option.value == value
|
||||
then {e | selected = True }
|
||||
else if model.multiple then e else {e | selected = False}
|
||||
avail = List.map hide model.available
|
||||
in
|
||||
{ model | selected = sel, available = avail }
|
||||
|
||||
|
||||
filterOptions: String -> List (Item a) -> List (Item a)
|
||||
filterOptions str list =
|
||||
List.map (\e -> {e | visible = Simple.Fuzzy.match str e.option.text, active = False}) list
|
||||
|
||||
applyFilter: String -> Model a -> Model a
|
||||
applyFilter str model =
|
||||
{ model | filterString = str, available = filterOptions str model.available }
|
||||
|
||||
|
||||
makeNextActive: (Int -> Int) -> Model a -> Model a
|
||||
makeNextActive nextEl model =
|
||||
let
|
||||
opts = getOptions model
|
||||
current = Util.List.findIndexed .active opts
|
||||
next = Maybe.map Tuple.second current
|
||||
|> Maybe.map nextEl
|
||||
|> Maybe.andThen (Util.List.get opts)
|
||||
merge item1 item2 = { item2 | active = item1.option.value == item2.option.value }
|
||||
updateModel item = { model | available = List.map (merge item) model.available, menuOpen = True }
|
||||
in
|
||||
case next of
|
||||
Just item -> updateModel item
|
||||
Nothing ->
|
||||
case List.head opts of
|
||||
Just item -> updateModel item
|
||||
Nothing -> model
|
||||
|
||||
selectActive: Model a -> Model a
|
||||
selectActive model =
|
||||
let
|
||||
current = getOptions model |> Util.List.find .active
|
||||
in
|
||||
case current of
|
||||
Just item ->
|
||||
selectItem model item |> applyFilter ""
|
||||
Nothing ->
|
||||
model
|
||||
|
||||
clearActive: Model a -> Model a
|
||||
clearActive model =
|
||||
{ model | available = List.map (\e -> {e | active = False}) model.available }
|
||||
|
||||
|
||||
-- TODO enhance update function to return this info
|
||||
isDropdownChangeMsg: Msg a -> Bool
|
||||
isDropdownChangeMsg cm =
|
||||
case cm of
|
||||
AddItem _ -> True
|
||||
RemoveItem _ -> True
|
||||
KeyPress code ->
|
||||
Util.Html.intToKeyCode code
|
||||
|> Maybe.map (\c -> c == Util.Html.Enter)
|
||||
|> Maybe.withDefault False
|
||||
_ -> False
|
||||
|
||||
|
||||
update: Msg a -> Model a -> (Model a, Cmd (Msg a))
|
||||
update msg model =
|
||||
case msg of
|
||||
SetOptions list ->
|
||||
({model | available = List.map (makeItem model) list}, Cmd.none)
|
||||
|
||||
SetSelection list ->
|
||||
let
|
||||
m0 = List.foldl (\item -> \m -> deselectItem m item) model model.selected
|
||||
m1 = List.map (makeItem model) list
|
||||
|> List.foldl (\item -> \m -> selectItem m item) m0
|
||||
in
|
||||
(m1, Cmd.none)
|
||||
|
||||
ToggleMenu ->
|
||||
({model | menuOpen = not model.menuOpen}, Cmd.none)
|
||||
|
||||
AddItem e ->
|
||||
let
|
||||
m = selectItem model e |> applyFilter ""
|
||||
in
|
||||
({ m | menuOpen = False }, Cmd.none)
|
||||
|
||||
RemoveItem e ->
|
||||
let
|
||||
m = deselectItem model e |> applyFilter ""
|
||||
in
|
||||
({ m | menuOpen = False }, Cmd.none)
|
||||
|
||||
Filter str ->
|
||||
let
|
||||
m = applyFilter str model
|
||||
in
|
||||
({ m | menuOpen = True}, Cmd.none)
|
||||
|
||||
ShowMenu flag ->
|
||||
({ model | menuOpen = flag }, Cmd.none)
|
||||
|
||||
KeyPress code ->
|
||||
case Util.Html.intToKeyCode code of
|
||||
Just Util.Html.Up ->
|
||||
(makeNextActive (\n -> n - 1) model, Cmd.none)
|
||||
Just Util.Html.Down ->
|
||||
(makeNextActive ((+) 1) model, Cmd.none)
|
||||
Just Util.Html.Enter ->
|
||||
let
|
||||
m = selectActive model
|
||||
in
|
||||
({m | menuOpen = False }, Cmd.none)
|
||||
_ ->
|
||||
(model, Cmd.none)
|
||||
|
||||
|
||||
-- View
|
||||
|
||||
view: Model a -> Html (Msg a)
|
||||
view model =
|
||||
if model.multiple then viewMultiple model else viewSingle model
|
||||
|
||||
|
||||
viewSingle: Model a -> Html (Msg a)
|
||||
viewSingle model =
|
||||
let
|
||||
renderClosed item =
|
||||
div [class "message"
|
||||
,style "display" "inline-block !important"
|
||||
,onClick ToggleMenu
|
||||
]
|
||||
[i [class "delete icon", onClick (RemoveItem item)][]
|
||||
,text item.option.text
|
||||
]
|
||||
renderDefault =
|
||||
[ List.head model.selected |> Maybe.map renderClosed |> Maybe.withDefault (renderPlaceholder model)
|
||||
, renderMenu model
|
||||
]
|
||||
|
||||
|
||||
openSearch =
|
||||
[ input [ class "search"
|
||||
, placeholder "Search…"
|
||||
, onInput Filter
|
||||
, onKeyUp KeyPress
|
||||
, value model.filterString
|
||||
][]
|
||||
, renderMenu model
|
||||
]
|
||||
in
|
||||
div [classList [ ("ui search dropdown selection", True)
|
||||
, ("open", model.menuOpen)
|
||||
]
|
||||
]
|
||||
(List.append [ i [class "dropdown icon", onClick ToggleMenu][]
|
||||
] <|
|
||||
if model.menuOpen && isSearchable model
|
||||
then openSearch
|
||||
else renderDefault
|
||||
)
|
||||
|
||||
|
||||
viewMultiple: Model a -> Html (Msg a)
|
||||
viewMultiple model =
|
||||
let
|
||||
renderSelectMultiple: Item a -> Html (Msg a)
|
||||
renderSelectMultiple item =
|
||||
div [classList [ ("ui label", True)
|
||||
, (model.labelColor item.value, True)
|
||||
]
|
||||
,style "display" "inline-block !important"
|
||||
,onClick (RemoveItem item)
|
||||
]
|
||||
[text item.option.text
|
||||
,i [class "delete icon"][]
|
||||
]
|
||||
in
|
||||
div [classList [ ("ui search dropdown multiple selection", True)
|
||||
, ("open", model.menuOpen)
|
||||
]
|
||||
]
|
||||
(List.concat
|
||||
[ [i [class "dropdown icon", onClick ToggleMenu][]
|
||||
]
|
||||
, List.map renderSelectMultiple model.selected
|
||||
, if isSearchable model then
|
||||
[ input [ class "search"
|
||||
, placeholder "Search…"
|
||||
, onInput Filter
|
||||
, onKeyUp KeyPress
|
||||
, value model.filterString
|
||||
][]
|
||||
]
|
||||
else []
|
||||
, [ renderMenu model
|
||||
]
|
||||
])
|
||||
|
||||
renderMenu: Model a -> Html (Msg a)
|
||||
renderMenu model =
|
||||
div [classList [( "menu", True )
|
||||
,( "transition visible", model.menuOpen )
|
||||
]
|
||||
] (getOptions model |> List.map renderOption)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
renderPlaceholder: Model a -> Html (Msg a)
|
||||
renderPlaceholder model =
|
||||
div [classList [ ("placeholder-message", True)
|
||||
, ("text", model.multiple)
|
||||
]
|
||||
,style "display" "inline-block !important"
|
||||
,onClick ToggleMenu
|
||||
]
|
||||
[text model.placeholder
|
||||
]
|
||||
|
||||
renderOption: Item a -> Html (Msg a)
|
||||
renderOption item =
|
||||
div [classList [ ("item", True)
|
||||
, ("active", item.active || item.selected)
|
||||
]
|
||||
,onClick (AddItem item)
|
||||
]
|
||||
[text item.option.text
|
||||
]
|
||||
142
modules/webapp/src/main/elm/Comp/Dropzone.elm
Normal file
142
modules/webapp/src/main/elm/Comp/Dropzone.elm
Normal file
@ -0,0 +1,142 @@
|
||||
-- inspired from here: https://ellie-app.com/3T5mNms7SwKa1
|
||||
module Comp.Dropzone exposing ( view
|
||||
, Settings
|
||||
, defaultSettings
|
||||
, update
|
||||
, setActive
|
||||
, Model
|
||||
, init
|
||||
, Msg(..)
|
||||
)
|
||||
import File exposing (File)
|
||||
import File.Select
|
||||
import Json.Decode as D
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
|
||||
type alias State =
|
||||
{ hover: Bool
|
||||
, active: Bool
|
||||
}
|
||||
|
||||
|
||||
type alias Settings =
|
||||
{ classList: State -> List (String, Bool)
|
||||
, contentTypes: List String
|
||||
}
|
||||
|
||||
defaultSettings: Settings
|
||||
defaultSettings =
|
||||
{ classList = \m -> [("ui placeholder segment", True)]
|
||||
, contentTypes = [ "application/pdf" ]
|
||||
}
|
||||
|
||||
type alias Model =
|
||||
{ state: State
|
||||
, settings: Settings
|
||||
}
|
||||
|
||||
init: Settings -> Model
|
||||
init settings =
|
||||
{ state = State False True
|
||||
, settings = settings
|
||||
}
|
||||
|
||||
type Msg
|
||||
= DragEnter
|
||||
| DragLeave
|
||||
| GotFiles File (List File)
|
||||
| PickFiles
|
||||
| SetActive Bool
|
||||
|
||||
setActive: Bool -> Msg
|
||||
setActive flag =
|
||||
SetActive flag
|
||||
|
||||
update: Msg -> Model -> (Model, Cmd Msg, List File)
|
||||
update msg model =
|
||||
case msg of
|
||||
SetActive flag ->
|
||||
let
|
||||
ns = { hover = model.state.hover, active = flag }
|
||||
in
|
||||
({ model | state = ns }, Cmd.none, [])
|
||||
|
||||
PickFiles ->
|
||||
(model, File.Select.files model.settings.contentTypes GotFiles, [])
|
||||
|
||||
DragEnter ->
|
||||
let
|
||||
ns = {hover = True, active = model.state.active}
|
||||
in
|
||||
({model| state = ns}, Cmd.none, [])
|
||||
|
||||
DragLeave ->
|
||||
let
|
||||
ns = {hover = False, active = model.state.active}
|
||||
in
|
||||
({model | state = ns}, Cmd.none, [])
|
||||
|
||||
GotFiles file files ->
|
||||
let
|
||||
ns = {hover = False, active = model.state.active}
|
||||
newFiles = if model.state.active then filterMime model.settings (file :: files)
|
||||
else []
|
||||
in
|
||||
({model | state = ns}, Cmd.none, newFiles)
|
||||
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div
|
||||
[ classList (model.settings.classList model.state)
|
||||
, hijackOn "dragenter" (D.succeed DragEnter)
|
||||
, hijackOn "dragover" (D.succeed DragEnter)
|
||||
, hijackOn "dragleave" (D.succeed DragLeave)
|
||||
, hijackOn "drop" dropDecoder
|
||||
]
|
||||
[div [class "ui icon header"]
|
||||
[i [class "mouse pointer icon"][]
|
||||
,div [class "content"]
|
||||
[text "Drop files here"
|
||||
,div [class "sub header"]
|
||||
[text "PDF files only"
|
||||
]
|
||||
]
|
||||
]
|
||||
,div [class "ui horizontal divider"]
|
||||
[text "Or"
|
||||
]
|
||||
,a [classList [("ui basic primary button", True)
|
||||
,("disabled", not model.state.active)
|
||||
]
|
||||
, onClick PickFiles
|
||||
, href ""]
|
||||
[i [class "folder open icon"][]
|
||||
,text "Select ..."
|
||||
]
|
||||
]
|
||||
|
||||
filterMime: Settings -> List File -> List File
|
||||
filterMime settings files =
|
||||
let
|
||||
pred f =
|
||||
List.member (File.mime f) settings.contentTypes
|
||||
in
|
||||
List.filter pred files
|
||||
|
||||
dropDecoder : D.Decoder Msg
|
||||
dropDecoder =
|
||||
D.at ["dataTransfer","files"] (D.oneOrMore GotFiles File.decoder)
|
||||
|
||||
|
||||
hijackOn : String -> D.Decoder msg -> Attribute msg
|
||||
hijackOn event decoder =
|
||||
preventDefaultOn event (D.map hijack decoder)
|
||||
|
||||
|
||||
hijack : msg -> (msg, Bool)
|
||||
hijack msg =
|
||||
(msg, True)
|
||||
62
modules/webapp/src/main/elm/Comp/EquipmentForm.elm
Normal file
62
modules/webapp/src/main/elm/Comp/EquipmentForm.elm
Normal file
@ -0,0 +1,62 @@
|
||||
module Comp.EquipmentForm exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update
|
||||
, isValid
|
||||
, getEquipment)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Equipment exposing (Equipment)
|
||||
|
||||
type alias Model =
|
||||
{ equipment: Equipment
|
||||
, name: String
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ equipment = Api.Model.Equipment.empty
|
||||
, name = ""
|
||||
}
|
||||
|
||||
isValid: Model -> Bool
|
||||
isValid model =
|
||||
model.name /= ""
|
||||
|
||||
getEquipment: Model -> Equipment
|
||||
getEquipment model =
|
||||
Equipment model.equipment.id model.name model.equipment.created
|
||||
|
||||
type Msg
|
||||
= SetName String
|
||||
| SetEquipment Equipment
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetEquipment t ->
|
||||
({model | equipment = t, name = t.name }, Cmd.none)
|
||||
|
||||
SetName n ->
|
||||
({model | name = n}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [class "ui form"]
|
||||
[div [classList [("field", True)
|
||||
,("error", not (isValid model))
|
||||
]
|
||||
]
|
||||
[label [][text "Name*"]
|
||||
,input [type_ "text"
|
||||
,onInput SetName
|
||||
,placeholder "Name"
|
||||
,value model.name
|
||||
][]
|
||||
]
|
||||
]
|
||||
206
modules/webapp/src/main/elm/Comp/EquipmentManage.elm
Normal file
206
modules/webapp/src/main/elm/Comp/EquipmentManage.elm
Normal file
@ -0,0 +1,206 @@
|
||||
module Comp.EquipmentManage exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Http
|
||||
import Api
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick, onSubmit)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Comp.EquipmentTable
|
||||
import Comp.EquipmentForm
|
||||
import Comp.YesNoDimmer
|
||||
import Api.Model.Equipment
|
||||
import Api.Model.EquipmentList exposing (EquipmentList)
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Util.Maybe
|
||||
import Util.Http
|
||||
|
||||
type alias Model =
|
||||
{ tableModel: Comp.EquipmentTable.Model
|
||||
, formModel: Comp.EquipmentForm.Model
|
||||
, viewMode: ViewMode
|
||||
, formError: Maybe String
|
||||
, loading: Bool
|
||||
, deleteConfirm: Comp.YesNoDimmer.Model
|
||||
}
|
||||
|
||||
type ViewMode = Table | Form
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tableModel = Comp.EquipmentTable.emptyModel
|
||||
, formModel = Comp.EquipmentForm.emptyModel
|
||||
, viewMode = Table
|
||||
, formError = Nothing
|
||||
, loading = False
|
||||
, deleteConfirm = Comp.YesNoDimmer.emptyModel
|
||||
}
|
||||
|
||||
type Msg
|
||||
= TableMsg Comp.EquipmentTable.Msg
|
||||
| FormMsg Comp.EquipmentForm.Msg
|
||||
| LoadEquipments
|
||||
| EquipmentResp (Result Http.Error EquipmentList)
|
||||
| SetViewMode ViewMode
|
||||
| InitNewEquipment
|
||||
| Submit
|
||||
| SubmitResp (Result Http.Error BasicResult)
|
||||
| YesNoMsg Comp.YesNoDimmer.Msg
|
||||
| RequestDelete
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
TableMsg m ->
|
||||
let
|
||||
(tm, tc) = Comp.EquipmentTable.update flags m model.tableModel
|
||||
(m2, c2) = ({model | tableModel = tm
|
||||
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
|
||||
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
|
||||
}
|
||||
, Cmd.map TableMsg tc
|
||||
)
|
||||
(m3, c3) = case tm.selected of
|
||||
Just equipment ->
|
||||
update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) m2
|
||||
Nothing ->
|
||||
(m2, Cmd.none)
|
||||
in
|
||||
(m3, Cmd.batch [c2, c3])
|
||||
|
||||
FormMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.EquipmentForm.update flags m model.formModel
|
||||
in
|
||||
({model | formModel = m2}, Cmd.map FormMsg c2)
|
||||
|
||||
LoadEquipments ->
|
||||
({model| loading = True}, Api.getEquipments flags EquipmentResp)
|
||||
|
||||
EquipmentResp (Ok equipments) ->
|
||||
let
|
||||
m2 = {model|viewMode = Table, loading = False}
|
||||
in
|
||||
update flags (TableMsg (Comp.EquipmentTable.SetEquipments equipments.items)) m2
|
||||
|
||||
EquipmentResp (Err err) ->
|
||||
({model|loading = False}, Cmd.none)
|
||||
|
||||
SetViewMode m ->
|
||||
let
|
||||
m2 = {model | viewMode = m }
|
||||
in
|
||||
case m of
|
||||
Table ->
|
||||
update flags (TableMsg Comp.EquipmentTable.Deselect) m2
|
||||
Form ->
|
||||
(m2, Cmd.none)
|
||||
|
||||
InitNewEquipment ->
|
||||
let
|
||||
nm = {model | viewMode = Form, formError = Nothing }
|
||||
equipment = Api.Model.Equipment.empty
|
||||
in
|
||||
update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) nm
|
||||
|
||||
Submit ->
|
||||
let
|
||||
equipment = Comp.EquipmentForm.getEquipment model.formModel
|
||||
valid = Comp.EquipmentForm.isValid model.formModel
|
||||
in if valid then
|
||||
({model|loading = True}, Api.postEquipment flags equipment SubmitResp)
|
||||
else
|
||||
({model|formError = Just "Please correct the errors in the form."}, Cmd.none)
|
||||
|
||||
SubmitResp (Ok res) ->
|
||||
if res.success then
|
||||
let
|
||||
(m2, c2) = update flags (SetViewMode Table) model
|
||||
(m3, c3) = update flags LoadEquipments m2
|
||||
in
|
||||
({m3|loading = False}, Cmd.batch [c2,c3])
|
||||
else
|
||||
({model | formError = Just res.message, loading = False }, Cmd.none)
|
||||
|
||||
SubmitResp (Err err) ->
|
||||
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
|
||||
|
||||
RequestDelete ->
|
||||
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
|
||||
|
||||
YesNoMsg m ->
|
||||
let
|
||||
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
|
||||
equip = Comp.EquipmentForm.getEquipment model.formModel
|
||||
cmd = if confirmed then Api.deleteEquip flags equip.id SubmitResp else Cmd.none
|
||||
in
|
||||
({model | deleteConfirm = cm}, cmd)
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
if model.viewMode == Table then viewTable model
|
||||
else viewForm model
|
||||
|
||||
viewTable: Model -> Html Msg
|
||||
viewTable model =
|
||||
div []
|
||||
[button [class "ui basic button", onClick InitNewEquipment]
|
||||
[i [class "plus icon"][]
|
||||
,text "Create new"
|
||||
]
|
||||
,Html.map TableMsg (Comp.EquipmentTable.view model.tableModel)
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
|
||||
viewForm: Model -> Html Msg
|
||||
viewForm model =
|
||||
let
|
||||
newEquipment = model.formModel.equipment.id == ""
|
||||
in
|
||||
Html.form [class "ui segment", onSubmit Submit]
|
||||
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
|
||||
,if newEquipment then
|
||||
h3 [class "ui dividing header"]
|
||||
[text "Create new equipment"
|
||||
]
|
||||
else
|
||||
h3 [class "ui dividing header"]
|
||||
[text ("Edit equipment: " ++ model.formModel.equipment.name)
|
||||
,div [class "sub header"]
|
||||
[text "Id: "
|
||||
,text model.formModel.equipment.id
|
||||
]
|
||||
]
|
||||
,Html.map FormMsg (Comp.EquipmentForm.view model.formModel)
|
||||
,div [classList [("ui error message", True)
|
||||
,("invisible", Util.Maybe.isEmpty model.formError)
|
||||
]
|
||||
]
|
||||
[Maybe.withDefault "" model.formError |> text
|
||||
]
|
||||
,div [class "ui horizontal divider"][]
|
||||
,button [class "ui primary button", type_ "submit"]
|
||||
[text "Submit"
|
||||
]
|
||||
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
|
||||
[text "Cancel"
|
||||
]
|
||||
,if not newEquipment then
|
||||
a [class "ui right floated red button", href "", onClick RequestDelete]
|
||||
[text "Delete"]
|
||||
else
|
||||
span[][]
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
62
modules/webapp/src/main/elm/Comp/EquipmentTable.elm
Normal file
62
modules/webapp/src/main/elm/Comp/EquipmentTable.elm
Normal file
@ -0,0 +1,62 @@
|
||||
module Comp.EquipmentTable exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Equipment exposing (Equipment)
|
||||
|
||||
type alias Model =
|
||||
{ equips: List Equipment
|
||||
, selected: Maybe Equipment
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ equips = []
|
||||
, selected = Nothing
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetEquipments (List Equipment)
|
||||
| Select Equipment
|
||||
| Deselect
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetEquipments list ->
|
||||
({model | equips = list, selected = Nothing }, Cmd.none)
|
||||
|
||||
Select equip ->
|
||||
({model | selected = Just equip}, Cmd.none)
|
||||
|
||||
Deselect ->
|
||||
({model | selected = Nothing}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
table [class "ui selectable table"]
|
||||
[thead []
|
||||
[tr []
|
||||
[th [][text "Name"]
|
||||
]
|
||||
]
|
||||
,tbody []
|
||||
(List.map (renderEquipmentLine model) model.equips)
|
||||
]
|
||||
|
||||
renderEquipmentLine: Model -> Equipment -> Html Msg
|
||||
renderEquipmentLine model equip =
|
||||
tr [classList [("active", model.selected == Just equip)]
|
||||
,onClick (Select equip)
|
||||
]
|
||||
[td []
|
||||
[text equip.name
|
||||
]
|
||||
]
|
||||
832
modules/webapp/src/main/elm/Comp/ItemDetail.elm
Normal file
832
modules/webapp/src/main/elm/Comp/ItemDetail.elm
Normal file
@ -0,0 +1,832 @@
|
||||
module Comp.ItemDetail exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, UserNav(..)
|
||||
, update
|
||||
, view
|
||||
)
|
||||
|
||||
import Api
|
||||
import Http
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick, onInput)
|
||||
import Comp.Dropdown exposing (isDropdownChangeMsg)
|
||||
import Comp.YesNoDimmer
|
||||
import Comp.DatePicker
|
||||
import DatePicker exposing (DatePicker)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Data.Direction exposing (Direction)
|
||||
import Api.Model.ItemDetail exposing (ItemDetail)
|
||||
import Api.Model.Tag exposing (Tag)
|
||||
import Api.Model.TagList exposing (TagList)
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Api.Model.ReferenceList exposing (ReferenceList)
|
||||
import Api.Model.IdName exposing (IdName)
|
||||
import Api.Model.DirectionValue exposing (DirectionValue)
|
||||
import Api.Model.OptionalId exposing (OptionalId)
|
||||
import Api.Model.OptionalText exposing (OptionalText)
|
||||
import Api.Model.OptionalDate exposing (OptionalDate)
|
||||
import Api.Model.EquipmentList exposing (EquipmentList)
|
||||
import Api.Model.ItemProposals exposing (ItemProposals)
|
||||
import Util.Time
|
||||
import Util.String
|
||||
import Util.Maybe
|
||||
import Util.Html
|
||||
import Util.Size
|
||||
import Markdown
|
||||
|
||||
type alias Model =
|
||||
{ item: ItemDetail
|
||||
, visibleAttach: Int
|
||||
, menuOpen: Bool
|
||||
, tagModel: Comp.Dropdown.Model Tag
|
||||
, directionModel: Comp.Dropdown.Model Direction
|
||||
, corrOrgModel: Comp.Dropdown.Model IdName
|
||||
, corrPersonModel: Comp.Dropdown.Model IdName
|
||||
, concPersonModel: Comp.Dropdown.Model IdName
|
||||
, concEquipModel: Comp.Dropdown.Model IdName
|
||||
, nameModel: String
|
||||
, notesModel: Maybe String
|
||||
, deleteConfirm: Comp.YesNoDimmer.Model
|
||||
, itemDatePicker: DatePicker
|
||||
, itemDate: Maybe Int
|
||||
, itemProposals: ItemProposals
|
||||
, dueDate: Maybe Int
|
||||
, dueDatePicker: DatePicker
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ item = Api.Model.ItemDetail.empty
|
||||
, visibleAttach = 0
|
||||
, menuOpen = False
|
||||
, tagModel = Comp.Dropdown.makeMultiple
|
||||
{ makeOption = \tag -> { value = tag.id, text = tag.name }
|
||||
, labelColor = \tag -> if Util.Maybe.nonEmpty tag.category then "basic blue" else ""
|
||||
}
|
||||
, directionModel = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \entry -> {value = Data.Direction.toString entry, text = Data.Direction.toString entry}
|
||||
, options = Data.Direction.all
|
||||
, placeholder = "Choose a direction…"
|
||||
, selected = Nothing
|
||||
}
|
||||
, corrOrgModel = Comp.Dropdown.makeSingle
|
||||
{ makeOption = \e -> {value = e.id, text = e.name}
|
||||
, placeholder = ""
|
||||
}
|
||||
, corrPersonModel = Comp.Dropdown.makeSingle
|
||||
{ makeOption = \e -> {value = e.id, text = e.name}
|
||||
, placeholder = ""
|
||||
}
|
||||
, concPersonModel = Comp.Dropdown.makeSingle
|
||||
{ makeOption = \e -> {value = e.id, text = e.name}
|
||||
, placeholder = ""
|
||||
}
|
||||
, concEquipModel = Comp.Dropdown.makeSingle
|
||||
{ makeOption = \e -> {value = e.id, text = e.name}
|
||||
, placeholder = ""
|
||||
}
|
||||
, nameModel = ""
|
||||
, notesModel = Nothing
|
||||
, deleteConfirm = Comp.YesNoDimmer.emptyModel
|
||||
, itemDatePicker = Comp.DatePicker.emptyModel
|
||||
, itemDate = Nothing
|
||||
, itemProposals = Api.Model.ItemProposals.empty
|
||||
, dueDate = Nothing
|
||||
, dueDatePicker = Comp.DatePicker.emptyModel
|
||||
}
|
||||
|
||||
type UserNav
|
||||
= NavBack | NavPrev | NavNext | NavNone | NavNextOrBack
|
||||
|
||||
noNav: (Model, Cmd Msg) -> (Model, Cmd Msg, UserNav)
|
||||
noNav (model, cmd) =
|
||||
(model, cmd, NavNone)
|
||||
|
||||
type Msg
|
||||
= ToggleMenu
|
||||
| ReloadItem
|
||||
| Init
|
||||
| SetItem ItemDetail
|
||||
| SetActiveAttachment Int
|
||||
| NavClick UserNav
|
||||
| TagDropdownMsg (Comp.Dropdown.Msg Tag)
|
||||
| DirDropdownMsg (Comp.Dropdown.Msg Direction)
|
||||
| OrgDropdownMsg (Comp.Dropdown.Msg IdName)
|
||||
| CorrPersonMsg (Comp.Dropdown.Msg IdName)
|
||||
| ConcPersonMsg (Comp.Dropdown.Msg IdName)
|
||||
| ConcEquipMsg (Comp.Dropdown.Msg IdName)
|
||||
| GetTagsResp (Result Http.Error TagList)
|
||||
| GetOrgResp (Result Http.Error ReferenceList)
|
||||
| GetPersonResp (Result Http.Error ReferenceList)
|
||||
| GetEquipResp (Result Http.Error EquipmentList)
|
||||
| SetName String
|
||||
| SaveName
|
||||
| SetNotes String
|
||||
| SaveNotes
|
||||
| ConfirmItem
|
||||
| UnconfirmItem
|
||||
| SetCorrOrgSuggestion IdName
|
||||
| SetCorrPersonSuggestion IdName
|
||||
| SetConcPersonSuggestion IdName
|
||||
| SetConcEquipSuggestion IdName
|
||||
| SetItemDateSuggestion Int
|
||||
| SetDueDateSuggestion Int
|
||||
| ItemDatePickerMsg Comp.DatePicker.Msg
|
||||
| DueDatePickerMsg Comp.DatePicker.Msg
|
||||
| YesNoMsg Comp.YesNoDimmer.Msg
|
||||
| RequestDelete
|
||||
| SaveResp (Result Http.Error BasicResult)
|
||||
| DeleteResp (Result Http.Error BasicResult)
|
||||
| GetItemResp (Result Http.Error ItemDetail)
|
||||
| GetProposalResp (Result Http.Error ItemProposals)
|
||||
| RemoveDueDate
|
||||
| RemoveDate
|
||||
|
||||
|
||||
-- update
|
||||
|
||||
getOptions: Flags -> Cmd Msg
|
||||
getOptions flags =
|
||||
Cmd.batch
|
||||
[ Api.getTags flags GetTagsResp
|
||||
, Api.getOrgLight flags GetOrgResp
|
||||
, Api.getPersonsLight flags GetPersonResp
|
||||
, Api.getEquipments flags GetEquipResp
|
||||
]
|
||||
|
||||
saveTags: Flags -> Model -> Cmd Msg
|
||||
saveTags flags model =
|
||||
let
|
||||
tags = Comp.Dropdown.getSelected model.tagModel
|
||||
|> List.map (\t -> IdName t.id t.name)
|
||||
|> ReferenceList
|
||||
in
|
||||
Api.setTags flags model.item.id tags SaveResp
|
||||
|
||||
setDirection: Flags -> Model -> Cmd Msg
|
||||
setDirection flags model =
|
||||
let
|
||||
dir = Comp.Dropdown.getSelected model.directionModel |> List.head
|
||||
in
|
||||
case dir of
|
||||
Just d ->
|
||||
Api.setDirection flags model.item.id (DirectionValue (Data.Direction.toString d)) SaveResp
|
||||
Nothing ->
|
||||
Cmd.none
|
||||
|
||||
setCorrOrg: Flags -> Model -> Maybe IdName -> Cmd Msg
|
||||
setCorrOrg flags model mref =
|
||||
let
|
||||
idref = Maybe.map .id mref
|
||||
|> OptionalId
|
||||
in
|
||||
Api.setCorrOrg flags model.item.id idref SaveResp
|
||||
|
||||
setCorrPerson: Flags -> Model -> Maybe IdName -> Cmd Msg
|
||||
setCorrPerson flags model mref =
|
||||
let
|
||||
idref = Maybe.map .id mref
|
||||
|> OptionalId
|
||||
in
|
||||
Api.setCorrPerson flags model.item.id idref SaveResp
|
||||
|
||||
setConcPerson: Flags -> Model -> Maybe IdName -> Cmd Msg
|
||||
setConcPerson flags model mref =
|
||||
let
|
||||
idref = Maybe.map .id mref
|
||||
|> OptionalId
|
||||
in
|
||||
Api.setConcPerson flags model.item.id idref SaveResp
|
||||
|
||||
setConcEquip: Flags -> Model -> Maybe IdName -> Cmd Msg
|
||||
setConcEquip flags model mref =
|
||||
let
|
||||
idref = Maybe.map .id mref
|
||||
|> OptionalId
|
||||
in
|
||||
Api.setConcEquip flags model.item.id idref SaveResp
|
||||
|
||||
setName: Flags -> Model -> Cmd Msg
|
||||
setName flags model =
|
||||
let
|
||||
text = OptionalText (Just model.nameModel)
|
||||
in
|
||||
if model.nameModel == "" then Cmd.none
|
||||
else Api.setItemName flags model.item.id text SaveResp
|
||||
|
||||
setNotes: Flags -> Model -> Cmd Msg
|
||||
setNotes flags model =
|
||||
let
|
||||
text = OptionalText model.notesModel
|
||||
in
|
||||
if model.notesModel == Nothing then Cmd.none
|
||||
else Api.setItemNotes flags model.item.id text SaveResp
|
||||
|
||||
setDate: Flags -> Model-> Maybe Int -> Cmd Msg
|
||||
setDate flags model date =
|
||||
Api.setItemDate flags model.item.id (OptionalDate date) SaveResp
|
||||
|
||||
setDueDate: Flags -> Model -> Maybe Int -> Cmd Msg
|
||||
setDueDate flags model date =
|
||||
Api.setItemDueDate flags model.item.id (OptionalDate date) SaveResp
|
||||
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg, UserNav)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
Init ->
|
||||
let
|
||||
(dp, dpc) = Comp.DatePicker.init
|
||||
in
|
||||
( {model | itemDatePicker = dp, dueDatePicker = dp}
|
||||
, Cmd.batch [getOptions flags
|
||||
, Cmd.map ItemDatePickerMsg dpc
|
||||
, Cmd.map DueDatePickerMsg dpc
|
||||
]
|
||||
, NavNone
|
||||
)
|
||||
|
||||
SetItem item ->
|
||||
let
|
||||
(m1, c1, _) = update flags (TagDropdownMsg (Comp.Dropdown.SetSelection item.tags)) model
|
||||
(m2, c2, _) = update flags (DirDropdownMsg (Comp.Dropdown.SetSelection (Data.Direction.fromString item.direction
|
||||
|> Maybe.map List.singleton
|
||||
|> Maybe.withDefault []))) m1
|
||||
(m3, c3, _) = update flags (OrgDropdownMsg (Comp.Dropdown.SetSelection (item.corrOrg
|
||||
|> Maybe.map List.singleton
|
||||
|> Maybe.withDefault []))) m2
|
||||
(m4, c4, _) = update flags (CorrPersonMsg (Comp.Dropdown.SetSelection (item.corrPerson
|
||||
|> Maybe.map List.singleton
|
||||
|> Maybe.withDefault []))) m3
|
||||
(m5, c5, _) = update flags (ConcPersonMsg (Comp.Dropdown.SetSelection (item.concPerson
|
||||
|> Maybe.map List.singleton
|
||||
|> Maybe.withDefault []))) m4
|
||||
proposalCmd = if item.state == "created"
|
||||
then Api.getItemProposals flags item.id GetProposalResp
|
||||
else Cmd.none
|
||||
in
|
||||
({m5|item = item, nameModel = item.name, notesModel = item.notes, itemDate = item.itemDate, dueDate = item.dueDate}
|
||||
,Cmd.batch [c1, c2, c3,c4,c5, getOptions flags, proposalCmd]
|
||||
) |> noNav
|
||||
|
||||
SetActiveAttachment pos ->
|
||||
({model|visibleAttach = pos}, Cmd.none, NavNone)
|
||||
|
||||
NavClick nav ->
|
||||
(model, Cmd.none, nav)
|
||||
|
||||
ToggleMenu ->
|
||||
({model|menuOpen = not model.menuOpen}, Cmd.none, NavNone)
|
||||
|
||||
ReloadItem ->
|
||||
if model.item.id == "" then (model, Cmd.none, NavNone)
|
||||
else (model, Api.itemDetail flags model.item.id GetItemResp, NavNone)
|
||||
|
||||
TagDropdownMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.tagModel
|
||||
newModel = {model|tagModel = m2}
|
||||
save = if isDropdownChangeMsg m then saveTags flags newModel else Cmd.none
|
||||
in
|
||||
(newModel, Cmd.batch[ save, Cmd.map TagDropdownMsg c2 ], NavNone)
|
||||
DirDropdownMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.directionModel
|
||||
newModel = {model|directionModel = m2}
|
||||
save = if isDropdownChangeMsg m then setDirection flags newModel else Cmd.none
|
||||
in
|
||||
(newModel, Cmd.batch [save, Cmd.map DirDropdownMsg c2 ]) |> noNav
|
||||
OrgDropdownMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.corrOrgModel
|
||||
newModel = {model|corrOrgModel = m2}
|
||||
idref = Comp.Dropdown.getSelected m2 |> List.head
|
||||
save = if isDropdownChangeMsg m then setCorrOrg flags newModel idref else Cmd.none
|
||||
in
|
||||
(newModel, Cmd.batch [save, Cmd.map OrgDropdownMsg c2]) |> noNav
|
||||
CorrPersonMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.corrPersonModel
|
||||
newModel = {model|corrPersonModel = m2}
|
||||
idref = Comp.Dropdown.getSelected m2 |> List.head
|
||||
save = if isDropdownChangeMsg m then setCorrPerson flags newModel idref else Cmd.none
|
||||
in
|
||||
(newModel, Cmd.batch [save, Cmd.map CorrPersonMsg c2]) |> noNav
|
||||
ConcPersonMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.concPersonModel
|
||||
newModel = {model|concPersonModel = m2}
|
||||
idref = Comp.Dropdown.getSelected m2 |> List.head
|
||||
save = if isDropdownChangeMsg m then setConcPerson flags newModel idref else Cmd.none
|
||||
in
|
||||
(newModel, Cmd.batch [save, Cmd.map ConcPersonMsg c2]) |> noNav
|
||||
ConcEquipMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.concEquipModel
|
||||
newModel = {model|concEquipModel = m2}
|
||||
idref = Comp.Dropdown.getSelected m2 |> List.head
|
||||
save = if isDropdownChangeMsg m then setConcEquip flags newModel idref else Cmd.none
|
||||
in
|
||||
(newModel, Cmd.batch [save, Cmd.map ConcEquipMsg c2]) |> noNav
|
||||
SetName str ->
|
||||
({model|nameModel = str}, Cmd.none) |> noNav
|
||||
|
||||
SaveName ->
|
||||
(model, setName flags model) |> noNav
|
||||
|
||||
SetNotes str ->
|
||||
({model|notesModel = if str == "" then Nothing else Just str}, Cmd.none) |> noNav
|
||||
SaveNotes ->
|
||||
(model, setNotes flags model) |> noNav
|
||||
|
||||
ConfirmItem ->
|
||||
(model, Api.setConfirmed flags model.item.id SaveResp) |> noNav
|
||||
|
||||
UnconfirmItem ->
|
||||
(model, Api.setUnconfirmed flags model.item.id SaveResp) |> noNav
|
||||
|
||||
ItemDatePickerMsg m ->
|
||||
let
|
||||
(dp, event) = Comp.DatePicker.updateDefault m model.itemDatePicker
|
||||
in
|
||||
case event of
|
||||
DatePicker.Picked date ->
|
||||
let
|
||||
newModel = {model|itemDatePicker = dp, itemDate = Just (Comp.DatePicker.midOfDay date)}
|
||||
in
|
||||
(newModel, setDate flags newModel newModel.itemDate) |> noNav
|
||||
_ ->
|
||||
({model|itemDatePicker = dp}, Cmd.none) |> noNav
|
||||
|
||||
RemoveDate ->
|
||||
({ model | itemDate = Nothing }, setDate flags model Nothing ) |> noNav
|
||||
|
||||
DueDatePickerMsg m ->
|
||||
let
|
||||
(dp, event) = Comp.DatePicker.updateDefault m model.dueDatePicker
|
||||
in
|
||||
case event of
|
||||
DatePicker.Picked date ->
|
||||
let
|
||||
newModel = {model|dueDatePicker = dp, dueDate = Just (Comp.DatePicker.midOfDay date)}
|
||||
in
|
||||
(newModel, setDueDate flags newModel newModel.dueDate) |> noNav
|
||||
_ ->
|
||||
({model|dueDatePicker = dp}, Cmd.none) |> noNav
|
||||
|
||||
RemoveDueDate ->
|
||||
({ model | dueDate = Nothing }, setDueDate flags model Nothing ) |> noNav
|
||||
|
||||
YesNoMsg m ->
|
||||
let
|
||||
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
|
||||
cmd = if confirmed then Api.deleteItem flags model.item.id DeleteResp else Cmd.none
|
||||
in
|
||||
({model | deleteConfirm = cm}, cmd) |> noNav
|
||||
|
||||
RequestDelete ->
|
||||
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
|
||||
|
||||
SetCorrOrgSuggestion idname ->
|
||||
(model, setCorrOrg flags model (Just idname)) |> noNav
|
||||
SetCorrPersonSuggestion idname ->
|
||||
(model, setCorrPerson flags model (Just idname)) |> noNav
|
||||
SetConcPersonSuggestion idname ->
|
||||
(model, setConcPerson flags model (Just idname)) |> noNav
|
||||
SetConcEquipSuggestion idname ->
|
||||
(model, setConcEquip flags model (Just idname)) |> noNav
|
||||
SetItemDateSuggestion date ->
|
||||
(model, setDate flags model (Just date)) |> noNav
|
||||
SetDueDateSuggestion date ->
|
||||
(model, setDueDate flags model (Just date)) |> noNav
|
||||
|
||||
GetTagsResp (Ok tags) ->
|
||||
let
|
||||
tagList = Comp.Dropdown.SetOptions tags.items
|
||||
(m1, c1, _) = update flags (TagDropdownMsg tagList) model
|
||||
in
|
||||
(m1, c1) |> noNav
|
||||
GetTagsResp (Err err) ->
|
||||
(model, Cmd.none) |> noNav
|
||||
GetOrgResp (Ok orgs) ->
|
||||
let
|
||||
opts = Comp.Dropdown.SetOptions orgs.items
|
||||
in
|
||||
update flags (OrgDropdownMsg opts) model
|
||||
|
||||
GetOrgResp (Err err) ->
|
||||
(model, Cmd.none) |> noNav
|
||||
GetPersonResp (Ok ps) ->
|
||||
let
|
||||
opts = Comp.Dropdown.SetOptions ps.items
|
||||
(m1, c1, _) = update flags (CorrPersonMsg opts) model
|
||||
(m2, c2, _) = update flags (ConcPersonMsg opts) m1
|
||||
in
|
||||
(m2, Cmd.batch [c1, c2]) |> noNav
|
||||
|
||||
GetPersonResp (Err err) ->
|
||||
(model, Cmd.none) |> noNav
|
||||
GetEquipResp (Ok equips) ->
|
||||
let
|
||||
opts = Comp.Dropdown.SetOptions (List.map (\e -> IdName e.id e.name) equips.items)
|
||||
in
|
||||
update flags (ConcEquipMsg opts) model
|
||||
|
||||
GetEquipResp (Err err) ->
|
||||
(model, Cmd.none) |> noNav
|
||||
SaveResp (Ok res) ->
|
||||
if res.success then (model, Api.itemDetail flags model.item.id GetItemResp) |> noNav
|
||||
else (model, Cmd.none) |> noNav
|
||||
SaveResp (Err err) ->
|
||||
(model, Cmd.none) |> noNav
|
||||
DeleteResp (Ok res) ->
|
||||
if res.success then (model, Cmd.none, NavNextOrBack)
|
||||
else (model, Cmd.none) |> noNav
|
||||
DeleteResp (Err err) ->
|
||||
(model, Cmd.none) |> noNav
|
||||
GetItemResp (Ok item) ->
|
||||
update flags (SetItem item) model
|
||||
GetItemResp (Err err) ->
|
||||
(model, Cmd.none) |> noNav
|
||||
|
||||
GetProposalResp (Ok ip) ->
|
||||
({model | itemProposals = ip}, Cmd.none) |> noNav
|
||||
GetProposalResp (Err err) ->
|
||||
(model, Cmd.none) |> noNav
|
||||
|
||||
-- view
|
||||
|
||||
actionInputDatePicker: DatePicker.Settings
|
||||
actionInputDatePicker =
|
||||
let
|
||||
ds = Comp.DatePicker.defaultSettings
|
||||
in
|
||||
{ ds | containerClassList = [("ui action input", True)] }
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div []
|
||||
[div [classList [("ui ablue-comp menu", True)
|
||||
]]
|
||||
[a [class "item", href "", onClick (NavClick NavBack)]
|
||||
[i [class "arrow left icon"][]
|
||||
]
|
||||
,a [class "item", href "", onClick (NavClick NavPrev)]
|
||||
[i [class "caret square left outline icon"][]
|
||||
]
|
||||
,a [class "item", href "", onClick (NavClick NavNext)]
|
||||
[i [class "caret square right outline icon"][]
|
||||
]
|
||||
,a [classList [("toggle item", True)
|
||||
,("active", model.menuOpen)
|
||||
]
|
||||
,title "Expand Menu"
|
||||
,onClick ToggleMenu
|
||||
,href ""
|
||||
]
|
||||
[i [class "edit icon"][]
|
||||
]
|
||||
]
|
||||
,div [class "ui grid"]
|
||||
[div [classList [("six wide column", True)
|
||||
,("invisible", not model.menuOpen)
|
||||
]]
|
||||
(if model.menuOpen then (renderEditMenu model) else [])
|
||||
,div [classList [("ten", model.menuOpen)
|
||||
,("sixteen", not model.menuOpen)
|
||||
,("wide column", True)
|
||||
]]
|
||||
<| List.concat
|
||||
[ [renderItemInfo model]
|
||||
, [renderAttachmentsTabMenu model]
|
||||
, renderAttachmentsTabBody model
|
||||
, renderNotes model
|
||||
, renderIdInfo model
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
renderIdInfo: Model -> List (Html Msg)
|
||||
renderIdInfo model =
|
||||
[div [class "ui center aligned container"]
|
||||
[span [class "small-info"]
|
||||
[text model.item.id
|
||||
,text " • "
|
||||
,text "Created: "
|
||||
,Util.Time.formatDateTime model.item.created |> text
|
||||
,text " • "
|
||||
,text "Updated: "
|
||||
,Util.Time.formatDateTime model.item.updated |> text
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
renderNotes: Model -> List (Html Msg)
|
||||
renderNotes model =
|
||||
case model.item.notes of
|
||||
Nothing -> []
|
||||
Just str ->
|
||||
[h3 [class "ui header"]
|
||||
[text "Notes"
|
||||
]
|
||||
,Markdown.toHtml [class "item-notes"] str
|
||||
]
|
||||
|
||||
renderAttachmentsTabMenu: Model -> Html Msg
|
||||
renderAttachmentsTabMenu model =
|
||||
div [class "ui top attached tabular menu"]
|
||||
(List.indexedMap (\pos -> \a ->
|
||||
div [classList [("item", True)
|
||||
,("active", pos == model.visibleAttach)
|
||||
]
|
||||
,onClick (SetActiveAttachment pos)
|
||||
]
|
||||
[a.name |> Maybe.withDefault "No Name" |> text
|
||||
,text " ("
|
||||
,text (Util.Size.bytesReadable Util.Size.B (toFloat a.size))
|
||||
,text ")"
|
||||
])
|
||||
model.item.attachments)
|
||||
|
||||
renderAttachmentsTabBody: Model -> List (Html Msg)
|
||||
renderAttachmentsTabBody model =
|
||||
List.indexedMap (\pos -> \a ->
|
||||
div [classList [("ui attached tab segment", True)
|
||||
,("active", pos == model.visibleAttach)
|
||||
]
|
||||
]
|
||||
[div [class "ui 4:3 embed doc-embed"]
|
||||
[embed [src ("/api/v1/sec/attachment/" ++ a.id), type_ a.contentType]
|
||||
[]
|
||||
]
|
||||
]
|
||||
) model.item.attachments
|
||||
|
||||
renderItemInfo: Model -> Html Msg
|
||||
renderItemInfo model =
|
||||
let
|
||||
name = div [class "item"]
|
||||
[i [class (Data.Direction.iconFromString model.item.direction)][]
|
||||
,text model.item.name
|
||||
]
|
||||
date = div [class "item"]
|
||||
[Maybe.withDefault model.item.created model.item.itemDate
|
||||
|> Util.Time.formatDate
|
||||
|> text
|
||||
]
|
||||
duedate = div [class "item"]
|
||||
[i [class "bell icon"][]
|
||||
,Maybe.map Util.Time.formatDate model.item.dueDate
|
||||
|> Maybe.withDefault ""
|
||||
|> text
|
||||
]
|
||||
corr = div [class "item"]
|
||||
[i [class "envelope outline icon"][]
|
||||
, List.filterMap identity [model.item.corrOrg, model.item.corrPerson]
|
||||
|> List.map .name
|
||||
|> String.join ", "
|
||||
|> Util.String.withDefault "(None)"
|
||||
|> text
|
||||
]
|
||||
conc = div [class "item"]
|
||||
[i [class "comment outline icon"][]
|
||||
,List.filterMap identity [model.item.concPerson, model.item.concEquipment]
|
||||
|> List.map .name
|
||||
|> String.join ", "
|
||||
|> Util.String.withDefault "(None)"
|
||||
|> text
|
||||
]
|
||||
src = div [class "item"]
|
||||
[text model.item.source
|
||||
]
|
||||
in
|
||||
div [class "ui fluid container"]
|
||||
([h2 [class "ui header"]
|
||||
[i [class (Data.Direction.iconFromString model.item.direction)][]
|
||||
,div [class "content"]
|
||||
[text model.item.name
|
||||
,div [classList [("ui teal label", True)
|
||||
,("invisible", model.item.state /= "created")
|
||||
]]
|
||||
[text "New!"
|
||||
]
|
||||
,div [class "sub header"]
|
||||
[div [class "ui horizontal bulleted list"] <|
|
||||
List.append
|
||||
[ date
|
||||
, corr
|
||||
, conc
|
||||
, src
|
||||
] (if Util.Maybe.isEmpty model.item.dueDate then [] else [duedate])
|
||||
]
|
||||
]
|
||||
]
|
||||
] ++ (renderTags model))
|
||||
|
||||
renderTags: Model -> List (Html Msg)
|
||||
renderTags model =
|
||||
case model.item.tags of
|
||||
[] -> []
|
||||
_ ->
|
||||
[div [class "ui right aligned fluid container"] <|
|
||||
List.map
|
||||
(\t -> div [classList [("ui tag label", True)
|
||||
,("blue", Util.Maybe.nonEmpty t.category)
|
||||
]
|
||||
]
|
||||
[text t.name
|
||||
]
|
||||
) model.item.tags
|
||||
]
|
||||
|
||||
|
||||
renderEditMenu: Model -> List (Html Msg)
|
||||
renderEditMenu model =
|
||||
[renderEditButtons model
|
||||
,renderEditForm model
|
||||
]
|
||||
|
||||
renderEditButtons: Model -> Html Msg
|
||||
renderEditButtons model =
|
||||
div [class "ui top attached right aligned segment"]
|
||||
[ button [classList [("ui primary button", True)
|
||||
,("invisible", model.item.state /= "created")
|
||||
]
|
||||
,onClick ConfirmItem
|
||||
]
|
||||
[ i [class "check icon"][]
|
||||
, text "Confirm"
|
||||
]
|
||||
, button [classList [("ui primary button", True)
|
||||
,("invisible", model.item.state /= "confirmed")
|
||||
]
|
||||
,onClick UnconfirmItem
|
||||
]
|
||||
[ i [class "eye slash outline icon"][]
|
||||
, text "Unconfirm"
|
||||
]
|
||||
, button [class "ui negative button", onClick RequestDelete]
|
||||
[ i [class "delete icon"] []
|
||||
, text "Delete"
|
||||
]
|
||||
]
|
||||
|
||||
renderEditForm: Model -> Html Msg
|
||||
renderEditForm model =
|
||||
div [class "ui attached segment"]
|
||||
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
|
||||
,div [class "ui form"]
|
||||
[div [class "field"]
|
||||
[label []
|
||||
[i [class "tags icon"][]
|
||||
,text "Tags"
|
||||
]
|
||||
,Html.map TagDropdownMsg (Comp.Dropdown.view model.tagModel)
|
||||
]
|
||||
,div [class " field"]
|
||||
[label [][text "Name"]
|
||||
,div [class "ui action input"]
|
||||
[input [type_ "text", value model.nameModel, onInput SetName][]
|
||||
,button [class "ui icon button", onClick SaveName][i [class "save outline icon"][]]
|
||||
]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Direction"]
|
||||
,Html.map DirDropdownMsg (Comp.Dropdown.view model.directionModel)
|
||||
]
|
||||
,div [class " field"]
|
||||
[label [][text "Date"]
|
||||
,div [class "ui action input"]
|
||||
[Html.map ItemDatePickerMsg (Comp.DatePicker.viewTime model.itemDate actionInputDatePicker model.itemDatePicker)
|
||||
,a [class "ui icon button", href "", onClick RemoveDate]
|
||||
[i [class "trash alternate outline icon"][]
|
||||
]
|
||||
]
|
||||
,renderItemDateSuggestions model
|
||||
]
|
||||
,div [class " field"]
|
||||
[label [][text "Due Date"]
|
||||
,div [class "ui action input"]
|
||||
[Html.map DueDatePickerMsg (Comp.DatePicker.viewTime model.dueDate actionInputDatePicker model.dueDatePicker)
|
||||
,a [class "ui icon button", href "", onClick RemoveDueDate]
|
||||
[i [class "trash alternate outline icon"][]]
|
||||
]
|
||||
,renderDueDateSuggestions model
|
||||
]
|
||||
,h4 [class "ui dividing header"]
|
||||
[i [class "tiny envelope outline icon"][]
|
||||
,text "Correspondent"
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Organization"]
|
||||
,Html.map OrgDropdownMsg (Comp.Dropdown.view model.corrOrgModel)
|
||||
,renderOrgSuggestions model
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Person"]
|
||||
,Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel)
|
||||
,renderCorrPersonSuggestions model
|
||||
]
|
||||
,h4 [class "ui dividing header"]
|
||||
[i [class "tiny comment outline icon"][]
|
||||
,text "Concerning"
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Person"]
|
||||
,Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel)
|
||||
,renderConcPersonSuggestions model
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Equipment"]
|
||||
,Html.map ConcEquipMsg (Comp.Dropdown.view model.concEquipModel)
|
||||
,renderConcEquipSuggestions model
|
||||
]
|
||||
,h4 [class "ui dividing header"]
|
||||
[i [class "tiny edit icon"][]
|
||||
,div [class "content"]
|
||||
[text "Notes"
|
||||
,div [class "sub header"]
|
||||
[a [class "ui link"
|
||||
,target "_blank"
|
||||
,href "https://guides.github.com/features/mastering-markdown"
|
||||
]
|
||||
[text "Markdown"
|
||||
]
|
||||
,text " is supported"
|
||||
]
|
||||
]
|
||||
]
|
||||
,div [class "field"]
|
||||
[div [class "ui action input"]
|
||||
[textarea [rows 7, onInput SetNotes][Maybe.withDefault "" model.notesModel |> text]
|
||||
,button [class "ui icon button", onClick SaveNotes]
|
||||
[i [class "save outline icon"][]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
renderSuggestions: Model -> (a -> String) -> List a -> (a -> Msg) -> Html Msg
|
||||
renderSuggestions model mkName idnames tagger =
|
||||
div [classList [("ui secondary vertical menu", True)
|
||||
,("invisible", model.item.state /= "created")
|
||||
]]
|
||||
[div [class "item"]
|
||||
[div [class "header"]
|
||||
[text "Suggestions"
|
||||
]
|
||||
,div [class "menu"] <|
|
||||
(idnames
|
||||
|> List.take 5
|
||||
|> List.map (\p -> a [class "item", href "", onClick (tagger p)][text (mkName p)]))
|
||||
]
|
||||
]
|
||||
|
||||
renderOrgSuggestions: Model -> Html Msg
|
||||
renderOrgSuggestions model =
|
||||
renderSuggestions model
|
||||
.name
|
||||
(List.take 5 model.itemProposals.corrOrg)
|
||||
SetCorrOrgSuggestion
|
||||
|
||||
renderCorrPersonSuggestions: Model -> Html Msg
|
||||
renderCorrPersonSuggestions model =
|
||||
renderSuggestions model
|
||||
.name
|
||||
(List.take 5 model.itemProposals.corrPerson)
|
||||
SetCorrPersonSuggestion
|
||||
|
||||
renderConcPersonSuggestions: Model -> Html Msg
|
||||
renderConcPersonSuggestions model =
|
||||
renderSuggestions model
|
||||
.name
|
||||
(List.take 5 model.itemProposals.concPerson)
|
||||
SetConcPersonSuggestion
|
||||
|
||||
renderConcEquipSuggestions: Model -> Html Msg
|
||||
renderConcEquipSuggestions model =
|
||||
renderSuggestions model
|
||||
.name
|
||||
(List.take 5 model.itemProposals.concEquipment)
|
||||
SetConcEquipSuggestion
|
||||
|
||||
renderItemDateSuggestions: Model -> Html Msg
|
||||
renderItemDateSuggestions model =
|
||||
renderSuggestions model
|
||||
Util.Time.formatDate
|
||||
(List.take 5 model.itemProposals.itemDate)
|
||||
SetItemDateSuggestion
|
||||
|
||||
renderDueDateSuggestions: Model -> Html Msg
|
||||
renderDueDateSuggestions model =
|
||||
renderSuggestions model
|
||||
Util.Time.formatDate
|
||||
(List.take 5 model.itemProposals.dueDate)
|
||||
SetDueDateSuggestion
|
||||
235
modules/webapp/src/main/elm/Comp/ItemList.elm
Normal file
235
modules/webapp/src/main/elm/Comp/ItemList.elm
Normal file
@ -0,0 +1,235 @@
|
||||
module Comp.ItemList exposing (Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, prevItem
|
||||
, nextItem
|
||||
, update
|
||||
, view)
|
||||
|
||||
import Set exposing (Set)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
import Api.Model.ItemLightList exposing (ItemLightList)
|
||||
import Api.Model.ItemLightGroup exposing (ItemLightGroup)
|
||||
import Api.Model.ItemLight exposing (ItemLight)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Data.Direction
|
||||
import Util.List
|
||||
import Util.String
|
||||
import Util.Time
|
||||
import Util.Maybe
|
||||
|
||||
type alias Model =
|
||||
{ results: ItemLightList
|
||||
, openGroups: Set String
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ results = Api.Model.ItemLightList.empty
|
||||
, openGroups = Set.empty
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetResults ItemLightList
|
||||
| ToggleGroupState ItemLightGroup
|
||||
| CollapseAll
|
||||
| ExpandAll
|
||||
| SelectItem ItemLight
|
||||
|
||||
nextItem: Model -> String -> Maybe ItemLight
|
||||
nextItem model id =
|
||||
List.concatMap .items model.results.groups
|
||||
|> Util.List.findNext (\i -> i.id == id)
|
||||
|
||||
prevItem: Model -> String -> Maybe ItemLight
|
||||
prevItem model id =
|
||||
List.concatMap .items model.results.groups
|
||||
|> Util.List.findPrev (\i -> i.id == id)
|
||||
|
||||
openAllGroups: Model -> Set String
|
||||
openAllGroups model =
|
||||
List.foldl
|
||||
(\g -> \set -> Set.insert g.name set)
|
||||
model.openGroups
|
||||
model.results.groups
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg, Maybe ItemLight)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetResults list ->
|
||||
let
|
||||
newModel = { model | results = list, openGroups = Set.empty }
|
||||
in
|
||||
({newModel|openGroups = openAllGroups newModel}, Cmd.none, Nothing)
|
||||
|
||||
ToggleGroupState group ->
|
||||
let
|
||||
m2 = if isGroupOpen model group then closeGroup model group
|
||||
else openGroup model group
|
||||
in
|
||||
(m2, Cmd.none, Nothing)
|
||||
|
||||
CollapseAll ->
|
||||
({model | openGroups = Set.empty }, Cmd.none, Nothing)
|
||||
|
||||
ExpandAll ->
|
||||
let
|
||||
open = openAllGroups model
|
||||
in
|
||||
({model | openGroups = open }, Cmd.none, Nothing)
|
||||
|
||||
SelectItem item ->
|
||||
(model, Cmd.none, Just item)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div []
|
||||
[div [class "ui ablue-comp menu"]
|
||||
[div [class "right floated menu"]
|
||||
[a [class "item"
|
||||
,title "Expand all"
|
||||
,onClick ExpandAll
|
||||
,href ""
|
||||
]
|
||||
[i [class "double angle down icon"][]
|
||||
]
|
||||
,a [class "item"
|
||||
,title "Collapse all"
|
||||
,onClick CollapseAll
|
||||
,href ""
|
||||
]
|
||||
[i [class "double angle up icon"][]
|
||||
]
|
||||
]
|
||||
]
|
||||
,div [class "ui middle aligned very relaxed divided basic list segment"]
|
||||
(List.map (viewGroup model) model.results.groups)
|
||||
]
|
||||
|
||||
|
||||
isGroupOpen: Model -> ItemLightGroup -> Bool
|
||||
isGroupOpen model group =
|
||||
Set.member group.name model.openGroups
|
||||
|
||||
openGroup: Model -> ItemLightGroup -> Model
|
||||
openGroup model group =
|
||||
{ model | openGroups = Set.insert group.name model.openGroups }
|
||||
|
||||
closeGroup: Model -> ItemLightGroup -> Model
|
||||
closeGroup model group =
|
||||
{ model | openGroups = Set.remove group.name model.openGroups }
|
||||
|
||||
viewGroup: Model -> ItemLightGroup -> Html Msg
|
||||
viewGroup model group =
|
||||
let
|
||||
groupOpen = isGroupOpen model group
|
||||
children =
|
||||
[i [classList [("large middle aligned icon", True)
|
||||
,("caret right", not groupOpen)
|
||||
,("caret down", groupOpen)
|
||||
]][]
|
||||
,div [class "content"]
|
||||
[div [class "right floated content"]
|
||||
[div [class "ui blue label"]
|
||||
[List.length group.items |> String.fromInt |> text
|
||||
]
|
||||
]
|
||||
,a [class "header"
|
||||
,onClick (ToggleGroupState group)
|
||||
,href ""
|
||||
]
|
||||
[text group.name
|
||||
]
|
||||
,div [class "description"]
|
||||
[makeSummary group |> text
|
||||
]
|
||||
]
|
||||
]
|
||||
itemTable =
|
||||
div [class "ui basic content segment no-margin"]
|
||||
[(renderItemTable model group.items)
|
||||
]
|
||||
in
|
||||
if isGroupOpen model group then
|
||||
div [class "item"]
|
||||
(List.append children [itemTable])
|
||||
else
|
||||
div [class "item"]
|
||||
children
|
||||
|
||||
|
||||
renderItemTable: Model -> List ItemLight -> Html Msg
|
||||
renderItemTable model items =
|
||||
table [class "ui selectable padded table"]
|
||||
[thead []
|
||||
[tr []
|
||||
[th [class "collapsing"][]
|
||||
,th [class "collapsing"][text "Name"]
|
||||
,th [class "collapsing"][text "Date"]
|
||||
,th [class "collapsing"][text "Source"]
|
||||
,th [][text "Correspondent"]
|
||||
,th [][text "Concerning"]
|
||||
]
|
||||
]
|
||||
,tbody[]
|
||||
(List.map (renderItemLine model) items)
|
||||
]
|
||||
|
||||
renderItemLine: Model -> ItemLight -> Html Msg
|
||||
renderItemLine model item =
|
||||
let
|
||||
dirIcon = i [class (Data.Direction.iconFromMaybe item.direction)][]
|
||||
corr = List.filterMap identity [item.corrOrg, item.corrPerson]
|
||||
|> List.map .name
|
||||
|> List.intersperse ", "
|
||||
|> String.concat
|
||||
conc = List.filterMap identity [item.concPerson, item.concEquip]
|
||||
|> List.map .name
|
||||
|> List.intersperse ", "
|
||||
|> String.concat
|
||||
in
|
||||
tr [onClick (SelectItem item)]
|
||||
[td [class "collapsing"]
|
||||
[div [classList [("ui teal ribbon label", True)
|
||||
,("invisible", item.state /= "created")
|
||||
]
|
||||
][text "New"
|
||||
]
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[ dirIcon
|
||||
, Util.String.ellipsis 45 item.name |> text
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[Util.Time.formatDateShort item.date |> text
|
||||
,span [classList [("invisible", Util.Maybe.isEmpty item.dueDate)
|
||||
]
|
||||
]
|
||||
[text " "
|
||||
,div [class "ui basic label"]
|
||||
[i [class "bell icon"][]
|
||||
,Maybe.map Util.Time.formatDateShort item.dueDate |> Maybe.withDefault "" |> text
|
||||
]
|
||||
]
|
||||
]
|
||||
,td [class "collapsing"][text item.source]
|
||||
,td [][text corr]
|
||||
,td [][text conc]
|
||||
]
|
||||
|
||||
makeSummary: ItemLightGroup -> String
|
||||
makeSummary group =
|
||||
let
|
||||
corrOrgs = List.filterMap .corrOrg group.items
|
||||
corrPers = List.filterMap .corrPerson group.items
|
||||
concPers = List.filterMap .concPerson group.items
|
||||
concEqui = List.filterMap .concEquip group.items
|
||||
all = List.concat [corrOrgs, corrPers, concPers, concEqui]
|
||||
in
|
||||
List.map .name all
|
||||
|> Util.List.distinct
|
||||
|> List.intersperse ", "
|
||||
|> String.concat
|
||||
113
modules/webapp/src/main/elm/Comp/OrgForm.elm
Normal file
113
modules/webapp/src/main/elm/Comp/OrgForm.elm
Normal file
@ -0,0 +1,113 @@
|
||||
module Comp.OrgForm exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update
|
||||
, isValid
|
||||
, getOrg)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Organization exposing (Organization)
|
||||
import Comp.AddressForm
|
||||
import Comp.ContactField
|
||||
|
||||
type alias Model =
|
||||
{ org: Organization
|
||||
, name: String
|
||||
, addressModel: Comp.AddressForm.Model
|
||||
, contactModel: Comp.ContactField.Model
|
||||
, notes: Maybe String
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ org = Api.Model.Organization.empty
|
||||
, name = ""
|
||||
, addressModel = Comp.AddressForm.emptyModel
|
||||
, contactModel = Comp.ContactField.emptyModel
|
||||
, notes = Nothing
|
||||
}
|
||||
|
||||
isValid: Model -> Bool
|
||||
isValid model =
|
||||
model.name /= ""
|
||||
|
||||
getOrg: Model -> Organization
|
||||
getOrg model =
|
||||
let
|
||||
o = model.org
|
||||
in
|
||||
{ o | name = model.name
|
||||
, address = Comp.AddressForm.getAddress model.addressModel
|
||||
, contacts = Comp.ContactField.getContacts model.contactModel
|
||||
, notes = model.notes
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetName String
|
||||
| SetOrg Organization
|
||||
| AddressMsg Comp.AddressForm.Msg
|
||||
| ContactMsg Comp.ContactField.Msg
|
||||
| SetNotes String
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetOrg t ->
|
||||
let
|
||||
(m1, c1) = update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model
|
||||
(m2, c2) = update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1
|
||||
in
|
||||
({m2 | org = t, name = t.name, notes = t.notes }, Cmd.none)
|
||||
|
||||
AddressMsg am ->
|
||||
let
|
||||
(m1, c1) = Comp.AddressForm.update am model.addressModel
|
||||
in
|
||||
({model | addressModel = m1}, Cmd.map AddressMsg c1)
|
||||
|
||||
ContactMsg m ->
|
||||
let
|
||||
(m1, c1) = Comp.ContactField.update m model.contactModel
|
||||
in
|
||||
({model | contactModel = m1}, Cmd.map ContactMsg c1)
|
||||
|
||||
SetName n ->
|
||||
({model | name = n}, Cmd.none)
|
||||
|
||||
SetNotes str ->
|
||||
({model | notes = if str == "" then Nothing else Just str}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [class "ui form"]
|
||||
[div [classList [("field", True)
|
||||
,("error", not (isValid model))
|
||||
]
|
||||
]
|
||||
[label [][text "Name*"]
|
||||
,input [type_ "text"
|
||||
,onInput SetName
|
||||
,placeholder "Name"
|
||||
,value model.name
|
||||
][]
|
||||
]
|
||||
,h3 [class "ui dividing header"]
|
||||
[text "Address"
|
||||
]
|
||||
,Html.map AddressMsg (Comp.AddressForm.view model.addressModel)
|
||||
,h3 [class "ui dividing header"]
|
||||
[text "Contacts"
|
||||
]
|
||||
,Html.map ContactMsg (Comp.ContactField.view model.contactModel)
|
||||
,h3 [class "ui dividing header"]
|
||||
[text "Notes"
|
||||
]
|
||||
,div [class "field"]
|
||||
[textarea [onInput SetNotes][Maybe.withDefault "" model.notes |> text ]
|
||||
]
|
||||
]
|
||||
206
modules/webapp/src/main/elm/Comp/OrgManage.elm
Normal file
206
modules/webapp/src/main/elm/Comp/OrgManage.elm
Normal file
@ -0,0 +1,206 @@
|
||||
module Comp.OrgManage exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Http
|
||||
import Api
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick, onSubmit)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Comp.OrgTable
|
||||
import Comp.OrgForm
|
||||
import Comp.YesNoDimmer
|
||||
import Api.Model.Organization
|
||||
import Api.Model.OrganizationList exposing (OrganizationList)
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Util.Maybe
|
||||
import Util.Http
|
||||
|
||||
type alias Model =
|
||||
{ tableModel: Comp.OrgTable.Model
|
||||
, formModel: Comp.OrgForm.Model
|
||||
, viewMode: ViewMode
|
||||
, formError: Maybe String
|
||||
, loading: Bool
|
||||
, deleteConfirm: Comp.YesNoDimmer.Model
|
||||
}
|
||||
|
||||
type ViewMode = Table | Form
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tableModel = Comp.OrgTable.emptyModel
|
||||
, formModel = Comp.OrgForm.emptyModel
|
||||
, viewMode = Table
|
||||
, formError = Nothing
|
||||
, loading = False
|
||||
, deleteConfirm = Comp.YesNoDimmer.emptyModel
|
||||
}
|
||||
|
||||
type Msg
|
||||
= TableMsg Comp.OrgTable.Msg
|
||||
| FormMsg Comp.OrgForm.Msg
|
||||
| LoadOrgs
|
||||
| OrgResp (Result Http.Error OrganizationList)
|
||||
| SetViewMode ViewMode
|
||||
| InitNewOrg
|
||||
| Submit
|
||||
| SubmitResp (Result Http.Error BasicResult)
|
||||
| YesNoMsg Comp.YesNoDimmer.Msg
|
||||
| RequestDelete
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
TableMsg m ->
|
||||
let
|
||||
(tm, tc) = Comp.OrgTable.update flags m model.tableModel
|
||||
(m2, c2) = ({model | tableModel = tm
|
||||
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
|
||||
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
|
||||
}
|
||||
, Cmd.map TableMsg tc
|
||||
)
|
||||
(m3, c3) = case tm.selected of
|
||||
Just org ->
|
||||
update flags (FormMsg (Comp.OrgForm.SetOrg org)) m2
|
||||
Nothing ->
|
||||
(m2, Cmd.none)
|
||||
in
|
||||
(m3, Cmd.batch [c2, c3])
|
||||
|
||||
FormMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.OrgForm.update flags m model.formModel
|
||||
in
|
||||
({model | formModel = m2}, Cmd.map FormMsg c2)
|
||||
|
||||
LoadOrgs ->
|
||||
({model| loading = True}, Api.getOrganizations flags OrgResp)
|
||||
|
||||
OrgResp (Ok orgs) ->
|
||||
let
|
||||
m2 = {model|viewMode = Table, loading = False}
|
||||
in
|
||||
update flags (TableMsg (Comp.OrgTable.SetOrgs orgs.items)) m2
|
||||
|
||||
OrgResp (Err err) ->
|
||||
({model|loading = False}, Cmd.none)
|
||||
|
||||
SetViewMode m ->
|
||||
let
|
||||
m2 = {model | viewMode = m }
|
||||
in
|
||||
case m of
|
||||
Table ->
|
||||
update flags (TableMsg Comp.OrgTable.Deselect) m2
|
||||
Form ->
|
||||
(m2, Cmd.none)
|
||||
|
||||
InitNewOrg ->
|
||||
let
|
||||
nm = {model | viewMode = Form, formError = Nothing }
|
||||
org = Api.Model.Organization.empty
|
||||
in
|
||||
update flags (FormMsg (Comp.OrgForm.SetOrg org)) nm
|
||||
|
||||
Submit ->
|
||||
let
|
||||
org = Comp.OrgForm.getOrg model.formModel
|
||||
valid = Comp.OrgForm.isValid model.formModel
|
||||
in if valid then
|
||||
({model|loading = True}, Api.postOrg flags org SubmitResp)
|
||||
else
|
||||
({model|formError = Just "Please correct the errors in the form."}, Cmd.none)
|
||||
|
||||
SubmitResp (Ok res) ->
|
||||
if res.success then
|
||||
let
|
||||
(m2, c2) = update flags (SetViewMode Table) model
|
||||
(m3, c3) = update flags LoadOrgs m2
|
||||
in
|
||||
({m3|loading = False}, Cmd.batch [c2,c3])
|
||||
else
|
||||
({model | formError = Just res.message, loading = False }, Cmd.none)
|
||||
|
||||
SubmitResp (Err err) ->
|
||||
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
|
||||
|
||||
RequestDelete ->
|
||||
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
|
||||
|
||||
YesNoMsg m ->
|
||||
let
|
||||
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
|
||||
org = Comp.OrgForm.getOrg model.formModel
|
||||
cmd = if confirmed then Api.deleteOrg flags org.id SubmitResp else Cmd.none
|
||||
in
|
||||
({model | deleteConfirm = cm}, cmd)
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
if model.viewMode == Table then viewTable model
|
||||
else viewForm model
|
||||
|
||||
viewTable: Model -> Html Msg
|
||||
viewTable model =
|
||||
div []
|
||||
[button [class "ui basic button", onClick InitNewOrg]
|
||||
[i [class "plus icon"][]
|
||||
,text "Create new"
|
||||
]
|
||||
,Html.map TableMsg (Comp.OrgTable.view model.tableModel)
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
|
||||
viewForm: Model -> Html Msg
|
||||
viewForm model =
|
||||
let
|
||||
newOrg = model.formModel.org.id == ""
|
||||
in
|
||||
Html.form [class "ui segment", onSubmit Submit]
|
||||
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
|
||||
,if newOrg then
|
||||
h3 [class "ui dividing header"]
|
||||
[text "Create new organization"
|
||||
]
|
||||
else
|
||||
h3 [class "ui dividing header"]
|
||||
[text ("Edit org: " ++ model.formModel.org.name)
|
||||
,div [class "sub header"]
|
||||
[text "Id: "
|
||||
,text model.formModel.org.id
|
||||
]
|
||||
]
|
||||
,Html.map FormMsg (Comp.OrgForm.view model.formModel)
|
||||
,div [classList [("ui error message", True)
|
||||
,("invisible", Util.Maybe.isEmpty model.formError)
|
||||
]
|
||||
]
|
||||
[Maybe.withDefault "" model.formError |> text
|
||||
]
|
||||
,div [class "ui horizontal divider"][]
|
||||
,button [class "ui primary button", type_ "submit"]
|
||||
[text "Submit"
|
||||
]
|
||||
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
|
||||
[text "Cancel"
|
||||
]
|
||||
,if not newOrg then
|
||||
a [class "ui right floated red button", href "", onClick RequestDelete]
|
||||
[text "Delete"]
|
||||
else
|
||||
span[][]
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
74
modules/webapp/src/main/elm/Comp/OrgTable.elm
Normal file
74
modules/webapp/src/main/elm/Comp/OrgTable.elm
Normal file
@ -0,0 +1,74 @@
|
||||
module Comp.OrgTable exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Organization exposing (Organization)
|
||||
import Api.Model.Address exposing (Address)
|
||||
import Api.Model.Contact exposing (Contact)
|
||||
import Util.Address
|
||||
import Util.Contact
|
||||
|
||||
type alias Model =
|
||||
{ equips: List Organization
|
||||
, selected: Maybe Organization
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ equips = []
|
||||
, selected = Nothing
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetOrgs (List Organization)
|
||||
| Select Organization
|
||||
| Deselect
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetOrgs list ->
|
||||
({model | equips = list, selected = Nothing }, Cmd.none)
|
||||
|
||||
Select equip ->
|
||||
({model | selected = Just equip}, Cmd.none)
|
||||
|
||||
Deselect ->
|
||||
({model | selected = Nothing}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
table [class "ui selectable table"]
|
||||
[thead []
|
||||
[tr []
|
||||
[th [class "collapsing"][text "Name"]
|
||||
,th [][text "Address"]
|
||||
,th [][text "Contact"]
|
||||
]
|
||||
]
|
||||
,tbody []
|
||||
(List.map (renderOrgLine model) model.equips)
|
||||
]
|
||||
|
||||
renderOrgLine: Model -> Organization -> Html Msg
|
||||
renderOrgLine model org =
|
||||
tr [classList [("active", model.selected == Just org)]
|
||||
,onClick (Select org)
|
||||
]
|
||||
[td [class "collapsing"]
|
||||
[text org.name
|
||||
]
|
||||
,td []
|
||||
[Util.Address.toString org.address |> text
|
||||
]
|
||||
,td []
|
||||
[Util.Contact.toString org.contacts |> text
|
||||
]
|
||||
]
|
||||
129
modules/webapp/src/main/elm/Comp/PersonForm.elm
Normal file
129
modules/webapp/src/main/elm/Comp/PersonForm.elm
Normal file
@ -0,0 +1,129 @@
|
||||
module Comp.PersonForm exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update
|
||||
, isValid
|
||||
, getPerson)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput, onCheck)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Person exposing (Person)
|
||||
import Comp.AddressForm
|
||||
import Comp.ContactField
|
||||
import Comp.YesNoDimmer
|
||||
|
||||
type alias Model =
|
||||
{ org: Person
|
||||
, name: String
|
||||
, addressModel: Comp.AddressForm.Model
|
||||
, contactModel: Comp.ContactField.Model
|
||||
, notes: Maybe String
|
||||
, concerning: Bool
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ org = Api.Model.Person.empty
|
||||
, name = ""
|
||||
, addressModel = Comp.AddressForm.emptyModel
|
||||
, contactModel = Comp.ContactField.emptyModel
|
||||
, notes = Nothing
|
||||
, concerning = False
|
||||
}
|
||||
|
||||
isValid: Model -> Bool
|
||||
isValid model =
|
||||
model.name /= ""
|
||||
|
||||
getPerson: Model -> Person
|
||||
getPerson model =
|
||||
let
|
||||
o = model.org
|
||||
in
|
||||
{ o | name = model.name
|
||||
, address = Comp.AddressForm.getAddress model.addressModel
|
||||
, contacts = Comp.ContactField.getContacts model.contactModel
|
||||
, notes = model.notes
|
||||
, concerning = model.concerning
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetName String
|
||||
| SetPerson Person
|
||||
| AddressMsg Comp.AddressForm.Msg
|
||||
| ContactMsg Comp.ContactField.Msg
|
||||
| SetNotes String
|
||||
| SetConcerning Bool
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetPerson t ->
|
||||
let
|
||||
(m1, c1) = update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model
|
||||
(m2, c2) = update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1
|
||||
in
|
||||
({m2 | org = t, name = t.name, notes = t.notes, concerning = t.concerning }, Cmd.none)
|
||||
|
||||
AddressMsg am ->
|
||||
let
|
||||
(m1, c1) = Comp.AddressForm.update am model.addressModel
|
||||
in
|
||||
({model | addressModel = m1}, Cmd.map AddressMsg c1)
|
||||
|
||||
ContactMsg m ->
|
||||
let
|
||||
(m1, c1) = Comp.ContactField.update m model.contactModel
|
||||
in
|
||||
({model | contactModel = m1}, Cmd.map ContactMsg c1)
|
||||
|
||||
SetName n ->
|
||||
({model | name = n}, Cmd.none)
|
||||
|
||||
SetNotes str ->
|
||||
({model | notes = if str == "" then Nothing else Just str}, Cmd.none)
|
||||
|
||||
SetConcerning flag ->
|
||||
({model | concerning = not model.concerning}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [class "ui form"]
|
||||
[div [classList [("field", True)
|
||||
,("error", not (isValid model))
|
||||
]
|
||||
]
|
||||
[label [][text "Name*"]
|
||||
,input [type_ "text"
|
||||
,onInput SetName
|
||||
,placeholder "Name"
|
||||
,value model.name
|
||||
][]
|
||||
]
|
||||
,div [class "inline field"]
|
||||
[div [class "ui checkbox"]
|
||||
[input [type_ "checkbox"
|
||||
, checked model.concerning
|
||||
, onCheck SetConcerning][]
|
||||
,label [][text "Use for concerning person suggestion only"]
|
||||
]
|
||||
]
|
||||
,h3 [class "ui dividing header"]
|
||||
[text "Address"
|
||||
]
|
||||
,Html.map AddressMsg (Comp.AddressForm.view model.addressModel)
|
||||
,h3 [class "ui dividing header"]
|
||||
[text "Contacts"
|
||||
]
|
||||
,Html.map ContactMsg (Comp.ContactField.view model.contactModel)
|
||||
,h3 [class "ui dividing header"]
|
||||
[text "Notes"
|
||||
]
|
||||
,div [class "field"]
|
||||
[textarea [onInput SetNotes][Maybe.withDefault "" model.notes |> text ]
|
||||
]
|
||||
]
|
||||
207
modules/webapp/src/main/elm/Comp/PersonManage.elm
Normal file
207
modules/webapp/src/main/elm/Comp/PersonManage.elm
Normal file
@ -0,0 +1,207 @@
|
||||
module Comp.PersonManage exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Http
|
||||
import Api
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick, onSubmit)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Comp.PersonTable
|
||||
import Comp.PersonForm
|
||||
import Comp.YesNoDimmer
|
||||
import Api.Model.Person
|
||||
import Api.Model.PersonList exposing (PersonList)
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Util.Maybe
|
||||
import Util.Http
|
||||
|
||||
type alias Model =
|
||||
{ tableModel: Comp.PersonTable.Model
|
||||
, formModel: Comp.PersonForm.Model
|
||||
, viewMode: ViewMode
|
||||
, formError: Maybe String
|
||||
, loading: Bool
|
||||
, deleteConfirm: Comp.YesNoDimmer.Model
|
||||
}
|
||||
|
||||
type ViewMode = Table | Form
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tableModel = Comp.PersonTable.emptyModel
|
||||
, formModel = Comp.PersonForm.emptyModel
|
||||
, viewMode = Table
|
||||
, formError = Nothing
|
||||
, loading = False
|
||||
, deleteConfirm = Comp.YesNoDimmer.emptyModel
|
||||
}
|
||||
|
||||
type Msg
|
||||
= TableMsg Comp.PersonTable.Msg
|
||||
| FormMsg Comp.PersonForm.Msg
|
||||
| LoadPersons
|
||||
| PersonResp (Result Http.Error PersonList)
|
||||
| SetViewMode ViewMode
|
||||
| InitNewPerson
|
||||
| Submit
|
||||
| SubmitResp (Result Http.Error BasicResult)
|
||||
| YesNoMsg Comp.YesNoDimmer.Msg
|
||||
| RequestDelete
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
TableMsg m ->
|
||||
let
|
||||
(tm, tc) = Comp.PersonTable.update flags m model.tableModel
|
||||
(m2, c2) = ({model | tableModel = tm
|
||||
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
|
||||
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
|
||||
}
|
||||
, Cmd.map TableMsg tc
|
||||
)
|
||||
(m3, c3) = case tm.selected of
|
||||
Just org ->
|
||||
update flags (FormMsg (Comp.PersonForm.SetPerson org)) m2
|
||||
Nothing ->
|
||||
(m2, Cmd.none)
|
||||
in
|
||||
(m3, Cmd.batch [c2, c3])
|
||||
|
||||
FormMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.PersonForm.update flags m model.formModel
|
||||
in
|
||||
({model | formModel = m2}, Cmd.map FormMsg c2)
|
||||
|
||||
LoadPersons ->
|
||||
({model| loading = True}, Api.getPersons flags PersonResp)
|
||||
|
||||
PersonResp (Ok orgs) ->
|
||||
let
|
||||
m2 = {model|viewMode = Table, loading = False}
|
||||
in
|
||||
update flags (TableMsg (Comp.PersonTable.SetPersons orgs.items)) m2
|
||||
|
||||
PersonResp (Err err) ->
|
||||
({model|loading = False}, Cmd.none)
|
||||
|
||||
SetViewMode m ->
|
||||
let
|
||||
m2 = {model | viewMode = m }
|
||||
in
|
||||
case m of
|
||||
Table ->
|
||||
update flags (TableMsg Comp.PersonTable.Deselect) m2
|
||||
Form ->
|
||||
(m2, Cmd.none)
|
||||
|
||||
InitNewPerson ->
|
||||
let
|
||||
nm = {model | viewMode = Form, formError = Nothing }
|
||||
org = Api.Model.Person.empty
|
||||
in
|
||||
update flags (FormMsg (Comp.PersonForm.SetPerson org)) nm
|
||||
|
||||
Submit ->
|
||||
let
|
||||
person = Comp.PersonForm.getPerson model.formModel
|
||||
valid = Comp.PersonForm.isValid model.formModel
|
||||
in if valid then
|
||||
({model|loading = True}, Api.postPerson flags person SubmitResp)
|
||||
else
|
||||
({model|formError = Just "Please correct the errors in the form."}, Cmd.none)
|
||||
|
||||
SubmitResp (Ok res) ->
|
||||
if res.success then
|
||||
let
|
||||
(m2, c2) = update flags (SetViewMode Table) model
|
||||
(m3, c3) = update flags LoadPersons m2
|
||||
in
|
||||
({m3|loading = False}, Cmd.batch [c2,c3])
|
||||
else
|
||||
({model | formError = Just res.message, loading = False }, Cmd.none)
|
||||
|
||||
SubmitResp (Err err) ->
|
||||
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
|
||||
|
||||
RequestDelete ->
|
||||
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
|
||||
|
||||
YesNoMsg m ->
|
||||
let
|
||||
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
|
||||
person = Comp.PersonForm.getPerson model.formModel
|
||||
cmd = if confirmed then Api.deletePerson flags person.id SubmitResp else Cmd.none
|
||||
in
|
||||
({model | deleteConfirm = cm}, cmd)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
if model.viewMode == Table then viewTable model
|
||||
else viewForm model
|
||||
|
||||
viewTable: Model -> Html Msg
|
||||
viewTable model =
|
||||
div []
|
||||
[button [class "ui basic button", onClick InitNewPerson]
|
||||
[i [class "plus icon"][]
|
||||
,text "Create new"
|
||||
]
|
||||
,Html.map TableMsg (Comp.PersonTable.view model.tableModel)
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
|
||||
viewForm: Model -> Html Msg
|
||||
viewForm model =
|
||||
let
|
||||
newPerson = model.formModel.org.id == ""
|
||||
in
|
||||
Html.form [class "ui segment", onSubmit Submit]
|
||||
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
|
||||
,if newPerson then
|
||||
h3 [class "ui dividing header"]
|
||||
[text "Create new person"
|
||||
]
|
||||
else
|
||||
h3 [class "ui dividing header"]
|
||||
[text ("Edit org: " ++ model.formModel.org.name)
|
||||
,div [class "sub header"]
|
||||
[text "Id: "
|
||||
,text model.formModel.org.id
|
||||
]
|
||||
]
|
||||
,Html.map FormMsg (Comp.PersonForm.view model.formModel)
|
||||
,div [classList [("ui error message", True)
|
||||
,("invisible", Util.Maybe.isEmpty model.formError)
|
||||
]
|
||||
]
|
||||
[Maybe.withDefault "" model.formError |> text
|
||||
]
|
||||
,div [class "ui horizontal divider"][]
|
||||
,button [class "ui primary button", type_ "submit"]
|
||||
[text "Submit"
|
||||
]
|
||||
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
|
||||
[text "Cancel"
|
||||
]
|
||||
,if not newPerson then
|
||||
a [class "ui right floated red button", href "", onClick RequestDelete]
|
||||
[text "Delete"]
|
||||
else
|
||||
span[][]
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
81
modules/webapp/src/main/elm/Comp/PersonTable.elm
Normal file
81
modules/webapp/src/main/elm/Comp/PersonTable.elm
Normal file
@ -0,0 +1,81 @@
|
||||
module Comp.PersonTable exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Person exposing (Person)
|
||||
import Api.Model.Address exposing (Address)
|
||||
import Api.Model.Contact exposing (Contact)
|
||||
import Util.Address
|
||||
import Util.Contact
|
||||
|
||||
type alias Model =
|
||||
{ equips: List Person
|
||||
, selected: Maybe Person
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ equips = []
|
||||
, selected = Nothing
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetPersons (List Person)
|
||||
| Select Person
|
||||
| Deselect
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetPersons list ->
|
||||
({model | equips = list, selected = Nothing }, Cmd.none)
|
||||
|
||||
Select equip ->
|
||||
({model | selected = Just equip}, Cmd.none)
|
||||
|
||||
Deselect ->
|
||||
({model | selected = Nothing}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
table [class "ui selectable table"]
|
||||
[thead []
|
||||
[tr []
|
||||
[th [class "collapsing"][text "Name"]
|
||||
,th [class "collapsing"][text "Concerning"]
|
||||
,th [][text "Address"]
|
||||
,th [][text "Contact"]
|
||||
]
|
||||
]
|
||||
,tbody []
|
||||
(List.map (renderPersonLine model) model.equips)
|
||||
]
|
||||
|
||||
renderPersonLine: Model -> Person -> Html Msg
|
||||
renderPersonLine model person =
|
||||
tr [classList [("active", model.selected == Just person)]
|
||||
,onClick (Select person)
|
||||
]
|
||||
[td [class "collapsing"]
|
||||
[text person.name
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[if person.concerning then
|
||||
i [class "check square outline icon"][]
|
||||
else
|
||||
i [class "minus square outline icon"][]
|
||||
]
|
||||
,td []
|
||||
[Util.Address.toString person.address |> text
|
||||
]
|
||||
,td []
|
||||
[Util.Contact.toString person.contacts |> text
|
||||
]
|
||||
]
|
||||
429
modules/webapp/src/main/elm/Comp/SearchMenu.elm
Normal file
429
modules/webapp/src/main/elm/Comp/SearchMenu.elm
Normal file
@ -0,0 +1,429 @@
|
||||
module Comp.SearchMenu exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, update
|
||||
, NextState
|
||||
, view
|
||||
, getItemSearch
|
||||
)
|
||||
|
||||
import Http
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onCheck, onInput)
|
||||
import Data.Direction exposing (Direction)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Comp.Dropdown exposing (isDropdownChangeMsg)
|
||||
import Comp.DatePicker
|
||||
import DatePicker exposing (DatePicker)
|
||||
import Api
|
||||
import Api.Model.IdName exposing (IdName)
|
||||
import Api.Model.ItemSearch exposing (ItemSearch)
|
||||
import Api.Model.TagList exposing (TagList)
|
||||
import Api.Model.Tag exposing (Tag)
|
||||
import Api.Model.Equipment exposing (Equipment)
|
||||
import Api.Model.ReferenceList exposing (ReferenceList)
|
||||
import Api.Model.EquipmentList exposing (EquipmentList)
|
||||
import Util.Maybe
|
||||
import Util.Update
|
||||
|
||||
-- Data Model
|
||||
|
||||
type alias Model =
|
||||
{ tagInclModel: Comp.Dropdown.Model Tag
|
||||
, tagExclModel: Comp.Dropdown.Model Tag
|
||||
, directionModel: Comp.Dropdown.Model Direction
|
||||
, orgModel: Comp.Dropdown.Model IdName
|
||||
, corrPersonModel: Comp.Dropdown.Model IdName
|
||||
, concPersonModel: Comp.Dropdown.Model IdName
|
||||
, concEquipmentModel: Comp.Dropdown.Model Equipment
|
||||
, inboxCheckbox: Bool
|
||||
, fromDateModel: DatePicker
|
||||
, fromDate: Maybe Int
|
||||
, untilDateModel: DatePicker
|
||||
, untilDate: Maybe Int
|
||||
, fromDueDateModel: DatePicker
|
||||
, fromDueDate: Maybe Int
|
||||
, untilDueDateModel: DatePicker
|
||||
, untilDueDate: Maybe Int
|
||||
, nameModel: Maybe String
|
||||
}
|
||||
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tagInclModel = makeTagModel
|
||||
, tagExclModel = makeTagModel
|
||||
, directionModel = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \entry -> {value = Data.Direction.toString entry, text = Data.Direction.toString entry}
|
||||
, options = Data.Direction.all
|
||||
, placeholder = "Choose a direction…"
|
||||
, selected = Nothing
|
||||
}
|
||||
, orgModel = Comp.Dropdown.makeModel
|
||||
{ multiple = False
|
||||
, searchable = \n -> n > 5
|
||||
, makeOption = \e -> {value = e.id, text = e.name}
|
||||
, labelColor = \_ -> ""
|
||||
, placeholder = "Choose an organization"
|
||||
}
|
||||
, corrPersonModel = Comp.Dropdown.makeSingle
|
||||
{ makeOption = \e -> {value = e.id, text = e.name}
|
||||
, placeholder = "Choose a person"
|
||||
}
|
||||
, concPersonModel = Comp.Dropdown.makeSingle
|
||||
{ makeOption = \e -> {value = e.id, text = e.name}
|
||||
, placeholder = "Choose a person"
|
||||
}
|
||||
, concEquipmentModel = Comp.Dropdown.makeModel
|
||||
{ multiple = False
|
||||
, searchable = \n -> n > 5
|
||||
, makeOption = \e -> {value = e.id, text = e.name}
|
||||
, labelColor = \_ -> ""
|
||||
, placeholder = "Choosa an equipment"
|
||||
}
|
||||
, inboxCheckbox = False
|
||||
, fromDateModel = Comp.DatePicker.emptyModel
|
||||
, fromDate = Nothing
|
||||
, untilDateModel = Comp.DatePicker.emptyModel
|
||||
, untilDate = Nothing
|
||||
, fromDueDateModel = Comp.DatePicker.emptyModel
|
||||
, fromDueDate = Nothing
|
||||
, untilDueDateModel = Comp.DatePicker.emptyModel
|
||||
, untilDueDate = Nothing
|
||||
, nameModel = Nothing
|
||||
}
|
||||
|
||||
type Msg
|
||||
= Init
|
||||
| TagIncMsg (Comp.Dropdown.Msg Tag)
|
||||
| TagExcMsg (Comp.Dropdown.Msg Tag)
|
||||
| DirectionMsg (Comp.Dropdown.Msg Direction)
|
||||
| OrgMsg (Comp.Dropdown.Msg IdName)
|
||||
| CorrPersonMsg (Comp.Dropdown.Msg IdName)
|
||||
| ConcPersonMsg (Comp.Dropdown.Msg IdName)
|
||||
| ConcEquipmentMsg (Comp.Dropdown.Msg Equipment)
|
||||
| FromDateMsg Comp.DatePicker.Msg
|
||||
| UntilDateMsg Comp.DatePicker.Msg
|
||||
| FromDueDateMsg Comp.DatePicker.Msg
|
||||
| UntilDueDateMsg Comp.DatePicker.Msg
|
||||
| ToggleInbox
|
||||
| GetTagsResp (Result Http.Error TagList)
|
||||
| GetOrgResp (Result Http.Error ReferenceList)
|
||||
| GetEquipResp (Result Http.Error EquipmentList)
|
||||
| GetPersonResp (Result Http.Error ReferenceList)
|
||||
| SetName String
|
||||
|
||||
|
||||
makeTagModel: Comp.Dropdown.Model Tag
|
||||
makeTagModel =
|
||||
Comp.Dropdown.makeModel
|
||||
{ multiple = True
|
||||
, searchable = \n -> n > 4
|
||||
, makeOption = \tag -> { value = tag.id, text = tag.name }
|
||||
, labelColor = \tag -> if Util.Maybe.nonEmpty tag.category then "basic blue" else ""
|
||||
, placeholder = "Choose a tag…"
|
||||
}
|
||||
|
||||
getDirection: Model -> Maybe Direction
|
||||
getDirection model =
|
||||
let
|
||||
selection = Comp.Dropdown.getSelected model.directionModel
|
||||
in
|
||||
case selection of
|
||||
[d] -> Just d
|
||||
_ -> Nothing
|
||||
|
||||
getItemSearch: Model -> ItemSearch
|
||||
getItemSearch model =
|
||||
let e = Api.Model.ItemSearch.empty in
|
||||
{ e | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id
|
||||
, tagsExclude = Comp.Dropdown.getSelected model.tagExclModel |> List.map .id
|
||||
, corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head
|
||||
, corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head
|
||||
, concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head
|
||||
, concEquip = Comp.Dropdown.getSelected model.concEquipmentModel |> List.map .id |> List.head
|
||||
, direction = Comp.Dropdown.getSelected model.directionModel |> List.head |> Maybe.map Data.Direction.toString
|
||||
, inbox = model.inboxCheckbox
|
||||
, dateFrom = model.fromDate
|
||||
, dateUntil = model.untilDate
|
||||
, dueDateFrom = model.fromDueDate
|
||||
, dueDateUntil = model.untilDueDate
|
||||
, name = model.nameModel
|
||||
}
|
||||
|
||||
-- Update
|
||||
|
||||
type alias NextState
|
||||
= { modelCmd: (Model, Cmd Msg)
|
||||
, stateChange: Bool
|
||||
}
|
||||
|
||||
noChange: (Model, Cmd Msg) -> NextState
|
||||
noChange p =
|
||||
NextState p False
|
||||
|
||||
update: Flags -> Msg -> Model -> NextState
|
||||
update flags msg model =
|
||||
case msg of
|
||||
Init ->
|
||||
let
|
||||
(dp, dpc) = Comp.DatePicker.init
|
||||
in
|
||||
noChange ({model|untilDateModel = dp, fromDateModel = dp, untilDueDateModel = dp, fromDueDateModel = dp}
|
||||
, Cmd.batch
|
||||
[Api.getTags flags GetTagsResp
|
||||
,Api.getOrgLight flags GetOrgResp
|
||||
,Api.getEquipments flags GetEquipResp
|
||||
,Api.getPersonsLight flags GetPersonResp
|
||||
,Cmd.map UntilDateMsg dpc
|
||||
,Cmd.map FromDateMsg dpc
|
||||
,Cmd.map UntilDueDateMsg dpc
|
||||
,Cmd.map FromDueDateMsg dpc
|
||||
]
|
||||
)
|
||||
|
||||
GetTagsResp (Ok tags) ->
|
||||
let
|
||||
tagList = Comp.Dropdown.SetOptions tags.items
|
||||
in
|
||||
noChange <|
|
||||
Util.Update.andThen1
|
||||
[ update flags (TagIncMsg tagList) >> .modelCmd
|
||||
, update flags (TagExcMsg tagList) >> .modelCmd
|
||||
]
|
||||
model
|
||||
|
||||
GetTagsResp (Err err) ->
|
||||
noChange (model, Cmd.none)
|
||||
|
||||
GetEquipResp (Ok equips) ->
|
||||
let
|
||||
opts = Comp.Dropdown.SetOptions equips.items
|
||||
in
|
||||
update flags (ConcEquipmentMsg opts) model
|
||||
|
||||
GetEquipResp (Err err) ->
|
||||
noChange (model, Cmd.none)
|
||||
|
||||
GetOrgResp (Ok orgs) ->
|
||||
let
|
||||
opts = Comp.Dropdown.SetOptions orgs.items
|
||||
in
|
||||
update flags (OrgMsg opts) model
|
||||
|
||||
GetOrgResp (Err err) ->
|
||||
noChange (model, Cmd.none)
|
||||
|
||||
GetPersonResp (Ok ps) ->
|
||||
let
|
||||
opts = Comp.Dropdown.SetOptions ps.items
|
||||
in
|
||||
noChange <|
|
||||
Util.Update.andThen1
|
||||
[ update flags (CorrPersonMsg opts) >> .modelCmd
|
||||
, update flags (ConcPersonMsg opts) >> .modelCmd
|
||||
]
|
||||
model
|
||||
|
||||
GetPersonResp (Err err) ->
|
||||
noChange (model, Cmd.none)
|
||||
|
||||
TagIncMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.tagInclModel
|
||||
in
|
||||
NextState ({model|tagInclModel = m2}, Cmd.map TagIncMsg c2) (isDropdownChangeMsg m)
|
||||
|
||||
TagExcMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.tagExclModel
|
||||
in
|
||||
NextState ({model|tagExclModel = m2}, Cmd.map TagExcMsg c2) (isDropdownChangeMsg m)
|
||||
|
||||
DirectionMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.directionModel
|
||||
in
|
||||
NextState ({model|directionModel = m2}, Cmd.map DirectionMsg c2) (isDropdownChangeMsg m)
|
||||
|
||||
OrgMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.orgModel
|
||||
in
|
||||
NextState ({model|orgModel = m2}, Cmd.map OrgMsg c2) (isDropdownChangeMsg m)
|
||||
|
||||
CorrPersonMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.corrPersonModel
|
||||
in
|
||||
NextState ({model|corrPersonModel = m2}, Cmd.map CorrPersonMsg c2) (isDropdownChangeMsg m)
|
||||
|
||||
ConcPersonMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.concPersonModel
|
||||
in
|
||||
NextState ({model|concPersonModel = m2}, Cmd.map ConcPersonMsg c2) (isDropdownChangeMsg m)
|
||||
|
||||
ConcEquipmentMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.concEquipmentModel
|
||||
in
|
||||
NextState ({model|concEquipmentModel = m2}, Cmd.map ConcEquipmentMsg c2) (isDropdownChangeMsg m)
|
||||
|
||||
ToggleInbox ->
|
||||
let
|
||||
current = model.inboxCheckbox
|
||||
in
|
||||
NextState ({model | inboxCheckbox = not current }, Cmd.none) True
|
||||
|
||||
FromDateMsg m ->
|
||||
let
|
||||
(dp, event) = Comp.DatePicker.updateDefault m model.fromDateModel
|
||||
nextDate = case event of
|
||||
DatePicker.Picked date ->
|
||||
Just (Comp.DatePicker.startOfDay date)
|
||||
_ ->
|
||||
Nothing
|
||||
in
|
||||
NextState ({model|fromDateModel = dp, fromDate = nextDate}, Cmd.none) (model.fromDate /= nextDate)
|
||||
|
||||
UntilDateMsg m ->
|
||||
let
|
||||
(dp, event) = Comp.DatePicker.updateDefault m model.untilDateModel
|
||||
nextDate = case event of
|
||||
DatePicker.Picked date ->
|
||||
Just (Comp.DatePicker.endOfDay date)
|
||||
_ ->
|
||||
Nothing
|
||||
in
|
||||
NextState ({model|untilDateModel = dp, untilDate = nextDate}, Cmd.none) (model.untilDate /= nextDate)
|
||||
|
||||
FromDueDateMsg m ->
|
||||
let
|
||||
(dp, event) = Comp.DatePicker.updateDefault m model.fromDueDateModel
|
||||
nextDate = case event of
|
||||
DatePicker.Picked date ->
|
||||
Just (Comp.DatePicker.startOfDay date)
|
||||
_ ->
|
||||
Nothing
|
||||
in
|
||||
NextState ({model|fromDueDateModel = dp, fromDueDate = nextDate}, Cmd.none) (model.fromDueDate /= nextDate)
|
||||
|
||||
UntilDueDateMsg m ->
|
||||
let
|
||||
(dp, event) = Comp.DatePicker.updateDefault m model.untilDueDateModel
|
||||
nextDate = case event of
|
||||
DatePicker.Picked date ->
|
||||
Just (Comp.DatePicker.endOfDay date)
|
||||
_ ->
|
||||
Nothing
|
||||
in
|
||||
NextState ({model|untilDueDateModel = dp, untilDueDate = nextDate}, Cmd.none) (model.untilDueDate /= nextDate)
|
||||
|
||||
SetName str ->
|
||||
let
|
||||
next = if str == "" then Nothing else Just str
|
||||
in
|
||||
NextState ({model|nameModel = next}, Cmd.none) (model.nameModel /= next)
|
||||
|
||||
|
||||
-- View
|
||||
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [class "ui form"]
|
||||
[div [class "inline field"]
|
||||
[div [class "ui checkbox"]
|
||||
[input [type_ "checkbox"
|
||||
, onCheck (\_ -> ToggleInbox)
|
||||
, checked model.inboxCheckbox][]
|
||||
,label [][text "Only New"
|
||||
]
|
||||
]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Name"]
|
||||
,input [type_ "text"
|
||||
,onInput SetName
|
||||
,model.nameModel |> Maybe.withDefault "" |> value
|
||||
][]
|
||||
,span [class "small-info"]
|
||||
[text "May contain wildcard "
|
||||
,code [][text "*"]
|
||||
,text " at beginning or end"
|
||||
]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Direction"]
|
||||
,Html.map DirectionMsg (Comp.Dropdown.view model.directionModel)
|
||||
]
|
||||
,h3 [class "ui header"]
|
||||
[text "Tags"
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Include (and)"]
|
||||
,Html.map TagIncMsg (Comp.Dropdown.view model.tagInclModel)
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Exclude (or)"]
|
||||
,Html.map TagExcMsg (Comp.Dropdown.view model.tagExclModel)
|
||||
]
|
||||
,h3 [class "ui header"]
|
||||
[ case getDirection model of
|
||||
Just Data.Direction.Incoming -> text "Sender"
|
||||
Just Data.Direction.Outgoing -> text "Recipient"
|
||||
Nothing -> text "Correspondent"
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Organization"]
|
||||
,Html.map OrgMsg (Comp.Dropdown.view model.orgModel)
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Person"]
|
||||
,Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel)
|
||||
]
|
||||
,h3 [class "ui header"]
|
||||
[text "Concerned"
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Person"]
|
||||
,Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel)
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Equipment"]
|
||||
,Html.map ConcEquipmentMsg (Comp.Dropdown.view model.concEquipmentModel)
|
||||
]
|
||||
,h3 [class "ui header"]
|
||||
[text "Date"
|
||||
]
|
||||
,div [class "fields"]
|
||||
[div [class "field"]
|
||||
[label [][text "From"
|
||||
]
|
||||
,Html.map FromDateMsg (Comp.DatePicker.viewTimeDefault model.fromDate model.fromDateModel)
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "To"
|
||||
]
|
||||
,Html.map UntilDateMsg (Comp.DatePicker.viewTimeDefault model.untilDate model.untilDateModel)
|
||||
]
|
||||
]
|
||||
,h3 [class "ui header"]
|
||||
[text "Due Date"
|
||||
]
|
||||
,div [class "fields"]
|
||||
[div [class "field"]
|
||||
[label [][text "Due From"
|
||||
]
|
||||
,Html.map FromDueDateMsg (Comp.DatePicker.viewTimeDefault model.fromDueDate model.fromDueDateModel)
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Due To"
|
||||
]
|
||||
,Html.map UntilDueDateMsg (Comp.DatePicker.viewTimeDefault model.untilDueDate model.untilDueDateModel)
|
||||
]
|
||||
]
|
||||
]
|
||||
62
modules/webapp/src/main/elm/Comp/Settings.elm
Normal file
62
modules/webapp/src/main/elm/Comp/Settings.elm
Normal file
@ -0,0 +1,62 @@
|
||||
module Comp.Settings exposing (..)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Data.Language exposing (Language)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Comp.Dropdown
|
||||
import Api.Model.CollectiveSettings exposing (CollectiveSettings)
|
||||
|
||||
type alias Model =
|
||||
{ langModel: Comp.Dropdown.Model Language
|
||||
, initSettings: CollectiveSettings
|
||||
}
|
||||
|
||||
init: CollectiveSettings -> Model
|
||||
init settings =
|
||||
let
|
||||
lang = Data.Language.fromString settings.language |> Maybe.withDefault Data.Language.German
|
||||
in
|
||||
{ langModel = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \l -> { value = Data.Language.toIso3 l, text = Data.Language.toName l }
|
||||
, placeholder = ""
|
||||
, options = Data.Language.all
|
||||
, selected = Just lang
|
||||
}
|
||||
, initSettings = settings
|
||||
}
|
||||
|
||||
getSettings: Model -> CollectiveSettings
|
||||
getSettings model =
|
||||
CollectiveSettings
|
||||
(Comp.Dropdown.getSelected model.langModel
|
||||
|> List.head
|
||||
|> Maybe.map Data.Language.toIso3
|
||||
|> Maybe.withDefault model.initSettings.language
|
||||
)
|
||||
|
||||
type Msg
|
||||
= LangDropdownMsg (Comp.Dropdown.Msg Language)
|
||||
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg, Maybe CollectiveSettings)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
LangDropdownMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.langModel
|
||||
nextModel = {model|langModel = m2}
|
||||
nextSettings = if Comp.Dropdown.isDropdownChangeMsg m then Just (getSettings nextModel)
|
||||
else Nothing
|
||||
in
|
||||
(nextModel, Cmd.map LangDropdownMsg c2, nextSettings)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [class "ui form"]
|
||||
[div [class "field"]
|
||||
[label [][text "Document Language"]
|
||||
,Html.map LangDropdownMsg (Comp.Dropdown.view model.langModel)
|
||||
]
|
||||
]
|
||||
168
modules/webapp/src/main/elm/Comp/SourceForm.elm
Normal file
168
modules/webapp/src/main/elm/Comp/SourceForm.elm
Normal file
@ -0,0 +1,168 @@
|
||||
module Comp.SourceForm exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update
|
||||
, isValid
|
||||
, getSource)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput, onCheck)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Data.SourceState exposing (SourceState)
|
||||
import Data.Priority exposing (Priority)
|
||||
import Comp.Dropdown
|
||||
import Api.Model.Source exposing (Source)
|
||||
import Util.Maybe
|
||||
|
||||
type alias Model =
|
||||
{ source: Source
|
||||
, abbrev: String
|
||||
, description: Maybe String
|
||||
, priority: Comp.Dropdown.Model Priority
|
||||
, enabled: Bool
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ source = Api.Model.Source.empty
|
||||
, abbrev = ""
|
||||
, description = Nothing
|
||||
, priority = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p }
|
||||
, placeholder = ""
|
||||
, options = Data.Priority.all
|
||||
, selected = Nothing
|
||||
}
|
||||
, enabled = False
|
||||
}
|
||||
|
||||
isValid: Model -> Bool
|
||||
isValid model =
|
||||
model.abbrev /= ""
|
||||
|
||||
getSource: Model -> Source
|
||||
getSource model =
|
||||
let
|
||||
s = model.source
|
||||
in
|
||||
{s | abbrev = model.abbrev
|
||||
, description = model.description
|
||||
, enabled = model.enabled
|
||||
, priority = Comp.Dropdown.getSelected model.priority
|
||||
|> List.head
|
||||
|> Maybe.map Data.Priority.toName
|
||||
|> Maybe.withDefault s.priority
|
||||
}
|
||||
|
||||
|
||||
type Msg
|
||||
= SetAbbrev String
|
||||
| SetSource Source
|
||||
| SetDescr String
|
||||
| ToggleEnabled
|
||||
| PrioDropdownMsg (Comp.Dropdown.Msg Priority)
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetSource t ->
|
||||
let
|
||||
post = model.source
|
||||
np = {post | id = t.id
|
||||
, abbrev = t.abbrev
|
||||
, description = t.description
|
||||
, priority = t.priority
|
||||
, enabled = t.enabled
|
||||
}
|
||||
in
|
||||
({model | source = np
|
||||
, abbrev = t.abbrev
|
||||
, description = t.description
|
||||
, priority = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p }
|
||||
, placeholder = ""
|
||||
, options = Data.Priority.all
|
||||
, selected = Data.Priority.fromString t.priority
|
||||
}
|
||||
, enabled = t.enabled }, Cmd.none)
|
||||
|
||||
ToggleEnabled ->
|
||||
let
|
||||
_ = Debug.log "got" model.enabled
|
||||
in
|
||||
({model | enabled = not model.enabled}, Cmd.none)
|
||||
|
||||
SetAbbrev n ->
|
||||
({model | abbrev = n}, Cmd.none)
|
||||
|
||||
SetDescr d ->
|
||||
({model | description = if d /= "" then Just d else Nothing }, Cmd.none)
|
||||
|
||||
PrioDropdownMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.Dropdown.update m model.priority
|
||||
in
|
||||
({model | priority = m2 }, Cmd.map PrioDropdownMsg c2)
|
||||
|
||||
view: Flags -> Model -> Html Msg
|
||||
view flags model =
|
||||
div [class "ui form"]
|
||||
[div [classList [("field", True)
|
||||
,("error", not (isValid model))
|
||||
]
|
||||
]
|
||||
[label [][text "Abbrev*"]
|
||||
,input [type_ "text"
|
||||
,onInput SetAbbrev
|
||||
,placeholder "Abbrev"
|
||||
,value model.abbrev
|
||||
][]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Description"]
|
||||
,textarea [onInput SetDescr][model.description |> Maybe.withDefault "" |> text]
|
||||
]
|
||||
,div [class "inline field"]
|
||||
[div [class "ui checkbox"]
|
||||
[input [type_ "checkbox"
|
||||
, onCheck (\_ -> ToggleEnabled)
|
||||
, checked model.enabled][]
|
||||
,label [][text "Enabled"]
|
||||
]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Priority"]
|
||||
,Html.map PrioDropdownMsg (Comp.Dropdown.view model.priority)
|
||||
]
|
||||
,urlInfoMessage flags model
|
||||
]
|
||||
|
||||
urlInfoMessage: Flags -> Model -> Html Msg
|
||||
urlInfoMessage flags model =
|
||||
div [classList [("ui info icon message", True)
|
||||
,("hidden", not model.enabled || model.source.id == "")
|
||||
]]
|
||||
[i [class "info icon"][]
|
||||
,div [class "content"]
|
||||
[div [class "header"]
|
||||
[text "Public Uploads"
|
||||
]
|
||||
,p [][text "This source defines URLs that can be used by anyone to send files to "
|
||||
,text "you. There is a web page that you can share or tha API url can be used "
|
||||
,text "with other clients."
|
||||
]
|
||||
,dl [class "ui list"]
|
||||
[dt [][text "Public Upload Page"]
|
||||
,dd [][let
|
||||
url = flags.config.baseUrl ++ "/app/index.html#/upload/" ++ model.source.id
|
||||
in
|
||||
a [href url, target "_blank"][code [][text url]]
|
||||
]
|
||||
,dt [][text "Public API Upload URL"]
|
||||
,dd [][code [][text (flags.config.baseUrl ++ "/api/v1/open/upload/item/" ++ model.source.id)]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
207
modules/webapp/src/main/elm/Comp/SourceManage.elm
Normal file
207
modules/webapp/src/main/elm/Comp/SourceManage.elm
Normal file
@ -0,0 +1,207 @@
|
||||
module Comp.SourceManage exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Http
|
||||
import Api
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick, onSubmit)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Comp.SourceTable
|
||||
import Comp.SourceForm
|
||||
import Comp.YesNoDimmer
|
||||
import Api.Model.Source
|
||||
import Api.Model.SourceList exposing (SourceList)
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Util.Maybe
|
||||
import Util.Http
|
||||
|
||||
type alias Model =
|
||||
{ tableModel: Comp.SourceTable.Model
|
||||
, formModel: Comp.SourceForm.Model
|
||||
, viewMode: ViewMode
|
||||
, formError: Maybe String
|
||||
, loading: Bool
|
||||
, deleteConfirm: Comp.YesNoDimmer.Model
|
||||
}
|
||||
|
||||
type ViewMode = Table | Form
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tableModel = Comp.SourceTable.emptyModel
|
||||
, formModel = Comp.SourceForm.emptyModel
|
||||
, viewMode = Table
|
||||
, formError = Nothing
|
||||
, loading = False
|
||||
, deleteConfirm = Comp.YesNoDimmer.emptyModel
|
||||
}
|
||||
|
||||
type Msg
|
||||
= TableMsg Comp.SourceTable.Msg
|
||||
| FormMsg Comp.SourceForm.Msg
|
||||
| LoadSources
|
||||
| SourceResp (Result Http.Error SourceList)
|
||||
| SetViewMode ViewMode
|
||||
| InitNewSource
|
||||
| Submit
|
||||
| SubmitResp (Result Http.Error BasicResult)
|
||||
| YesNoMsg Comp.YesNoDimmer.Msg
|
||||
| RequestDelete
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
TableMsg m ->
|
||||
let
|
||||
(tm, tc) = Comp.SourceTable.update flags m model.tableModel
|
||||
(m2, c2) = ({model | tableModel = tm
|
||||
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
|
||||
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
|
||||
}
|
||||
, Cmd.map TableMsg tc
|
||||
)
|
||||
(m3, c3) = case tm.selected of
|
||||
Just source ->
|
||||
update flags (FormMsg (Comp.SourceForm.SetSource source)) m2
|
||||
Nothing ->
|
||||
(m2, Cmd.none)
|
||||
in
|
||||
(m3, Cmd.batch [c2, c3])
|
||||
|
||||
FormMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.SourceForm.update flags m model.formModel
|
||||
in
|
||||
({model | formModel = m2}, Cmd.map FormMsg c2)
|
||||
|
||||
LoadSources ->
|
||||
({model| loading = True}, Api.getSources flags SourceResp)
|
||||
|
||||
SourceResp (Ok sources) ->
|
||||
let
|
||||
m2 = {model|viewMode = Table, loading = False}
|
||||
in
|
||||
update flags (TableMsg (Comp.SourceTable.SetSources sources.items)) m2
|
||||
|
||||
SourceResp (Err err) ->
|
||||
({model|loading = False}, Cmd.none)
|
||||
|
||||
SetViewMode m ->
|
||||
let
|
||||
m2 = {model | viewMode = m }
|
||||
in
|
||||
case m of
|
||||
Table ->
|
||||
update flags (TableMsg Comp.SourceTable.Deselect) m2
|
||||
Form ->
|
||||
(m2, Cmd.none)
|
||||
|
||||
InitNewSource ->
|
||||
let
|
||||
nm = {model | viewMode = Form, formError = Nothing }
|
||||
source = Api.Model.Source.empty
|
||||
in
|
||||
update flags (FormMsg (Comp.SourceForm.SetSource source)) nm
|
||||
|
||||
Submit ->
|
||||
let
|
||||
source = Comp.SourceForm.getSource model.formModel
|
||||
valid = Comp.SourceForm.isValid model.formModel
|
||||
in if valid then
|
||||
({model|loading = True}, Api.postSource flags source SubmitResp)
|
||||
else
|
||||
({model|formError = Just "Please correct the errors in the form."}, Cmd.none)
|
||||
|
||||
SubmitResp (Ok res) ->
|
||||
if res.success then
|
||||
let
|
||||
(m2, c2) = update flags (SetViewMode Table) model
|
||||
(m3, c3) = update flags LoadSources m2
|
||||
in
|
||||
({m3|loading = False}, Cmd.batch [c2,c3])
|
||||
else
|
||||
({model | formError = Just res.message, loading = False }, Cmd.none)
|
||||
|
||||
SubmitResp (Err err) ->
|
||||
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
|
||||
|
||||
RequestDelete ->
|
||||
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
|
||||
|
||||
YesNoMsg m ->
|
||||
let
|
||||
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
|
||||
src = Comp.SourceForm.getSource model.formModel
|
||||
cmd = if confirmed then Api.deleteSource flags src.id SubmitResp else Cmd.none
|
||||
in
|
||||
({model | deleteConfirm = cm}, cmd)
|
||||
|
||||
view: Flags -> Model -> Html Msg
|
||||
view flags model =
|
||||
if model.viewMode == Table then viewTable model
|
||||
else div [](viewForm flags model)
|
||||
|
||||
viewTable: Model -> Html Msg
|
||||
viewTable model =
|
||||
div []
|
||||
[button [class "ui basic button", onClick InitNewSource]
|
||||
[i [class "plus icon"][]
|
||||
,text "Create new"
|
||||
]
|
||||
,Html.map TableMsg (Comp.SourceTable.view model.tableModel)
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
|
||||
viewForm: Flags -> Model -> List (Html Msg)
|
||||
viewForm flags model =
|
||||
let
|
||||
newSource = model.formModel.source.id == ""
|
||||
in
|
||||
[if newSource then
|
||||
h3 [class "ui top attached header"]
|
||||
[text "Create new source"
|
||||
]
|
||||
else
|
||||
h3 [class "ui top attached header"]
|
||||
[text ("Edit: " ++ model.formModel.source.abbrev)
|
||||
,div [class "sub header"]
|
||||
[text "Id: "
|
||||
,text model.formModel.source.id
|
||||
]
|
||||
]
|
||||
,Html.form [class "ui attached segment", onSubmit Submit]
|
||||
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
|
||||
,Html.map FormMsg (Comp.SourceForm.view flags model.formModel)
|
||||
,div [classList [("ui error message", True)
|
||||
,("invisible", Util.Maybe.isEmpty model.formError)
|
||||
]
|
||||
]
|
||||
[Maybe.withDefault "" model.formError |> text
|
||||
]
|
||||
,div [class "ui horizontal divider"][]
|
||||
,button [class "ui primary button", type_ "submit"]
|
||||
[text "Submit"
|
||||
]
|
||||
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
|
||||
[text "Cancel"
|
||||
]
|
||||
,if not newSource then
|
||||
a [class "ui right floated red button", href "", onClick RequestDelete]
|
||||
[text "Delete"]
|
||||
else
|
||||
span[][]
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
]
|
||||
85
modules/webapp/src/main/elm/Comp/SourceTable.elm
Normal file
85
modules/webapp/src/main/elm/Comp/SourceTable.elm
Normal file
@ -0,0 +1,85 @@
|
||||
module Comp.SourceTable exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Data.Priority exposing (Priority)
|
||||
import Api.Model.Source exposing (Source)
|
||||
|
||||
type alias Model =
|
||||
{ sources: List Source
|
||||
, selected: Maybe Source
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ sources = []
|
||||
, selected = Nothing
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetSources (List Source)
|
||||
| Select Source
|
||||
| Deselect
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetSources list ->
|
||||
({model | sources = list, selected = Nothing }, Cmd.none)
|
||||
|
||||
Select source ->
|
||||
({model | selected = Just source}, Cmd.none)
|
||||
|
||||
Deselect ->
|
||||
({model | selected = Nothing}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
table [class "ui selectable table"]
|
||||
[thead []
|
||||
[tr []
|
||||
[th [class "collapsing"][text "Abbrev"]
|
||||
,th [class "collapsing"][text "Enabled"]
|
||||
,th [class "collapsing"][text "Counter"]
|
||||
,th [class "collapsing"][text "Priority"]
|
||||
,th [][text "Id"]
|
||||
]
|
||||
]
|
||||
,tbody []
|
||||
(List.map (renderSourceLine model) model.sources)
|
||||
]
|
||||
|
||||
renderSourceLine: Model -> Source -> Html Msg
|
||||
renderSourceLine model source =
|
||||
tr [classList [("active", model.selected == Just source)]
|
||||
,onClick (Select source)
|
||||
]
|
||||
[td [class "collapsing"]
|
||||
[text source.abbrev
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[if source.enabled then
|
||||
i [class "check square outline icon"][]
|
||||
else
|
||||
i [class "minus square outline icon"][]
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[source.counter |> String.fromInt |> text
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[Data.Priority.fromString source.priority
|
||||
|> Maybe.map Data.Priority.toName
|
||||
|> Maybe.withDefault source.priority
|
||||
|> text
|
||||
]
|
||||
,td []
|
||||
[text source.id
|
||||
]
|
||||
]
|
||||
76
modules/webapp/src/main/elm/Comp/TagForm.elm
Normal file
76
modules/webapp/src/main/elm/Comp/TagForm.elm
Normal file
@ -0,0 +1,76 @@
|
||||
module Comp.TagForm exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update
|
||||
, isValid
|
||||
, getTag)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Tag exposing (Tag)
|
||||
|
||||
type alias Model =
|
||||
{ tag: Tag
|
||||
, name: String
|
||||
, category: Maybe String
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tag = Api.Model.Tag.empty
|
||||
, name = ""
|
||||
, category = Nothing
|
||||
}
|
||||
|
||||
isValid: Model -> Bool
|
||||
isValid model =
|
||||
model.name /= ""
|
||||
|
||||
getTag: Model -> Tag
|
||||
getTag model =
|
||||
Tag model.tag.id model.name model.category 0
|
||||
|
||||
type Msg
|
||||
= SetName String
|
||||
| SetCategory String
|
||||
| SetTag Tag
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetTag t ->
|
||||
({model | tag = t, name = t.name, category = t.category }, Cmd.none)
|
||||
|
||||
SetName n ->
|
||||
({model | name = n}, Cmd.none)
|
||||
|
||||
SetCategory n ->
|
||||
({model | category = Just n}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [class "ui form"]
|
||||
[div [classList [("field", True)
|
||||
,("error", not (isValid model))
|
||||
]
|
||||
]
|
||||
[label [][text "Name*"]
|
||||
,input [type_ "text"
|
||||
,onInput SetName
|
||||
,placeholder "Name"
|
||||
,value model.name
|
||||
][]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "Category"]
|
||||
,input [type_ "text"
|
||||
,onInput SetCategory
|
||||
,placeholder "Category (optional)"
|
||||
,value (Maybe.withDefault "" model.category)
|
||||
][]
|
||||
]
|
||||
]
|
||||
206
modules/webapp/src/main/elm/Comp/TagManage.elm
Normal file
206
modules/webapp/src/main/elm/Comp/TagManage.elm
Normal file
@ -0,0 +1,206 @@
|
||||
module Comp.TagManage exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Http
|
||||
import Api
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick, onSubmit)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Comp.TagTable
|
||||
import Comp.TagForm
|
||||
import Comp.YesNoDimmer
|
||||
import Api.Model.Tag
|
||||
import Api.Model.TagList exposing (TagList)
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Util.Maybe
|
||||
import Util.Http
|
||||
|
||||
type alias Model =
|
||||
{ tagTableModel: Comp.TagTable.Model
|
||||
, tagFormModel: Comp.TagForm.Model
|
||||
, viewMode: ViewMode
|
||||
, formError: Maybe String
|
||||
, loading: Bool
|
||||
, deleteConfirm: Comp.YesNoDimmer.Model
|
||||
}
|
||||
|
||||
type ViewMode = Table | Form
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tagTableModel = Comp.TagTable.emptyModel
|
||||
, tagFormModel = Comp.TagForm.emptyModel
|
||||
, viewMode = Table
|
||||
, formError = Nothing
|
||||
, loading = False
|
||||
, deleteConfirm = Comp.YesNoDimmer.emptyModel
|
||||
}
|
||||
|
||||
type Msg
|
||||
= TableMsg Comp.TagTable.Msg
|
||||
| FormMsg Comp.TagForm.Msg
|
||||
| LoadTags
|
||||
| TagResp (Result Http.Error TagList)
|
||||
| SetViewMode ViewMode
|
||||
| InitNewTag
|
||||
| Submit
|
||||
| SubmitResp (Result Http.Error BasicResult)
|
||||
| YesNoMsg Comp.YesNoDimmer.Msg
|
||||
| RequestDelete
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
TableMsg m ->
|
||||
let
|
||||
(tm, tc) = Comp.TagTable.update flags m model.tagTableModel
|
||||
(m2, c2) = ({model | tagTableModel = tm
|
||||
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
|
||||
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
|
||||
}
|
||||
, Cmd.map TableMsg tc
|
||||
)
|
||||
(m3, c3) = case tm.selected of
|
||||
Just tag ->
|
||||
update flags (FormMsg (Comp.TagForm.SetTag tag)) m2
|
||||
Nothing ->
|
||||
(m2, Cmd.none)
|
||||
in
|
||||
(m3, Cmd.batch [c2, c3])
|
||||
|
||||
FormMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.TagForm.update flags m model.tagFormModel
|
||||
in
|
||||
({model | tagFormModel = m2}, Cmd.map FormMsg c2)
|
||||
|
||||
LoadTags ->
|
||||
({model| loading = True}, Api.getTags flags TagResp)
|
||||
|
||||
TagResp (Ok tags) ->
|
||||
let
|
||||
m2 = {model|viewMode = Table, loading = False}
|
||||
in
|
||||
update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2
|
||||
|
||||
TagResp (Err err) ->
|
||||
({model|loading = False}, Cmd.none)
|
||||
|
||||
SetViewMode m ->
|
||||
let
|
||||
m2 = {model | viewMode = m }
|
||||
in
|
||||
case m of
|
||||
Table ->
|
||||
update flags (TableMsg Comp.TagTable.Deselect) m2
|
||||
Form ->
|
||||
(m2, Cmd.none)
|
||||
|
||||
InitNewTag ->
|
||||
let
|
||||
nm = {model | viewMode = Form, formError = Nothing }
|
||||
tag = Api.Model.Tag.empty
|
||||
in
|
||||
update flags (FormMsg (Comp.TagForm.SetTag tag)) nm
|
||||
|
||||
Submit ->
|
||||
let
|
||||
tag = Comp.TagForm.getTag model.tagFormModel
|
||||
valid = Comp.TagForm.isValid model.tagFormModel
|
||||
in if valid then
|
||||
({model|loading = True}, Api.postTag flags tag SubmitResp)
|
||||
else
|
||||
({model|formError = Just "Please correct the errors in the form."}, Cmd.none)
|
||||
|
||||
SubmitResp (Ok res) ->
|
||||
if res.success then
|
||||
let
|
||||
(m2, c2) = update flags (SetViewMode Table) model
|
||||
(m3, c3) = update flags LoadTags m2
|
||||
in
|
||||
({m3|loading = False}, Cmd.batch [c2,c3])
|
||||
else
|
||||
({model | formError = Just res.message, loading = False }, Cmd.none)
|
||||
|
||||
SubmitResp (Err err) ->
|
||||
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
|
||||
|
||||
RequestDelete ->
|
||||
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
|
||||
|
||||
YesNoMsg m ->
|
||||
let
|
||||
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
|
||||
tag = Comp.TagForm.getTag model.tagFormModel
|
||||
cmd = if confirmed then Api.deleteTag flags tag.id SubmitResp else Cmd.none
|
||||
in
|
||||
({model | deleteConfirm = cm}, cmd)
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
if model.viewMode == Table then viewTable model
|
||||
else viewForm model
|
||||
|
||||
viewTable: Model -> Html Msg
|
||||
viewTable model =
|
||||
div []
|
||||
[button [class "ui basic button", onClick InitNewTag]
|
||||
[i [class "plus icon"][]
|
||||
,text "Create new"
|
||||
]
|
||||
,Html.map TableMsg (Comp.TagTable.view model.tagTableModel)
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
|
||||
viewForm: Model -> Html Msg
|
||||
viewForm model =
|
||||
let
|
||||
newTag = model.tagFormModel.tag.id == ""
|
||||
in
|
||||
Html.form [class "ui segment", onSubmit Submit]
|
||||
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
|
||||
,if newTag then
|
||||
h3 [class "ui dividing header"]
|
||||
[text "Create new tag"
|
||||
]
|
||||
else
|
||||
h3 [class "ui dividing header"]
|
||||
[text ("Edit tag: " ++ model.tagFormModel.tag.name)
|
||||
,div [class "sub header"]
|
||||
[text "Id: "
|
||||
,text model.tagFormModel.tag.id
|
||||
]
|
||||
]
|
||||
,Html.map FormMsg (Comp.TagForm.view model.tagFormModel)
|
||||
,div [classList [("ui error message", True)
|
||||
,("invisible", Util.Maybe.isEmpty model.formError)
|
||||
]
|
||||
]
|
||||
[Maybe.withDefault "" model.formError |> text
|
||||
]
|
||||
,div [class "ui horizontal divider"][]
|
||||
,button [class "ui primary button", type_ "submit"]
|
||||
[text "Submit"
|
||||
]
|
||||
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
|
||||
[text "Cancel"
|
||||
]
|
||||
,if not newTag then
|
||||
a [class "ui right floated red button", href "", onClick RequestDelete]
|
||||
[text "Delete"]
|
||||
else
|
||||
span[][]
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
66
modules/webapp/src/main/elm/Comp/TagTable.elm
Normal file
66
modules/webapp/src/main/elm/Comp/TagTable.elm
Normal file
@ -0,0 +1,66 @@
|
||||
module Comp.TagTable exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.Tag exposing (Tag)
|
||||
|
||||
type alias Model =
|
||||
{ tags: List Tag
|
||||
, selected: Maybe Tag
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tags = []
|
||||
, selected = Nothing
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetTags (List Tag)
|
||||
| Select Tag
|
||||
| Deselect
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetTags list ->
|
||||
({model | tags = list, selected = Nothing }, Cmd.none)
|
||||
|
||||
Select tag ->
|
||||
({model | selected = Just tag}, Cmd.none)
|
||||
|
||||
Deselect ->
|
||||
({model | selected = Nothing}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
table [class "ui selectable table"]
|
||||
[thead []
|
||||
[tr []
|
||||
[th [][text "Name"]
|
||||
,th [][text "Category"]
|
||||
]
|
||||
]
|
||||
,tbody []
|
||||
(List.map (renderTagLine model) model.tags)
|
||||
]
|
||||
|
||||
renderTagLine: Model -> Tag -> Html Msg
|
||||
renderTagLine model tag =
|
||||
tr [classList [("active", model.selected == Just tag)]
|
||||
,onClick (Select tag)
|
||||
]
|
||||
[td []
|
||||
[text tag.name
|
||||
]
|
||||
,td []
|
||||
[Maybe.withDefault "-" tag.category |> text
|
||||
]
|
||||
]
|
||||
150
modules/webapp/src/main/elm/Comp/UserForm.elm
Normal file
150
modules/webapp/src/main/elm/Comp/UserForm.elm
Normal file
@ -0,0 +1,150 @@
|
||||
module Comp.UserForm exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update
|
||||
, isValid
|
||||
, isNewUser
|
||||
, getUser)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput, onCheck)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Data.UserState exposing (UserState)
|
||||
import Api.Model.User exposing (User)
|
||||
import Util.Maybe
|
||||
import Comp.Dropdown
|
||||
|
||||
type alias Model =
|
||||
{ user: User
|
||||
, login: String
|
||||
, email: Maybe String
|
||||
, state: Comp.Dropdown.Model UserState
|
||||
, password: Maybe String
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ user = Api.Model.User.empty
|
||||
, login = ""
|
||||
, email = Nothing
|
||||
, password = Nothing
|
||||
, state = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s }
|
||||
, placeholder = ""
|
||||
, options = Data.UserState.all
|
||||
, selected = List.head Data.UserState.all
|
||||
}
|
||||
}
|
||||
|
||||
isValid: Model -> Bool
|
||||
isValid model =
|
||||
if model.user.login == "" then
|
||||
model.login /= "" && Util.Maybe.nonEmpty model.password
|
||||
else
|
||||
True
|
||||
|
||||
isNewUser: Model -> Bool
|
||||
isNewUser model =
|
||||
model.user.login == ""
|
||||
|
||||
getUser: Model -> User
|
||||
getUser model =
|
||||
let
|
||||
s = model.user
|
||||
state = Comp.Dropdown.getSelected model.state
|
||||
|> List.head
|
||||
|> Maybe.withDefault Data.UserState.Active
|
||||
|> Data.UserState.toString
|
||||
in
|
||||
{s | login = model.login
|
||||
, email = model.email
|
||||
, state = state
|
||||
, password = model.password
|
||||
}
|
||||
|
||||
|
||||
type Msg
|
||||
= SetLogin String
|
||||
| SetUser User
|
||||
| SetEmail String
|
||||
| StateMsg (Comp.Dropdown.Msg UserState)
|
||||
| SetPassword String
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetUser t ->
|
||||
let
|
||||
state = Comp.Dropdown.makeSingleList
|
||||
{ makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s }
|
||||
, placeholder = ""
|
||||
, options = Data.UserState.all
|
||||
, selected = Data.UserState.fromString t.state
|
||||
|> Maybe.map (\u -> List.filter ((==) u) Data.UserState.all)
|
||||
|> Maybe.andThen List.head
|
||||
|> Util.Maybe.withDefault (List.head Data.UserState.all)
|
||||
}
|
||||
in
|
||||
({model | user = t
|
||||
, login = t.login
|
||||
, email = t.email
|
||||
, password = t.password
|
||||
, state = state }, Cmd.none)
|
||||
|
||||
StateMsg m ->
|
||||
let
|
||||
(m1, c1) = Comp.Dropdown.update m model.state
|
||||
in
|
||||
({model | state = m1}, Cmd.map StateMsg c1)
|
||||
|
||||
SetLogin n ->
|
||||
({model | login = n}, Cmd.none)
|
||||
|
||||
SetEmail e ->
|
||||
({model | email = if e == "" then Nothing else Just e }, Cmd.none)
|
||||
|
||||
SetPassword p ->
|
||||
({model | password = if p == "" then Nothing else Just p}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
div [class "ui form"]
|
||||
[div [classList [("field", True)
|
||||
,("error", model.login == "")
|
||||
,("invisible", model.user.login /= "")
|
||||
]
|
||||
]
|
||||
[label [][text "Login*"]
|
||||
,input [type_ "text"
|
||||
,onInput SetLogin
|
||||
,placeholder "Login"
|
||||
,value model.login
|
||||
][]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "E-Mail"]
|
||||
,input [ onInput SetEmail
|
||||
, model.email |> Maybe.withDefault "" |> value
|
||||
, placeholder "E-Mail"
|
||||
][]
|
||||
]
|
||||
,div [class "field"]
|
||||
[label [][text "State"]
|
||||
,Html.map StateMsg (Comp.Dropdown.view model.state)
|
||||
]
|
||||
,div [classList [("field", True)
|
||||
,("invisible", model.user.login /= "")
|
||||
,("error", Util.Maybe.isEmpty model.password)
|
||||
]
|
||||
]
|
||||
[label [][text "Password*"]
|
||||
,input [type_ "text"
|
||||
, onInput SetPassword
|
||||
, placeholder "Password"
|
||||
, Maybe.withDefault "" model.password |> value
|
||||
][]
|
||||
]
|
||||
]
|
||||
205
modules/webapp/src/main/elm/Comp/UserManage.elm
Normal file
205
modules/webapp/src/main/elm/Comp/UserManage.elm
Normal file
@ -0,0 +1,205 @@
|
||||
module Comp.UserManage exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Http
|
||||
import Api
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick, onSubmit)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Comp.UserTable
|
||||
import Comp.UserForm
|
||||
import Comp.YesNoDimmer
|
||||
import Api.Model.User
|
||||
import Api.Model.UserList exposing (UserList)
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Util.Maybe
|
||||
import Util.Http
|
||||
|
||||
type alias Model =
|
||||
{ tableModel: Comp.UserTable.Model
|
||||
, formModel: Comp.UserForm.Model
|
||||
, viewMode: ViewMode
|
||||
, formError: Maybe String
|
||||
, loading: Bool
|
||||
, deleteConfirm: Comp.YesNoDimmer.Model
|
||||
}
|
||||
|
||||
type ViewMode = Table | Form
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ tableModel = Comp.UserTable.emptyModel
|
||||
, formModel = Comp.UserForm.emptyModel
|
||||
, viewMode = Table
|
||||
, formError = Nothing
|
||||
, loading = False
|
||||
, deleteConfirm = Comp.YesNoDimmer.emptyModel
|
||||
}
|
||||
|
||||
type Msg
|
||||
= TableMsg Comp.UserTable.Msg
|
||||
| FormMsg Comp.UserForm.Msg
|
||||
| LoadUsers
|
||||
| UserResp (Result Http.Error UserList)
|
||||
| SetViewMode ViewMode
|
||||
| InitNewUser
|
||||
| Submit
|
||||
| SubmitResp (Result Http.Error BasicResult)
|
||||
| YesNoMsg Comp.YesNoDimmer.Msg
|
||||
| RequestDelete
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
TableMsg m ->
|
||||
let
|
||||
(tm, tc) = Comp.UserTable.update flags m model.tableModel
|
||||
(m2, c2) = ({model | tableModel = tm
|
||||
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
|
||||
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
|
||||
}
|
||||
, Cmd.map TableMsg tc
|
||||
)
|
||||
(m3, c3) = case tm.selected of
|
||||
Just user ->
|
||||
update flags (FormMsg (Comp.UserForm.SetUser user)) m2
|
||||
Nothing ->
|
||||
(m2, Cmd.none)
|
||||
in
|
||||
(m3, Cmd.batch [c2, c3])
|
||||
|
||||
FormMsg m ->
|
||||
let
|
||||
(m2, c2) = Comp.UserForm.update flags m model.formModel
|
||||
in
|
||||
({model | formModel = m2}, Cmd.map FormMsg c2)
|
||||
|
||||
LoadUsers ->
|
||||
({model| loading = True}, Api.getUsers flags UserResp)
|
||||
|
||||
UserResp (Ok users) ->
|
||||
let
|
||||
m2 = {model|viewMode = Table, loading = False}
|
||||
in
|
||||
update flags (TableMsg (Comp.UserTable.SetUsers users.items)) m2
|
||||
|
||||
UserResp (Err err) ->
|
||||
({model|loading = False}, Cmd.none)
|
||||
|
||||
SetViewMode m ->
|
||||
let
|
||||
m2 = {model | viewMode = m }
|
||||
in
|
||||
case m of
|
||||
Table ->
|
||||
update flags (TableMsg Comp.UserTable.Deselect) m2
|
||||
Form ->
|
||||
(m2, Cmd.none)
|
||||
|
||||
InitNewUser ->
|
||||
let
|
||||
nm = {model | viewMode = Form, formError = Nothing }
|
||||
user = Api.Model.User.empty
|
||||
in
|
||||
update flags (FormMsg (Comp.UserForm.SetUser user)) nm
|
||||
|
||||
Submit ->
|
||||
let
|
||||
user = Comp.UserForm.getUser model.formModel
|
||||
valid = Comp.UserForm.isValid model.formModel
|
||||
cmd = if Comp.UserForm.isNewUser model.formModel
|
||||
then Api.postNewUser flags user SubmitResp
|
||||
else Api.putUser flags user SubmitResp
|
||||
in if valid then
|
||||
({model|loading = True}, cmd)
|
||||
else
|
||||
({model|formError = Just "Please correct the errors in the form."}, Cmd.none)
|
||||
|
||||
SubmitResp (Ok res) ->
|
||||
if res.success then
|
||||
let
|
||||
(m2, c2) = update flags (SetViewMode Table) model
|
||||
(m3, c3) = update flags LoadUsers m2
|
||||
in
|
||||
({m3|loading = False}, Cmd.batch [c2,c3])
|
||||
else
|
||||
({model | formError = Just res.message, loading = False }, Cmd.none)
|
||||
|
||||
SubmitResp (Err err) ->
|
||||
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
|
||||
|
||||
RequestDelete ->
|
||||
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
|
||||
|
||||
YesNoMsg m ->
|
||||
let
|
||||
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
|
||||
user = Comp.UserForm.getUser model.formModel
|
||||
cmd = if confirmed then Api.deleteUser flags user.login SubmitResp else Cmd.none
|
||||
in
|
||||
({model | deleteConfirm = cm}, cmd)
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
if model.viewMode == Table then viewTable model
|
||||
else viewForm model
|
||||
|
||||
viewTable: Model -> Html Msg
|
||||
viewTable model =
|
||||
div []
|
||||
[button [class "ui basic button", onClick InitNewUser]
|
||||
[i [class "plus icon"][]
|
||||
,text "Create new"
|
||||
]
|
||||
,Html.map TableMsg (Comp.UserTable.view model.tableModel)
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
|
||||
viewForm: Model -> Html Msg
|
||||
viewForm model =
|
||||
let
|
||||
newUser = Comp.UserForm.isNewUser model.formModel
|
||||
in
|
||||
Html.form [class "ui segment", onSubmit Submit]
|
||||
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
|
||||
,if newUser then
|
||||
h3 [class "ui dividing header"]
|
||||
[text "Create new user"
|
||||
]
|
||||
else
|
||||
h3 [class "ui dividing header"]
|
||||
[text ("Edit user: " ++ model.formModel.user.login)
|
||||
]
|
||||
,Html.map FormMsg (Comp.UserForm.view model.formModel)
|
||||
,div [classList [("ui error message", True)
|
||||
,("invisible", Util.Maybe.isEmpty model.formError)
|
||||
]
|
||||
]
|
||||
[Maybe.withDefault "" model.formError |> text
|
||||
]
|
||||
,div [class "ui horizontal divider"][]
|
||||
,button [class "ui primary button", type_ "submit"]
|
||||
[text "Submit"
|
||||
]
|
||||
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
|
||||
[text "Cancel"
|
||||
]
|
||||
,if not newUser then
|
||||
a [class "ui right floated red button", href "", onClick RequestDelete]
|
||||
[text "Delete"]
|
||||
else
|
||||
span[][]
|
||||
,div [classList [("ui dimmer", True)
|
||||
,("active", model.loading)
|
||||
]]
|
||||
[div [class "ui loader"][]
|
||||
]
|
||||
]
|
||||
83
modules/webapp/src/main/elm/Comp/UserTable.elm
Normal file
83
modules/webapp/src/main/elm/Comp/UserTable.elm
Normal file
@ -0,0 +1,83 @@
|
||||
module Comp.UserTable exposing ( Model
|
||||
, emptyModel
|
||||
, Msg(..)
|
||||
, view
|
||||
, update)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Api.Model.User exposing (User)
|
||||
import Util.Time exposing (formatDateTime)
|
||||
|
||||
type alias Model =
|
||||
{ users: List User
|
||||
, selected: Maybe User
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ users = []
|
||||
, selected = Nothing
|
||||
}
|
||||
|
||||
type Msg
|
||||
= SetUsers (List User)
|
||||
| Select User
|
||||
| Deselect
|
||||
|
||||
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
|
||||
update flags msg model =
|
||||
case msg of
|
||||
SetUsers list ->
|
||||
({model | users = list, selected = Nothing }, Cmd.none)
|
||||
|
||||
Select user ->
|
||||
({model | selected = Just user}, Cmd.none)
|
||||
|
||||
Deselect ->
|
||||
({model | selected = Nothing}, Cmd.none)
|
||||
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
table [class "ui selectable table"]
|
||||
[thead []
|
||||
[tr []
|
||||
[th [class "collapsing"][text "Login"]
|
||||
,th [class "collapsing"][text "State"]
|
||||
,th [class "collapsing"][text "Email"]
|
||||
,th [class "collapsing"][text "Logins"]
|
||||
,th [class "collapsing"][text "Last Login"]
|
||||
,th [class "collapsing"][text "Created"]
|
||||
]
|
||||
]
|
||||
,tbody []
|
||||
(List.map (renderUserLine model) model.users)
|
||||
]
|
||||
|
||||
renderUserLine: Model -> User -> Html Msg
|
||||
renderUserLine model user =
|
||||
tr [classList [("active", model.selected == Just user)]
|
||||
,onClick (Select user)
|
||||
]
|
||||
[td [class "collapsing"]
|
||||
[text user.login
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[text user.state
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[Maybe.withDefault "" user.email |> text
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[String.fromInt user.loginCount |> text
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[Maybe.map formatDateTime user.lastLogin |> Maybe.withDefault "" |> text
|
||||
]
|
||||
,td [class "collapsing"]
|
||||
[formatDateTime user.created |> text
|
||||
]
|
||||
]
|
||||
95
modules/webapp/src/main/elm/Comp/YesNoDimmer.elm
Normal file
95
modules/webapp/src/main/elm/Comp/YesNoDimmer.elm
Normal file
@ -0,0 +1,95 @@
|
||||
module Comp.YesNoDimmer exposing ( Model
|
||||
, Msg(..)
|
||||
, emptyModel
|
||||
, update
|
||||
, view
|
||||
, view2
|
||||
, activate
|
||||
, disable
|
||||
, Settings
|
||||
, defaultSettings
|
||||
)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
|
||||
type alias Model =
|
||||
{ active: Bool
|
||||
}
|
||||
|
||||
emptyModel: Model
|
||||
emptyModel =
|
||||
{ active = False
|
||||
}
|
||||
|
||||
type Msg
|
||||
= Activate
|
||||
| Disable
|
||||
| ConfirmDelete
|
||||
|
||||
type alias Settings =
|
||||
{ message: String
|
||||
, headerIcon: String
|
||||
, headerClass: String
|
||||
, confirmButton: String
|
||||
, cancelButton: String
|
||||
, invertedDimmer: Bool
|
||||
}
|
||||
|
||||
defaultSettings: Settings
|
||||
defaultSettings =
|
||||
{ message = "Delete this item permanently?"
|
||||
, headerIcon = "exclamation icon"
|
||||
, headerClass = "ui inverted icon header"
|
||||
, confirmButton = "Yes, do it!"
|
||||
, cancelButton = "No"
|
||||
, invertedDimmer = False
|
||||
}
|
||||
|
||||
|
||||
activate: Msg
|
||||
activate = Activate
|
||||
|
||||
disable: Msg
|
||||
disable = Disable
|
||||
|
||||
update: Msg -> Model -> (Model, Bool)
|
||||
update msg model =
|
||||
case msg of
|
||||
Activate ->
|
||||
({model | active = True}, False)
|
||||
Disable ->
|
||||
({model | active = False}, False)
|
||||
ConfirmDelete ->
|
||||
({model | active = False}, True)
|
||||
|
||||
view: Model -> Html Msg
|
||||
view model =
|
||||
view2 True defaultSettings model
|
||||
|
||||
view2: Bool -> Settings -> Model -> Html Msg
|
||||
view2 active settings model =
|
||||
div [classList [("ui dimmer", True)
|
||||
,("inverted", settings.invertedDimmer)
|
||||
,("active", (active && model.active))
|
||||
]
|
||||
]
|
||||
[div [class "content"]
|
||||
[h3 [class settings.headerClass]
|
||||
[if settings.headerIcon == "" then span[][] else i [class settings.headerIcon][]
|
||||
,text settings.message
|
||||
]
|
||||
]
|
||||
,div [class "content"]
|
||||
[div [class "ui buttons"]
|
||||
[a [class "ui primary button", onClick ConfirmDelete, href ""]
|
||||
[text settings.confirmButton
|
||||
]
|
||||
,div [class "or"][]
|
||||
,a [class "ui secondary button", onClick Disable, href ""]
|
||||
[text settings.cancelButton
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
Reference in New Issue
Block a user