TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-03-25 08:45:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

Using elm-format for all files

Browse Source
This commit is contained in:
Eike Kettner 2019-12-29 21:55:12 +01:00
parent 546f1a6ee3
commit 2001cca88b
84 changed files with 7668 additions and 5079 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
elm.json
View File

@ -1,8 +1,8 @@
{
"type": "application",
"source-directories": [
"modules/webapp/target/elm-src",
"modules/webapp/src/main/elm"
"modules/webapp/src/main/elm",
"modules/webapp/target/elm-src"
],
"elm-version": "0.19.1",
"dependencies": {

393
modules/webapp/src/main/elm/Api.elm
View File

@ -1,12 +1,60 @@
module Api exposing (..)
module Api exposing
( cancelJob
, changePassword
, deleteEquip
, deleteItem
, deleteOrg
, deletePerson
, deleteSource
, deleteTag
, deleteUser
, getCollective
, getCollectiveSettings
, getEquipments
, getInsights
, getItemProposals
, getJobQueueState
, getJobQueueStateIn
, getOrgLight
, getOrganizations
, getPersons
, getPersonsLight
, getSources
, getTags
, getUsers
, itemDetail
, itemSearch
, login
, loginSession
, logout
, newInvite
, postEquipment
, postNewUser
, postOrg
, postPerson
, postSource
, postTag
, putUser
, refreshSession
, register
, setCollectiveSettings
, setConcEquip
, setConcPerson
, setConfirmed
, setCorrOrg
, setCorrPerson
, setDirection
, setItemDate
, setItemDueDate
, setItemName
, setItemNotes
, setTags
, setUnconfirmed
, upload
, uploadSingle
, versionInfo
)
import Http
import Task
import Util.Http as Http2
import Util.File
import Json.Encode as JsonEncode
import File exposing (File)
import Data.Flags exposing (Flags)
import Api.Model.AuthResult exposing (AuthResult)
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Collective exposing (Collective)
@ -41,46 +89,69 @@ import Api.Model.User exposing (User)
import Api.Model.UserList exposing (UserList)
import Api.Model.UserPass exposing (UserPass)
import Api.Model.VersionInfo exposing (VersionInfo)
import Data.Flags exposing (Flags)
import File exposing (File)
import Http
import Json.Encode as JsonEncode
import Task
import Util.File
import Util.Http as Http2
upload: Flags -> Maybe String -> ItemUploadMeta -> List File -> (String -> (Result Http.Error BasicResult) -> msg) -> List (Cmd msg)
upload : Flags -> Maybe String -> ItemUploadMeta -> List File -> (String -> Result Http.Error BasicResult -> msg) -> List (Cmd msg)
upload flags sourceId meta files receive =
let
metaStr = JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta)
metaStr =
JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta)
mkReq file =
let
fid = Util.File.makeFileId file
path = Maybe.map ((++) "/api/v1/open/upload/item/") sourceId
|> Maybe.withDefault "/api/v1/sec/upload/item"
in
Http2.authPostTrack
{ url = flags.config.baseUrl ++ path
, account = getAccount flags
, body = Http.multipartBody <|
[Http.stringPart "meta" metaStr, Http.filePart "file[]" file]
, expect = Http.expectJson (receive fid) Api.Model.BasicResult.decoder
, tracker = fid
}
in
List.map mkReq files
fid =
Util.File.makeFileId file
uploadSingle: Flags -> Maybe String -> ItemUploadMeta -> String -> List File -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
path =
Maybe.map ((++) "/api/v1/open/upload/item/") sourceId
|> Maybe.withDefault "/api/v1/sec/upload/item"
in
Http2.authPostTrack
{ url = flags.config.baseUrl ++ path
, account = getAccount flags
, body =
Http.multipartBody <|
[ Http.stringPart "meta" metaStr, Http.filePart "file[]" file ]
, expect = Http.expectJson (receive fid) Api.Model.BasicResult.decoder
, tracker = fid
}
in
List.map mkReq files
uploadSingle : Flags -> Maybe String -> ItemUploadMeta -> String -> List File -> (Result Http.Error BasicResult -> msg) -> Cmd msg
uploadSingle flags sourceId meta track files receive =
let
metaStr = JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta)
fileParts = List.map (\f -> Http.filePart "file[]" f) files
allParts = (Http.stringPart "meta" metaStr) :: fileParts
path = Maybe.map ((++) "/api/v1/open/upload/item/") sourceId
|> Maybe.withDefault "/api/v1/sec/upload/item"
in
Http2.authPostTrack
{ url = flags.config.baseUrl ++ path
, account = getAccount flags
, body = Http.multipartBody allParts
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
, tracker = track
}
metaStr =
JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta)
register: Flags -> Registration -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
fileParts =
List.map (\f -> Http.filePart "file[]" f) files
allParts =
Http.stringPart "meta" metaStr :: fileParts
path =
Maybe.map ((++) "/api/v1/open/upload/item/") sourceId
|> Maybe.withDefault "/api/v1/sec/upload/item"
in
Http2.authPostTrack
{ url = flags.config.baseUrl ++ path
, account = getAccount flags
, body = Http.multipartBody allParts
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
, tracker = track
}
register : Flags -> Registration -> (Result Http.Error BasicResult -> msg) -> Cmd msg
register flags reg receive =
Http.post
{ url = flags.config.baseUrl ++ "/api/v1/open/signup/register"
@ -88,7 +159,8 @@ register flags reg receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
newInvite: Flags -> GenInvite -> ((Result Http.Error InviteResult) -> msg) -> Cmd msg
newInvite : Flags -> GenInvite -> (Result Http.Error InviteResult -> msg) -> Cmd msg
newInvite flags req receive =
Http.post
{ url = flags.config.baseUrl ++ "/api/v1/open/signup/newinvite"
@ -96,7 +168,8 @@ newInvite flags req receive =
, expect = Http.expectJson receive Api.Model.InviteResult.decoder
}
login: Flags -> UserPass -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg
login : Flags -> UserPass -> (Result Http.Error AuthResult -> msg) -> Cmd msg
login flags up receive =
Http.post
{ url = flags.config.baseUrl ++ "/api/v1/open/auth/login"
@ -104,7 +177,8 @@ login flags up receive =
, expect = Http.expectJson receive Api.Model.AuthResult.decoder
}
logout: Flags -> ((Result Http.Error ()) -> msg) -> Cmd msg
logout : Flags -> (Result Http.Error () -> msg) -> Cmd msg
logout flags receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/auth/logout"
@ -113,7 +187,8 @@ logout flags receive =
, expect = Http.expectWhatever receive
}
loginSession: Flags -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg
loginSession : Flags -> (Result Http.Error AuthResult -> msg) -> Cmd msg
loginSession flags receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/auth/session"
@ -122,28 +197,34 @@ loginSession flags receive =
, expect = Http.expectJson receive Api.Model.AuthResult.decoder
}
versionInfo: Flags -> ((Result Http.Error VersionInfo) -> msg) -> Cmd msg
versionInfo : Flags -> (Result Http.Error VersionInfo -> msg) -> Cmd msg
versionInfo flags receive =
Http.get
{ url = flags.config.baseUrl ++ "/api/info/version"
, expect = Http.expectJson receive Api.Model.VersionInfo.decoder
}
refreshSession: Flags -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg
refreshSession : Flags -> (Result Http.Error AuthResult -> msg) -> Cmd msg
refreshSession flags receive =
case flags.account of
Just acc ->
if acc.success && acc.validMs > 30000
then
if acc.success && acc.validMs > 30000 then
let
delay = Debug.log "Refresh session in " (acc.validMs - 30000) |> toFloat
delay =
acc.validMs - 30000 |> toFloat
in
Http2.executeIn delay receive (refreshSessionTask flags)
else Cmd.none
Http2.executeIn delay receive (refreshSessionTask flags)
else
Cmd.none
Nothing ->
Cmd.none
refreshSessionTask: Flags -> Task.Task Http.Error AuthResult
refreshSessionTask : Flags -> Task.Task Http.Error AuthResult
refreshSessionTask flags =
Http2.authTask
{ url = flags.config.baseUrl ++ "/api/v1/sec/auth/session"
@ -156,7 +237,7 @@ refreshSessionTask flags =
}
getInsights: Flags -> ((Result Http.Error ItemInsights) -> msg) -> Cmd msg
getInsights : Flags -> (Result Http.Error ItemInsights -> msg) -> Cmd msg
getInsights flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/collective/insights"
@ -164,7 +245,8 @@ getInsights flags receive =
, expect = Http.expectJson receive Api.Model.ItemInsights.decoder
}
getCollective: Flags -> ((Result Http.Error Collective) -> msg) -> Cmd msg
getCollective : Flags -> (Result Http.Error Collective -> msg) -> Cmd msg
getCollective flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/collective"
@ -172,7 +254,8 @@ getCollective flags receive =
, expect = Http.expectJson receive Api.Model.Collective.decoder
}
getCollectiveSettings: Flags -> ((Result Http.Error CollectiveSettings) -> msg) -> Cmd msg
getCollectiveSettings : Flags -> (Result Http.Error CollectiveSettings -> msg) -> Cmd msg
getCollectiveSettings flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/collective/settings"
@ -180,7 +263,8 @@ getCollectiveSettings flags receive =
, expect = Http.expectJson receive Api.Model.CollectiveSettings.decoder
}
setCollectiveSettings: Flags -> CollectiveSettings -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setCollectiveSettings : Flags -> CollectiveSettings -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setCollectiveSettings flags settings receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/collective/settings"
@ -189,9 +273,12 @@ setCollectiveSettings flags settings receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
-- Tags
getTags: Flags -> ((Result Http.Error TagList) -> msg) -> Cmd msg
getTags : Flags -> (Result Http.Error TagList -> msg) -> Cmd msg
getTags flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/tag"
@ -199,7 +286,8 @@ getTags flags receive =
, expect = Http.expectJson receive Api.Model.TagList.decoder
}
postTag: Flags -> Tag -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
postTag : Flags -> Tag -> (Result Http.Error BasicResult -> msg) -> Cmd msg
postTag flags tag receive =
let
params =
@ -209,10 +297,14 @@ postTag flags tag receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
in
if tag.id == "" then Http2.authPost params
else Http2.authPut params
if tag.id == "" then
Http2.authPost params
deleteTag: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
else
Http2.authPut params
deleteTag : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
deleteTag flags tag receive =
Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/tag/" ++ tag
@ -220,9 +312,12 @@ deleteTag flags tag receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
-- Equipments
getEquipments: Flags -> ((Result Http.Error EquipmentList) -> msg) -> Cmd msg
getEquipments : Flags -> (Result Http.Error EquipmentList -> msg) -> Cmd msg
getEquipments flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/equipment"
@ -230,7 +325,8 @@ getEquipments flags receive =
, expect = Http.expectJson receive Api.Model.EquipmentList.decoder
}
postEquipment: Flags -> Equipment -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
postEquipment : Flags -> Equipment -> (Result Http.Error BasicResult -> msg) -> Cmd msg
postEquipment flags equip receive =
let
params =
@ -240,10 +336,14 @@ postEquipment flags equip receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
in
if equip.id == "" then Http2.authPost params
else Http2.authPut params
if equip.id == "" then
Http2.authPost params
deleteEquip: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
else
Http2.authPut params
deleteEquip : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
deleteEquip flags equip receive =
Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/equipment/" ++ equip
@ -252,9 +352,11 @@ deleteEquip flags equip receive =
}
-- Organization
getOrgLight: Flags -> ((Result Http.Error ReferenceList) -> msg) -> Cmd msg
getOrgLight : Flags -> (Result Http.Error ReferenceList -> msg) -> Cmd msg
getOrgLight flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/organization"
@ -262,7 +364,8 @@ getOrgLight flags receive =
, expect = Http.expectJson receive Api.Model.ReferenceList.decoder
}
getOrganizations: Flags -> ((Result Http.Error OrganizationList) -> msg) -> Cmd msg
getOrganizations : Flags -> (Result Http.Error OrganizationList -> msg) -> Cmd msg
getOrganizations flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/organization?full=true"
@ -270,7 +373,8 @@ getOrganizations flags receive =
, expect = Http.expectJson receive Api.Model.OrganizationList.decoder
}
postOrg: Flags -> Organization -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
postOrg : Flags -> Organization -> (Result Http.Error BasicResult -> msg) -> Cmd msg
postOrg flags org receive =
let
params =
@ -280,10 +384,14 @@ postOrg flags org receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
in
if org.id == "" then Http2.authPost params
else Http2.authPut params
if org.id == "" then
Http2.authPost params
deleteOrg: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
else
Http2.authPut params
deleteOrg : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
deleteOrg flags org receive =
Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/organization/" ++ org
@ -292,10 +400,11 @@ deleteOrg flags org receive =
}
-- Person
getPersonsLight: Flags -> ((Result Http.Error ReferenceList) -> msg) -> Cmd msg
getPersonsLight : Flags -> (Result Http.Error ReferenceList -> msg) -> Cmd msg
getPersonsLight flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/person?full=false"
@ -303,7 +412,8 @@ getPersonsLight flags receive =
, expect = Http.expectJson receive Api.Model.ReferenceList.decoder
}
getPersons: Flags -> ((Result Http.Error PersonList) -> msg) -> Cmd msg
getPersons : Flags -> (Result Http.Error PersonList -> msg) -> Cmd msg
getPersons flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/person?full=true"
@ -311,7 +421,8 @@ getPersons flags receive =
, expect = Http.expectJson receive Api.Model.PersonList.decoder
}
postPerson: Flags -> Person -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
postPerson : Flags -> Person -> (Result Http.Error BasicResult -> msg) -> Cmd msg
postPerson flags person receive =
let
params =
@ -321,10 +432,14 @@ postPerson flags person receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
in
if person.id == "" then Http2.authPost params
else Http2.authPut params
if person.id == "" then
Http2.authPost params
deletePerson: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
else
Http2.authPut params
deletePerson : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
deletePerson flags person receive =
Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/person/" ++ person
@ -332,9 +447,12 @@ deletePerson flags person receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
--- Sources
getSources: Flags -> ((Result Http.Error SourceList) -> msg) -> Cmd msg
getSources : Flags -> (Result Http.Error SourceList -> msg) -> Cmd msg
getSources flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/source"
@ -342,7 +460,8 @@ getSources flags receive =
, expect = Http.expectJson receive Api.Model.SourceList.decoder
}
postSource: Flags -> Source -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
postSource : Flags -> Source -> (Result Http.Error BasicResult -> msg) -> Cmd msg
postSource flags source receive =
let
params =
@ -352,10 +471,14 @@ postSource flags source receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
in
if source.id == "" then Http2.authPost params
else Http2.authPut params
if source.id == "" then
Http2.authPost params
deleteSource: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
else
Http2.authPut params
deleteSource : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
deleteSource flags src receive =
Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/source/" ++ src
@ -363,9 +486,12 @@ deleteSource flags src receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
-- Users
getUsers: Flags -> ((Result Http.Error UserList) -> msg) -> Cmd msg
getUsers : Flags -> (Result Http.Error UserList -> msg) -> Cmd msg
getUsers flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/user"
@ -373,16 +499,18 @@ getUsers flags receive =
, expect = Http.expectJson receive Api.Model.UserList.decoder
}
postNewUser: Flags -> User -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
postNewUser : Flags -> User -> (Result Http.Error BasicResult -> msg) -> Cmd msg
postNewUser flags user receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/user"
, account = getAccount flags
, body = Http.jsonBody (Api.Model.User.encode user)
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
{ url = flags.config.baseUrl ++ "/api/v1/sec/user"
, account = getAccount flags
, body = Http.jsonBody (Api.Model.User.encode user)
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
putUser: Flags -> User -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
putUser : Flags -> User -> (Result Http.Error BasicResult -> msg) -> Cmd msg
putUser flags user receive =
Http2.authPut
{ url = flags.config.baseUrl ++ "/api/v1/sec/user"
@ -391,7 +519,8 @@ putUser flags user receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
changePassword: Flags -> PasswordChange -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
changePassword : Flags -> PasswordChange -> (Result Http.Error BasicResult -> msg) -> Cmd msg
changePassword flags cp receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/user/changePassword"
@ -400,7 +529,8 @@ changePassword flags cp receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
deleteUser: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
deleteUser : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
deleteUser flags user receive =
Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/user/" ++ user
@ -409,9 +539,11 @@ deleteUser flags user receive =
}
-- Job Queue
cancelJob: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
cancelJob : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
cancelJob flags jobid receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/queue/" ++ jobid ++ "/cancel"
@ -420,7 +552,8 @@ cancelJob flags jobid receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
getJobQueueState: Flags -> ((Result Http.Error JobQueueState) -> msg) -> Cmd msg
getJobQueueState : Flags -> (Result Http.Error JobQueueState -> msg) -> Cmd msg
getJobQueueState flags receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/queue/state"
@ -429,21 +562,21 @@ getJobQueueState flags receive =
}
getJobQueueStateIn: Flags -> Float -> ((Result Http.Error JobQueueState) -> msg) -> Cmd msg
getJobQueueStateIn : Flags -> Float -> (Result Http.Error JobQueueState -> msg) -> Cmd msg
getJobQueueStateIn flags delay receive =
case flags.account of
Just acc ->
if acc.success && delay > 100
then
let
_ = Debug.log "Refresh job qeue state in " delay
in
Http2.executeIn delay receive (getJobQueueStateTask flags)
else Cmd.none
if acc.success && delay > 100 then
Http2.executeIn delay receive (getJobQueueStateTask flags)
else
Cmd.none
Nothing ->
Cmd.none
getJobQueueStateTask: Flags -> Task.Task Http.Error JobQueueState
getJobQueueStateTask : Flags -> Task.Task Http.Error JobQueueState
getJobQueueStateTask flags =
Http2.authTask
{ url = flags.config.baseUrl ++ "/api/v1/sec/queue/state"
@ -455,9 +588,12 @@ getJobQueueStateTask flags =
, timeout = Nothing
}
-- Item
itemSearch: Flags -> ItemSearch -> ((Result Http.Error ItemLightList) -> msg) -> Cmd msg
itemSearch : Flags -> ItemSearch -> (Result Http.Error ItemLightList -> msg) -> Cmd msg
itemSearch flags search receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/search"
@ -466,7 +602,8 @@ itemSearch flags search receive =
, expect = Http.expectJson receive Api.Model.ItemLightList.decoder
}
itemDetail: Flags -> String -> ((Result Http.Error ItemDetail) -> msg) -> Cmd msg
itemDetail : Flags -> String -> (Result Http.Error ItemDetail -> msg) -> Cmd msg
itemDetail flags id receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ id
@ -474,7 +611,8 @@ itemDetail flags id receive =
, expect = Http.expectJson receive Api.Model.ItemDetail.decoder
}
setTags: Flags -> String -> ReferenceList -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setTags : Flags -> String -> ReferenceList -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setTags flags item tags receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/tags"
@ -483,7 +621,8 @@ setTags flags item tags receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setDirection: Flags -> String -> DirectionValue -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setDirection : Flags -> String -> DirectionValue -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setDirection flags item dir receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/direction"
@ -492,7 +631,8 @@ setDirection flags item dir receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setCorrOrg: Flags -> String -> OptionalId -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setCorrOrg : Flags -> String -> OptionalId -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setCorrOrg flags item id receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/corrOrg"
@ -501,7 +641,8 @@ setCorrOrg flags item id receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setCorrPerson: Flags -> String -> OptionalId -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setCorrPerson : Flags -> String -> OptionalId -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setCorrPerson flags item id receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/corrPerson"
@ -510,7 +651,8 @@ setCorrPerson flags item id receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setConcPerson: Flags -> String -> OptionalId -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setConcPerson : Flags -> String -> OptionalId -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setConcPerson flags item id receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/concPerson"
@ -519,7 +661,8 @@ setConcPerson flags item id receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setConcEquip: Flags -> String -> OptionalId -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setConcEquip : Flags -> String -> OptionalId -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setConcEquip flags item id receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/concEquipment"
@ -528,7 +671,8 @@ setConcEquip flags item id receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setItemName: Flags -> String -> OptionalText -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setItemName : Flags -> String -> OptionalText -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setItemName flags item text receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/name"
@ -537,7 +681,8 @@ setItemName flags item text receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setItemNotes: Flags -> String -> OptionalText -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setItemNotes : Flags -> String -> OptionalText -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setItemNotes flags item text receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/notes"
@ -546,7 +691,8 @@ setItemNotes flags item text receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setItemDate: Flags -> String -> OptionalDate -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setItemDate : Flags -> String -> OptionalDate -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setItemDate flags item date receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/date"
@ -555,7 +701,8 @@ setItemDate flags item date receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setItemDueDate: Flags -> String -> OptionalDate -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setItemDueDate : Flags -> String -> OptionalDate -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setItemDueDate flags item date receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/duedate"
@ -564,7 +711,8 @@ setItemDueDate flags item date receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setConfirmed: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setConfirmed : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setConfirmed flags item receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/confirm"
@ -573,7 +721,8 @@ setConfirmed flags item receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
setUnconfirmed: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
setUnconfirmed : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
setUnconfirmed flags item receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/unconfirm"
@ -582,7 +731,8 @@ setUnconfirmed flags item receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
deleteItem: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg
deleteItem : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
deleteItem flags item receive =
Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item
@ -590,7 +740,8 @@ deleteItem flags item receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
getItemProposals: Flags -> String -> ((Result Http.Error ItemProposals) -> msg) -> Cmd msg
getItemProposals : Flags -> String -> (Result Http.Error ItemProposals -> msg) -> Cmd msg
getItemProposals flags item receive =
Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/proposals"
@ -599,8 +750,10 @@ getItemProposals flags item receive =
}
-- Helper
getAccount: Flags -> AuthResult
getAccount : Flags -> AuthResult
getAccount flags =
Maybe.withDefault Api.Model.AuthResult.empty flags.account

122
modules/webapp/src/main/elm/App/Data.elm
View File

@ -1,63 +1,73 @@
module App.Data exposing (..)
module App.Data exposing
( Model
, Msg(..)
, checkPage
, defaultPage
, init
)
import Api.Model.AuthResult exposing (AuthResult)
import Api.Model.VersionInfo exposing (VersionInfo)
import Browser exposing (UrlRequest)
import Browser.Navigation exposing (Key)
import Url exposing (Url)
import Http
import Data.Flags exposing (Flags)
import Api.Model.VersionInfo exposing (VersionInfo)
import Api.Model.AuthResult exposing (AuthResult)
import Http
import Page exposing (Page(..))
import Page.CollectiveSettings.Data
import Page.Home.Data
import Page.Login.Data
import Page.ManageData.Data
import Page.CollectiveSettings.Data
import Page.UserSettings.Data
import Page.NewInvite.Data
import Page.Queue.Data
import Page.Register.Data
import Page.Upload.Data
import Page.NewInvite.Data
import Page.UserSettings.Data
import Url exposing (Url)
type alias Model =
{ flags: Flags
, key: Key
, page: Page
, version: VersionInfo
, homeModel: Page.Home.Data.Model
, loginModel: Page.Login.Data.Model
, manageDataModel: Page.ManageData.Data.Model
, collSettingsModel: Page.CollectiveSettings.Data.Model
, userSettingsModel: Page.UserSettings.Data.Model
, queueModel: Page.Queue.Data.Model
, registerModel: Page.Register.Data.Model
, uploadModel: Page.Upload.Data.Model
, newInviteModel: Page.NewInvite.Data.Model
, navMenuOpen: Bool
, subs: Sub Msg
{ flags : Flags
, key : Key
, page : Page
, version : VersionInfo
, homeModel : Page.Home.Data.Model
, loginModel : Page.Login.Data.Model
, manageDataModel : Page.ManageData.Data.Model
, collSettingsModel : Page.CollectiveSettings.Data.Model
, userSettingsModel : Page.UserSettings.Data.Model
, queueModel : Page.Queue.Data.Model
, registerModel : Page.Register.Data.Model
, uploadModel : Page.Upload.Data.Model
, newInviteModel : Page.NewInvite.Data.Model
, navMenuOpen : Bool
, subs : Sub Msg
}
init: Key -> Url -> Flags -> Model
init : Key -> Url -> Flags -> Model
init key url flags =
let
page = Page.fromUrl url
|> Maybe.withDefault (defaultPage flags)
page =
Page.fromUrl url
|> Maybe.withDefault (defaultPage flags)
in
{ flags = flags
, key = key
, page = page
, version = Api.Model.VersionInfo.empty
, homeModel = Page.Home.Data.emptyModel
, loginModel = Page.Login.Data.emptyModel
, manageDataModel = Page.ManageData.Data.emptyModel
, collSettingsModel = Page.CollectiveSettings.Data.emptyModel
, userSettingsModel = Page.UserSettings.Data.emptyModel
, queueModel = Page.Queue.Data.emptyModel
, registerModel = Page.Register.Data.emptyModel
, uploadModel = Page.Upload.Data.emptyModel
, newInviteModel = Page.NewInvite.Data.emptyModel
, navMenuOpen = False
, subs = Sub.none
}
{ flags = flags
, key = key
, page = page
, version = Api.Model.VersionInfo.empty
, homeModel = Page.Home.Data.emptyModel
, loginModel = Page.Login.Data.emptyModel
, manageDataModel = Page.ManageData.Data.emptyModel
, collSettingsModel = Page.CollectiveSettings.Data.emptyModel
, userSettingsModel = Page.UserSettings.Data.emptyModel
, queueModel = Page.Queue.Data.emptyModel
, registerModel = Page.Register.Data.emptyModel
, uploadModel = Page.Upload.Data.emptyModel
, newInviteModel = Page.NewInvite.Data.emptyModel
, navMenuOpen = False
, subs = Sub.none
}
type Msg
= NavRequest UrlRequest
@ -77,18 +87,30 @@ type Msg
| SessionCheckResp (Result Http.Error AuthResult)
| ToggleNavMenu
isSignedIn: Flags -> Bool
isSignedIn : Flags -> Bool
isSignedIn flags =
flags.account
|> Maybe.map .success
|> Maybe.withDefault False
checkPage: Flags -> Page -> Page
checkPage flags page =
if Page.isSecured page && isSignedIn flags then page
else if Page.isOpen page then page
else Page.loginPage page
defaultPage: Flags -> Page
checkPage : Flags -> Page -> Page
checkPage flags page =
if Page.isSecured page && isSignedIn flags then
page
else if Page.isOpen page then
page
else
Page.loginPage page
defaultPage : Flags -> Page
defaultPage flags =
if isSignedIn flags then HomePage else (LoginPage Nothing)
if isSignedIn flags then
HomePage
else
LoginPage Nothing

272
modules/webapp/src/main/elm/App/Update.elm
View File

@ -1,42 +1,48 @@
module App.Update exposing (update, initPage)
module App.Update exposing
( initPage
, update
)
import Api
import Ports
import App.Data exposing (..)
import Browser exposing (UrlRequest(..))
import Browser.Navigation as Nav
import Url
import Data.Flags
import App.Data exposing (..)
import Page exposing (Page(..))
import Page.CollectiveSettings.Data
import Page.CollectiveSettings.Update
import Page.Home.Data
import Page.Home.Update
import Page.Login.Data
import Page.Login.Update
import Page.ManageData.Data
import Page.ManageData.Update
import Page.CollectiveSettings.Data
import Page.CollectiveSettings.Update
import Page.UserSettings.Data
import Page.UserSettings.Update
import Page.NewInvite.Data
import Page.NewInvite.Update
import Page.Queue.Data
import Page.Queue.Update
import Page.Register.Data
import Page.Register.Update
import Page.Upload.Data
import Page.Upload.Update
import Page.NewInvite.Data
import Page.NewInvite.Update
import Page.UserSettings.Data
import Page.UserSettings.Update
import Ports
import Url
import Util.Update
update: Msg -> Model -> (Model, Cmd Msg)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
let
(m, c, s) = updateWithSub msg model
( m, c, s ) =
updateWithSub msg model
in
({m|subs = s}, c)
( { m | subs = s }, c )
updateWithSub: Msg -> Model -> (Model, Cmd Msg, Sub Msg)
updateWithSub msg model =
updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
updateWithSub msg model =
case msg of
HomeMsg lm ->
updateHome lm model |> noSub
@ -66,49 +72,75 @@ updateWithSub msg model =
updateNewInvite m model |> noSub
VersionResp (Ok info) ->
({model|version = info}, Cmd.none) |> noSub
( { model | version = info }, Cmd.none ) |> noSub
VersionResp (Err err) ->
(model, Cmd.none, Sub.none)
VersionResp (Err _) ->
( model, Cmd.none, Sub.none )
Logout ->
(model
( model
, Cmd.batch
[ Api.logout model.flags LogoutResp
, Ports.removeAccount ()
]
, Sub.none)
, Sub.none
)
LogoutResp _ ->
({model|loginModel = Page.Login.Data.emptyModel}, Page.goto (LoginPage Nothing), Sub.none)
( { model | loginModel = Page.Login.Data.emptyModel }, Page.goto (LoginPage Nothing), Sub.none )
SessionCheckResp res ->
case res of
Ok lr ->
let
newFlags = if lr.success then Data.Flags.withAccount model.flags lr
else Data.Flags.withoutAccount model.flags
command = if lr.success then Api.refreshSession newFlags SessionCheckResp
else Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)]
newFlags =
if lr.success then
Data.Flags.withAccount model.flags lr
else
Data.Flags.withoutAccount model.flags
command =
if lr.success then
Api.refreshSession newFlags SessionCheckResp
else
Cmd.batch
[ Ports.removeAccount ()
, Page.goto (Page.loginPage model.page)
]
in
({model | flags = newFlags}, command, Sub.none)
( { model | flags = newFlags }, command, Sub.none )
Err _ ->
(model, Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)], Sub.none)
( model
, Cmd.batch
[ Ports.removeAccount ()
, Page.goto (Page.loginPage model.page)
]
, Sub.none
)
NavRequest req ->
case req of
Internal url ->
let
newPage = Page.fromUrl url
newPage =
Page.fromUrl url
isCurrent =
Page.fromUrl url |>
Maybe.map (\p -> p == model.page) |>
Maybe.withDefault True
Page.fromUrl url
|> Maybe.map (\p -> p == model.page)
|> Maybe.withDefault True
in
( model
, if isCurrent then Cmd.none else Nav.pushUrl model.key (Url.toString url)
, Sub.none
)
( model
, if isCurrent then
Cmd.none
else
Nav.pushUrl model.key (Url.toString url)
, Sub.none
)
External url ->
( model
@ -118,111 +150,148 @@ updateWithSub msg model =
NavChange url ->
let
page = Page.fromUrl url
|> Maybe.withDefault (defaultPage model.flags)
check = checkPage model.flags page
(m, c) = initPage model page
page =
Page.fromUrl url
|> Maybe.withDefault (defaultPage model.flags)
check =
checkPage model.flags page
( m, c ) =
initPage model page
in
if check == page then ( { m | page = page }, c, Sub.none )
else (model, Page.goto check, Sub.none)
if check == page then
( { m | page = page }, c, Sub.none )
else
( model, Page.goto check, Sub.none )
ToggleNavMenu ->
({model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none)
( { model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none )
updateNewInvite: Page.NewInvite.Data.Msg -> Model -> (Model, Cmd Msg)
updateNewInvite : Page.NewInvite.Data.Msg -> Model -> ( Model, Cmd Msg )
updateNewInvite lmsg model =
let
(lm, lc) = Page.NewInvite.Update.update model.flags lmsg model.newInviteModel
( lm, lc ) =
Page.NewInvite.Update.update model.flags lmsg model.newInviteModel
in
( {model | newInviteModel = lm }
, Cmd.map NewInviteMsg lc
)
( { model | newInviteModel = lm }
, Cmd.map NewInviteMsg lc
)
updateUpload: Page.Upload.Data.Msg -> Model -> (Model, Cmd Msg, Sub Msg)
updateUpload : Page.Upload.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
updateUpload lmsg model =
let
(lm, lc, ls) = Page.Upload.Update.update (Page.uploadId model.page) model.flags lmsg model.uploadModel
( lm, lc, ls ) =
Page.Upload.Update.update
(Page.uploadId model.page)
model.flags
lmsg
model.uploadModel
in
( { model | uploadModel = lm }
, Cmd.map UploadMsg lc
, Sub.map UploadMsg ls
)
( { model | uploadModel = lm }
, Cmd.map UploadMsg lc
, Sub.map UploadMsg ls
)
updateRegister: Page.Register.Data.Msg -> Model -> (Model, Cmd Msg)
updateRegister : Page.Register.Data.Msg -> Model -> ( Model, Cmd Msg )
updateRegister lmsg model =
let
(lm, lc) = Page.Register.Update.update model.flags lmsg model.registerModel
( lm, lc ) =
Page.Register.Update.update model.flags lmsg model.registerModel
in
( { model | registerModel = lm }
, Cmd.map RegisterMsg lc
)
( { model | registerModel = lm }
, Cmd.map RegisterMsg lc
)
updateQueue: Page.Queue.Data.Msg -> Model -> (Model, Cmd Msg)
updateQueue : Page.Queue.Data.Msg -> Model -> ( Model, Cmd Msg )
updateQueue lmsg model =
let
(lm, lc) = Page.Queue.Update.update model.flags lmsg model.queueModel
( lm, lc ) =
Page.Queue.Update.update model.flags lmsg model.queueModel
in
( { model | queueModel = lm }
, Cmd.map QueueMsg lc
)
( { model | queueModel = lm }
, Cmd.map QueueMsg lc
)
updateUserSettings: Page.UserSettings.Data.Msg -> Model -> (Model, Cmd Msg)
updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg )
updateUserSettings lmsg model =
let
(lm, lc) = Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel
( lm, lc ) =
Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel
in
( { model | userSettingsModel = lm }
, Cmd.map UserSettingsMsg lc
)
( { model | userSettingsModel = lm }
, Cmd.map UserSettingsMsg lc
)
updateCollSettings: Page.CollectiveSettings.Data.Msg -> Model -> (Model, Cmd Msg)
updateCollSettings : Page.CollectiveSettings.Data.Msg -> Model -> ( Model, Cmd Msg )
updateCollSettings lmsg model =
let
(lm, lc) = Page.CollectiveSettings.Update.update model.flags lmsg model.collSettingsModel
( lm, lc ) =
Page.CollectiveSettings.Update.update model.flags
lmsg
model.collSettingsModel
in
( { model | collSettingsModel = lm }
, Cmd.map CollSettingsMsg lc
)
( { model | collSettingsModel = lm }
, Cmd.map CollSettingsMsg lc
)
updateLogin: Page.Login.Data.Msg -> Model -> (Model, Cmd Msg)
updateLogin : Page.Login.Data.Msg -> Model -> ( Model, Cmd Msg )
updateLogin lmsg model =
let
(lm, lc, ar) = Page.Login.Update.update (Page.loginPageReferrer model.page) model.flags lmsg model.loginModel
newFlags = Maybe.map (Data.Flags.withAccount model.flags) ar
|> Maybe.withDefault model.flags
in
({model | loginModel = lm, flags = newFlags}
,Cmd.map LoginMsg lc
)
( lm, lc, ar ) =
Page.Login.Update.update (Page.loginPageReferrer model.page)
model.flags
lmsg
model.loginModel
updateHome: Page.Home.Data.Msg -> Model -> (Model, Cmd Msg)
newFlags =
Maybe.map (Data.Flags.withAccount model.flags) ar
|> Maybe.withDefault model.flags
in
( { model | loginModel = lm, flags = newFlags }
, Cmd.map LoginMsg lc
)
updateHome : Page.Home.Data.Msg -> Model -> ( Model, Cmd Msg )
updateHome lmsg model =
let
(lm, lc) = Page.Home.Update.update model.flags lmsg model.homeModel
( lm, lc ) =
Page.Home.Update.update model.flags lmsg model.homeModel
in
( {model | homeModel = lm }
, Cmd.map HomeMsg lc
)
( { model | homeModel = lm }
, Cmd.map HomeMsg lc
)
updateManageData: Page.ManageData.Data.Msg -> Model -> (Model, Cmd Msg)
updateManageData : Page.ManageData.Data.Msg -> Model -> ( Model, Cmd Msg )
updateManageData lmsg model =
let
(lm, lc) = Page.ManageData.Update.update model.flags lmsg model.manageDataModel
( lm, lc ) =
Page.ManageData.Update.update model.flags lmsg model.manageDataModel
in
({ model | manageDataModel = lm }
,Cmd.map ManageDataMsg lc
)
( { model | manageDataModel = lm }
, Cmd.map ManageDataMsg lc
)
initPage: Model -> Page -> (Model, Cmd Msg)
initPage : Model -> Page -> ( Model, Cmd Msg )
initPage model page =
case page of
HomePage ->
Util.Update.andThen1
[updateHome Page.Home.Data.Init
,updateQueue Page.Queue.Data.StopRefresh
] model
[ updateHome Page.Home.Data.Init
, updateQueue Page.Queue.Data.StopRefresh
]
model
LoginPage _ ->
updateQueue Page.Queue.Data.StopRefresh model
@ -232,9 +301,10 @@ initPage model page =
CollectiveSettingPage ->
Util.Update.andThen1
[updateQueue Page.Queue.Data.StopRefresh
,updateCollSettings Page.CollectiveSettings.Data.Init
] model
[ updateQueue Page.Queue.Data.StopRefresh
, updateCollSettings Page.CollectiveSettings.Data.Init
]
model
UserSettingPage ->
updateQueue Page.Queue.Data.StopRefresh model
@ -252,6 +322,6 @@ initPage model page =
updateQueue Page.Queue.Data.StopRefresh model
noSub: (Model, Cmd Msg) -> (Model, Cmd Msg, Sub Msg)
noSub (m, c) =
(m, c, Sub.none)
noSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg )
noSub ( m, c ) =
( m, c, Sub.none )

335
modules/webapp/src/main/elm/App/View.elm
View File

@ -1,227 +1,278 @@
module App.View exposing (view)
import App.Data exposing (..)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page
import App.Data exposing (..)
import Data.Flags exposing (Flags)
import Page exposing (Page(..))
import Page.CollectiveSettings.View
import Page.Home.View
import Page.Login.View
import Page.ManageData.View
import Page.CollectiveSettings.View
import Page.UserSettings.View
import Page.NewInvite.View
import Page.Queue.View
import Page.Register.View
import Page.Upload.View
import Page.NewInvite.View
import Page.UserSettings.View
view: Model -> Html Msg
view : Model -> Html Msg
view model =
case model.page of
LoginPage _ ->
loginLayout model
RegisterPage ->
registerLayout model
NewInvitePage ->
newInviteLayout model
_ ->
defaultLayout model
registerLayout: Model -> Html Msg
registerLayout : Model -> Html Msg
registerLayout model =
div [class "register-layout"]
[ (viewRegister model)
, (footer model)
div [ class "register-layout" ]
[ viewRegister model
, footer model
]
loginLayout: Model -> Html Msg
loginLayout : Model -> Html Msg
loginLayout model =
div [class "login-layout"]
[ (viewLogin model)
, (footer model)
div [ class "login-layout" ]
[ viewLogin model
, footer model
]
newInviteLayout: Model -> Html Msg
newInviteLayout : Model -> Html Msg
newInviteLayout model =
div [class "newinvite-layout"]
[ (viewNewInvite model)
, (footer model)
div [ class "newinvite-layout" ]
[ viewNewInvite model
, footer model
]
defaultLayout: Model -> Html Msg
defaultLayout : Model -> Html Msg
defaultLayout model =
div [class "default-layout"]
[ div [class "ui fixed top sticky attached large menu top-menu"]
[div [class "ui fluid container"]
[ a [class "header item narrow-item"
,Page.href HomePage
]
[img [class "image"
,src (model.flags.config.docspellAssetPath ++ "/img/logo-96.png")][]
,div [class "content"]
[text model.flags.config.appName
]
]
, (loginInfo model)
]
]
, div [ class "main-content" ]
[ (case model.page of
HomePage ->
viewHome model
LoginPage _ ->
viewLogin model
ManageDataPage ->
viewManageData model
CollectiveSettingPage ->
viewCollectiveSettings model
UserSettingPage ->
viewUserSettings model
QueuePage ->
viewQueue model
RegisterPage ->
viewRegister model
UploadPage mid ->
viewUpload mid model
NewInvitePage ->
viewNewInvite model
)
div [ class "default-layout" ]
[ div [ class "ui fixed top sticky attached large menu top-menu" ]
[ div [ class "ui fluid container" ]
[ a
[ class "header item narrow-item"
, Page.href HomePage
]
[ img
[ class "image"
, src (model.flags.config.docspellAssetPath ++ "/img/logo-96.png")
]
[]
, div [ class "content" ]
[ text model.flags.config.appName
]
]
, loginInfo model
]
]
, (footer model)
, div [ class "main-content" ]
[ case model.page of
HomePage ->
viewHome model
LoginPage _ ->
viewLogin model
ManageDataPage ->
viewManageData model
CollectiveSettingPage ->
viewCollectiveSettings model
UserSettingPage ->
viewUserSettings model
QueuePage ->
viewQueue model
RegisterPage ->
viewRegister model
UploadPage mid ->
viewUpload mid model
NewInvitePage ->
viewNewInvite model
]
, footer model
]
viewNewInvite: Model -> Html Msg
viewNewInvite : Model -> Html Msg
viewNewInvite model =
Html.map NewInviteMsg (Page.NewInvite.View.view model.flags model.newInviteModel)
viewUpload: (Maybe String) ->Model -> Html Msg
viewUpload : Maybe String -> Model -> Html Msg
viewUpload mid model =
Html.map UploadMsg (Page.Upload.View.view mid model.uploadModel)
viewRegister: Model -> Html Msg
viewRegister : Model -> Html Msg
viewRegister model =
Html.map RegisterMsg (Page.Register.View.view model.flags model.registerModel)
viewQueue: Model -> Html Msg
viewQueue : Model -> Html Msg
viewQueue model =
Html.map QueueMsg (Page.Queue.View.view model.queueModel)
viewUserSettings: Model -> Html Msg
viewUserSettings : Model -> Html Msg
viewUserSettings model =
Html.map UserSettingsMsg (Page.UserSettings.View.view model.userSettingsModel)
viewCollectiveSettings: Model -> Html Msg
viewCollectiveSettings : Model -> Html Msg
viewCollectiveSettings model =
Html.map CollSettingsMsg (Page.CollectiveSettings.View.view model.flags model.collSettingsModel)
viewManageData: Model -> Html Msg
viewManageData : Model -> Html Msg
viewManageData model =
Html.map ManageDataMsg (Page.ManageData.View.view model.manageDataModel)
viewLogin: Model -> Html Msg
viewLogin : Model -> Html Msg
viewLogin model =
Html.map LoginMsg (Page.Login.View.view model.flags model.loginModel)
viewHome: Model -> Html Msg
viewHome : Model -> Html Msg
viewHome model =
Html.map HomeMsg (Page.Home.View.view model.homeModel)
menuEntry: Model -> Page -> List (Html Msg) -> Html Msg
menuEntry : Model -> Page -> List (Html Msg) -> Html Msg
menuEntry model page children =
a [classList [("icon item", True)
,("active", model.page == page)
]
, Page.href page]
children
a
[ classList
[ ( "icon item", True )
, ( "active", model.page == page )
]
, Page.href page
]
children
loginInfo: Model -> Html Msg
loginInfo : Model -> Html Msg
loginInfo model =
div [class "right menu"]
div [ class "right menu" ]
(case model.flags.account of
Just acc ->
[div [class "ui dropdown icon link item"
, onClick ToggleNavMenu
]
[i [class "ui bars icon"][]
,div [classList [("left menu", True)
,("transition visible", model.navMenuOpen)
]
]
[menuEntry model HomePage
[img [class "image icon"
,src (model.flags.config.docspellAssetPath ++ "/img/logo-mc-96.png")
][]
,text "Items"
Just _ ->
[ div
[ class "ui dropdown icon link item"
, onClick ToggleNavMenu
]
[ i [ class "ui bars icon" ] []
, div
[ classList
[ ( "left menu", True )
, ( "transition visible", model.navMenuOpen )
]
,div [class "divider"][]
,menuEntry model CollectiveSettingPage
[i [class "users circle icon"][]
,text "Collective Settings"
]
,menuEntry model UserSettingPage
[i [class "user circle icon"][]
,text "User Settings"
]
,div [class "divider"][]
,menuEntry model ManageDataPage
[i [class "cubes icon"][]
,text "Manage Data"
]
,div [class "divider"][]
,menuEntry model (UploadPage Nothing)
[i [class "upload icon"][]
,text "Upload files"
]
[ menuEntry model
HomePage
[ img
[ class "image icon"
, src (model.flags.config.docspellAssetPath ++ "/img/logo-mc-96.png")
]
[]
, text "Items"
]
,menuEntry model QueuePage
[i [class "tachometer alternate icon"][]
,text "Procesing Queue"
]
,div [classList [("divider", True)
,("invisible", model.flags.config.signupMode /= "invite")
]]
[]
,a [classList [("icon item", True)
,("invisible", model.flags.config.signupMode /= "invite")
]
, div [ class "divider" ] []
, menuEntry model
CollectiveSettingPage
[ i [ class "users circle icon" ] []
, text "Collective Settings"
]
, menuEntry model
UserSettingPage
[ i [ class "user circle icon" ] []
, text "User Settings"
]
, div [ class "divider" ] []
, menuEntry model
ManageDataPage
[ i [ class "cubes icon" ] []
, text "Manage Data"
]
, div [ class "divider" ] []
, menuEntry model
(UploadPage Nothing)
[ i [ class "upload icon" ] []
, text "Upload files"
]
, menuEntry model
QueuePage
[ i [ class "tachometer alternate icon" ] []
, text "Procesing Queue"
]
, div
[ classList
[ ( "divider", True )
, ( "invisible", model.flags.config.signupMode /= "invite" )
]
]
[]
, a
[ classList
[ ( "icon item", True )
, ( "invisible", model.flags.config.signupMode /= "invite" )
]
, Page.href NewInvitePage
]
[i [class "key icon"][]
,text "New Invites"
[ i [ class "key icon" ] []
, text "New Invites"
]
,div [class "divider"][]
,a [class "icon item"
,href ""
,onClick Logout]
[i [class "sign-out icon"][]
,text "Logout"
]
]
]
, div [ class "divider" ] []
, a
[ class "icon item"
, href ""
, onClick Logout
]
[ i [ class "sign-out icon" ] []
, text "Logout"
]
]
]
]
Nothing ->
[a [class "item"
,Page.href (Page.loginPage model.page)
]
[text "Login"
]
,a [class "item"
,Page.href RegisterPage
]
[text "Register"
[ a
[ class "item"
, Page.href (Page.loginPage model.page)
]
[ text "Login"
]
, a
[ class "item"
, Page.href RegisterPage
]
[ text "Register"
]
]
)
footer: Model -> Html Msg
footer : Model -> Html Msg
footer model =
div [ class "ui footer" ]
[ a [href "https://github.com/eikek/docspell"]
[ i [class "ui github icon"][]
]
[ a [ href "https://github.com/eikek/docspell" ]
[ i [ class "ui github icon" ] []
]
, span []
[ text "Docspell "
, text model.version.version

160
modules/webapp/src/main/elm/Comp/AddressForm.elm
View File

@ -1,32 +1,36 @@
module Comp.AddressForm exposing ( Model
, emptyModel
, Msg(..)
, view
, update
, getAddress)
module Comp.AddressForm exposing
( Model
, Msg(..)
, emptyModel
, getAddress
, update
, view
)
import Api.Model.Address exposing (Address)
import Comp.Dropdown
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
{ address : Address
, street : String
, zip : String
, city : String
, country : Comp.Dropdown.Model Country
}
type alias Country =
{ code: String
, label: String
{ code : String
, label : String
}
countries: List Country
countries : List Country
countries =
[ Country "DE" "Germany"
, Country "CH" "Switzerland"
@ -35,22 +39,24 @@ countries =
, Country "AU" "Austria"
]
emptyModel: Model
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
}
, country =
Comp.Dropdown.makeSingleList
{ makeOption = \c -> { value = c.code, text = c.label }
, placeholder = "Select Country"
, options = countries
, selected = Nothing
}
}
getAddress: Model -> Address
getAddress : Model -> Address
getAddress model =
{ street = model.street
, zip = model.zip
@ -58,6 +64,7 @@ getAddress model =
, country = Comp.Dropdown.getSelected model.country |> List.head |> Maybe.map .code |> Maybe.withDefault ""
}
type Msg
= SetStreet String
| SetCity String
@ -65,65 +72,80 @@ type Msg
| SetAddress Address
| CountryMsg (Comp.Dropdown.Msg Country)
update: Msg -> Model -> (Model, Cmd Msg)
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
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)
( { 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)
( { model | street = n }, Cmd.none )
SetCity c ->
({model | city = c }, Cmd.none)
( { model | city = c }, Cmd.none )
SetZip z ->
({model | zip = z }, Cmd.none)
( { model | zip = z }, Cmd.none )
CountryMsg m ->
let
(m1, c1) = Comp.Dropdown.update m model.country
( m1, c1 ) =
Comp.Dropdown.update m model.country
in
({model | country = m1}, Cmd.map CountryMsg c1)
( { model | country = m1 }, Cmd.map CountryMsg c1 )
view: Model -> Html Msg
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)
]
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)
]
]

330
modules/webapp/src/main/elm/Comp/ChangePasswordForm.elm
View File

@ -1,45 +1,49 @@
module Comp.ChangePasswordForm exposing (Model
,emptyModel
,Msg(..)
,update
,view
)
import Http
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onClick)
module Comp.ChangePasswordForm exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Api
import Api.Model.PasswordChange exposing (PasswordChange)
import Util.Http
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.PasswordChange exposing (PasswordChange)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput)
import Http
import Util.Http
type alias Model =
{ current: String
, newPass1: String
, newPass2: String
, showCurrent: Bool
, showPass1: Bool
, showPass2: Bool
, errors: List String
, loading: Bool
, successMsg: String
{ current : String
, newPass1 : String
, newPass2 : String
, showCurrent : Bool
, showPass1 : Bool
, showPass2 : Bool
, errors : List String
, loading : Bool
, successMsg : String
}
emptyModel: Model
emptyModel : Model
emptyModel =
validateModel
{ current = ""
, newPass1 = ""
, newPass2 = ""
, showCurrent = False
, showPass1 = False
, showPass2 = False
, errors = []
, loading = False
, successMsg = ""
}
{ current = ""
, newPass1 = ""
, newPass2 = ""
, showCurrent = False
, showPass1 = False
, showPass2 = False
, errors = []
, loading = False
, successMsg = ""
}
type Msg
= SetCurrent String
@ -52,147 +56,205 @@ type Msg
| SubmitResp (Result Http.Error BasicResult)
validate: Model -> List String
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 []
[ 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 -> Model
validateModel model =
let
err = validate model
err =
validate model
in
{model | errors = err, successMsg = if err == [] then model.successMsg else "" }
{ model
| errors = err
, successMsg =
if err == [] then
model.successMsg
else
""
}
-- Update
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetCurrent s ->
(validateModel {model | current = s}, Cmd.none)
( validateModel { model | current = s }, Cmd.none )
SetNew1 s ->
(validateModel {model | newPass1 = s}, Cmd.none)
( validateModel { model | newPass1 = s }, Cmd.none )
SetNew2 s ->
(validateModel {model | newPass2 = s}, Cmd.none)
( validateModel { model | newPass2 = s }, Cmd.none )
ToggleShowCurrent ->
({model | showCurrent = not model.showCurrent}, Cmd.none)
( { model | showCurrent = not model.showCurrent }, Cmd.none )
ToggleShowPass1 ->
({model | showPass1 = not model.showPass1}, Cmd.none)
( { model | showPass1 = not model.showPass1 }, Cmd.none )
ToggleShowPass2 ->
({model | showPass2 = not model.showPass2}, Cmd.none)
( { model | showPass2 = not model.showPass2 }, Cmd.none )
Submit ->
let
valid = validate model
cp = PasswordChange model.current model.newPass1
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)
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."}
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)
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
str =
Util.Http.errorToString err
in
({model | errors = [str], loading = False, successMsg = ""}, Cmd.none)
( { model | errors = [ str ], loading = False, successMsg = "" }, Cmd.none )
-- View
view: Model -> Html Msg
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"][]
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" ] []
]
]

167
modules/webapp/src/main/elm/Comp/ContactField.elm
View File

@ -1,40 +1,50 @@
module Comp.ContactField exposing (Model
,emptyModel
,getContacts
,Msg(..)
,update
,view
)
module Comp.ContactField exposing
( Model
, Msg(..)
, emptyModel
, getContacts
, update
, view
)
import Api.Model.Contact exposing (Contact)
import Comp.Dropdown
import Data.ContactType exposing (ContactType)
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
import Html.Events exposing (onClick, onInput)
type alias Model =
{ items: List Contact
, kind: Comp.Dropdown.Model ContactType
, value: String
{ items : List Contact
, kind : Comp.Dropdown.Model ContactType
, value : String
}
emptyModel: Model
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
}
, 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 = ""
}
getContacts: Model -> List Contact
getContacts : Model -> List Contact
getContacts model =
List.filter (\c -> c.value /= "") model.items
type Msg
= SetValue String
| TypeMsg (Comp.Dropdown.Msg ContactType)
@ -42,76 +52,89 @@ type Msg
| Select Contact
| SetItems (List Contact)
update: Msg -> Model -> (Model, Cmd Msg)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SetItems contacts ->
({model | items = contacts, value = "" }, Cmd.none)
( { model | items = contacts, value = "" }, Cmd.none )
SetValue v ->
({model | value = v}, Cmd.none)
( { model | value = v }, Cmd.none )
TypeMsg m ->
let
(m1, c1) = Comp.Dropdown.update m model.kind
( m1, c1 ) =
Comp.Dropdown.update m model.kind
in
({model|kind = m1}, Cmd.map TypeMsg c1)
( { model | kind = m1 }, Cmd.map TypeMsg c1 )
AddContact ->
if model.value == "" then (model, Cmd.none)
if model.value == "" then
( model, Cmd.none )
else
let
kind = Comp.Dropdown.getSelected model.kind
|> List.head
|> Maybe.map Data.ContactType.toString
|> Maybe.withDefault ""
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)
( { 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)
newItems =
List.filter (\c -> c /= contact) model.items
view: Model -> Html Msg
( 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 "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
]
]
[div [class "ui vertical secondary fluid menu"]
(List.map renderItem model.items)
]
]
renderItem: Contact -> Html Msg
renderItem contact =
div [class "link item", onClick (Select contact) ]
[i [class "delete icon"][]
,div [class "ui blue label"]
[text contact.kind
[]
, 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.items)
]
,text contact.value
]
renderItem : Contact -> Html Msg
renderItem contact =
div [ class "link item", onClick (Select contact) ]
[ i [ class "delete icon" ] []
, div [ class "ui blue label" ]
[ text contact.kind
]
, text contact.value
]

79
modules/webapp/src/main/elm/Comp/DatePicker.elm
View File

@ -1,65 +1,94 @@
module Comp.DatePicker exposing (..)
module Comp.DatePicker exposing
( Msg
, defaultSettings
, emptyModel
, endOfDay
, init
, midOfDay
, startOfDay
, update
, updateDefault
, view
, viewTime
, viewTimeDefault
)
import Html exposing (Html)
import DatePicker exposing (DatePicker, DateEvent, Settings)
import Date exposing (Date)
import Time exposing (Posix, Zone, utc, Month(..))
import DatePicker exposing (DateEvent, DatePicker, Settings)
import Html exposing (Html)
import Time exposing (Month(..), Posix, Zone, utc)
type alias Msg = DatePicker.Msg
init: (DatePicker, Cmd Msg)
type alias Msg =
DatePicker.Msg
init : ( DatePicker, Cmd Msg )
init =
DatePicker.init
emptyModel: DatePicker
emptyModel : DatePicker
emptyModel =
DatePicker.initFromDate (Date.fromCalendarDate 2019 Aug 21)
defaultSettings: Settings
defaultSettings : Settings
defaultSettings =
let
ds = DatePicker.defaultSettings
ds =
DatePicker.defaultSettings
in
{ds | changeYear = DatePicker.from 2010}
{ ds | changeYear = DatePicker.from 2010 }
update: Settings -> Msg -> DatePicker -> (DatePicker, DateEvent)
update : Settings -> Msg -> DatePicker -> ( DatePicker, DateEvent )
update settings msg model =
DatePicker.update settings msg model
updateDefault: Msg -> DatePicker -> (DatePicker, DateEvent)
updateDefault : Msg -> DatePicker -> ( DatePicker, DateEvent )
updateDefault msg model =
DatePicker.update defaultSettings msg model
view : Maybe Date -> Settings -> DatePicker -> Html Msg
view md settings model =
view md settings model =
DatePicker.view md settings model
viewTime : Maybe Int -> Settings -> DatePicker -> Html Msg
viewTime md settings model =
viewTime md settings model =
let
date = Maybe.map Time.millisToPosix md
date =
Maybe.map Time.millisToPosix md
|> Maybe.map (Date.fromPosix Time.utc)
in
view date settings model
view date settings model
viewTimeDefault: Maybe Int -> DatePicker -> Html Msg
viewTimeDefault : Maybe Int -> DatePicker -> Html Msg
viewTimeDefault md model =
viewTime md defaultSettings model
startOfDay: Date -> Int
startOfDay : Date -> Int
startOfDay date =
let
unix0 = Date.fromPosix Time.utc (Time.millisToPosix 0)
days = Date.diff Date.Days unix0 date
unix0 =
Date.fromPosix Time.utc (Time.millisToPosix 0)
days =
Date.diff Date.Days unix0 date
in
days * 24 * 60 * 60 * 1000
days * 24 * 60 * 60 * 1000
endOfDay: Date -> Int
endOfDay : Date -> Int
endOfDay date =
(startOfDay date) + ((24 * 60) - 1) * 60 * 1000
startOfDay date + ((24 * 60) - 1) * 60 * 1000
midOfDay: Date -> Int
midOfDay : Date -> Int
midOfDay date =
(startOfDay date) + (12 * 60 * 60 * 1000)
startOfDay date + (12 * 60 * 60 * 1000)

558
modules/webapp/src/main/elm/Comp/Dropdown.elm
View File

@ -1,39 +1,41 @@
module Comp.Dropdown exposing ( Model
, Option
, makeModel
, makeSingle
, makeSingleList
, makeMultiple
, update
, isDropdownChangeMsg
, view
, getSelected
, Msg(..))
module Comp.Dropdown exposing
( Model
, Msg(..)
, Option
, getSelected
, isDropdownChangeMsg
, makeModel
, makeMultiple
, makeSingle
, makeSingleList
, update
, view
)
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 Html.Events exposing (onClick, onInput)
import Simple.Fuzzy
import Util.Html exposing (onKeyUp)
import Util.List
type alias Option =
{ value: String
, text: String
{ value : String
, text : String
}
type alias Item a =
{ value: a
, option: Option
, visible: Bool
, selected: Bool
, active: Bool
{ value : a
, option : Option
, visible : Bool
, selected : Bool
, active : Bool
}
makeItem: Model a -> a -> Item a
makeItem : Model a -> a -> Item a
makeItem model val =
{ value = val
, option = model.makeOption val
@ -42,25 +44,28 @@ makeItem model val =
, 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
{ 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 :
{ multiple : Bool
, searchable : Int -> Bool
, makeOption : a -> Option
, labelColor : a -> String
, placeholder : String
}
-> Model a
makeModel input =
{ multiple = input.multiple
, searchable = input.searchable
@ -73,10 +78,12 @@ makeModel input =
, placeholder = input.placeholder
}
makeSingle:
{ makeOption: a -> Option
, placeholder: String
} -> Model a
makeSingle :
{ makeOption : a -> Option
, placeholder : String
}
-> Model a
makeSingle opts =
makeModel
{ multiple = False
@ -86,26 +93,35 @@ makeSingle opts =
, placeholder = opts.placeholder
}
makeSingleList:
{ makeOption: a -> Option
, placeholder: String
, options: List a
, selected: Maybe a
} -> Model a
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
m =
makeSingle { makeOption = opts.makeOption, placeholder = opts.placeholder }
makeMultiple:
{ makeOption: a -> Option
, labelColor: a -> String
} -> Model a
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
@ -115,10 +131,12 @@ makeMultiple opts =
, placeholder = ""
}
getSelected: Model a -> List a
getSelected : Model a -> List a
getSelected model =
List.map .value model.selected
type Msg a
= SetOptions (List a)
| SetSelection (List a)
@ -129,265 +147,367 @@ type Msg a
| 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
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 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 []
value =
item.option.value
show e = if e.option.value == value then {e | selected = False } else e
avail = List.map show model.available
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 }
{ model | selected = sel, available = avail }
selectItem: Model a -> Item a -> Model a
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 ]
value =
item.option.value
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
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 }
{ model | selected = sel, available = avail }
filterOptions: String -> List (Item a) -> List (Item a)
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
List.map (\e -> { e | visible = Simple.Fuzzy.match str e.option.text, active = False }) list
applyFilter: String -> Model a -> Model a
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 : (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
opts =
getOptions model
selectActive: Model a -> Model a
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
current =
getOptions model |> Util.List.find .active
in
case current of
Just item ->
selectItem model item |> applyFilter ""
Nothing ->
model
case current of
Just item ->
selectItem model item |> applyFilter ""
clearActive: Model a -> Model a
Nothing ->
model
clearActive : Model a -> Model a
clearActive model =
{ model | available = List.map (\e -> {e | active = False}) model.available }
{ model | available = List.map (\e -> { e | active = False }) model.available }
-- TODO enhance update function to return this info
isDropdownChangeMsg: Msg a -> Bool
isDropdownChangeMsg : Msg a -> Bool
isDropdownChangeMsg cm =
case cm of
AddItem _ -> True
RemoveItem _ -> True
AddItem _ ->
True
RemoveItem _ ->
True
KeyPress code ->
Util.Html.intToKeyCode code
|> Maybe.map (\c -> c == Util.Html.Enter)
|> Maybe.withDefault False
_ -> False
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 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)
( { 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
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)
( m1, Cmd.none )
ToggleMenu ->
({model | menuOpen = not model.menuOpen}, Cmd.none)
( { model | menuOpen = not model.menuOpen }, Cmd.none )
AddItem e ->
let
m = selectItem model e |> applyFilter ""
m =
selectItem model e |> applyFilter ""
in
({ m | menuOpen = False }, Cmd.none)
( { m | menuOpen = False }, Cmd.none )
RemoveItem e ->
let
m = deselectItem model e |> applyFilter ""
m =
deselectItem model e |> applyFilter ""
in
({ m | menuOpen = False }, Cmd.none)
( { m | menuOpen = False }, Cmd.none )
Filter str ->
let
m = applyFilter str model
m =
applyFilter str model
in
({ m | menuOpen = True}, Cmd.none)
( { m | menuOpen = True }, Cmd.none )
ShowMenu flag ->
({ model | menuOpen = flag }, Cmd.none)
( { model | menuOpen = flag }, Cmd.none )
KeyPress code ->
case Util.Html.intToKeyCode code of
Just Util.Html.Up ->
(makeNextActive (\n -> n - 1) model, Cmd.none)
( makeNextActive (\n -> n - 1) model, Cmd.none )
Just Util.Html.Down ->
(makeNextActive ((+) 1) model, Cmd.none)
( makeNextActive ((+) 1) model, Cmd.none )
Just Util.Html.Enter ->
let
m = selectActive model
m =
selectActive model
in
({m | menuOpen = False }, Cmd.none)
( { m | menuOpen = False }, Cmd.none )
_ ->
(model, Cmd.none)
( model, Cmd.none )
-- View
view: Model a -> Html (Msg a)
view : Model a -> Html (Msg a)
view model =
if model.multiple then viewMultiple model else viewSingle model
if model.multiple then
viewMultiple model
else
viewSingle model
viewSingle: Model a -> Html (Msg a)
viewSingle : Model a -> Html (Msg a)
viewSingle model =
let
renderClosed item =
div [class "message"
,style "display" "inline-block !important"
,onClick ToggleMenu
div
[ class "message"
, style "display" "inline-block !important"
, onClick ToggleMenu
]
[i [class "delete icon", onClick (RemoveItem item)][]
,text item.option.text
[ 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"
[ 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
][]
, 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)
else
[]
, [ renderMenu model
]
]
)
renderMenu : Model a -> Html (Msg a)
renderMenu model =
div [classList [( "menu", True )
,( "transition visible", model.menuOpen )
]
] (getOptions model |> List.map renderOption)
div
[ classList
[ ( "menu", True )
, ( "transition visible", model.menuOpen )
]
]
(getOptions model |> List.map renderOption)
renderPlaceholder: Model a -> Html (Msg a)
renderPlaceholder : Model a -> Html (Msg a)
renderPlaceholder model =
div [classList [ ("placeholder-message", True)
, ("text", model.multiple)
]
,style "display" "inline-block !important"
,onClick ToggleMenu
div
[ classList
[ ( "placeholder-message", True )
, ( "text", model.multiple )
]
, style "display" "inline-block !important"
, onClick ToggleMenu
]
[ text model.placeholder
]
[text model.placeholder
]
renderOption: Item a -> Html (Msg a)
renderOption : Item a -> Html (Msg a)
renderOption item =
div [classList [ ("item", True)
, ("active", item.active || item.selected)
]
,onClick (AddItem item)
div
[ classList
[ ( "item", True )
, ( "active", item.active || item.selected )
]
, onClick (AddItem item)
]
[text item.option.text
[ text item.option.text
]

142
modules/webapp/src/main/elm/Comp/Dropzone.elm
View File

@ -1,48 +1,57 @@
-- inspired from here: https://ellie-app.com/3T5mNms7SwKa1
module Comp.Dropzone exposing ( view
, Settings
, defaultSettings
, update
, setActive
, Model
, init
, Msg(..)
)
module Comp.Dropzone exposing
( Model
, Msg(..)
, Settings
, defaultSettings
, init
, setActive
, update
, view
)
import File exposing (File)
import File.Select
import Json.Decode as D
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Decode as D
type alias State =
{ hover: Bool
, active: Bool
{ hover : Bool
, active : Bool
}
type alias Settings =
{ classList: State -> List (String, Bool)
, contentTypes: List String
{ classList : State -> List ( String, Bool )
, contentTypes : List String
}
defaultSettings: Settings
defaultSettings : Settings
defaultSettings =
{ classList = \m -> [("ui placeholder segment", True)]
{ classList = \_ -> [ ( "ui placeholder segment", True ) ]
, contentTypes = [ "application/pdf" ]
}
type alias Model =
{ state: State
, settings: Settings
{ state : State
, settings : Settings
}
init: Settings -> Model
init : Settings -> Model
init settings =
{ state = State False True
, settings = settings
}
type Msg
= DragEnter
| DragLeave
@ -50,45 +59,55 @@ type Msg
| PickFiles
| SetActive Bool
setActive: Bool -> Msg
setActive : Bool -> Msg
setActive flag =
SetActive flag
update: Msg -> Model -> (Model, Cmd Msg, List File)
update : Msg -> Model -> ( Model, Cmd Msg, List File )
update msg model =
case msg of
SetActive flag ->
let
ns = { hover = model.state.hover, active = flag }
ns =
{ hover = model.state.hover, active = flag }
in
({ model | state = ns }, Cmd.none, [])
( { model | state = ns }, Cmd.none, [] )
PickFiles ->
(model, File.Select.files model.settings.contentTypes GotFiles, [])
( model, File.Select.files model.settings.contentTypes GotFiles, [] )
DragEnter ->
let
ns = {hover = True, active = model.state.active}
ns =
{ hover = True, active = model.state.active }
in
({model| state = ns}, Cmd.none, [])
( { model | state = ns }, Cmd.none, [] )
DragLeave ->
let
ns = {hover = False, active = model.state.active}
ns =
{ hover = False, active = model.state.active }
in
({model | state = ns}, Cmd.none, [])
( { 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 []
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)
( { model | state = ns }, Cmd.none, newFiles )
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div
[ classList (model.settings.classList model.state)
@ -97,46 +116,51 @@ view model =
, 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"
[ 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 ..."
]
,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 -> List File -> List File
filterMime settings files =
let
pred f =
List.member (File.mime f) settings.contentTypes
in
List.filter pred files
List.filter pred files
dropDecoder : D.Decoder Msg
dropDecoder =
D.at ["dataTransfer","files"] (D.oneOrMore GotFiles File.decoder)
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)
preventDefaultOn event (D.map hijack decoder)
hijack : msg -> (msg, Bool)
hijack : msg -> ( msg, Bool )
hijack msg =
(msg, True)
( msg, True )

72
modules/webapp/src/main/elm/Comp/EquipmentForm.elm
View File

@ -1,62 +1,74 @@
module Comp.EquipmentForm exposing ( Model
, emptyModel
, Msg(..)
, view
, update
, isValid
, getEquipment)
module Comp.EquipmentForm exposing
( Model
, Msg(..)
, emptyModel
, getEquipment
, isValid
, update
, view
)
import Api.Model.Equipment exposing (Equipment)
import Data.Flags exposing (Flags)
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
{ equipment : Equipment
, name : String
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ equipment = Api.Model.Equipment.empty
, name = ""
}
isValid: Model -> Bool
isValid : Model -> Bool
isValid model =
model.name /= ""
getEquipment: Model -> Equipment
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 -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetEquipment t ->
({model | equipment = t, name = t.name }, Cmd.none)
( { model | equipment = t, name = t.name }, Cmd.none )
SetName n ->
({model | name = n}, Cmd.none)
( { model | name = n }, Cmd.none )
view: Model -> Html Msg
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 "ui form" ]
[ div
[ classList
[ ( "field", True )
, ( "error", not (isValid model) )
]
]
[ label [] [ text "Name*" ]
, input
[ type_ "text"
, onInput SetName
, placeholder "Name"
, value model.name
]
[]
]
]

293
modules/webapp/src/main/elm/Comp/EquipmentManage.elm
View File

@ -1,36 +1,43 @@
module Comp.EquipmentManage exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.EquipmentManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Equipment
import Api.Model.EquipmentList exposing (EquipmentList)
import Comp.EquipmentForm
import Comp.EquipmentTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
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 Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel: Comp.EquipmentTable.Model
, formModel: Comp.EquipmentForm.Model
, viewMode: ViewMode
, formError: Maybe String
, loading: Bool
, deleteConfirm: Comp.YesNoDimmer.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
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
{ tableModel = Comp.EquipmentTable.emptyModel
, formModel = Comp.EquipmentForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.EquipmentTable.Msg
| FormMsg Comp.EquipmentForm.Msg
@ -52,155 +60,210 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
( 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)
( m2, Cmd.none )
in
(m3, Cmd.batch [c2, c3])
( m3, Cmd.batch [ c2, c3 ] )
FormMsg m ->
let
(m2, c2) = Comp.EquipmentForm.update flags m model.formModel
( m2, c2 ) =
Comp.EquipmentForm.update flags m model.formModel
in
({model | formModel = m2}, Cmd.map FormMsg c2)
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadEquipments ->
({model| loading = True}, Api.getEquipments flags EquipmentResp)
( { model | loading = True }, Api.getEquipments flags EquipmentResp )
EquipmentResp (Ok equipments) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.EquipmentTable.SetEquipments equipments.items)) m2
update flags (TableMsg (Comp.EquipmentTable.SetEquipments equipments.items)) m2
EquipmentResp (Err err) ->
({model|loading = False}, Cmd.none)
EquipmentResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.EquipmentTable.Deselect) m2
Form ->
(m2, Cmd.none)
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
nm =
{ model | viewMode = Form, formError = Nothing }
equipment =
Api.Model.Equipment.empty
in
update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) nm
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)
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
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadEquipments m2
in
({m3|loading = False}, Cmd.batch [c2,c3])
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
({model | formError = Just res.message, loading = False }, Cmd.none)
( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
( { 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
( 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)
( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
viewTable: Model -> Html Msg
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"][]
[ 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 -> Html Msg
viewForm model =
let
newEquipment = model.formModel.equipment.id == ""
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"
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"
]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel"
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 )
]
,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"][]
]
]
[ 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" ] []
]
]

66
modules/webapp/src/main/elm/Comp/EquipmentTable.elm
View File

@ -1,62 +1,70 @@
module Comp.EquipmentTable exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.EquipmentTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Api.Model.Equipment exposing (Equipment)
import Data.Flags exposing (Flags)
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
{ equips : List Equipment
, selected : Maybe Equipment
}
emptyModel: Model
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 -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetEquipments list ->
({model | equips = list, selected = Nothing }, Cmd.none)
( { model | equips = list, selected = Nothing }, Cmd.none )
Select equip ->
({model | selected = Just equip}, Cmd.none)
( { model | selected = Just equip }, Cmd.none )
Deselect ->
({model | selected = Nothing}, Cmd.none)
( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg
view : Model -> Html Msg
view model =
table [class "ui selectable table"]
[thead []
[tr []
[th [][text "Name"]
]
]
,tbody []
table [ class "ui selectable table" ]
[ thead []
[ tr []
[ th [] [ text "Name" ]
]
]
, tbody []
(List.map (renderEquipmentLine model) model.equips)
]
renderEquipmentLine: Model -> Equipment -> Html Msg
renderEquipmentLine : Model -> Equipment -> Html Msg
renderEquipmentLine model equip =
tr [classList [("active", model.selected == Just equip)]
,onClick (Select equip)
]
[td []
[text equip.name
]
tr
[ classList [ ( "active", model.selected == Just equip ) ]
, onClick (Select equip)
]
[ td []
[ text equip.name
]
]

1379
modules/webapp/src/main/elm/Comp/ItemDetail.elm
View File

File diff suppressed because it is too large Load Diff

328
modules/webapp/src/main/elm/Comp/ItemList.elm
View File

@ -1,36 +1,41 @@
module Comp.ItemList exposing (Model
, emptyModel
, Msg(..)
, prevItem
, nextItem
, update
, view)
module Comp.ItemList exposing
( Model
, Msg(..)
, emptyModel
, nextItem
, prevItem
, update
, view
)
import Set exposing (Set)
import Api.Model.ItemLight exposing (ItemLight)
import Api.Model.ItemLightGroup exposing (ItemLightGroup)
import Api.Model.ItemLightList exposing (ItemLightList)
import Data.Direction
import Data.Flags exposing (Flags)
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 Set exposing (Set)
import Util.List
import Util.Maybe
import Util.String
import Util.Time
import Util.Maybe
type alias Model =
{ results: ItemLightList
, openGroups: Set String
{ results : ItemLightList
, openGroups : Set String
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ results = Api.Model.ItemLightList.empty
, openGroups = Set.empty
}
type Msg
= SetResults ItemLightList
| ToggleGroupState ItemLightGroup
@ -38,198 +43,243 @@ type Msg
| ExpandAll
| SelectItem ItemLight
nextItem: Model -> String -> Maybe 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 -> 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 -> 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 -> ( Model, Cmd Msg, Maybe ItemLight )
update flags msg model =
case msg of
SetResults list ->
let
newModel = { model | results = list, openGroups = Set.empty }
newModel =
{ model | results = list, openGroups = Set.empty }
in
({newModel|openGroups = openAllGroups newModel}, Cmd.none, Nothing)
( { newModel | openGroups = openAllGroups newModel }, Cmd.none, Nothing )
ToggleGroupState group ->
let
m2 = if isGroupOpen model group then closeGroup model group
else openGroup model group
m2 =
if isGroupOpen model group then
closeGroup model group
else
openGroup model group
in
(m2, Cmd.none, Nothing)
( m2, Cmd.none, Nothing )
CollapseAll ->
({model | openGroups = Set.empty }, Cmd.none, Nothing)
( { model | openGroups = Set.empty }, Cmd.none, Nothing )
ExpandAll ->
let
open = openAllGroups model
open =
openAllGroups model
in
({model | openGroups = open }, Cmd.none, Nothing)
( { model | openGroups = open }, Cmd.none, Nothing )
SelectItem item ->
(model, Cmd.none, Just item)
( model, Cmd.none, Just item )
view: Model -> Html Msg
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"]
[ 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 -> ItemLightGroup -> Bool
isGroupOpen model group =
Set.member group.name model.openGroups
openGroup: Model -> ItemLightGroup -> Model
openGroup : Model -> ItemLightGroup -> Model
openGroup model group =
{ model | openGroups = Set.insert group.name model.openGroups }
closeGroup: Model -> ItemLightGroup -> Model
closeGroup : Model -> ItemLightGroup -> Model
closeGroup model group =
{ model | openGroups = Set.remove group.name model.openGroups }
viewGroup: Model -> ItemLightGroup -> Html Msg
viewGroup : Model -> ItemLightGroup -> Html Msg
viewGroup model group =
let
groupOpen = isGroupOpen model group
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
[ 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)
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
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 -> 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[]
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 -> 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
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
]
tr [ onClick (SelectItem item) ]
[ td [ class "collapsing" ]
[ div
[ classList
[ ( "ui teal ribbon label", True )
, ( "invisible", item.state /= "created" )
]
]
,td [class "collapsing"][text item.source]
,td [][text corr]
,td [][text conc]
[ 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 : 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]
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
List.map .name all
|> Util.List.distinct
|> List.intersperse ", "
|> String.concat

144
modules/webapp/src/main/elm/Comp/OrgForm.elm
View File

@ -1,28 +1,32 @@
module Comp.OrgForm exposing ( Model
, emptyModel
, Msg(..)
, view
, update
, isValid
, getOrg)
module Comp.OrgForm exposing
( Model
, Msg(..)
, emptyModel
, getOrg
, isValid
, update
, view
)
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
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
type alias Model =
{ org: Organization
, name: String
, addressModel: Comp.AddressForm.Model
, contactModel: Comp.ContactField.Model
, notes: Maybe String
{ org : Organization
, name : String
, addressModel : Comp.AddressForm.Model
, contactModel : Comp.ContactField.Model
, notes : Maybe String
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ org = Api.Model.Organization.empty
, name = ""
@ -31,20 +35,25 @@ emptyModel =
, notes = Nothing
}
isValid: Model -> Bool
isValid : Model -> Bool
isValid model =
model.name /= ""
getOrg: Model -> Organization
getOrg : Model -> Organization
getOrg model =
let
o = model.org
o =
model.org
in
{ o | name = model.name
, address = Comp.AddressForm.getAddress model.addressModel
, contacts = Comp.ContactField.getContacts model.contactModel
, notes = model.notes
}
{ o
| name = model.name
, address = Comp.AddressForm.getAddress model.addressModel
, contacts = Comp.ContactField.getContacts model.contactModel
, notes = model.notes
}
type Msg
= SetName String
@ -53,61 +62,80 @@ type Msg
| ContactMsg Comp.ContactField.Msg
| SetNotes String
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
( 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)
( { m2 | org = t, name = t.name, notes = t.notes }, Cmd.batch [ c1, c2 ] )
AddressMsg am ->
let
(m1, c1) = Comp.AddressForm.update am model.addressModel
( m1, c1 ) =
Comp.AddressForm.update am model.addressModel
in
({model | addressModel = m1}, Cmd.map AddressMsg c1)
( { model | addressModel = m1 }, Cmd.map AddressMsg c1 )
ContactMsg m ->
let
(m1, c1) = Comp.ContactField.update m model.contactModel
( m1, c1 ) =
Comp.ContactField.update m model.contactModel
in
({model | contactModel = m1}, Cmd.map ContactMsg c1)
( { model | contactModel = m1 }, Cmd.map ContactMsg c1 )
SetName n ->
({model | name = n}, Cmd.none)
( { model | name = n }, Cmd.none )
SetNotes str ->
({model | notes = if str == "" then Nothing else Just str}, Cmd.none)
( { model
| notes =
if str == "" then
Nothing
else
Just str
}
, Cmd.none
)
view: Model -> Html Msg
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"
div [ class "ui form" ]
[ div
[ classList
[ ( "field", True )
, ( "error", not (isValid model) )
]
]
,Html.map AddressMsg (Comp.AddressForm.view model.addressModel)
,h3 [class "ui dividing header"]
[text "Contacts"
[ label [] [ text "Name*" ]
, input
[ type_ "text"
, onInput SetName
, placeholder "Name"
, value model.name
]
[]
]
,Html.map ContactMsg (Comp.ContactField.view model.contactModel)
,h3 [class "ui dividing header"]
[text "Notes"
, h3 [ class "ui dividing header" ]
[ text "Address"
]
,div [class "field"]
[textarea [onInput SetNotes][Maybe.withDefault "" model.notes |> text ]
, 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 ]
]
]

293
modules/webapp/src/main/elm/Comp/OrgManage.elm
View File

@ -1,36 +1,43 @@
module Comp.OrgManage exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.OrgManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Organization
import Api.Model.OrganizationList exposing (OrganizationList)
import Comp.OrgForm
import Comp.OrgTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
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 Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel: Comp.OrgTable.Model
, formModel: Comp.OrgForm.Model
, viewMode: ViewMode
, formError: Maybe String
, loading: Bool
, deleteConfirm: Comp.YesNoDimmer.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
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
{ tableModel = Comp.OrgTable.emptyModel
, formModel = Comp.OrgForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.OrgTable.Msg
| FormMsg Comp.OrgForm.Msg
@ -52,155 +60,210 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
( 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)
( m2, Cmd.none )
in
(m3, Cmd.batch [c2, c3])
( m3, Cmd.batch [ c2, c3 ] )
FormMsg m ->
let
(m2, c2) = Comp.OrgForm.update flags m model.formModel
( m2, c2 ) =
Comp.OrgForm.update flags m model.formModel
in
({model | formModel = m2}, Cmd.map FormMsg c2)
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadOrgs ->
({model| loading = True}, Api.getOrganizations flags OrgResp)
( { model | loading = True }, Api.getOrganizations flags OrgResp )
OrgResp (Ok orgs) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.OrgTable.SetOrgs orgs.items)) m2
update flags (TableMsg (Comp.OrgTable.SetOrgs orgs.items)) m2
OrgResp (Err err) ->
({model|loading = False}, Cmd.none)
OrgResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.OrgTable.Deselect) m2
Form ->
(m2, Cmd.none)
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
nm =
{ model | viewMode = Form, formError = Nothing }
org =
Api.Model.Organization.empty
in
update flags (FormMsg (Comp.OrgForm.SetOrg org)) nm
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)
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
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadOrgs m2
in
({m3|loading = False}, Cmd.batch [c2,c3])
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
({model | formError = Just res.message, loading = False }, Cmd.none)
( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
( { 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
( 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)
( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
viewTable: Model -> Html Msg
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"][]
[ 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 -> Html Msg
viewForm model =
let
newOrg = model.formModel.org.id == ""
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"
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"
]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel"
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 )
]
,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"][]
]
]
[ 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" ] []
]
]

80
modules/webapp/src/main/elm/Comp/OrgTable.elm
View File

@ -1,74 +1,80 @@
module Comp.OrgTable exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.OrgTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Api.Model.Organization exposing (Organization)
import Data.Flags exposing (Flags)
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
{ equips : List Organization
, selected : Maybe Organization
}
emptyModel: Model
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 -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetOrgs list ->
({model | equips = list, selected = Nothing }, Cmd.none)
( { model | equips = list, selected = Nothing }, Cmd.none )
Select equip ->
({model | selected = Just equip}, Cmd.none)
( { model | selected = Just equip }, Cmd.none )
Deselect ->
({model | selected = Nothing}, Cmd.none)
( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg
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 []
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 -> 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
tr
[ classList [ ( "active", model.selected == Just org ) ]
, onClick (Select org)
]
[ td [ class "collapsing" ]
[ text org.name
]
,td []
[Util.Contact.toString org.contacts |> text
, td []
[ Util.Address.toString org.address |> text
]
, td []
[ Util.Contact.toString org.contacts |> text
]
]

177
modules/webapp/src/main/elm/Comp/PersonForm.elm
View File

@ -1,30 +1,33 @@
module Comp.PersonForm exposing ( Model
, emptyModel
, Msg(..)
, view
, update
, isValid
, getPerson)
module Comp.PersonForm exposing
( Model
, Msg(..)
, emptyModel
, getPerson
, isValid
, update
, view
)
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
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onInput)
type alias Model =
{ org: Person
, name: String
, addressModel: Comp.AddressForm.Model
, contactModel: Comp.ContactField.Model
, notes: Maybe String
, concerning: Bool
{ org : Person
, name : String
, addressModel : Comp.AddressForm.Model
, contactModel : Comp.ContactField.Model
, notes : Maybe String
, concerning : Bool
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ org = Api.Model.Person.empty
, name = ""
@ -34,21 +37,26 @@ emptyModel =
, concerning = False
}
isValid: Model -> Bool
isValid : Model -> Bool
isValid model =
model.name /= ""
getPerson: Model -> Person
getPerson : Model -> Person
getPerson model =
let
o = model.org
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
}
{ 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
@ -58,72 +66,101 @@ type Msg
| SetNotes String
| SetConcerning Bool
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
( 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)
( { m2
| org = t
, name = t.name
, notes = t.notes
, concerning = t.concerning
}
, Cmd.batch [ c1, c2 ]
)
AddressMsg am ->
let
(m1, c1) = Comp.AddressForm.update am model.addressModel
( m1, c1 ) =
Comp.AddressForm.update am model.addressModel
in
({model | addressModel = m1}, Cmd.map AddressMsg c1)
( { model | addressModel = m1 }, Cmd.map AddressMsg c1 )
ContactMsg m ->
let
(m1, c1) = Comp.ContactField.update m model.contactModel
( m1, c1 ) =
Comp.ContactField.update m model.contactModel
in
({model | contactModel = m1}, Cmd.map ContactMsg c1)
( { model | contactModel = m1 }, Cmd.map ContactMsg c1 )
SetName n ->
({model | name = n}, Cmd.none)
( { model | name = n }, Cmd.none )
SetNotes str ->
({model | notes = if str == "" then Nothing else Just str}, Cmd.none)
( { model
| notes =
if str == "" then
Nothing
SetConcerning flag ->
({model | concerning = not model.concerning}, Cmd.none)
else
Just str
}
, Cmd.none
)
SetConcerning _ ->
( { model | concerning = not model.concerning }, Cmd.none )
view: Model -> Html Msg
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"]
]
div [ class "ui form" ]
[ div
[ classList
[ ( "field", True )
, ( "error", not (isValid model) )
]
]
,h3 [class "ui dividing header"]
[text "Address"
[ label [] [ text "Name*" ]
, input
[ type_ "text"
, onInput SetName
, placeholder "Name"
, value model.name
]
[]
]
,Html.map AddressMsg (Comp.AddressForm.view model.addressModel)
,h3 [class "ui dividing header"]
[text "Contacts"
, div [ class "inline field" ]
[ div [ class "ui checkbox" ]
[ input
[ type_ "checkbox"
, checked model.concerning
, onCheck SetConcerning
]
[]
, label [] [ text "Use for concerning person suggestion only" ]
]
]
,Html.map ContactMsg (Comp.ContactField.view model.contactModel)
,h3 [class "ui dividing header"]
[text "Notes"
, h3 [ class "ui dividing header" ]
[ text "Address"
]
,div [class "field"]
[textarea [onInput SetNotes][Maybe.withDefault "" model.notes |> text ]
, 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 ]
]
]

292
modules/webapp/src/main/elm/Comp/PersonManage.elm
View File

@ -1,36 +1,43 @@
module Comp.PersonManage exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.PersonManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Person
import Api.Model.PersonList exposing (PersonList)
import Comp.PersonForm
import Comp.PersonTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
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 Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel: Comp.PersonTable.Model
, formModel: Comp.PersonForm.Model
, viewMode: ViewMode
, formError: Maybe String
, loading: Bool
, deleteConfirm: Comp.YesNoDimmer.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
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
{ tableModel = Comp.PersonTable.emptyModel
, formModel = Comp.PersonForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.PersonTable.Msg
| FormMsg Comp.PersonForm.Msg
@ -52,156 +60,210 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
( 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)
( m2, Cmd.none )
in
(m3, Cmd.batch [c2, c3])
( m3, Cmd.batch [ c2, c3 ] )
FormMsg m ->
let
(m2, c2) = Comp.PersonForm.update flags m model.formModel
( m2, c2 ) =
Comp.PersonForm.update flags m model.formModel
in
({model | formModel = m2}, Cmd.map FormMsg c2)
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadPersons ->
({model| loading = True}, Api.getPersons flags PersonResp)
( { model | loading = True }, Api.getPersons flags PersonResp )
PersonResp (Ok orgs) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.PersonTable.SetPersons orgs.items)) m2
update flags (TableMsg (Comp.PersonTable.SetPersons orgs.items)) m2
PersonResp (Err err) ->
({model|loading = False}, Cmd.none)
PersonResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.PersonTable.Deselect) m2
Form ->
(m2, Cmd.none)
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
nm =
{ model | viewMode = Form, formError = Nothing }
org =
Api.Model.Person.empty
in
update flags (FormMsg (Comp.PersonForm.SetPerson org)) nm
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)
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
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadPersons m2
in
({m3|loading = False}, Cmd.batch [c2,c3])
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
({model | formError = Just res.message, loading = False }, Cmd.none)
( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
( { 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
( 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)
( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
viewTable: Model -> Html Msg
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"][]
[ 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 -> Html Msg
viewForm model =
let
newPerson = model.formModel.org.id == ""
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"
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"
]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel"
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 )
]
,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"][]
]
]
[ 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" ] []
]
]

93
modules/webapp/src/main/elm/Comp/PersonTable.elm
View File

@ -1,81 +1,88 @@
module Comp.PersonTable exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.PersonTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Api.Model.Person exposing (Person)
import Data.Flags exposing (Flags)
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
{ equips : List Person
, selected : Maybe Person
}
emptyModel: Model
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 -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetPersons list ->
({model | equips = list, selected = Nothing }, Cmd.none)
( { model | equips = list, selected = Nothing }, Cmd.none )
Select equip ->
({model | selected = Just equip}, Cmd.none)
( { model | selected = Just equip }, Cmd.none )
Deselect ->
({model | selected = Nothing}, Cmd.none)
( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg
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 []
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 -> 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"][]
tr
[ classList [ ( "active", model.selected == Just person ) ]
, onClick (Select person)
]
[ td [ class "collapsing" ]
[ text person.name
]
,td []
[Util.Address.toString person.address |> text
, td [ class "collapsing" ]
[ if person.concerning then
i [ class "check square outline icon" ] []
else
i [ class "minus square outline icon" ] []
]
,td []
[Util.Contact.toString person.contacts |> text
, td []
[ Util.Address.toString person.address |> text
]
, td []
[ Util.Contact.toString person.contacts |> text
]
]

619
modules/webapp/src/main/elm/Comp/SearchMenu.elm
View File

@ -1,87 +1,96 @@
module Comp.SearchMenu exposing ( Model
, emptyModel
, Msg(..)
, update
, NextState
, view
, getItemSearch
)
module Comp.SearchMenu exposing
( Model
, Msg(..)
, NextState
, emptyModel
, getItemSearch
, update
, view
)
import Http
import Api
import Api.Model.Equipment exposing (Equipment)
import Api.Model.EquipmentList exposing (EquipmentList)
import Api.Model.IdName exposing (IdName)
import Api.Model.ItemSearch exposing (ItemSearch)
import Api.Model.ReferenceList exposing (ReferenceList)
import Api.Model.Tag exposing (Tag)
import Api.Model.TagList exposing (TagList)
import Comp.DatePicker
import Comp.Dropdown exposing (isDropdownChangeMsg)
import Data.Direction exposing (Direction)
import Data.Flags exposing (Flags)
import DatePicker exposing (DatePicker)
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 Http
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
{ 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 : 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"
}
, 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
@ -94,6 +103,7 @@ emptyModel =
, nameModel = Nothing
}
type Msg
= Init
| TagIncMsg (Comp.Dropdown.Msg Tag)
@ -115,315 +125,386 @@ type Msg
| SetName String
makeTagModel: Comp.Dropdown.Model Tag
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 ""
, labelColor =
\tag ->
if Util.Maybe.nonEmpty tag.category then
"basic blue"
else
""
, placeholder = "Choose a tag…"
}
getDirection: Model -> Maybe Direction
getDirection : Model -> Maybe Direction
getDirection model =
let
selection = Comp.Dropdown.getSelected model.directionModel
selection =
Comp.Dropdown.getSelected model.directionModel
in
case selection of
[d] -> Just d
_ -> Nothing
case selection of
[ d ] ->
Just d
getItemSearch: Model -> ItemSearch
_ ->
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
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
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 -> NextState
update flags msg model =
case msg of
Init ->
let
(dp, dpc) = Comp.DatePicker.init
( 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
]
)
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
tagList =
Comp.Dropdown.SetOptions tags.items
in
noChange <|
Util.Update.andThen1
[ update flags (TagIncMsg tagList) >> .modelCmd
, update flags (TagExcMsg tagList) >> .modelCmd
]
model
noChange <|
Util.Update.andThen1
[ update flags (TagIncMsg tagList) >> .modelCmd
, update flags (TagExcMsg tagList) >> .modelCmd
]
model
GetTagsResp (Err err) ->
noChange (model, Cmd.none)
GetTagsResp (Err _) ->
noChange ( model, Cmd.none )
GetEquipResp (Ok equips) ->
let
opts = Comp.Dropdown.SetOptions equips.items
opts =
Comp.Dropdown.SetOptions equips.items
in
update flags (ConcEquipmentMsg opts) model
update flags (ConcEquipmentMsg opts) model
GetEquipResp (Err err) ->
noChange (model, Cmd.none)
GetEquipResp (Err _) ->
noChange ( model, Cmd.none )
GetOrgResp (Ok orgs) ->
let
opts = Comp.Dropdown.SetOptions orgs.items
opts =
Comp.Dropdown.SetOptions orgs.items
in
update flags (OrgMsg opts) model
update flags (OrgMsg opts) model
GetOrgResp (Err err) ->
noChange (model, Cmd.none)
GetOrgResp (Err _) ->
noChange ( model, Cmd.none )
GetPersonResp (Ok ps) ->
let
opts = Comp.Dropdown.SetOptions ps.items
opts =
Comp.Dropdown.SetOptions ps.items
in
noChange <|
Util.Update.andThen1
[ update flags (CorrPersonMsg opts) >> .modelCmd
, update flags (ConcPersonMsg opts) >> .modelCmd
]
model
noChange <|
Util.Update.andThen1
[ update flags (CorrPersonMsg opts) >> .modelCmd
, update flags (ConcPersonMsg opts) >> .modelCmd
]
model
GetPersonResp (Err err) ->
noChange (model, Cmd.none)
GetPersonResp (Err _) ->
noChange ( model, Cmd.none )
TagIncMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.tagInclModel
( m2, c2 ) =
Comp.Dropdown.update m model.tagInclModel
in
NextState ({model|tagInclModel = m2}, Cmd.map TagIncMsg c2) (isDropdownChangeMsg m)
NextState ( { model | tagInclModel = m2 }, Cmd.map TagIncMsg c2 ) (isDropdownChangeMsg m)
TagExcMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.tagExclModel
( m2, c2 ) =
Comp.Dropdown.update m model.tagExclModel
in
NextState ({model|tagExclModel = m2}, Cmd.map TagExcMsg c2) (isDropdownChangeMsg m)
NextState ( { model | tagExclModel = m2 }, Cmd.map TagExcMsg c2 ) (isDropdownChangeMsg m)
DirectionMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.directionModel
( m2, c2 ) =
Comp.Dropdown.update m model.directionModel
in
NextState ({model|directionModel = m2}, Cmd.map DirectionMsg c2) (isDropdownChangeMsg m)
NextState ( { model | directionModel = m2 }, Cmd.map DirectionMsg c2 ) (isDropdownChangeMsg m)
OrgMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.orgModel
( m2, c2 ) =
Comp.Dropdown.update m model.orgModel
in
NextState ({model|orgModel = m2}, Cmd.map OrgMsg c2) (isDropdownChangeMsg m)
NextState ( { model | orgModel = m2 }, Cmd.map OrgMsg c2 ) (isDropdownChangeMsg m)
CorrPersonMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.corrPersonModel
( m2, c2 ) =
Comp.Dropdown.update m model.corrPersonModel
in
NextState ({model|corrPersonModel = m2}, Cmd.map CorrPersonMsg c2) (isDropdownChangeMsg m)
NextState ( { model | corrPersonModel = m2 }, Cmd.map CorrPersonMsg c2 ) (isDropdownChangeMsg m)
ConcPersonMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.concPersonModel
( m2, c2 ) =
Comp.Dropdown.update m model.concPersonModel
in
NextState ({model|concPersonModel = m2}, Cmd.map ConcPersonMsg c2) (isDropdownChangeMsg m)
NextState ( { model | concPersonModel = m2 }, Cmd.map ConcPersonMsg c2 ) (isDropdownChangeMsg m)
ConcEquipmentMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.concEquipmentModel
( m2, c2 ) =
Comp.Dropdown.update m model.concEquipmentModel
in
NextState ({model|concEquipmentModel = m2}, Cmd.map ConcEquipmentMsg c2) (isDropdownChangeMsg m)
NextState ( { model | concEquipmentModel = m2 }, Cmd.map ConcEquipmentMsg c2 ) (isDropdownChangeMsg m)
ToggleInbox ->
let
current = model.inboxCheckbox
current =
model.inboxCheckbox
in
NextState ({model | inboxCheckbox = not current }, Cmd.none) True
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
( 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)
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
( 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)
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
( 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)
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
( 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)
NextState ( { model | untilDueDateModel = dp, untilDueDate = nextDate }, Cmd.none ) (model.untilDueDate /= nextDate)
SetName str ->
let
next = if str == "" then Nothing else Just str
next =
if str == "" then
Nothing
else
Just str
in
NextState ({model|nameModel = next}, Cmd.none) (model.nameModel /= next)
NextState ( { model | nameModel = next }, Cmd.none ) (model.nameModel /= next)
-- View
view: Model -> Html Msg
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 "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 "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"]
, 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"
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 "Organization" ]
, Html.map OrgMsg (Comp.Dropdown.view model.orgModel)
]
,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 "field" ]
[ label [] [ text "Person" ]
, Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel)
]
,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"
, 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)
]
]
,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)
]
]
]

92
modules/webapp/src/main/elm/Comp/Settings.elm
View File

@ -1,62 +1,88 @@
module Comp.Settings exposing (..)
module Comp.Settings exposing
( Model
, Msg
, getSettings
, init
, update
, view
)
import Api.Model.CollectiveSettings exposing (CollectiveSettings)
import Comp.Dropdown
import Data.Flags exposing (Flags)
import Data.Language exposing (Language)
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
{ langModel : Comp.Dropdown.Model Language
, initSettings : CollectiveSettings
}
init: CollectiveSettings -> Model
init : CollectiveSettings -> Model
init settings =
let
lang = Data.Language.fromString settings.language |> Maybe.withDefault Data.Language.German
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
}
{ 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
getSettings model =
CollectiveSettings
(Comp.Dropdown.getSelected model.langModel
|> List.head
|> Maybe.map Data.Language.toIso3
|> Maybe.withDefault model.initSettings.language
|> 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 -> ( 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
( 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)
( nextModel, Cmd.map LangDropdownMsg c2, nextSettings )
view: Model -> Html Msg
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)
]
div [ class "ui form" ]
[ div [ class "field" ]
[ label [] [ text "Document Language" ]
, Html.map LangDropdownMsg (Comp.Dropdown.view model.langModel)
]
]

269
modules/webapp/src/main/elm/Comp/SourceForm.elm
View File

@ -1,60 +1,68 @@
module Comp.SourceForm exposing ( Model
, emptyModel
, Msg(..)
, view
, update
, isValid
, getSource)
module Comp.SourceForm exposing
( Model
, Msg(..)
, emptyModel
, getSource
, isValid
, update
, view
)
import Api.Model.Source exposing (Source)
import Comp.Dropdown
import Data.Flags exposing (Flags)
import Data.Priority exposing (Priority)
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
import Html.Events exposing (onCheck, onInput)
type alias Model =
{ source: Source
, abbrev: String
, description: Maybe String
, priority: Comp.Dropdown.Model Priority
, enabled: Bool
{ source : Source
, abbrev : String
, description : Maybe String
, priority : Comp.Dropdown.Model Priority
, enabled : Bool
}
emptyModel: Model
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
}
, 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 -> Bool
isValid model =
model.abbrev /= ""
getSource: Model -> Source
getSource : Model -> Source
getSource model =
let
s = model.source
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
}
{ 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
@ -64,105 +72,138 @@ type Msg
| ToggleEnabled
| PrioDropdownMsg (Comp.Dropdown.Msg Priority)
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
}
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)
( { 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)
( { model | enabled = not model.enabled }, Cmd.none )
SetAbbrev n ->
({model | abbrev = n}, Cmd.none)
( { model | abbrev = n }, Cmd.none )
SetDescr d ->
({model | description = if d /= "" then Just d else Nothing }, Cmd.none)
( { model
| description =
if d /= "" then
Just d
else
Nothing
}
, Cmd.none
)
PrioDropdownMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.priority
( m2, c2 ) =
Comp.Dropdown.update m model.priority
in
({model | priority = m2 }, Cmd.map PrioDropdownMsg c2)
( { model | priority = m2 }, Cmd.map PrioDropdownMsg c2 )
view: Flags -> Model -> Html Msg
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 "ui form" ]
[ div
[ classList
[ ( "field", True )
, ( "error", not (isValid model) )
]
]
,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)
[ label [] [ text "Abbrev*" ]
, input
[ type_ "text"
, onInput SetAbbrev
, placeholder "Abbrev"
, value model.abbrev
]
[]
]
,urlInfoMessage flags model
, 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 -> 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)]
]
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) ]
]
]
]
]

293
modules/webapp/src/main/elm/Comp/SourceManage.elm
View File

@ -1,36 +1,43 @@
module Comp.SourceManage exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.SourceManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Source
import Api.Model.SourceList exposing (SourceList)
import Comp.SourceForm
import Comp.SourceTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
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 Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel: Comp.SourceTable.Model
, formModel: Comp.SourceForm.Model
, viewMode: ViewMode
, formError: Maybe String
, loading: Bool
, deleteConfirm: Comp.YesNoDimmer.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
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
{ tableModel = Comp.SourceTable.emptyModel
, formModel = Comp.SourceForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.SourceTable.Msg
| FormMsg Comp.SourceForm.Msg
@ -52,156 +60,211 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
( 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)
( m2, Cmd.none )
in
(m3, Cmd.batch [c2, c3])
( m3, Cmd.batch [ c2, c3 ] )
FormMsg m ->
let
(m2, c2) = Comp.SourceForm.update flags m model.formModel
( m2, c2 ) =
Comp.SourceForm.update flags m model.formModel
in
({model | formModel = m2}, Cmd.map FormMsg c2)
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadSources ->
({model| loading = True}, Api.getSources flags SourceResp)
( { model | loading = True }, Api.getSources flags SourceResp )
SourceResp (Ok sources) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.SourceTable.SetSources sources.items)) m2
update flags (TableMsg (Comp.SourceTable.SetSources sources.items)) m2
SourceResp (Err err) ->
({model|loading = False}, Cmd.none)
SourceResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.SourceTable.Deselect) m2
Form ->
(m2, Cmd.none)
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
nm =
{ model | viewMode = Form, formError = Nothing }
source =
Api.Model.Source.empty
in
update flags (FormMsg (Comp.SourceForm.SetSource source)) nm
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)
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
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadSources m2
in
({m3|loading = False}, Cmd.batch [c2,c3])
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
({model | formError = Just res.message, loading = False }, Cmd.none)
( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
( { 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
( 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)
( { model | deleteConfirm = cm }, cmd )
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
if model.viewMode == Table then viewTable model
else div [](viewForm flags model)
if model.viewMode == Table then
viewTable model
viewTable: Model -> Html Msg
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"][]
[ 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 -> List (Html Msg)
viewForm flags model =
let
newSource = model.formModel.source.id == ""
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"
[ 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
]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel"
]
, 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 )
]
,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"][]
]
]
[ 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" ] []
]
]
]

105
modules/webapp/src/main/elm/Comp/SourceTable.elm
View File

@ -1,85 +1,94 @@
module Comp.SourceTable exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.SourceTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Api.Model.Source exposing (Source)
import Data.Flags exposing (Flags)
import Data.Priority
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
{ sources : List Source
, selected : Maybe Source
}
emptyModel: Model
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 -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetSources list ->
({model | sources = list, selected = Nothing }, Cmd.none)
( { model | sources = list, selected = Nothing }, Cmd.none )
Select source ->
({model | selected = Just source}, Cmd.none)
( { model | selected = Just source }, Cmd.none )
Deselect ->
({model | selected = Nothing}, Cmd.none)
( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg
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 []
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 -> 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"][]
tr
[ classList [ ( "active", model.selected == Just source ) ]
, onClick (Select source)
]
[ td [ class "collapsing" ]
[ text source.abbrev
]
,td [class "collapsing"]
[source.counter |> String.fromInt |> text
, td [ class "collapsing" ]
[ if source.enabled then
i [ class "check square outline icon" ] []
else
i [ class "minus square outline icon" ] []
]
,td [class "collapsing"]
[Data.Priority.fromString source.priority
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault source.priority
|> text
, td [ class "collapsing" ]
[ source.counter |> String.fromInt |> text
]
,td []
[text source.id
, td [ class "collapsing" ]
[ Data.Priority.fromString source.priority
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault source.priority
|> text
]
, td []
[ text source.id
]
]

92
modules/webapp/src/main/elm/Comp/TagForm.elm
View File

@ -1,76 +1,90 @@
module Comp.TagForm exposing ( Model
, emptyModel
, Msg(..)
, view
, update
, isValid
, getTag)
module Comp.TagForm exposing
( Model
, Msg(..)
, emptyModel
, getTag
, isValid
, update
, view
)
import Api.Model.Tag exposing (Tag)
import Data.Flags exposing (Flags)
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
{ tag : Tag
, name : String
, category : Maybe String
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ tag = Api.Model.Tag.empty
, name = ""
, category = Nothing
}
isValid: Model -> Bool
isValid : Model -> Bool
isValid model =
model.name /= ""
getTag: Model -> Tag
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 -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTag t ->
({model | tag = t, name = t.name, category = t.category }, Cmd.none)
( { model | tag = t, name = t.name, category = t.category }, Cmd.none )
SetName n ->
({model | name = n}, Cmd.none)
( { model | name = n }, Cmd.none )
SetCategory n ->
({model | category = Just n}, Cmd.none)
( { model | category = Just n }, Cmd.none )
view: Model -> Html Msg
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)
][]
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)
]
[]
]
]

293
modules/webapp/src/main/elm/Comp/TagManage.elm
View File

@ -1,36 +1,43 @@
module Comp.TagManage exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.TagManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Tag
import Api.Model.TagList exposing (TagList)
import Comp.TagForm
import Comp.TagTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
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 Http
import Util.Http
import Util.Maybe
type alias Model =
{ tagTableModel: Comp.TagTable.Model
, tagFormModel: Comp.TagForm.Model
, viewMode: ViewMode
, formError: Maybe String
, loading: Bool
, deleteConfirm: Comp.YesNoDimmer.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
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
{ tagTableModel = Comp.TagTable.emptyModel
, tagFormModel = Comp.TagForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.TagTable.Msg
| FormMsg Comp.TagForm.Msg
@ -52,155 +60,210 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
( 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)
( m2, Cmd.none )
in
(m3, Cmd.batch [c2, c3])
( m3, Cmd.batch [ c2, c3 ] )
FormMsg m ->
let
(m2, c2) = Comp.TagForm.update flags m model.tagFormModel
( m2, c2 ) =
Comp.TagForm.update flags m model.tagFormModel
in
({model | tagFormModel = m2}, Cmd.map FormMsg c2)
( { model | tagFormModel = m2 }, Cmd.map FormMsg c2 )
LoadTags ->
({model| loading = True}, Api.getTags flags TagResp)
( { model | loading = True }, Api.getTags flags TagResp )
TagResp (Ok tags) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2
update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2
TagResp (Err err) ->
({model|loading = False}, Cmd.none)
TagResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.TagTable.Deselect) m2
Form ->
(m2, Cmd.none)
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
nm =
{ model | viewMode = Form, formError = Nothing }
tag =
Api.Model.Tag.empty
in
update flags (FormMsg (Comp.TagForm.SetTag tag)) nm
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)
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
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadTags m2
in
({m3|loading = False}, Cmd.batch [c2,c3])
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
({model | formError = Just res.message, loading = False }, Cmd.none)
( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
( { 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
( 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)
( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
viewTable: Model -> Html Msg
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"][]
[ 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 -> Html Msg
viewForm model =
let
newTag = model.tagFormModel.tag.id == ""
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"
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"
]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel"
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 )
]
,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"][]
]
]
[ 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" ] []
]
]

72
modules/webapp/src/main/elm/Comp/TagTable.elm
View File

@ -1,66 +1,74 @@
module Comp.TagTable exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.TagTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Api.Model.Tag exposing (Tag)
import Data.Flags exposing (Flags)
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
{ tags : List Tag
, selected : Maybe Tag
}
emptyModel: Model
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 -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTags list ->
({model | tags = list, selected = Nothing }, Cmd.none)
( { model | tags = list, selected = Nothing }, Cmd.none )
Select tag ->
({model | selected = Just tag}, Cmd.none)
( { model | selected = Just tag }, Cmd.none )
Deselect ->
({model | selected = Nothing}, Cmd.none)
( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg
view : Model -> Html Msg
view model =
table [class "ui selectable table"]
[thead []
[tr []
[th [][text "Name"]
,th [][text "Category"]
]
]
,tbody []
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 -> 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
tr
[ classList [ ( "active", model.selected == Just tag ) ]
, onClick (Select tag)
]
[ td []
[ text tag.name
]
, td []
[ Maybe.withDefault "-" tag.category |> text
]
]

223
modules/webapp/src/main/elm/Comp/UserForm.elm
View File

@ -1,68 +1,85 @@
module Comp.UserForm exposing ( Model
, emptyModel
, Msg(..)
, view
, update
, isValid
, isNewUser
, getUser)
module Comp.UserForm exposing
( Model
, Msg(..)
, emptyModel
, getUser
, isNewUser
, isValid
, update
, view
)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onCheck)
import Api.Model.User exposing (User)
import Comp.Dropdown
import Data.Flags exposing (Flags)
import Data.UserState exposing (UserState)
import Api.Model.User exposing (User)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
import Util.Maybe
import Comp.Dropdown
type alias Model =
{ user: User
, login: String
, email: Maybe String
, state: Comp.Dropdown.Model UserState
, password: Maybe String
{ user : User
, login : String
, email : Maybe String
, state : Comp.Dropdown.Model UserState
, password : Maybe String
}
emptyModel: Model
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
}
, 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 -> Bool
isValid model =
if model.user.login == "" then
model.login /= "" && Util.Maybe.nonEmpty model.password
else
True
isNewUser: Model -> Bool
isNewUser : Model -> Bool
isNewUser model =
model.user.login == ""
getUser: Model -> User
getUser : Model -> User
getUser model =
let
s = model.user
state = Comp.Dropdown.getSelected model.state
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
}
{ s
| login = model.login
, email = model.email
, state = state
, password = model.password
}
type Msg
@ -72,79 +89,115 @@ type Msg
| StateMsg (Comp.Dropdown.Msg UserState)
| SetPassword String
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetUser t ->
let
state = Comp.Dropdown.makeSingleList
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)
, 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)
( { 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
( m1, c1 ) =
Comp.Dropdown.update m model.state
in
({model | state = m1}, Cmd.map StateMsg c1)
( { model | state = m1 }, Cmd.map StateMsg c1 )
SetLogin n ->
({model | login = n}, Cmd.none)
( { model | login = n }, Cmd.none )
SetEmail e ->
({model | email = if e == "" then Nothing else Just e }, Cmd.none)
( { model
| email =
if e == "" then
Nothing
else
Just e
}
, Cmd.none
)
SetPassword p ->
({model | password = if p == "" then Nothing else Just p}, Cmd.none)
( { model
| password =
if p == "" then
Nothing
else
Just p
}
, Cmd.none
)
view: Model -> Html Msg
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 "ui form" ]
[ div
[ classList
[ ( "field", True )
, ( "error", model.login == "" )
, ( "invisible", model.user.login /= "" )
]
]
,div [class "field"]
[label [][text "State"]
,Html.map StateMsg (Comp.Dropdown.view model.state)
[ label [] [ text "Login*" ]
, input
[ type_ "text"
, onInput SetLogin
, placeholder "Login"
, value model.login
]
[]
]
,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
][]
, 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
]
[]
]
]

295
modules/webapp/src/main/elm/Comp/UserManage.elm
View File

@ -1,36 +1,43 @@
module Comp.UserManage exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.UserManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.User
import Api.Model.UserList exposing (UserList)
import Comp.UserForm
import Comp.UserTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
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 Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel: Comp.UserTable.Model
, formModel: Comp.UserForm.Model
, viewMode: ViewMode
, formError: Maybe String
, loading: Bool
, deleteConfirm: Comp.YesNoDimmer.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
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
{ tableModel = Comp.UserTable.emptyModel
, formModel = Comp.UserForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.UserTable.Msg
| FormMsg Comp.UserForm.Msg
@ -52,154 +60,213 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
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
( 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)
( m2, Cmd.none )
in
(m3, Cmd.batch [c2, c3])
( m3, Cmd.batch [ c2, c3 ] )
FormMsg m ->
let
(m2, c2) = Comp.UserForm.update flags m model.formModel
( m2, c2 ) =
Comp.UserForm.update flags m model.formModel
in
({model | formModel = m2}, Cmd.map FormMsg c2)
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadUsers ->
({model| loading = True}, Api.getUsers flags UserResp)
( { model | loading = True }, Api.getUsers flags UserResp )
UserResp (Ok users) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.UserTable.SetUsers users.items)) m2
update flags (TableMsg (Comp.UserTable.SetUsers users.items)) m2
UserResp (Err err) ->
({model|loading = False}, Cmd.none)
UserResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.UserTable.Deselect) m2
Form ->
(m2, Cmd.none)
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
nm =
{ model | viewMode = Form, formError = Nothing }
user =
Api.Model.User.empty
in
update flags (FormMsg (Comp.UserForm.SetUser user)) nm
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)
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
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadUsers m2
in
({m3|loading = False}, Cmd.batch [c2,c3])
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
({model | formError = Just res.message, loading = False }, Cmd.none)
( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none)
( { 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
( 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)
( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
viewTable: Model -> Html Msg
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"][]
[ 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 -> Html Msg
viewForm model =
let
newUser = Comp.UserForm.isNewUser model.formModel
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"
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"
]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel"
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 )
]
,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"][]
]
]
[ 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" ] []
]
]

96
modules/webapp/src/main/elm/Comp/UserTable.elm
View File

@ -1,83 +1,91 @@
module Comp.UserTable exposing ( Model
, emptyModel
, Msg(..)
, view
, update)
module Comp.UserTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Api.Model.User exposing (User)
import Data.Flags exposing (Flags)
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
{ users : List User
, selected : Maybe User
}
emptyModel: Model
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 -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetUsers list ->
({model | users = list, selected = Nothing }, Cmd.none)
( { model | users = list, selected = Nothing }, Cmd.none )
Select user ->
({model | selected = Just user}, Cmd.none)
( { model | selected = Just user }, Cmd.none )
Deselect ->
({model | selected = Nothing}, Cmd.none)
( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg
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 []
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 -> 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
tr
[ classList [ ( "active", model.selected == Just user ) ]
, onClick (Select user)
]
[ td [ class "collapsing" ]
[ text user.login
]
,td [class "collapsing"]
[Maybe.withDefault "" user.email |> text
, td [ class "collapsing" ]
[ text user.state
]
,td [class "collapsing"]
[String.fromInt user.loginCount |> text
, td [ class "collapsing" ]
[ Maybe.withDefault "" user.email |> text
]
,td [class "collapsing"]
[Maybe.map formatDateTime user.lastLogin |> Maybe.withDefault "" |> text
, td [ class "collapsing" ]
[ String.fromInt user.loginCount |> text
]
,td [class "collapsing"]
[formatDateTime user.created |> text
, td [ class "collapsing" ]
[ Maybe.map formatDateTime user.lastLogin |> Maybe.withDefault "" |> text
]
, td [ class "collapsing" ]
[ formatDateTime user.created |> text
]
]

132
modules/webapp/src/main/elm/Comp/YesNoDimmer.elm
View File

@ -1,43 +1,49 @@
module Comp.YesNoDimmer exposing ( Model
, Msg(..)
, emptyModel
, update
, view
, view2
, activate
, disable
, Settings
, defaultSettings
)
module Comp.YesNoDimmer exposing
( Model
, Msg(..)
, Settings
, activate
, defaultSettings
, disable
, emptyModel
, update
, view
, view2
)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
type alias Model =
{ active: Bool
{ active : Bool
}
emptyModel: Model
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
{ message : String
, headerIcon : String
, headerClass : String
, confirmButton : String
, cancelButton : String
, invertedDimmer : Bool
}
defaultSettings: Settings
defaultSettings : Settings
defaultSettings =
{ message = "Delete this item permanently?"
, headerIcon = "exclamation icon"
@ -48,48 +54,62 @@ defaultSettings =
}
activate: Msg
activate = Activate
activate : Msg
activate =
Activate
disable: Msg
disable = Disable
update: Msg -> Model -> (Model, Bool)
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)
( { model | active = True }, False )
view: Model -> Html Msg
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 : 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
]
]
]
]
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
]
]
]
]

66
modules/webapp/src/main/elm/Data/ContactType.elm
View File

@ -1,4 +1,10 @@
module Data.ContactType exposing (..)
module Data.ContactType exposing
( ContactType(..)
, all
, fromString
, toString
)
type ContactType
= Phone
@ -9,28 +15,54 @@ type ContactType
| Website
fromString: String -> Maybe ContactType
fromString : String -> Maybe ContactType
fromString str =
case String.toLower str of
"phone" -> Just Phone
"mobile" -> Just Mobile
"fax" -> Just Fax
"email" -> Just Email
"docspell" -> Just Docspell
"website" -> Just Website
_ -> Nothing
"phone" ->
Just Phone
toString: ContactType -> String
"mobile" ->
Just Mobile
"fax" ->
Just Fax
"email" ->
Just Email
"docspell" ->
Just Docspell
"website" ->
Just Website
_ ->
Nothing
toString : ContactType -> String
toString ct =
case ct of
Phone -> "Phone"
Mobile -> "Mobile"
Fax -> "Fax"
Email -> "Email"
Docspell -> "Docspell"
Website -> "Website"
Phone ->
"Phone"
all: List ContactType
Mobile ->
"Mobile"
Fax ->
"Fax"
Email ->
"Email"
Docspell ->
"Docspell"
Website ->
"Website"
all : List ContactType
all =
[ Mobile
, Phone

57
modules/webapp/src/main/elm/Data/Direction.elm
View File

@ -1,45 +1,72 @@
module Data.Direction exposing (..)
module Data.Direction exposing
( Direction(..)
, all
, fromString
, icon
, iconFromMaybe
, iconFromString
, toString
)
type Direction
= Incoming
| Outgoing
fromString: String -> Maybe Direction
fromString : String -> Maybe Direction
fromString str =
case String.toLower str of
"outgoing" -> Just Outgoing
"incoming" -> Just Incoming
_ -> Nothing
"outgoing" ->
Just Outgoing
all: List Direction
"incoming" ->
Just Incoming
_ ->
Nothing
all : List Direction
all =
[ Incoming
, Outgoing
]
toString: Direction -> String
toString : Direction -> String
toString dir =
case dir of
Incoming -> "Incoming"
Outgoing -> "Outgoing"
Incoming ->
"Incoming"
icon: Direction -> String
Outgoing ->
"Outgoing"
icon : Direction -> String
icon dir =
case dir of
Incoming -> "level down alternate icon"
Outgoing -> "level up alternate icon"
Incoming ->
"level down alternate icon"
unknownIcon: String
Outgoing ->
"level up alternate icon"
unknownIcon : String
unknownIcon =
"question circle outline icon"
iconFromString: String -> String
iconFromString : String -> String
iconFromString dir =
fromString dir
|> Maybe.map icon
|> Maybe.withDefault unknownIcon
iconFromMaybe: Maybe String -> String
iconFromMaybe : Maybe String -> String
iconFromMaybe ms =
Maybe.map iconFromString ms
|> Maybe.withDefault unknownIcon

31
modules/webapp/src/main/elm/Data/Flags.elm
View File

@ -1,28 +1,39 @@
module Data.Flags exposing (..)
module Data.Flags exposing
( Config
, Flags
, getToken
, withAccount
, withoutAccount
)
import Api.Model.AuthResult exposing (AuthResult)
type alias Config =
{ appName: String
, baseUrl: String
, signupMode: String
, docspellAssetPath: String
{ appName : String
, baseUrl : String
, signupMode : String
, docspellAssetPath : String
}
type alias Flags =
{ account: Maybe AuthResult
, config: Config
{ account : Maybe AuthResult
, config : Config
}
getToken: Flags -> Maybe String
getToken : Flags -> Maybe String
getToken flags =
flags.account
|> Maybe.andThen (\a -> a.token)
withAccount: Flags -> AuthResult -> Flags
withAccount : Flags -> AuthResult -> Flags
withAccount flags acc =
{ flags | account = Just acc }
withoutAccount: Flags -> Flags
withoutAccount : Flags -> Flags
withoutAccount flags =
{ flags | account = Nothing }

48
modules/webapp/src/main/elm/Data/Language.elm
View File

@ -1,27 +1,49 @@
module Data.Language exposing (..)
module Data.Language exposing
( Language(..)
, all
, fromString
, toIso3
, toName
)
type Language
= German
| English
fromString: String -> Maybe Language
fromString str =
if str == "deu" || str == "de" || str == "german" then Just German
else if str == "eng" || str == "en" || str == "english" then Just English
else Nothing
toIso3: Language -> String
fromString : String -> Maybe Language
fromString str =
if str == "deu" || str == "de" || str == "german" then
Just German
else if str == "eng" || str == "en" || str == "english" then
Just English
else
Nothing
toIso3 : Language -> String
toIso3 lang =
case lang of
German -> "deu"
English -> "eng"
German ->
"deu"
toName: Language -> String
English ->
"eng"
toName : Language -> String
toName lang =
case lang of
German -> "German"
English -> "English"
German ->
"German"
all: List Language
English ->
"English"
all : List Language
all =
[ German, English ]

40
modules/webapp/src/main/elm/Data/Priority.elm
View File

@ -1,25 +1,43 @@
module Data.Priority exposing (..)
module Data.Priority exposing
( Priority(..)
, all
, fromString
, toName
)
type Priority
= High
| Low
fromString: String -> Maybe Priority
fromString : String -> Maybe Priority
fromString str =
let
s = String.toLower str
s =
String.toLower str
in
case s of
"low" -> Just Low
"high" -> Just High
_ -> Nothing
case s of
"low" ->
Just Low
toName: Priority -> String
"high" ->
Just High
_ ->
Nothing
toName : Priority -> String
toName lang =
case lang of
Low -> "Low"
High-> "High"
Low ->
"Low"
all: List Priority
High ->
"High"
all : List Priority
all =
[ Low, High ]

35
modules/webapp/src/main/elm/Data/SourceState.elm
View File

@ -1,24 +1,41 @@
module Data.SourceState exposing (..)
module Data.SourceState exposing
( SourceState(..)
, all
, fromString
, toString
)
type SourceState
= Active
| Disabled
fromString: String -> Maybe SourceState
fromString : String -> Maybe SourceState
fromString str =
case String.toLower str of
"active" -> Just Active
"disabled" -> Just Disabled
_ -> Nothing
"active" ->
Just Active
all: List SourceState
"disabled" ->
Just Disabled
_ ->
Nothing
all : List SourceState
all =
[ Active
, Disabled
]
toString: SourceState -> String
toString : SourceState -> String
toString dir =
case dir of
Active -> "Active"
Disabled -> "Disabled"
Active ->
"Active"
Disabled ->
"Disabled"

35
modules/webapp/src/main/elm/Data/UserState.elm
View File

@ -1,24 +1,41 @@
module Data.UserState exposing (..)
module Data.UserState exposing
( UserState(..)
, all
, fromString
, toString
)
type UserState
= Active
| Disabled
fromString: String -> Maybe UserState
fromString : String -> Maybe UserState
fromString str =
case String.toLower str of
"active" -> Just Active
"disabled" -> Just Disabled
_ -> Nothing
"active" ->
Just Active
all: List UserState
"disabled" ->
Just Disabled
_ ->
Nothing
all : List UserState
all =
[ Active
, Disabled
]
toString: UserState -> String
toString : UserState -> String
toString dir =
case dir of
Active -> "Active"
Disabled -> "Disabled"
Active ->
"Active"
Disabled ->
"Disabled"

81
modules/webapp/src/main/elm/Main.elm
View File

@ -1,58 +1,75 @@
module Main exposing (..)
import Browser exposing (Document)
import Browser.Navigation exposing (Key)
import Url exposing (Url)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
module Main exposing (init, main)
import Api
import Ports
import Page
import Data.Flags exposing (Flags)
import App.Data exposing (..)
import App.Update exposing (..)
import App.View exposing (..)
import Browser exposing (Document)
import Browser.Navigation exposing (Key)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page
import Ports
import Url exposing (Url)
-- MAIN
main: Program Flags Model Msg
main : Program Flags Model Msg
main =
Browser.application
{ init = init
, view = viewDoc
, update = update
, subscriptions = subscriptions
, onUrlRequest = NavRequest
, onUrlChange = NavChange
}
Browser.application
{ init = init
, view = viewDoc
, update = update
, subscriptions = subscriptions
, onUrlRequest = NavRequest
, onUrlChange = NavChange
}
-- MODEL
init : Flags -> Url -> Key -> (Model, Cmd Msg)
init : Flags -> Url -> Key -> ( Model, Cmd Msg )
init flags url key =
let
im = App.Data.init key url flags
page = checkPage flags im.page
(m, cmd) = if im.page == page then App.Update.initPage im page
else (im, Page.goto page)
im =
App.Data.init key url flags
page =
checkPage flags im.page
( m, cmd ) =
if im.page == page then
App.Update.initPage im page
else
( im, Page.goto page )
sessionCheck =
case m.flags.account of
Just _ -> Api.loginSession flags SessionCheckResp
Nothing -> Cmd.none
in
(m, Cmd.batch [ cmd, Ports.initElements(), Api.versionInfo flags VersionResp, sessionCheck ])
Just _ ->
Api.loginSession flags SessionCheckResp
viewDoc: Model -> Document Msg
Nothing ->
Cmd.none
in
( m, Cmd.batch [ cmd, Api.versionInfo flags VersionResp, sessionCheck ] )
viewDoc : Model -> Document Msg
viewDoc model =
{ title = model.flags.config.appName ++ ": " ++ (Page.pageName model.page)
, body = [ (view model) ]
{ title = model.flags.config.appName ++ ": " ++ Page.pageName model.page
, body = [ view model ]
}
-- SUBSCRIPTIONS

217
modules/webapp/src/main/elm/Page.elm
View File

@ -1,25 +1,26 @@
module Page exposing ( Page(..)
, href
, goto
, pageToString
, pageFromString
, pageName
, loginPage
, loginPageReferrer
, uploadId
, fromUrl
, isSecured
, isOpen
)
module Page exposing
( Page(..)
, fromUrl
, goto
, href
, isOpen
, isSecured
, loginPage
, loginPageReferrer
, pageFromString
, pageName
, pageToString
, uploadId
)
import Url exposing (Url)
import Url.Parser as Parser exposing ((</>), (<?>), Parser, oneOf, s, string)
import Url.Parser.Query as Query
import Browser.Navigation as Nav
import Html exposing (Attribute)
import Html.Attributes as Attr
import Browser.Navigation as Nav
import Url exposing (Url)
import Url.Parser as Parser exposing ((</>), Parser, oneOf, s, string)
import Util.Maybe
type Page
= HomePage
| LoginPage (Maybe String)
@ -32,108 +33,178 @@ type Page
| NewInvitePage
isSecured: Page -> Bool
isSecured : Page -> Bool
isSecured page =
case page of
HomePage -> True
LoginPage _ -> False
ManageDataPage -> True
CollectiveSettingPage -> True
UserSettingPage -> True
QueuePage -> True
RegisterPage -> False
NewInvitePage -> False
HomePage ->
True
LoginPage _ ->
False
ManageDataPage ->
True
CollectiveSettingPage ->
True
UserSettingPage ->
True
QueuePage ->
True
RegisterPage ->
False
NewInvitePage ->
False
UploadPage arg ->
Util.Maybe.isEmpty arg
isOpen: Page -> Bool
isOpen : Page -> Bool
isOpen page =
not (isSecured page)
loginPage: Page -> Page
loginPage : Page -> Page
loginPage p =
case p of
LoginPage _ -> LoginPage Nothing
_ -> LoginPage (Just (pageToString p |> String.dropLeft 2))
LoginPage _ ->
LoginPage Nothing
_ ->
LoginPage (Just (pageToString p |> String.dropLeft 2))
pageName: Page -> String
pageName : Page -> String
pageName page =
case page of
HomePage -> "Home"
LoginPage _ -> "Login"
ManageDataPage -> "Manage Data"
CollectiveSettingPage -> "Collective Settings"
UserSettingPage -> "User Settings"
QueuePage -> "Processing"
RegisterPage -> "Register"
NewInvitePage -> "New Invite"
HomePage ->
"Home"
LoginPage _ ->
"Login"
ManageDataPage ->
"Manage Data"
CollectiveSettingPage ->
"Collective Settings"
UserSettingPage ->
"User Settings"
QueuePage ->
"Processing"
RegisterPage ->
"Register"
NewInvitePage ->
"New Invite"
UploadPage arg ->
case arg of
Just _ -> "Anonymous Upload"
Nothing -> "Upload"
Just _ ->
"Anonymous Upload"
loginPageReferrer: Page -> Maybe Page
Nothing ->
"Upload"
loginPageReferrer : Page -> Maybe Page
loginPageReferrer page =
case page of
LoginPage r -> Maybe.andThen pageFromString r
_ -> Nothing
LoginPage r ->
Maybe.andThen pageFromString r
uploadId: Page -> Maybe String
_ ->
Nothing
uploadId : Page -> Maybe String
uploadId page =
case page of
UploadPage id -> id
_ -> Nothing
UploadPage id ->
id
pageToString: Page -> String
_ ->
Nothing
pageToString : Page -> String
pageToString page =
case page of
HomePage -> "#/home"
HomePage ->
"#/home"
LoginPage referer ->
Maybe.map (\p -> "/" ++ p) referer
|> Maybe.withDefault ""
|> (++) "#/login"
ManageDataPage -> "#/manageData"
CollectiveSettingPage -> "#/collectiveSettings"
UserSettingPage -> "#/userSettings"
QueuePage -> "#/queue"
RegisterPage -> "#/register"
ManageDataPage ->
"#/manageData"
CollectiveSettingPage ->
"#/collectiveSettings"
UserSettingPage ->
"#/userSettings"
QueuePage ->
"#/queue"
RegisterPage ->
"#/register"
UploadPage sourceId ->
Maybe.map (\id -> "/" ++ id) sourceId
|> Maybe.withDefault ""
|> (++) "#/upload"
NewInvitePage -> "#/newinvite"
pageFromString: String -> Maybe Page
NewInvitePage ->
"#/newinvite"
pageFromString : String -> Maybe Page
pageFromString str =
let
url = Url.Url Url.Http "" Nothing str Nothing Nothing
url =
Url.Url Url.Http "" Nothing str Nothing Nothing
in
Parser.parse parser url
Parser.parse parser url
href: Page -> Attribute msg
href : Page -> Attribute msg
href page =
Attr.href (pageToString page)
goto: Page -> Cmd msg
goto : Page -> Cmd msg
goto page =
Nav.load (pageToString page)
parser: Parser (Page -> a) a
parser : Parser (Page -> a) a
parser =
oneOf
[ Parser.map HomePage (oneOf [s"", s "home"])
, Parser.map (\s -> LoginPage (Just s)) (s "login" </> string)
, Parser.map (LoginPage Nothing) (s "login")
, Parser.map ManageDataPage (s "manageData")
, Parser.map CollectiveSettingPage (s "collectiveSettings")
, Parser.map UserSettingPage (s "userSettings")
, Parser.map QueuePage (s "queue")
, Parser.map RegisterPage (s "register")
, Parser.map (\s -> UploadPage (Just s)) (s "upload" </> string)
, Parser.map (UploadPage Nothing) (s "upload")
, Parser.map NewInvitePage (s "newinvite")
]
[ Parser.map HomePage (oneOf [ s "", s "home" ])
, Parser.map (\s -> LoginPage (Just s)) (s "login" </> string)
, Parser.map (LoginPage Nothing) (s "login")
, Parser.map ManageDataPage (s "manageData")
, Parser.map CollectiveSettingPage (s "collectiveSettings")
, Parser.map UserSettingPage (s "userSettings")
, Parser.map QueuePage (s "queue")
, Parser.map RegisterPage (s "register")
, Parser.map (\s -> UploadPage (Just s)) (s "upload" </> string)
, Parser.map (UploadPage Nothing) (s "upload")
, Parser.map NewInvitePage (s "newinvite")
]
fromUrl : Url -> Maybe Page
fromUrl url =

34
modules/webapp/src/main/elm/Page/CollectiveSettings/Data.elm
View File

@ -1,24 +1,30 @@
module Page.CollectiveSettings.Data exposing (..)
module Page.CollectiveSettings.Data exposing
( Model
, Msg(..)
, Tab(..)
, emptyModel
)
import Http
import Comp.SourceManage
import Comp.UserManage
import Comp.Settings
import Data.Language
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.CollectiveSettings exposing (CollectiveSettings)
import Api.Model.ItemInsights exposing (ItemInsights)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Http
type alias Model =
{ currentTab: Maybe Tab
, sourceModel: Comp.SourceManage.Model
, userModel: Comp.UserManage.Model
, settingsModel: Comp.Settings.Model
, insights: ItemInsights
, submitResult: Maybe BasicResult
{ currentTab : Maybe Tab
, sourceModel : Comp.SourceManage.Model
, userModel : Comp.UserManage.Model
, settingsModel : Comp.Settings.Model
, insights : ItemInsights
, submitResult : Maybe BasicResult
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ currentTab = Just InsightsTab
, sourceModel = Comp.SourceManage.emptyModel
@ -28,12 +34,14 @@ emptyModel =
, submitResult = Nothing
}
type Tab
= SourceTab
| UserTab
| InsightsTab
| SettingsTab
type Msg
= SetTab Tab
| SourceMsg Comp.SourceManage.Msg

80
modules/webapp/src/main/elm/Page/CollectiveSettings/Update.elm
View File

@ -2,80 +2,90 @@ module Page.CollectiveSettings.Update exposing (update)
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Page.CollectiveSettings.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Comp.Settings
import Data.Flags exposing (Flags)
import Page.CollectiveSettings.Data exposing (..)
import Util.Http
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTab t ->
let
m = { model | currentTab = Just t }
m =
{ model | currentTab = Just t }
in
case t of
SourceTab ->
update flags (SourceMsg Comp.SourceManage.LoadSources) m
case t of
SourceTab ->
update flags (SourceMsg Comp.SourceManage.LoadSources) m
UserTab ->
update flags (UserMsg Comp.UserManage.LoadUsers) m
UserTab ->
update flags (UserMsg Comp.UserManage.LoadUsers) m
InsightsTab ->
update flags Init m
InsightsTab ->
update flags Init m
SettingsTab ->
update flags Init m
SettingsTab ->
update flags Init m
SourceMsg m ->
let
(m2, c2) = Comp.SourceManage.update flags m model.sourceModel
( m2, c2 ) =
Comp.SourceManage.update flags m model.sourceModel
in
({model | sourceModel = m2}, Cmd.map SourceMsg c2)
( { model | sourceModel = m2 }, Cmd.map SourceMsg c2 )
UserMsg m ->
let
(m2, c2) = Comp.UserManage.update flags m model.userModel
( m2, c2 ) =
Comp.UserManage.update flags m model.userModel
in
({model | userModel = m2}, Cmd.map UserMsg c2)
( { model | userModel = m2 }, Cmd.map UserMsg c2 )
SettingsMsg m ->
let
(m2, c2, msett) = Comp.Settings.update flags m model.settingsModel
cmd = case msett of
Nothing -> Cmd.none
Just sett ->
Api.setCollectiveSettings flags sett SubmitResp
( m2, c2, msett ) =
Comp.Settings.update flags m model.settingsModel
cmd =
case msett of
Nothing ->
Cmd.none
Just sett ->
Api.setCollectiveSettings flags sett SubmitResp
in
({model | settingsModel = m2, submitResult = Nothing}, Cmd.batch [cmd, Cmd.map SettingsMsg c2])
( { model | settingsModel = m2, submitResult = Nothing }, Cmd.batch [ cmd, Cmd.map SettingsMsg c2 ] )
Init ->
({model|submitResult = Nothing}
,Cmd.batch
( { model | submitResult = Nothing }
, Cmd.batch
[ Api.getInsights flags GetInsightsResp
, Api.getCollectiveSettings flags CollectiveSettingsResp
]
)
GetInsightsResp (Ok data) ->
({model|insights = data}, Cmd.none)
( { model | insights = data }, Cmd.none )
GetInsightsResp (Err err) ->
(model, Cmd.none)
GetInsightsResp (Err _) ->
( model, Cmd.none )
CollectiveSettingsResp (Ok data) ->
({model | settingsModel = Comp.Settings.init data }, Cmd.none)
( { model | settingsModel = Comp.Settings.init data }, Cmd.none )
CollectiveSettingsResp (Err err) ->
(model, Cmd.none)
CollectiveSettingsResp (Err _) ->
( model, Cmd.none )
SubmitResp (Ok res) ->
({model | submitResult = Just res}, Cmd.none)
( { model | submitResult = Just res }, Cmd.none )
SubmitResp (Err err) ->
let
res = BasicResult False (Util.Http.errorToString err)
res =
BasicResult False (Util.Http.errorToString err)
in
({model | submitResult = Just res}, Cmd.none)
( { model | submitResult = Just res }, Cmd.none )

338
modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm
View File

@ -1,197 +1,217 @@
module Page.CollectiveSettings.View exposing (view)
import Api.Model.NameCount exposing (NameCount)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Api.Model.NameCount exposing (NameCount)
import Util.Html exposing (classActive)
import Data.Flags exposing (Flags)
import Page.CollectiveSettings.Data exposing (..)
import Comp.SourceManage
import Comp.UserManage
import Comp.Settings
import Util.Size
import Util.Html exposing (classActive)
import Util.Maybe
import Util.Size
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
div [class "collectivesetting-page ui padded grid"]
[div [class "four wide column"]
[h4 [class "ui top attached ablue-comp header"]
[text "Collective"
]
,div [class "ui attached fluid segment"]
[div [class "ui fluid vertical secondary menu"]
[div [classActive (model.currentTab == Just InsightsTab) "link icon item"
,onClick (SetTab InsightsTab)
]
[i [class "chart bar outline icon"][]
,text "Insights"
]
,div [classActive (model.currentTab == Just SourceTab) "link icon item"
,onClick (SetTab SourceTab)
]
[i [class "upload icon"][]
,text "Sources"
]
, div [classActive (model.currentTab == Just SettingsTab) "link icon item"
,onClick (SetTab SettingsTab)
div [ class "collectivesetting-page ui padded grid" ]
[ div [ class "four wide column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
[ text "Collective"
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[ div
[ classActive (model.currentTab == Just InsightsTab) "link icon item"
, onClick (SetTab InsightsTab)
]
[i [class "language icon"][]
,text "Document Language"
]
,div [classActive (model.currentTab == Just UserTab) "link icon item"
,onClick (SetTab UserTab)
]
[i [class "user icon"][]
,text "Users"
]
]
]
]
,div [class "twelve wide column"]
[div [class ""]
(case model.currentTab of
Just SourceTab -> viewSources flags model
Just UserTab -> viewUsers model
Just InsightsTab -> viewInsights model
Just SettingsTab -> viewSettings model
Nothing -> []
)
[ i [ class "chart bar outline icon" ] []
, text "Insights"
]
, div
[ classActive (model.currentTab == Just SourceTab) "link icon item"
, onClick (SetTab SourceTab)
]
[ i [ class "upload icon" ] []
, text "Sources"
]
, div
[ classActive (model.currentTab == Just SettingsTab) "link icon item"
, onClick (SetTab SettingsTab)
]
[ i [ class "language icon" ] []
, text "Document Language"
]
, div
[ classActive (model.currentTab == Just UserTab) "link icon item"
, onClick (SetTab UserTab)
]
[ i [ class "user icon" ] []
, text "Users"
]
]
]
]
, div [ class "twelve wide column" ]
[ div [ class "" ]
(case model.currentTab of
Just SourceTab ->
viewSources flags model
Just UserTab ->
viewUsers model
Just InsightsTab ->
viewInsights model
Just SettingsTab ->
viewSettings model
Nothing ->
[]
)
]
]
viewInsights: Model -> List (Html Msg)
viewInsights : Model -> List (Html Msg)
viewInsights model =
[h1 [class "ui header"]
[i [class "chart bar outline icon"][]
,div [class "content"]
[text "Insights"
]
[ h1 [ class "ui header" ]
[ i [ class "chart bar outline icon" ] []
, div [ class "content" ]
[ text "Insights"
]
]
, div [ class "ui basic blue segment" ]
[ h4 [ class "ui header" ]
[ text "Items"
]
, div [ class "ui statistics" ]
[ div [ class "ui statistic" ]
[ div [ class "value" ]
[ String.fromInt (model.insights.incomingCount + model.insights.outgoingCount) |> text
]
, div [ class "label" ]
[ text "Items"
]
]
, div [ class "ui statistic" ]
[ div [ class "value" ]
[ String.fromInt model.insights.incomingCount |> text
]
, div [ class "label" ]
[ text "Incoming"
]
]
, div [ class "ui statistic" ]
[ div [ class "value" ]
[ String.fromInt model.insights.outgoingCount |> text
]
, div [ class "label" ]
[ text "Outgoing"
]
]
]
]
, div [ class "ui basic blue segment" ]
[ h4 [ class "ui header" ]
[ text "Size"
]
, div [ class "ui statistics" ]
[ div [ class "ui statistic" ]
[ div [ class "value" ]
[ toFloat model.insights.itemSize |> Util.Size.bytesReadable Util.Size.B |> text
]
, div [ class "label" ]
[ text "Size"
]
]
]
]
, div [ class "ui basic blue segment" ]
[ h4 [ class "ui header" ]
[ text "Tags"
]
, div [ class "ui statistics" ]
(List.map makeTagStats model.insights.tagCloud.items)
]
,div [class "ui basic blue segment"]
[h4 [class "ui header"]
[text "Items"
]
,div [class "ui statistics"]
[div [class "ui statistic"]
[div [class "value"]
[String.fromInt (model.insights.incomingCount + model.insights.outgoingCount) |> text
]
,div [class "label"]
[text "Items"
]
]
,div [class "ui statistic"]
[div [class "value"]
[String.fromInt model.insights.incomingCount |> text
]
,div [class "label"]
[text "Incoming"
]
]
,div [class "ui statistic"]
[div [class "value"]
[String.fromInt model.insights.outgoingCount |> text
]
,div [class "label"]
[text "Outgoing"
]
]
]
]
,div [class "ui basic blue segment"]
[h4 [class "ui header"]
[text "Size"
]
,div [class "ui statistics"]
[div [class "ui statistic"]
[div [class "value"]
[toFloat model.insights.itemSize |> Util.Size.bytesReadable Util.Size.B |> text
]
,div [class "label"]
[text "Size"
]
]
]
]
,div [class "ui basic blue segment"]
[h4 [class "ui header"]
[text "Tags"
]
,div [class "ui statistics"]
(List.map makeTagStats model.insights.tagCloud.items)
]
]
makeTagStats: NameCount -> Html Msg
makeTagStats : NameCount -> Html Msg
makeTagStats nc =
div [class "ui statistic"]
[div [class "value"]
[String.fromInt nc.count |> text
]
,div [class "label"]
[text nc.name
div [ class "ui statistic" ]
[ div [ class "value" ]
[ String.fromInt nc.count |> text
]
, div [ class "label" ]
[ text nc.name
]
]
viewSources: Flags -> Model -> List (Html Msg)
viewSources : Flags -> Model -> List (Html Msg)
viewSources flags model =
[h2 [class "ui header"]
[i [class "ui upload icon"][]
,div [class "content"]
[text "Sources"
[ h2 [ class "ui header" ]
[ i [ class "ui upload icon" ] []
, div [ class "content" ]
[ text "Sources"
]
]
,Html.map SourceMsg (Comp.SourceManage.view flags model.sourceModel)
, Html.map SourceMsg (Comp.SourceManage.view flags model.sourceModel)
]
viewUsers: Model -> List (Html Msg)
viewUsers : Model -> List (Html Msg)
viewUsers model =
[h2 [class "ui header"]
[i [class "ui user icon"][]
,div [class "content"]
[text "Users"
[ h2 [ class "ui header" ]
[ i [ class "ui user icon" ] []
, div [ class "content" ]
[ text "Users"
]
]
,Html.map UserMsg (Comp.UserManage.view model.userModel)
, Html.map UserMsg (Comp.UserManage.view model.userModel)
]
viewSettings: Model -> List (Html Msg)
viewSettings : Model -> List (Html Msg)
viewSettings model =
[div [class "ui grid"]
[div [class "row"]
[div [class "sixteen wide colum"]
[h2 [class "ui header"]
[i [class "ui language icon"][]
,div [class "content"]
[text "Document Language"
]
[ div [ class "ui grid" ]
[ div [ class "row" ]
[ div [ class "sixteen wide colum" ]
[ h2 [ class "ui header" ]
[ i [ class "ui language icon" ] []
, div [ class "content" ]
[ text "Document Language"
]
]
]
,div [class "row"]
[div [class "six wide column"]
[div [class "ui basic segment"]
[text "The language of your documents. This helps text recognition (OCR) and text analysis."
]
]
]
, div [ class "row" ]
[ div [ class "six wide column" ]
[ div [ class "ui basic segment" ]
[ text "The language of your documents. This helps text recognition (OCR) and text analysis."
]
]
]
, div [ class "row" ]
[ div [ class "six wide column" ]
[ Html.map SettingsMsg (Comp.Settings.view model.settingsModel)
, div
[ classList
[ ( "ui message", True )
, ( "hidden", Util.Maybe.isEmpty model.submitResult )
, ( "success", Maybe.map .success model.submitResult |> Maybe.withDefault False )
, ( "error", Maybe.map .success model.submitResult |> Maybe.map not |> Maybe.withDefault False )
]
]
]
,div [class "row"]
[div [class "six wide column"]
[Html.map SettingsMsg (Comp.Settings.view model.settingsModel)
,div [classList [("ui message", True)
,("hidden", Util.Maybe.isEmpty model.submitResult)
,("success", Maybe.map .success model.submitResult |> Maybe.withDefault False)
,("error", Maybe.map .success model.submitResult |> Maybe.map not |> Maybe.withDefault False)
]]
[Maybe.map .message model.submitResult
|> Maybe.withDefault ""
|> text
]
]
]
]
[ Maybe.map .message model.submitResult
|> Maybe.withDefault ""
|> text
]
]
]
]
]

39
modules/webapp/src/main/elm/Page/Home/Data.elm
View File

@ -1,22 +1,29 @@
module Page.Home.Data exposing (..)
module Page.Home.Data exposing
( Model
, Msg(..)
, ViewMode(..)
, emptyModel
)
import Http
import Comp.SearchMenu
import Comp.ItemList
import Comp.ItemDetail
import Api.Model.ItemLightList exposing (ItemLightList)
import Api.Model.ItemDetail exposing (ItemDetail)
import Api.Model.ItemLightList exposing (ItemLightList)
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Http
type alias Model =
{ searchMenuModel: Comp.SearchMenu.Model
, itemListModel: Comp.ItemList.Model
, searchInProgress: Bool
, itemDetailModel: Comp.ItemDetail.Model
, viewMode: ViewMode
{ searchMenuModel : Comp.SearchMenu.Model
, itemListModel : Comp.ItemList.Model
, searchInProgress : Bool
, itemDetailModel : Comp.ItemDetail.Model
, viewMode : ViewMode
}
emptyModel: Model
emptyModel =
emptyModel : Model
emptyModel =
{ searchMenuModel = Comp.SearchMenu.emptyModel
, itemListModel = Comp.ItemList.emptyModel
, itemDetailModel = Comp.ItemDetail.emptyModel
@ -24,6 +31,7 @@ emptyModel =
, viewMode = Listing
}
type Msg
= Init
| SearchMenuMsg Comp.SearchMenu.Msg
@ -33,4 +41,7 @@ type Msg
| ItemDetailMsg Comp.ItemDetail.Msg
| ItemDetailResp (Result Http.Error ItemDetail)
type ViewMode = Listing | Detail
type ViewMode
= Listing
| Detail

139
modules/webapp/src/main/elm/Page/Home/Update.elm
View File

@ -1,14 +1,15 @@
module Page.Home.Update exposing (update)
import Api
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Data.Flags exposing (Flags)
import Page.Home.Data exposing (..)
import Comp.SearchMenu
import Comp.ItemList
import Comp.ItemDetail
import Util.Update
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
Init ->
@ -21,80 +22,108 @@ update flags msg model =
SearchMenuMsg m ->
let
nextState = Comp.SearchMenu.update flags m model.searchMenuModel
newModel = {model | searchMenuModel = Tuple.first nextState.modelCmd}
(m2, c2) = if nextState.stateChange then doSearch flags newModel else (newModel, Cmd.none)
nextState =
Comp.SearchMenu.update flags m model.searchMenuModel
newModel =
{ model | searchMenuModel = Tuple.first nextState.modelCmd }
( m2, c2 ) =
if nextState.stateChange then
doSearch flags newModel
else
( newModel, Cmd.none )
in
(m2, Cmd.batch [c2, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd)])
( m2, Cmd.batch [ c2, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd) ] )
ItemListMsg m ->
let
(m2, c2, mitem) = Comp.ItemList.update flags m model.itemListModel
cmd = case mitem of
Just item ->
Api.itemDetail flags item.id ItemDetailResp
Nothing ->
Cmd.none
( m2, c2, mitem ) =
Comp.ItemList.update flags m model.itemListModel
cmd =
case mitem of
Just item ->
Api.itemDetail flags item.id ItemDetailResp
Nothing ->
Cmd.none
in
({model | itemListModel = m2}, Cmd.batch [ Cmd.map ItemListMsg c2, cmd ])
( { model | itemListModel = m2 }, Cmd.batch [ Cmd.map ItemListMsg c2, cmd ] )
ItemSearchResp (Ok list) ->
let
m = {model|searchInProgress = False, viewMode = Listing}
m =
{ model | searchInProgress = False, viewMode = Listing }
in
update flags (ItemListMsg (Comp.ItemList.SetResults list)) m
update flags (ItemListMsg (Comp.ItemList.SetResults list)) m
ItemSearchResp (Err err) ->
({model|searchInProgress = False}, Cmd.none)
ItemSearchResp (Err _) ->
( { model | searchInProgress = False }, Cmd.none )
DoSearch ->
doSearch flags model
ItemDetailMsg m ->
let
(m2, c2, nav) = Comp.ItemDetail.update flags m model.itemDetailModel
newModel = {model | itemDetailModel = m2}
newCmd = Cmd.map ItemDetailMsg c2
( m2, c2, nav ) =
Comp.ItemDetail.update flags m model.itemDetailModel
newModel =
{ model | itemDetailModel = m2 }
newCmd =
Cmd.map ItemDetailMsg c2
in
case nav of
Comp.ItemDetail.NavBack ->
doSearch flags newModel
Comp.ItemDetail.NavPrev ->
case Comp.ItemList.prevItem model.itemListModel m2.item.id of
Just n ->
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp])
Nothing ->
(newModel, newCmd)
Comp.ItemDetail.NavNext ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n ->
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp])
Nothing ->
(newModel, newCmd)
Comp.ItemDetail.NavNextOrBack ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n ->
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp])
Nothing ->
doSearch flags newModel
Comp.ItemDetail.NavNone ->
(newModel, newCmd)
case nav of
Comp.ItemDetail.NavBack ->
doSearch flags newModel
Comp.ItemDetail.NavPrev ->
case Comp.ItemList.prevItem model.itemListModel m2.item.id of
Just n ->
( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
Nothing ->
( newModel, newCmd )
Comp.ItemDetail.NavNext ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n ->
( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
Nothing ->
( newModel, newCmd )
Comp.ItemDetail.NavNextOrBack ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n ->
( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
Nothing ->
doSearch flags newModel
Comp.ItemDetail.NavNone ->
( newModel, newCmd )
ItemDetailResp (Ok item) ->
let
m = {model | viewMode = Detail}
m =
{ model | viewMode = Detail }
in
update flags (ItemDetailMsg (Comp.ItemDetail.SetItem item)) m
update flags (ItemDetailMsg (Comp.ItemDetail.SetItem item)) m
ItemDetailResp (Err err) ->
let
_ = Debug.log "Error" err
in
(model, Cmd.none)
ItemDetailResp (Err _) ->
( model, Cmd.none )
doSearch: Flags -> Model -> (Model, Cmd Msg)
doSearch : Flags -> Model -> ( Model, Cmd Msg )
doSearch flags model =
let
mask = Comp.SearchMenu.getItemSearch model.searchMenuModel
mask =
Comp.SearchMenu.getItemSearch model.searchMenuModel
in
({model|searchInProgress = True, viewMode = Listing}, Api.itemSearch flags mask ItemSearchResp)
( { model | searchInProgress = True, viewMode = Listing }
, Api.itemSearch flags mask ItemSearchResp
)

124
modules/webapp/src/main/elm/Page/Home/View.elm
View File

@ -1,74 +1,78 @@
module Page.Home.View exposing (view)
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page exposing (Page(..))
import Page.Home.Data exposing (..)
import Comp.SearchMenu
import Comp.ItemList
import Comp.ItemDetail
import Data.Flags
import Util.Html exposing (onClickk)
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div [class "home-page ui padded grid"]
[div [class "four wide column"]
[div [class "ui top attached ablue-comp menu"]
[h4 [class "header item"]
[text "Search"
]
,div [class "right floated menu"]
[a [class "item"
,onClick DoSearch
,href ""
]
[i [class "ui search icon"][]
]
]
]
,div [class "ui attached fluid segment"]
[(Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel))
]
]
,div [class "twelve wide column"]
[case model.viewMode of
Listing ->
if model.searchInProgress then resultPlaceholder
else (Html.map ItemListMsg (Comp.ItemList.view model.itemListModel))
Detail ->
Html.map ItemDetailMsg (Comp.ItemDetail.view model.itemDetailModel)
div [ class "home-page ui padded grid" ]
[ div [ class "four wide column" ]
[ div [ class "ui top attached ablue-comp menu" ]
[ h4 [ class "header item" ]
[ text "Search"
]
, div [ class "right floated menu" ]
[ a
[ class "item"
, onClick DoSearch
, href ""
]
[ i [ class "ui search icon" ] []
]
]
]
, div [ class "ui attached fluid segment" ]
[ Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel)
]
]
, div [ class "twelve wide column" ]
[ case model.viewMode of
Listing ->
if model.searchInProgress then
resultPlaceholder
else
Html.map ItemListMsg (Comp.ItemList.view model.itemListModel)
Detail ->
Html.map ItemDetailMsg (Comp.ItemDetail.view model.itemDetailModel)
]
]
resultPlaceholder: Html Msg
resultPlaceholder : Html Msg
resultPlaceholder =
div [class "ui basic segment"]
[div [class "ui active inverted dimmer"]
[div [class "ui medium text loader"]
[text "Searching …"
]
]
,div [class "ui middle aligned very relaxed divided basic list segment"]
[div [class "item"]
[div [class "ui fluid placeholder"]
[div [class "full line"][]
,div [class "full line"][]
]
]
,div [class "item"]
[div [class "ui fluid placeholder"]
[div [class "full line"][]
,div [class "full line"][]
]
]
,div [class "item"]
[div [class "ui fluid placeholder"]
[div [class "full line"][]
,div [class "full line"][]
]
]
]
div [ class "ui basic segment" ]
[ div [ class "ui active inverted dimmer" ]
[ div [ class "ui medium text loader" ]
[ text "Searching …"
]
]
, div [ class "ui middle aligned very relaxed divided basic list segment" ]
[ div [ class "item" ]
[ div [ class "ui fluid placeholder" ]
[ div [ class "full line" ] []
, div [ class "full line" ] []
]
]
, div [ class "item" ]
[ div [ class "ui fluid placeholder" ]
[ div [ class "full line" ] []
, div [ class "full line" ] []
]
]
, div [ class "item" ]
[ div [ class "ui fluid placeholder" ]
[ div [ class "full line" ] []
, div [ class "full line" ] []
]
]
]
]

19
modules/webapp/src/main/elm/Page/Login/Data.elm
View File

@ -1,22 +1,29 @@
module Page.Login.Data exposing (..)
module Page.Login.Data exposing
( Model
, Msg(..)
, emptyModel
)
import Api.Model.AuthResult exposing (AuthResult)
import Http
import Page exposing (Page(..))
import Api.Model.AuthResult exposing (AuthResult)
type alias Model =
{ username: String
, password: String
, result: Maybe AuthResult
{ username : String
, password : String
, result : Maybe AuthResult
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ username = ""
, password = ""
, result = Nothing
}
type Msg
= SetUsername String
| SetPassword String

49
modules/webapp/src/main/elm/Page/Login/Update.elm
View File

@ -1,42 +1,53 @@
module Page.Login.Update exposing (update)
import Api
import Ports
import Api.Model.AuthResult exposing (AuthResult)
import Api.Model.UserPass exposing (UserPass)
import Data.Flags exposing (Flags)
import Page exposing (Page(..))
import Page.Login.Data exposing (..)
import Api.Model.UserPass exposing (UserPass)
import Api.Model.AuthResult exposing (AuthResult)
import Ports
import Util.Http
update: Maybe Page -> Flags -> Msg -> Model -> (Model, Cmd Msg, Maybe AuthResult)
update : Maybe Page -> Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe AuthResult )
update referrer flags msg model =
case msg of
SetUsername str ->
({model | username = str}, Cmd.none, Nothing)
( { model | username = str }, Cmd.none, Nothing )
SetPassword str ->
({model | password = str}, Cmd.none, Nothing)
( { model | password = str }, Cmd.none, Nothing )
Authenticate ->
(model, Api.login flags (UserPass model.username model.password) AuthResp, Nothing)
( model, Api.login flags (UserPass model.username model.password) AuthResp, Nothing )
AuthResp (Ok lr) ->
let
gotoRef = Maybe.withDefault HomePage referrer |> Page.goto
gotoRef =
Maybe.withDefault HomePage referrer |> Page.goto
in
if lr.success
then ({model|result = Just lr, password = ""}, Cmd.batch [setAccount lr, gotoRef], Just lr)
else ({model|result = Just lr, password = ""}, Ports.removeAccount (), Just lr)
if lr.success then
( { model | result = Just lr, password = "" }, Cmd.batch [ setAccount lr, gotoRef ], Just lr )
else
( { model | result = Just lr, password = "" }, Ports.removeAccount (), Just lr )
AuthResp (Err err) ->
let
empty = Api.Model.AuthResult.empty
lr = {empty|message = Util.Http.errorToString err}
in
({model|password = "", result = Just lr}, Ports.removeAccount (), Just empty)
empty =
Api.Model.AuthResult.empty
setAccount: AuthResult -> Cmd msg
lr =
{ empty | message = Util.Http.errorToString err }
in
( { model | password = "", result = Just lr }, Ports.removeAccount (), Just empty )
setAccount : AuthResult -> Cmd msg
setAccount result =
if result.success
then Ports.setAccount result
else Ports.removeAccount ()
if result.success then
Ports.setAccount result
else
Ports.removeAccount ()

142
modules/webapp/src/main/elm/Page/Login/View.elm
View File

@ -1,87 +1,97 @@
module Page.Login.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
import Html.Events exposing (onInput, onSubmit)
import Page exposing (Page(..))
import Page.Login.Data exposing (..)
import Data.Flags exposing (Flags)
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
div [class "login-page"]
[div [class "ui centered grid"]
[div [class "row"]
[div [class "six wide column ui segment login-view"]
[h1 [class "ui center aligned icon header"]
[img [class "ui image"
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
][]
,div [class "content"]
[text "Sign in to Docspell"
]
div [ class "login-page" ]
[ div [ class "ui centered grid" ]
[ div [ class "row" ]
[ div [ class "six wide column ui segment login-view" ]
[ h1 [ class "ui center aligned icon header" ]
[ img
[ class "ui image"
, src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
]
,Html.form [ class "ui large error raised form segment"
, onSubmit Authenticate
, autocomplete False
]
[div [class "field"]
[label [][text "Username"]
,div [class "ui left icon input"]
[input [type_ "text"
,autocomplete False
,onInput SetUsername
,value model.username
,placeholder "Collective / Login"
,autofocus True
][]
,i [class "user icon"][]
]
]
,div [class "field"]
[label [][text "Password"]
,div [class "ui left icon input"]
[input [type_ "password"
,autocomplete False
,onInput SetPassword
,value model.password
,placeholder "Password"
][]
,i [class "lock icon"][]
[]
, div [ class "content" ]
[ text "Sign in to Docspell"
]
]
, Html.form
[ class "ui large error raised form segment"
, onSubmit Authenticate
, autocomplete False
]
[ div [ class "field" ]
[ label [] [ text "Username" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "text"
, autocomplete False
, onInput SetUsername
, value model.username
, placeholder "Collective / Login"
, autofocus True
]
]
,button [class "ui primary fluid button"
,type_ "submit"
]
[text "Login"
[]
, i [ class "user icon" ] []
]
]
,(resultMessage model)
,div[class "ui very basic right aligned segment"]
[text "No account? "
,a [class "ui icon link", Page.href RegisterPage]
[i [class "edit icon"][]
,text "Sign up!"
]
]
]
]
]
]
, div [ class "field" ]
[ label [] [ text "Password" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "password"
, autocomplete False
, onInput SetPassword
, value model.password
, placeholder "Password"
]
[]
, i [ class "lock icon" ] []
]
]
, button
[ class "ui primary fluid button"
, type_ "submit"
]
[ text "Login"
]
]
, resultMessage model
, div [ class "ui very basic right aligned segment" ]
[ text "No account? "
, a [ class "ui icon link", Page.href RegisterPage ]
[ i [ class "edit icon" ] []
, text "Sign up!"
]
]
]
]
]
]
resultMessage: Model -> Html Msg
resultMessage : Model -> Html Msg
resultMessage model =
case model.result of
Just r ->
if r.success
then
div [class "ui success message"]
[text "Login successful."
if r.success then
div [ class "ui success message" ]
[ text "Login successful."
]
else
div [class "ui error message"]
[text r.message
div [ class "ui error message" ]
[ text r.message
]
Nothing ->
span [][]
span [] []

25
modules/webapp/src/main/elm/Page/ManageData/Data.elm
View File

@ -1,19 +1,26 @@
module Page.ManageData.Data exposing (..)
module Page.ManageData.Data exposing
( Model
, Msg(..)
, Tab(..)
, emptyModel
)
import Comp.TagManage
import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
type alias Model =
{ currentTab: Maybe Tab
, tagManageModel: Comp.TagManage.Model
, equipManageModel: Comp.EquipmentManage.Model
, orgManageModel: Comp.OrgManage.Model
, personManageModel: Comp.PersonManage.Model
{ currentTab : Maybe Tab
, tagManageModel : Comp.TagManage.Model
, equipManageModel : Comp.EquipmentManage.Model
, orgManageModel : Comp.OrgManage.Model
, personManageModel : Comp.PersonManage.Model
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ currentTab = Nothing
, tagManageModel = Comp.TagManage.emptyModel
@ -22,12 +29,14 @@ emptyModel =
, personManageModel = Comp.PersonManage.emptyModel
}
type Tab
= TagTab
| EquipTab
| OrgTab
| PersonTab
type Msg
= SetTab Tab
| TagManageMsg Comp.TagManage.Msg

50
modules/webapp/src/main/elm/Page/ManageData/Update.elm
View File

@ -1,52 +1,58 @@
module Page.ManageData.Update exposing (update)
import Page.ManageData.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.TagManage
import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
import Data.Flags exposing (Flags)
import Page.ManageData.Data exposing (..)
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTab t ->
let
m = { model | currentTab = Just t }
m =
{ model | currentTab = Just t }
in
case t of
TagTab ->
update flags (TagManageMsg Comp.TagManage.LoadTags) m
case t of
TagTab ->
update flags (TagManageMsg Comp.TagManage.LoadTags) m
EquipTab ->
update flags (EquipManageMsg Comp.EquipmentManage.LoadEquipments) m
EquipTab ->
update flags (EquipManageMsg Comp.EquipmentManage.LoadEquipments) m
OrgTab ->
update flags (OrgManageMsg Comp.OrgManage.LoadOrgs) m
OrgTab ->
update flags (OrgManageMsg Comp.OrgManage.LoadOrgs) m
PersonTab ->
update flags (PersonManageMsg Comp.PersonManage.LoadPersons) m
PersonTab ->
update flags (PersonManageMsg Comp.PersonManage.LoadPersons) m
TagManageMsg m ->
let
(m2, c2) = Comp.TagManage.update flags m model.tagManageModel
( m2, c2 ) =
Comp.TagManage.update flags m model.tagManageModel
in
({model | tagManageModel = m2}, Cmd.map TagManageMsg c2)
( { model | tagManageModel = m2 }, Cmd.map TagManageMsg c2 )
EquipManageMsg m ->
let
(m2, c2) = Comp.EquipmentManage.update flags m model.equipManageModel
( m2, c2 ) =
Comp.EquipmentManage.update flags m model.equipManageModel
in
({model | equipManageModel = m2}, Cmd.map EquipManageMsg c2)
( { model | equipManageModel = m2 }, Cmd.map EquipManageMsg c2 )
OrgManageMsg m ->
let
(m2, c2) = Comp.OrgManage.update flags m model.orgManageModel
( m2, c2 ) =
Comp.OrgManage.update flags m model.orgManageModel
in
({model | orgManageModel = m2}, Cmd.map OrgManageMsg c2)
( { model | orgManageModel = m2 }, Cmd.map OrgManageMsg c2 )
PersonManageMsg m ->
let
(m2, c2) = Comp.PersonManage.update flags m model.personManageModel
( m2, c2 ) =
Comp.PersonManage.update flags m model.personManageModel
in
({model | personManageModel = m2}, Cmd.map PersonManageMsg c2)
( { model | personManageModel = m2 }, Cmd.map PersonManageMsg c2 )

167
modules/webapp/src/main/elm/Page/ManageData/View.elm
View File

@ -1,104 +1,121 @@
module Page.ManageData.View exposing (view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Util.Html exposing (classActive)
import Page.ManageData.Data exposing (..)
import Comp.TagManage
import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.ManageData.Data exposing (..)
import Util.Html exposing (classActive)
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div [class "managedata-page ui padded grid"]
[div [class "four wide column"]
[h4 [class "ui top attached ablue-comp header"]
[text "Manage Data"
]
,div [class "ui attached fluid segment"]
[div [class "ui fluid vertical secondary menu"]
[div [classActive (model.currentTab == Just TagTab) "link icon item"
,onClick (SetTab TagTab)
]
[i [class "tag icon"][]
,text "Tag"
]
,div [classActive (model.currentTab == Just EquipTab) "link icon item"
,onClick (SetTab EquipTab)
]
[i [class "box icon"][]
,text "Equipment"
]
,div [classActive (model.currentTab == Just OrgTab) "link icon item"
,onClick (SetTab OrgTab)
]
[i [class "factory icon"][]
,text "Organization"
]
,div [classActive (model.currentTab == Just PersonTab) "link icon item"
,onClick (SetTab PersonTab)
]
[i [class "user icon"][]
,text "Person"
]
]
]
]
,div [class "twelve wide column"]
[div [class ""]
(case model.currentTab of
Just TagTab -> viewTags model
Just EquipTab -> viewEquip model
Just OrgTab -> viewOrg model
Just PersonTab -> viewPerson model
Nothing -> []
)
div [ class "managedata-page ui padded grid" ]
[ div [ class "four wide column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
[ text "Manage Data"
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[ div
[ classActive (model.currentTab == Just TagTab) "link icon item"
, onClick (SetTab TagTab)
]
[ i [ class "tag icon" ] []
, text "Tag"
]
, div
[ classActive (model.currentTab == Just EquipTab) "link icon item"
, onClick (SetTab EquipTab)
]
[ i [ class "box icon" ] []
, text "Equipment"
]
, div
[ classActive (model.currentTab == Just OrgTab) "link icon item"
, onClick (SetTab OrgTab)
]
[ i [ class "factory icon" ] []
, text "Organization"
]
, div
[ classActive (model.currentTab == Just PersonTab) "link icon item"
, onClick (SetTab PersonTab)
]
[ i [ class "user icon" ] []
, text "Person"
]
]
]
]
, div [ class "twelve wide column" ]
[ div [ class "" ]
(case model.currentTab of
Just TagTab ->
viewTags model
Just EquipTab ->
viewEquip model
Just OrgTab ->
viewOrg model
Just PersonTab ->
viewPerson model
Nothing ->
[]
)
]
]
viewTags: Model -> List (Html Msg)
viewTags : Model -> List (Html Msg)
viewTags model =
[h2 [class "ui header"]
[i [class "ui tag icon"][]
,div [class "content"]
[text "Tags"
[ h2 [ class "ui header" ]
[ i [ class "ui tag icon" ] []
, div [ class "content" ]
[ text "Tags"
]
]
,Html.map TagManageMsg (Comp.TagManage.view model.tagManageModel)
, Html.map TagManageMsg (Comp.TagManage.view model.tagManageModel)
]
viewEquip: Model -> List (Html Msg)
viewEquip : Model -> List (Html Msg)
viewEquip model =
[h2 [class "ui header"]
[i [class "ui box icon"][]
,div [class "content"]
[text "Equipment"
[ h2 [ class "ui header" ]
[ i [ class "ui box icon" ] []
, div [ class "content" ]
[ text "Equipment"
]
]
,Html.map EquipManageMsg (Comp.EquipmentManage.view model.equipManageModel)
, Html.map EquipManageMsg (Comp.EquipmentManage.view model.equipManageModel)
]
viewOrg: Model -> List (Html Msg)
viewOrg : Model -> List (Html Msg)
viewOrg model =
[h2 [class "ui header"]
[i [class "ui factory icon"][]
,div [class "content"]
[text "Organizations"
[ h2 [ class "ui header" ]
[ i [ class "ui factory icon" ] []
, div [ class "content" ]
[ text "Organizations"
]
]
,Html.map OrgManageMsg (Comp.OrgManage.view model.orgManageModel)
, Html.map OrgManageMsg (Comp.OrgManage.view model.orgManageModel)
]
viewPerson: Model -> List (Html Msg)
viewPerson : Model -> List (Html Msg)
viewPerson model =
[h2 [class "ui header"]
[i [class "ui user icon"][]
,div [class "content"]
[text "Person"
[ h2 [ class "ui header" ]
[ i [ class "ui user icon" ] []
, div [ class "content" ]
[ text "Person"
]
]
,Html.map PersonManageMsg (Comp.PersonManage.view model.personManageModel)
, Html.map PersonManageMsg (Comp.PersonManage.view model.personManageModel)
]

40
modules/webapp/src/main/elm/Page/NewInvite/Data.elm
View File

@ -1,37 +1,55 @@
module Page.NewInvite.Data exposing (..)
module Page.NewInvite.Data exposing
( Model
, Msg(..)
, State(..)
, emptyModel
, isFailed
, isSuccess
)
import Http
import Api.Model.InviteResult exposing (InviteResult)
import Http
type alias Model =
{ password: String
, result: State
{ password : String
, result : State
}
type State
= Empty
| Failed String
| Success InviteResult
isFailed: State -> Bool
isFailed : State -> Bool
isFailed state =
case state of
Failed _ -> True
_ -> False
Failed _ ->
True
isSuccess: State -> Bool
_ ->
False
isSuccess : State -> Bool
isSuccess state =
case state of
Success _ -> True
_ -> False
Success _ ->
True
emptyModel: Model
_ ->
False
emptyModel : Model
emptyModel =
{ password = ""
, result = Empty
}
type Msg
= SetPassword String
| GenerateInvite

21
modules/webapp/src/main/elm/Page/NewInvite/Update.elm
View File

@ -1,27 +1,30 @@
module Page.NewInvite.Update exposing (update)
import Api
import Api.Model.GenInvite exposing (GenInvite)
import Data.Flags exposing (Flags)
import Page.NewInvite.Data exposing (..)
import Api.Model.GenInvite exposing (GenInvite)
import Api.Model.InviteResult
import Util.Http
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetPassword str ->
({model|password = str}, Cmd.none)
( { model | password = str }, Cmd.none )
Reset ->
(emptyModel, Cmd.none)
( emptyModel, Cmd.none )
GenerateInvite ->
(model, Api.newInvite flags (GenInvite model.password) InviteResp)
( model, Api.newInvite flags (GenInvite model.password) InviteResp )
InviteResp (Ok res) ->
if res.success then ({model | result = (Success res)}, Cmd.none)
else ({model | result = (Failed res.message)}, Cmd.none)
if res.success then
( { model | result = Success res }, Cmd.none )
else
( { model | result = Failed res.message }, Cmd.none )
InviteResp (Err err) ->
({model|result = Failed (Util.Http.errorToString err)}, Cmd.none)
( { model | result = Failed (Util.Http.errorToString err) }, Cmd.none )

187
modules/webapp/src/main/elm/Page/NewInvite/View.elm
View File

@ -1,106 +1,121 @@
module Page.NewInvite.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
import Data.Flags exposing (Flags)
import Page.NewInvite.Data exposing (..)
import Api.Model.InviteResult
import Util.Maybe
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
div [class "newinvite-page"]
[div [class "ui centered grid"]
[div [class "row"]
[div [class "eight wide column ui segment newinvite-view"]
[h1 [class "ui cener aligned icon header"]
[img [class "ui image"
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
][]
,div [class "content"]
[text "Create new invitations"
div [ class "newinvite-page" ]
[ div [ class "ui centered grid" ]
[ div [ class "row" ]
[ div [ class "eight wide column ui segment newinvite-view" ]
[ h1 [ class "ui cener aligned icon header" ]
[ img
[ class "ui image"
, src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
]
[]
, div [ class "content" ]
[ text "Create new invitations"
]
]
, inviteMessage flags
, Html.form
[ classList
[ ( "ui large form raised segment", True )
, ( "error", isFailed model.result )
, ( "success", isSuccess model.result )
]
, onSubmit GenerateInvite
]
[ div [ class "required field" ]
[ label [] [ text "New Invitation Password" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "password"
, onInput SetPassword
, value model.password
, autofocus True
]
[]
, i [ class "key icon" ] []
]
]
,inviteMessage flags
,Html.form [classList [("ui large form raised segment", True)
,("error", isFailed model.result)
,("success", isSuccess model.result)
]
, onSubmit GenerateInvite]
[div [class "required field"]
[label [][text "New Invitation Password"]
,div [class "ui left icon input"]
[input [type_ "password"
,onInput SetPassword
,value model.password
,autofocus True
][]
,i [class "key icon"][]
]
]
,button [class "ui primary button"
,type_ "submit"
]
[text "Submit"
]
,a [class "ui right floated button", href "", onClick Reset]
[text "Reset"
]
,resultMessage model
]
]
]
]
]
, button
[ class "ui primary button"
, type_ "submit"
]
[ text "Submit"
]
, a [ class "ui right floated button", href "", onClick Reset ]
[ text "Reset"
]
, resultMessage model
]
]
]
]
]
resultMessage: Model -> Html Msg
resultMessage : Model -> Html Msg
resultMessage model =
div [classList [("ui message", True)
,("error", isFailed model.result)
,("success", isSuccess model.result)
,("hidden", model.result == Empty)
]]
[case model.result of
Failed m ->
div [class "content"]
[div [class "header"][text "Error"]
,p [][text m]
]
Success r ->
div [class "content"]
[div [class "header"][text "Success"]
,p [][text r.message]
,p [][text "Invitation Key:"]
,pre[][Maybe.withDefault "" r.key |> text
]
]
Empty ->
span[][]
div
[ classList
[ ( "ui message", True )
, ( "error", isFailed model.result )
, ( "success", isSuccess model.result )
, ( "hidden", model.result == Empty )
]
]
[ case model.result of
Failed m ->
div [ class "content" ]
[ div [ class "header" ] [ text "Error" ]
, p [] [ text m ]
]
Success r ->
div [ class "content" ]
[ div [ class "header" ] [ text "Success" ]
, p [] [ text r.message ]
, p [] [ text "Invitation Key:" ]
, pre []
[ Maybe.withDefault "" r.key |> text
]
]
Empty ->
span [] []
]
inviteMessage: Flags -> Html Msg
inviteMessage flags =
div [classList [("ui message", True)
,("hidden", flags.config.signupMode /= "invite")
]]
[p [][text
"""Docspell requires an invite when signing up. You can
inviteMessage : Flags -> Html Msg
inviteMessage flags =
div
[ classList
[ ( "ui message", True )
, ( "hidden", flags.config.signupMode /= "invite" )
]
]
[ p []
[ text
"""Docspell requires an invite when signing up. You can
create these invites here and send them to friends so
they can signup with docspell."""
]
,p [][text
"""Each invite can only be used once. You'll need to
]
, p []
[ text
"""Each invite can only be used once. You'll need to
create one key for each person you want to invite."""
]
,p [][text
"""Creating an invite requires providing the password
]
, p []
[ text
"""Creating an invite requires providing the password
from the configuration."""
]
]
]

87
modules/webapp/src/main/elm/Page/Queue/Data.elm
View File

@ -1,27 +1,35 @@
module Page.Queue.Data exposing (..)
module Page.Queue.Data exposing
( Model
, Msg(..)
, emptyModel
, getDuration
, getRunningTime
)
import Http
import Api.Model.JobQueueState exposing (JobQueueState)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobQueueState exposing (JobQueueState)
import Comp.YesNoDimmer
import Http
import Time
import Util.Duration
import Util.Maybe
import Comp.YesNoDimmer
type alias Model =
{ state: JobQueueState
, error: String
, pollingInterval: Float
, init: Bool
, stopRefresh: Bool
, currentMillis: Int
, showLog: Maybe JobDetail
, deleteConfirm: Comp.YesNoDimmer.Model
, cancelJobRequest: Maybe String
{ state : JobQueueState
, error : String
, pollingInterval : Float
, init : Bool
, stopRefresh : Bool
, currentMillis : Int
, showLog : Maybe JobDetail
, deleteConfirm : Comp.YesNoDimmer.Model
, cancelJobRequest : Maybe String
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ state = Api.Model.JobQueueState.empty
, error = ""
@ -34,6 +42,7 @@ emptyModel =
, cancelJobRequest = Nothing
}
type Msg
= Init
| StateResp (Result Http.Error JobQueueState)
@ -45,35 +54,45 @@ type Msg
| DimmerMsg JobDetail Comp.YesNoDimmer.Msg
| CancelResp (Result Http.Error BasicResult)
getRunningTime: Model -> JobDetail -> Maybe String
getRunningTime : Model -> JobDetail -> Maybe String
getRunningTime model job =
let
mkTime: Int -> Int -> Maybe String
mkTime : Int -> Int -> Maybe String
mkTime start end =
if start < end then Just <| Util.Duration.toHuman (end - start)
else Nothing
in
case (job.started, job.finished) of
(Just sn, Just fn) ->
Util.Maybe.or
[ mkTime sn fn
, mkTime sn model.currentMillis
]
if start < end then
Just <| Util.Duration.toHuman (end - start)
(Just sn, Nothing) ->
mkTime sn model.currentMillis
(Nothing, _) ->
else
Nothing
in
case ( job.started, job.finished ) of
( Just sn, Just fn ) ->
Util.Maybe.or
[ mkTime sn fn
, mkTime sn model.currentMillis
]
getSubmittedTime: Model -> JobDetail -> Maybe String
( Just sn, Nothing ) ->
mkTime sn model.currentMillis
( Nothing, _ ) ->
Nothing
getSubmittedTime : Model -> JobDetail -> Maybe String
getSubmittedTime model job =
if model.currentMillis > job.submitted then
Just <| Util.Duration.toHuman (model.currentMillis - job.submitted)
else
Nothing
getDuration: Model -> JobDetail -> Maybe String
getDuration : Model -> JobDetail -> Maybe String
getDuration model job =
if job.state == "stuck" then getSubmittedTime model job
else Util.Maybe.or [ (getRunningTime model job), (getSubmittedTime model job) ]
if job.state == "stuck" then
getSubmittedTime model job
else
Util.Maybe.or [ getRunningTime model job, getSubmittedTime model job ]

90
modules/webapp/src/main/elm/Page/Queue/Update.elm
View File

@ -1,76 +1,92 @@
module Page.Queue.Update exposing (update)
import Api
import Ports
import Page.Queue.Data exposing (..)
import Data.Flags exposing (Flags)
import Util.Http
import Time
import Task
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Page.Queue.Data exposing (..)
import Ports
import Task
import Time
import Util.Http
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
Init ->
let
start = if model.init
then Cmd.none
else Cmd.batch
[Api.getJobQueueState flags StateResp
,getNewTime
start =
if model.init then
Cmd.none
else
Cmd.batch
[ Api.getJobQueueState flags StateResp
, getNewTime
]
in
({model|init = True, stopRefresh = False}, start)
( { model | init = True, stopRefresh = False }, start )
StateResp (Ok s) ->
let
progressCmd =
List.map (\job -> Ports.setProgress (job.id, job.progress)) s.progress
_ = Debug.log "stopRefresh" model.stopRefresh
List.map (\job -> Ports.setProgress ( job.id, job.progress )) s.progress
refresh =
if model.pollingInterval <= 0 || model.stopRefresh then Cmd.none
else Cmd.batch
[Api.getJobQueueStateIn flags model.pollingInterval StateResp
,getNewTime
]
if model.pollingInterval <= 0 || model.stopRefresh then
Cmd.none
else
Cmd.batch
[ Api.getJobQueueStateIn flags model.pollingInterval StateResp
, getNewTime
]
in
({model | state = s, stopRefresh = False}, Cmd.batch (refresh :: progressCmd))
( { model | state = s, stopRefresh = False }, Cmd.batch (refresh :: progressCmd) )
StateResp (Err err) ->
({model | error = Util.Http.errorToString err }, Cmd.none)
( { model | error = Util.Http.errorToString err }, Cmd.none )
StopRefresh ->
({model | stopRefresh = True, init = False }, Cmd.none)
( { model | stopRefresh = True, init = False }, Cmd.none )
NewTime t ->
({model | currentMillis = Time.posixToMillis t}, Cmd.none)
( { model | currentMillis = Time.posixToMillis t }, Cmd.none )
ShowLog job ->
({model | showLog = Just job}, Cmd.none)
( { model | showLog = Just job }, Cmd.none )
QuitShowLog ->
({model | showLog = Nothing}, Cmd.none)
( { model | showLog = Nothing }, Cmd.none )
RequestCancelJob job ->
let
newModel = {model|cancelJobRequest = Just job.id}
newModel =
{ model | cancelJobRequest = Just job.id }
in
update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel
update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel
DimmerMsg job m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.cancelJob flags job.id CancelResp else Cmd.none
in
({model | deleteConfirm = cm}, cmd)
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
CancelResp (Ok r) ->
(model, Cmd.none)
CancelResp (Err err) ->
(model, Cmd.none)
cmd =
if confirmed then
Api.cancelJob flags job.id CancelResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
CancelResp (Ok _) ->
( model, Cmd.none )
CancelResp (Err _) ->
( model, Cmd.none )
getNewTime : Cmd Msg
getNewTime =
Task.perform NewTime Time.now
Task.perform NewTime Time.now

411
modules/webapp/src/main/elm/Page/Queue/View.elm
View File

@ -1,217 +1,256 @@
module Page.Queue.View exposing (view)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobLogEvent exposing (JobLogEvent)
import Comp.YesNoDimmer
import Data.Priority
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.Queue.Data exposing (..)
import Api.Model.JobQueueState exposing (JobQueueState)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobLogEvent exposing (JobLogEvent)
import Data.Priority
import Comp.YesNoDimmer
import Util.Time exposing (formatDateTime, formatIsoDateTime)
import Util.Duration
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div [class "queue-page ui grid container"] <|
div [ class "queue-page ui grid container" ] <|
List.concat
[ case model.showLog of
Just job ->
[renderJobLog job]
Nothing ->
List.map (renderProgressCard model) model.state.progress
|> List.map (\el -> div [class "row"][div [class "column"][el]])
, [div [class "two column row"]
[renderWaiting model
,renderCompleted model
[ case model.showLog of
Just job ->
[ renderJobLog job ]
Nothing ->
List.map (renderProgressCard model) model.state.progress
|> List.map (\el -> div [ class "row" ] [ div [ class "column" ] [ el ] ])
, [ div [ class "two column row" ]
[ renderWaiting model
, renderCompleted model
]
]
]
]
]
renderJobLog: JobDetail -> Html Msg
renderJobLog : JobDetail -> Html Msg
renderJobLog job =
div [class "ui fluid card"]
[div [class "content"]
[i [class "delete link icon", onClick QuitShowLog][]
,text job.name
]
,div [class "content"]
[div [class "job-log"]
(List.map renderLogLine job.logs)
]
]
renderWaiting: Model -> Html Msg
renderWaiting model =
div [class "column"]
[div [class "ui center aligned basic segment"]
[i [class "ui large angle double up icon"][]
]
,div [class "ui centered cards"]
(List.map (renderInfoCard model) model.state.queued)
]
renderCompleted: Model -> Html Msg
renderCompleted model =
div [class "column"]
[div [class "ui center aligned basic segment"]
[i [class "ui large angle double down icon"][]
]
,div [class "ui centered cards"]
(List.map (renderInfoCard model) model.state.completed)
]
renderProgressCard: Model -> JobDetail -> Html Msg
renderProgressCard model job =
div [class "ui fluid card"]
[div [id job.id, class "ui top attached indicating progress"]
[div [class "bar"]
[]
]
,Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm)
,div [class "content"]
[ div [class "right floated meta"]
[div [class "ui label"]
[text job.state
,div [class "detail"]
[Maybe.withDefault "" job.worker |> text
]
]
,div [class "ui basic label"]
[i [class "clock icon"][]
,div [class "detail"]
[getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
]
, i [class "asterisk loading icon"][]
, text job.name
]
,div [class "content"]
[div [class "job-log"]
(List.map renderLogLine job.logs)
]
,div [class "meta"]
[div [class "right floated"]
[button [class "ui button", onClick (RequestCancelJob job)]
[text "Cancel"
]
]
div [ class "ui fluid card" ]
[ div [ class "content" ]
[ i [ class "delete link icon", onClick QuitShowLog ] []
, text job.name
]
, div [ class "content" ]
[ div [ class "job-log" ]
(List.map renderLogLine job.logs)
]
]
renderLogLine: JobLogEvent -> Html Msg
renderLogLine log =
span [class (String.toLower log.level)]
[formatIsoDateTime log.time |> text
,text ": "
,text log.message
, br[][]
renderWaiting : Model -> Html Msg
renderWaiting model =
div [ class "column" ]
[ div [ class "ui center aligned basic segment" ]
[ i [ class "ui large angle double up icon" ] []
]
, div [ class "ui centered cards" ]
(List.map (renderInfoCard model) model.state.queued)
]
isFinal: JobDetail -> Bool
isFinal job =
case job.state of
"failed" -> True
"success" -> True
"cancelled" -> True
_ -> False
dimmerSettings: Comp.YesNoDimmer.Settings
dimmerSettings =
let
defaults = Comp.YesNoDimmer.defaultSettings
in
{ defaults | headerClass = "ui inverted header", headerIcon = "", message = "Cancel/Delete this job?"}
renderInfoCard: Model -> JobDetail -> Html Msg
renderInfoCard model job =
div [classList [("ui fluid card", True)
,(jobStateColor job, True)
]
renderCompleted : Model -> Html Msg
renderCompleted model =
div [ class "column" ]
[ div [ class "ui center aligned basic segment" ]
[ i [ class "ui large angle double down icon" ] []
]
, div [ class "ui centered cards" ]
(List.map (renderInfoCard model) model.state.completed)
]
[Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm)
,div [class "content"]
[div [class "right floated"]
[if isFinal job || job.state == "stuck" then
span [onClick (ShowLog job)]
[i [class "file link icon", title "Show log"][]
renderProgressCard : Model -> JobDetail -> Html Msg
renderProgressCard model job =
div [ class "ui fluid card" ]
[ div [ id job.id, class "ui top attached indicating progress" ]
[ div [ class "bar" ]
[]
]
, Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm)
, div [ class "content" ]
[ div [ class "right floated meta" ]
[ div [ class "ui label" ]
[ text job.state
, div [ class "detail" ]
[ Maybe.withDefault "" job.worker |> text
]
else
span[][]
,i [class "delete link icon", title "Remove", onClick (RequestCancelJob job)][]
]
,if isFinal job then
span [class "invisible"][]
else
div [class "right floated"]
[div [class "meta"]
[getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
,i [classList [("check icon", job.state == "success")
,("redo icon", job.state == "stuck")
,("bolt icon", job.state == "failed")
,("meh outline icon", job.state == "canceled")
,("cog icon", not (isFinal job) && job.state /= "stuck")
]
][]
,text job.name
]
,div [class "content"]
[div [class "right floated"]
[if isFinal job then
div [class ("ui basic label " ++ jobStateColor job)]
[i [class "clock icon"][]
,div [class "detail"]
[getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
else
span [class "invisible"][]
,div [class ("ui basic label " ++ jobStateColor job)]
[text "Prio"
,div [class "detail"]
[code [][Data.Priority.fromString job.priority
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault job.priority
|> text
]
]
]
,div [class ("ui basic label " ++ jobStateColor job)]
[text "Retries"
,div [class "detail"]
[job.retries |> String.fromInt |> text
]
]
]
,jobStateLabel job
,div [class "ui basic label"]
[Util.Time.formatDateTime job.submitted |> text
]
, div [ class "ui basic label" ]
[ i [ class "clock icon" ] []
, div [ class "detail" ]
[ getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
]
, i [ class "asterisk loading icon" ] []
, text job.name
]
, div [ class "content" ]
[ div [ class "job-log" ]
(List.map renderLogLine job.logs)
]
, div [ class "meta" ]
[ div [ class "right floated" ]
[ button [ class "ui button", onClick (RequestCancelJob job) ]
[ text "Cancel"
]
]
]
]
jobStateColor: JobDetail -> String
renderLogLine : JobLogEvent -> Html Msg
renderLogLine log =
span [ class (String.toLower log.level) ]
[ formatIsoDateTime log.time |> text
, text ": "
, text log.message
, br [] []
]
isFinal : JobDetail -> Bool
isFinal job =
case job.state of
"failed" ->
True
"success" ->
True
"cancelled" ->
True
_ ->
False
dimmerSettings : Comp.YesNoDimmer.Settings
dimmerSettings =
let
defaults =
Comp.YesNoDimmer.defaultSettings
in
{ defaults | headerClass = "ui inverted header", headerIcon = "", message = "Cancel/Delete this job?" }
renderInfoCard : Model -> JobDetail -> Html Msg
renderInfoCard model job =
div
[ classList
[ ( "ui fluid card", True )
, ( jobStateColor job, True )
]
]
[ Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm)
, div [ class "content" ]
[ div [ class "right floated" ]
[ if isFinal job || job.state == "stuck" then
span [ onClick (ShowLog job) ]
[ i [ class "file link icon", title "Show log" ] []
]
else
span [] []
, i [ class "delete link icon", title "Remove", onClick (RequestCancelJob job) ] []
]
, if isFinal job then
span [ class "invisible" ] []
else
div [ class "right floated" ]
[ div [ class "meta" ]
[ getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
, i
[ classList
[ ( "check icon", job.state == "success" )
, ( "redo icon", job.state == "stuck" )
, ( "bolt icon", job.state == "failed" )
, ( "meh outline icon", job.state == "canceled" )
, ( "cog icon", not (isFinal job) && job.state /= "stuck" )
]
]
[]
, text job.name
]
, div [ class "content" ]
[ div [ class "right floated" ]
[ if isFinal job then
div [ class ("ui basic label " ++ jobStateColor job) ]
[ i [ class "clock icon" ] []
, div [ class "detail" ]
[ getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
else
span [ class "invisible" ] []
, div [ class ("ui basic label " ++ jobStateColor job) ]
[ text "Prio"
, div [ class "detail" ]
[ code []
[ Data.Priority.fromString job.priority
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault job.priority
|> text
]
]
]
, div [ class ("ui basic label " ++ jobStateColor job) ]
[ text "Retries"
, div [ class "detail" ]
[ job.retries |> String.fromInt |> text
]
]
]
, jobStateLabel job
, div [ class "ui basic label" ]
[ Util.Time.formatDateTime job.submitted |> text
]
]
]
jobStateColor : JobDetail -> String
jobStateColor job =
case job.state of
"success" -> "green"
"failed" -> "red"
"canceled" -> "orange"
"stuck" -> "purple"
"scheduled" -> "blue"
"waiting" -> "grey"
_ -> ""
"success" ->
"green"
jobStateLabel: JobDetail -> Html Msg
"failed" ->
"red"
"canceled" ->
"orange"
"stuck" ->
"purple"
"scheduled" ->
"blue"
"waiting" ->
"grey"
_ ->
""
jobStateLabel : JobDetail -> Html Msg
jobStateLabel job =
let
col = jobStateColor job
col =
jobStateColor job
in
div [class ("ui label " ++ col)]
[text job.state
]
div [ class ("ui label " ++ col) ]
[ text job.state
]

35
modules/webapp/src/main/elm/Page/Register/Data.elm
View File

@ -1,23 +1,29 @@
module Page.Register.Data exposing (..)
module Page.Register.Data exposing
( Model
, Msg(..)
, emptyModel
)
import Http
import Api.Model.BasicResult exposing (BasicResult)
import Http
type alias Model =
{ result: Maybe BasicResult
, collId: String
, login: String
, pass1: String
, pass2: String
, showPass1: Bool
, showPass2: Bool
, errorMsg: List String
, loading: Bool
, successMsg: String
, invite: Maybe String
{ result : Maybe BasicResult
, collId : String
, login : String
, pass1 : String
, pass2 : String
, showPass1 : Bool
, showPass2 : Bool
, errorMsg : List String
, loading : Bool
, successMsg : String
, invite : Maybe String
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ result = Nothing
, collId = ""
@ -32,6 +38,7 @@ emptyModel =
, invite = Nothing
}
type Msg
= SetCollId String
| SetLogin String

119
modules/webapp/src/main/elm/Page/Register/Update.elm
View File

@ -1,84 +1,131 @@
module Page.Register.Update exposing (update)
import Api
import Api.Model.Registration exposing (Registration)
import Page.Register.Data exposing (..)
import Data.Flags exposing (Flags)
import Page exposing (Page(..))
import Page.Register.Data exposing (..)
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
RegisterSubmit ->
case model.errorMsg of
[] ->
let
reg = { collectiveName = model.collId
, login = model.login
, password = model.pass1
, invite = model.invite
}
reg =
{ collectiveName = model.collId
, login = model.login
, password = model.pass1
, invite = model.invite
}
in
(model, Api.register flags reg SubmitResp)
( model, Api.register flags reg SubmitResp )
_ ->
(model, Cmd.none)
( model, Cmd.none )
SetCollId str ->
let
m = {model|collId = str}
err = validateForm m
m =
{ model | collId = str }
err =
validateForm m
in
({m|errorMsg = err}, Cmd.none)
( { m | errorMsg = err }, Cmd.none )
SetLogin str ->
let
m = {model|login = str}
err = validateForm m
m =
{ model | login = str }
err =
validateForm m
in
({m|errorMsg = err}, Cmd.none)
( { m | errorMsg = err }, Cmd.none )
SetPass1 str ->
let
m = {model|pass1 = str}
err = validateForm m
m =
{ model | pass1 = str }
err =
validateForm m
in
({m|errorMsg = err}, Cmd.none)
( { m | errorMsg = err }, Cmd.none )
SetPass2 str ->
let
m = {model|pass2 = str}
err = validateForm m
m =
{ model | pass2 = str }
err =
validateForm m
in
({m|errorMsg = err}, Cmd.none)
( { m | errorMsg = err }, Cmd.none )
SetInvite str ->
({model | invite = if str == "" then Nothing else Just str}, Cmd.none)
( { model
| invite =
if str == "" then
Nothing
else
Just str
}
, Cmd.none
)
ToggleShowPass1 ->
({model|showPass1 = not model.showPass1}, Cmd.none)
( { model | showPass1 = not model.showPass1 }, Cmd.none )
ToggleShowPass2 ->
({model|showPass2 = not model.showPass2}, Cmd.none)
( { model | showPass2 = not model.showPass2 }, Cmd.none )
SubmitResp (Ok r) ->
let
m = emptyModel
cmd = if r.success then Page.goto (LoginPage Nothing) else Cmd.none
m =
emptyModel
cmd =
if r.success then
Page.goto (LoginPage Nothing)
else
Cmd.none
in
({m|result = if r.success then Nothing else Just r}, cmd)
( { m
| result =
if r.success then
Nothing
else
Just r
}
, cmd
)
SubmitResp (Err err) ->
(model, Cmd.none)
( model, Cmd.none )
validateForm: Model -> List String
validateForm : Model -> List String
validateForm model =
if model.collId == "" ||
model.login == "" ||
model.pass1 == "" ||
model.pass2 == "" then
[ "All fields are required!"]
if
model.collId
== ""
|| model.login
== ""
|| model.pass1
== ""
|| model.pass2
== ""
then
[ "All fields are required!" ]
else if model.pass1 /= model.pass2 then
["The passwords do not match."]
[ "The passwords do not match." ]
else
[]

253
modules/webapp/src/main/elm/Page/Register/View.elm
View File

@ -1,131 +1,164 @@
module Page.Register.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
import Data.Flags exposing (Flags)
import Page.Register.Data exposing (..)
import Page exposing (Page(..))
import Page.Register.Data exposing (..)
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
div [class "register-page"]
[div [class "ui centered grid"]
[div [class "row"]
[div [class "six wide column ui segment register-view"]
[h1 [class "ui cener aligned icon header"]
[img [class "ui image"
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")][]
,div [class "content"]
[text "Sign up @ Docspell"
]
]
,Html.form [ class "ui large error form raised segment"
, onSubmit RegisterSubmit
, autocomplete False
]
[div [class "required field"]
[label [][text "Collective ID"]
,div [class "ui left icon input"]
[input [type_ "text"
,autocomplete False
,onInput SetCollId
,value model.collId
,autofocus True
][]
,i [class "users icon"][]
]
]
,div [class "required field"]
[label [][text "User Login"]
,div [class "ui left icon input"]
[input [type_ "text"
,autocomplete False
,onInput SetLogin
,value model.login
][]
,i [class "user icon"][]
]
]
,div [class "required field"
]
[label [][text "Password"]
,div [class "ui left icon action input"]
[input [type_ <| if model.showPass1 then "text" else "password"
,autocomplete False
,onInput SetPass1
,value model.pass1
][]
,i [class "lock icon"][]
,button [class "ui icon button", onClick ToggleShowPass1]
[i [class "eye icon"][]
]
]
]
,div [class "required field"
]
[label [][text "Password (repeat)"]
,div [class "ui left icon action input"]
[input [type_ <| if model.showPass2 then "text" else "password"
,autocomplete False
,onInput SetPass2
,value model.pass2
][]
,i [class "lock icon"][]
,button [class "ui icon button", onClick ToggleShowPass2]
[i [class "eye icon"][]
]
]
]
,div [classList [("field", True)
,("invisible", flags.config.signupMode /= "invite")
]]
[label [][text "Invitation Key"]
,div [class "ui left icon input"]
[input [type_ "text"
,autocomplete False
,onInput SetInvite
,model.invite |> Maybe.withDefault "" |> value
][]
,i [class "key icon"][]
]
]
,button [class "ui primary button"
,type_ "submit"
]
[text "Submit"
]
]
,(resultMessage model)
,div [class "ui very basic right aligned segment"]
[text "Already signed up? "
,a [class "ui link", Page.href (LoginPage Nothing)]
[i [class "sign-in icon"][]
,text "Sign in"
]
div [ class "register-page" ]
[ div [ class "ui centered grid" ]
[ div [ class "row" ]
[ div [ class "six wide column ui segment register-view" ]
[ h1 [ class "ui cener aligned icon header" ]
[ img
[ class "ui image"
, src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
]
]
]
]
[]
, div [ class "content" ]
[ text "Sign up @ Docspell"
]
]
, Html.form
[ class "ui large error form raised segment"
, onSubmit RegisterSubmit
, autocomplete False
]
[ div [ class "required field" ]
[ label [] [ text "Collective ID" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "text"
, autocomplete False
, onInput SetCollId
, value model.collId
, autofocus True
]
[]
, i [ class "users icon" ] []
]
]
, div [ class "required field" ]
[ label [] [ text "User Login" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "text"
, autocomplete False
, onInput SetLogin
, value model.login
]
[]
, i [ class "user icon" ] []
]
]
, div
[ class "required field"
]
[ label [] [ text "Password" ]
, div [ class "ui left icon action input" ]
[ input
[ type_ <|
if model.showPass1 then
"text"
else
"password"
, autocomplete False
, onInput SetPass1
, value model.pass1
]
[]
, i [ class "lock icon" ] []
, button [ class "ui icon button", onClick ToggleShowPass1 ]
[ i [ class "eye icon" ] []
]
]
]
, div
[ class "required field"
]
[ label [] [ text "Password (repeat)" ]
, div [ class "ui left icon action input" ]
[ input
[ type_ <|
if model.showPass2 then
"text"
else
"password"
, autocomplete False
, onInput SetPass2
, value model.pass2
]
[]
, i [ class "lock icon" ] []
, button [ class "ui icon button", onClick ToggleShowPass2 ]
[ i [ class "eye icon" ] []
]
]
]
, div
[ classList
[ ( "field", True )
, ( "invisible", flags.config.signupMode /= "invite" )
]
]
[ label [] [ text "Invitation Key" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "text"
, autocomplete False
, onInput SetInvite
, model.invite |> Maybe.withDefault "" |> value
]
[]
, i [ class "key icon" ] []
]
]
, button
[ class "ui primary button"
, type_ "submit"
]
[ text "Submit"
]
]
, resultMessage model
, div [ class "ui very basic right aligned segment" ]
[ text "Already signed up? "
, a [ class "ui link", Page.href (LoginPage Nothing) ]
[ i [ class "sign-in icon" ] []
, text "Sign in"
]
]
]
]
]
]
resultMessage: Model -> Html Msg
resultMessage : Model -> Html Msg
resultMessage model =
case model.result of
Just r ->
if r.success
then
div [class "ui success message"]
[text "Registration successful."
if r.success then
div [ class "ui success message" ]
[ text "Registration successful."
]
else
div [class "ui error message"]
[text r.message
div [ class "ui error message" ]
[ text r.message
]
Nothing ->
if List.isEmpty model.errorMsg then
span [class "invisible"][]
span [ class "invisible" ] []
else
div [class "ui error message"]
(List.map (\s -> div[][text s]) model.errorMsg)
div [ class "ui error message" ]
(List.map (\s -> div [] [ text s ]) model.errorMsg)

95
modules/webapp/src/main/elm/Page/Upload/Data.elm
View File

@ -1,35 +1,53 @@
module Page.Upload.Data exposing (..)
module Page.Upload.Data exposing
( Model
, Msg(..)
, emptyModel
, hasErrors
, isCompleted
, isDone
, isError
, isIdle
, isLoading
, isSuccessAll
, uploadAllTracker
)
import Api.Model.BasicResult exposing (BasicResult)
import Comp.Dropzone
import File exposing (File)
import Http
import Set exposing (Set)
import File exposing (File)
import Api.Model.BasicResult exposing (BasicResult)
import Util.File exposing (makeFileId)
import Comp.Dropzone
type alias Model =
{ incoming: Bool
, singleItem: Bool
, files: List File
, completed: Set String
, errored: Set String
, loading: Set String
, dropzone: Comp.Dropzone.Model
{ incoming : Bool
, singleItem : Bool
, files : List File
, completed : Set String
, errored : Set String
, loading : Set String
, dropzone : Comp.Dropzone.Model
}
dropzoneSettings: Comp.Dropzone.Settings
dropzoneSettings : Comp.Dropzone.Settings
dropzoneSettings =
let
ds = Comp.Dropzone.defaultSettings
ds =
Comp.Dropzone.defaultSettings
in
{ds | classList = (\m -> [("ui attached blue placeholder segment dropzone", True)
,("dragging", m.hover)
,("disabled", not m.active)
])
}
{ ds
| classList =
\m ->
[ ( "ui attached blue placeholder segment dropzone", True )
, ( "dragging", m.hover )
, ( "disabled", not m.active )
]
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ incoming = True
, singleItem = False
@ -40,6 +58,7 @@ emptyModel =
, dropzone = Comp.Dropzone.init dropzoneSettings
}
type Msg
= SubmitUpload
| SingleUploadResp String (Result Http.Error BasicResult)
@ -50,42 +69,50 @@ type Msg
| DropzoneMsg Comp.Dropzone.Msg
isLoading: Model -> File -> Bool
isLoading : Model -> File -> Bool
isLoading model file =
Set.member (makeFileId file)model.loading
Set.member (makeFileId file) model.loading
isCompleted: Model -> File -> Bool
isCompleted : Model -> File -> Bool
isCompleted model file =
Set.member (makeFileId file)model.completed
Set.member (makeFileId file) model.completed
isError: Model -> File -> Bool
isError : Model -> File -> Bool
isError model file =
Set.member (makeFileId file) model.errored
isIdle: Model -> File -> Bool
isIdle : Model -> File -> Bool
isIdle model file =
not (isLoading model file || isCompleted model file || isError model file)
uploadAllTracker: String
uploadAllTracker : String
uploadAllTracker =
"upload-all"
isInitial: Model -> Bool
isInitial model =
Set.isEmpty model.loading &&
Set.isEmpty model.completed &&
Set.isEmpty model.errored
isDone: Model -> Bool
isInitial : Model -> Bool
isInitial model =
Set.isEmpty model.loading
&& Set.isEmpty model.completed
&& Set.isEmpty model.errored
isDone : Model -> Bool
isDone model =
List.map makeFileId model.files
|> List.all (\id -> Set.member id model.completed || Set.member id model.errored)
isSuccessAll: Model -> Bool
isSuccessAll : Model -> Bool
isSuccessAll model =
List.map makeFileId model.files
|> List.all (\id -> Set.member id model.completed)
hasErrors: Model -> Bool
hasErrors : Model -> Bool
hasErrors model =
not (Set.isEmpty model.errored)

182
modules/webapp/src/main/elm/Page/Upload/Update.elm
View File

@ -1,94 +1,156 @@
module Page.Upload.Update exposing (update)
import Api
import Http
import Set exposing (Set)
import Page.Upload.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.Dropzone
import File
import File.Select
import Ports
import Api.Model.ItemUploadMeta
import Comp.Dropzone
import Data.Flags exposing (Flags)
import Http
import Page.Upload.Data exposing (..)
import Ports
import Set exposing (Set)
import Util.File exposing (makeFileId)
import Util.Http
update: (Maybe String) -> Flags -> Msg -> Model -> (Model, Cmd Msg, Sub Msg)
update : Maybe String -> Flags -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
update sourceId flags msg model =
case msg of
ToggleIncoming ->
({model|incoming = not model.incoming}, Cmd.none, Sub.none)
( { model | incoming = not model.incoming }, Cmd.none, Sub.none )
ToggleSingleItem ->
({model|singleItem = not model.singleItem}, Cmd.none, Sub.none)
( { model | singleItem = not model.singleItem }, Cmd.none, Sub.none )
SubmitUpload ->
let
emptyMeta = Api.Model.ItemUploadMeta.empty
meta = {emptyMeta | multiple = not model.singleItem
, direction = if model.incoming then Just "incoming" else Just "outgoing"
}
fileids = List.map makeFileId model.files
uploads = if model.singleItem then Api.uploadSingle flags sourceId meta uploadAllTracker model.files (SingleUploadResp uploadAllTracker)
else Cmd.batch (Api.upload flags sourceId meta model.files SingleUploadResp)
tracker = if model.singleItem then Http.track uploadAllTracker (GotProgress uploadAllTracker)
else Sub.batch <| List.map (\id -> Http.track id (GotProgress id)) fileids
(cm2, _, _) = Comp.Dropzone.update (Comp.Dropzone.setActive False) model.dropzone
emptyMeta =
Api.Model.ItemUploadMeta.empty
meta =
{ emptyMeta
| multiple = not model.singleItem
, direction =
if model.incoming then
Just "incoming"
else
Just "outgoing"
}
fileids =
List.map makeFileId model.files
uploads =
if model.singleItem then
Api.uploadSingle flags sourceId meta uploadAllTracker model.files (SingleUploadResp uploadAllTracker)
else
Cmd.batch (Api.upload flags sourceId meta model.files SingleUploadResp)
tracker =
if model.singleItem then
Http.track uploadAllTracker (GotProgress uploadAllTracker)
else
Sub.batch <| List.map (\id -> Http.track id (GotProgress id)) fileids
( cm2, _, _ ) =
Comp.Dropzone.update (Comp.Dropzone.setActive False) model.dropzone
in
({model|loading = Set.fromList fileids, dropzone = cm2}, uploads, tracker)
( { model | loading = Set.fromList fileids, dropzone = cm2 }, uploads, tracker )
SingleUploadResp fileid (Ok res) ->
let
compl = if res.success then setCompleted model fileid
else model.completed
errs = if not res.success then setErrored model fileid
else model.errored
load = if fileid == uploadAllTracker then Set.empty
else Set.remove fileid model.loading
in
({model|completed = compl, errored = errs, loading = load}
, Ports.setProgress (fileid, 100), Sub.none
)
compl =
if res.success then
setCompleted model fileid
SingleUploadResp fileid (Err err) ->
let
_ = Debug.log "error" err
errs = setErrored model fileid
load = if fileid == uploadAllTracker then Set.empty
else Set.remove fileid model.loading
else
model.completed
errs =
if not res.success then
setErrored model fileid
else
model.errored
load =
if fileid == uploadAllTracker then
Set.empty
else
Set.remove fileid model.loading
in
({model|errored = errs, loading = load}, Cmd.none, Sub.none)
( { model | completed = compl, errored = errs, loading = load }
, Ports.setProgress ( fileid, 100 )
, Sub.none
)
SingleUploadResp fileid (Err _) ->
let
errs =
setErrored model fileid
load =
if fileid == uploadAllTracker then
Set.empty
else
Set.remove fileid model.loading
in
( { model | errored = errs, loading = load }, Cmd.none, Sub.none )
GotProgress fileid progress ->
let
percent = case progress of
Http.Sending p ->
Http.fractionSent p
|> (*) 100
|> round
_ -> 0
updateBars = if percent == 0 then Cmd.none
else if model.singleItem then Ports.setAllProgress (uploadAllTracker, percent)
else Ports.setProgress (fileid, percent)
percent =
case progress of
Http.Sending p ->
Http.fractionSent p
|> (*) 100
|> round
_ ->
0
updateBars =
if percent == 0 then
Cmd.none
else if model.singleItem then
Ports.setAllProgress ( uploadAllTracker, percent )
else
Ports.setProgress ( fileid, percent )
in
(model, updateBars, Sub.none)
( model, updateBars, Sub.none )
Clear ->
(emptyModel, Cmd.none, Sub.none)
( emptyModel, Cmd.none, Sub.none )
DropzoneMsg m ->
let
(m2, c2, files) = Comp.Dropzone.update m model.dropzone
nextFiles = List.append model.files files
( m2, c2, files ) =
Comp.Dropzone.update m model.dropzone
nextFiles =
List.append model.files files
in
({model| files = nextFiles, dropzone = m2}, Cmd.map DropzoneMsg c2, Sub.none)
( { model | files = nextFiles, dropzone = m2 }, Cmd.map DropzoneMsg c2, Sub.none )
setCompleted: Model -> String -> Set String
setCompleted : Model -> String -> Set String
setCompleted model fileid =
if fileid == uploadAllTracker then List.map makeFileId model.files |> Set.fromList
else Set.insert fileid model.completed
if fileid == uploadAllTracker then
List.map makeFileId model.files |> Set.fromList
setErrored: Model -> String -> Set String
else
Set.insert fileid model.completed
setErrored : Model -> String -> Set String
setErrored model fileid =
if fileid == uploadAllTracker then List.map makeFileId model.files |> Set.fromList
else Set.insert fileid model.errored
if fileid == uploadAllTracker then
List.map makeFileId model.files |> Set.fromList
else
Set.insert fileid model.errored

322
modules/webapp/src/main/elm/Page/Upload/View.elm
View File

@ -1,166 +1,190 @@
module Page.Upload.View exposing (view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onCheck)
import Comp.Dropzone
import File exposing (File)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick)
import Page exposing (Page(..))
import Page.Upload.Data exposing (..)
import Util.File exposing (makeFileId)
import Util.Maybe
import Util.Size
view: (Maybe String) -> Model -> Html Msg
view : Maybe String -> Model -> Html Msg
view mid model =
div [class "upload-page ui grid container"]
[div [class "row"]
[div [class "sixteen wide column"]
[div [class "ui top attached segment"]
[renderForm model
]
,Html.map DropzoneMsg (Comp.Dropzone.view model.dropzone)
,div [class "ui bottom attached segment"]
[a [class "ui primary button", href "", onClick SubmitUpload]
[text "Submit"
]
,a [class "ui secondary button", href "", onClick Clear]
[text "Reset"
]
]
]
]
,if isDone model && hasErrors model then renderErrorMsg model
else span[class "invisible"][]
,if List.isEmpty model.files then span[][]
else if isSuccessAll model then renderSuccessMsg (Util.Maybe.nonEmpty mid) model
else renderUploads model
]
renderErrorMsg: Model -> Html Msg
renderErrorMsg model =
div [class "row"]
[div [class "sixteen wide column"]
[div [class "ui large error message"]
[h3 [class "ui header"]
[i [class "meh outline icon"][]
,text "Some files failed to upload"
]
,text "There were errors uploading some files."
]
]
]
renderSuccessMsg: Bool -> Model -> Html Msg
renderSuccessMsg public model =
div [class "row"]
[div [class "sixteen wide column"]
[div [class "ui large success message"]
[h3 [class "ui header"]
[i [class "smile outline icon"][]
,text "All files uploaded"
]
,if public then p [][] else p []
[text "Your files have been successfully uploaded. They are now being processed. Check the "
,a [class "ui link", Page.href HomePage]
[text "Items page"
]
,text " later where the files will arrive eventually. Or go to the "
,a [class "ui link", Page.href QueuePage]
[text "Processing Page"
]
,text " to view the current processing state."
]
,p []
[text "Click "
,a [class "ui link", href "", onClick Clear]
[text "Reset"
]
,text " to upload more files."
]
]
]
]
renderUploads: Model -> Html Msg
renderUploads model =
div [class "row"]
[div [class "sixteen wide column"]
[div [class "ui basic segment"]
[h2 [class "ui header"]
[text "Selected Files"
]
,div [class "ui items"] <|
if model.singleItem then
(List.map (renderFileItem model (Just uploadAllTracker)) model.files)
else
(List.map (renderFileItem model Nothing) model.files)
]
]
]
renderFileItem: Model -> Maybe String -> File -> Html Msg
renderFileItem model mtracker file =
let
name = File.name file
size = File.size file
|> toFloat
|> Util.Size.bytesReadable Util.Size.B
in
div [class "item"]
[i [classList [("large", True)
,("file outline icon", isIdle model file)
,("loading spinner icon", isLoading model file)
,("green check icon", isCompleted model file)
,("red bolt icon", isError model file)
]][]
,div [class "middle aligned content"]
[div [class "header"]
[text name
]
,div [class "right floated meta"]
[text size
]
,div [class "description"]
[div [classList [("ui small indicating progress", True)
,(uploadAllTracker, Util.Maybe.nonEmpty mtracker)
]
, id (makeFileId file)
]
[div [class "bar"]
[]
]
div [ class "upload-page ui grid container" ]
[ div [ class "row" ]
[ div [ class "sixteen wide column" ]
[ div [ class "ui top attached segment" ]
[ renderForm model
]
, Html.map DropzoneMsg (Comp.Dropzone.view model.dropzone)
, div [ class "ui bottom attached segment" ]
[ a [ class "ui primary button", href "", onClick SubmitUpload ]
[ text "Submit"
]
, a [ class "ui secondary button", href "", onClick Clear ]
[ text "Reset"
]
]
]
]
, if isDone model && hasErrors model then
renderErrorMsg model
else
span [ class "invisible" ] []
, if List.isEmpty model.files then
span [] []
renderForm: Model -> Html Msg
renderForm model =
div [class "row"]
[Html.form [class "ui form"]
[div [class "grouped fields"]
[div [class "field"]
[div [class "ui radio checkbox"]
[input [type_ "radio", checked model.incoming, onCheck (\_ ->ToggleIncoming)][]
,label [][text "Incoming"]
]
]
,div [class "field"]
[div [class "ui radio checkbox"]
[input [type_ "radio", checked (not model.incoming), onCheck (\_ -> ToggleIncoming)][]
,label [][text "Outgoing"]
]
]
]
,div [class "inline field"]
[div [class "ui checkbox"]
[input [type_ "checkbox", checked model.singleItem, onCheck (\_ -> ToggleSingleItem)][]
,label [][text "All files are one single item"]
]
]
]
else if isSuccessAll model then
renderSuccessMsg (Util.Maybe.nonEmpty mid) model
else
renderUploads model
]
renderErrorMsg : Model -> Html Msg
renderErrorMsg model =
div [ class "row" ]
[ div [ class "sixteen wide column" ]
[ div [ class "ui large error message" ]
[ h3 [ class "ui header" ]
[ i [ class "meh outline icon" ] []
, text "Some files failed to upload"
]
, text "There were errors uploading some files."
]
]
]
renderSuccessMsg : Bool -> Model -> Html Msg
renderSuccessMsg public model =
div [ class "row" ]
[ div [ class "sixteen wide column" ]
[ div [ class "ui large success message" ]
[ h3 [ class "ui header" ]
[ i [ class "smile outline icon" ] []
, text "All files uploaded"
]
, if public then
p [] []
else
p []
[ text "Your files have been successfully uploaded. They are now being processed. Check the "
, a [ class "ui link", Page.href HomePage ]
[ text "Items page"
]
, text " later where the files will arrive eventually. Or go to the "
, a [ class "ui link", Page.href QueuePage ]
[ text "Processing Page"
]
, text " to view the current processing state."
]
, p []
[ text "Click "
, a [ class "ui link", href "", onClick Clear ]
[ text "Reset"
]
, text " to upload more files."
]
]
]
]
renderUploads : Model -> Html Msg
renderUploads model =
div [ class "row" ]
[ div [ class "sixteen wide column" ]
[ div [ class "ui basic segment" ]
[ h2 [ class "ui header" ]
[ text "Selected Files"
]
, div [ class "ui items" ] <|
if model.singleItem then
List.map (renderFileItem model (Just uploadAllTracker)) model.files
else
List.map (renderFileItem model Nothing) model.files
]
]
]
renderFileItem : Model -> Maybe String -> File -> Html Msg
renderFileItem model mtracker file =
let
name =
File.name file
size =
File.size file
|> toFloat
|> Util.Size.bytesReadable Util.Size.B
in
div [ class "item" ]
[ i
[ classList
[ ( "large", True )
, ( "file outline icon", isIdle model file )
, ( "loading spinner icon", isLoading model file )
, ( "green check icon", isCompleted model file )
, ( "red bolt icon", isError model file )
]
]
[]
, div [ class "middle aligned content" ]
[ div [ class "header" ]
[ text name
]
, div [ class "right floated meta" ]
[ text size
]
, div [ class "description" ]
[ div
[ classList
[ ( "ui small indicating progress", True )
, ( uploadAllTracker, Util.Maybe.nonEmpty mtracker )
]
, id (makeFileId file)
]
[ div [ class "bar" ]
[]
]
]
]
]
renderForm : Model -> Html Msg
renderForm model =
div [ class "row" ]
[ Html.form [ class "ui form" ]
[ div [ class "grouped fields" ]
[ div [ class "field" ]
[ div [ class "ui radio checkbox" ]
[ input [ type_ "radio", checked model.incoming, onCheck (\_ -> ToggleIncoming) ] []
, label [] [ text "Incoming" ]
]
]
, div [ class "field" ]
[ div [ class "ui radio checkbox" ]
[ input [ type_ "radio", checked (not model.incoming), onCheck (\_ -> ToggleIncoming) ] []
, label [] [ text "Outgoing" ]
]
]
]
, div [ class "inline field" ]
[ div [ class "ui checkbox" ]
[ input [ type_ "checkbox", checked model.singleItem, onCheck (\_ -> ToggleSingleItem) ] []
, label [] [ text "All files are one single item" ]
]
]
]
]

20
modules/webapp/src/main/elm/Page/UserSettings/Data.elm
View File

@ -1,19 +1,29 @@
module Page.UserSettings.Data exposing (..)
module Page.UserSettings.Data exposing
( Model
, Msg(..)
, Tab(..)
, emptyModel
)
import Comp.ChangePasswordForm
type alias Model =
{ currentTab: Maybe Tab
, changePassModel: Comp.ChangePasswordForm.Model
{ currentTab : Maybe Tab
, changePassModel : Comp.ChangePasswordForm.Model
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ currentTab = Nothing
, changePassModel = Comp.ChangePasswordForm.emptyModel
}
type Tab = ChangePassTab
type Tab
= ChangePassTab
type Msg
= SetTab Tab

17
modules/webapp/src/main/elm/Page/UserSettings/Update.elm
View File

@ -1,20 +1,23 @@
module Page.UserSettings.Update exposing (update)
import Page.UserSettings.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.ChangePasswordForm
import Data.Flags exposing (Flags)
import Page.UserSettings.Data exposing (..)
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTab t ->
let
m = { model | currentTab = Just t }
m =
{ model | currentTab = Just t }
in
(m, Cmd.none)
( m, Cmd.none )
ChangePassMsg m ->
let
(m2, c2) = Comp.ChangePasswordForm.update flags m model.changePassModel
( m2, c2 ) =
Comp.ChangePasswordForm.update flags m model.changePassModel
in
({model | changePassModel = m2}, Cmd.map ChangePassMsg c2)
( { model | changePassModel = m2 }, Cmd.map ChangePassMsg c2 )

67
modules/webapp/src/main/elm/Page/UserSettings/View.elm
View File

@ -1,47 +1,52 @@
module Page.UserSettings.View exposing (view)
import Comp.ChangePasswordForm
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.UserSettings.Data exposing (..)
import Util.Html exposing (classActive)
import Page.UserSettings.Data exposing (..)
import Comp.ChangePasswordForm
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div [class "usersetting-page ui padded grid"]
[div [class "four wide column"]
[h4 [class "ui top attached ablue-comp header"]
[text "User"
]
,div [class "ui attached fluid segment"]
[div [class "ui fluid vertical secondary menu"]
[div [classActive (model.currentTab == Just ChangePassTab) "link icon item"
,onClick (SetTab ChangePassTab)
]
[i [class "user secret icon"][]
,text "Change Password"
]
]
]
]
,div [class "twelve wide column"]
[div [class ""]
(case model.currentTab of
Just ChangePassTab -> viewChangePassword model
Nothing -> []
)
div [ class "usersetting-page ui padded grid" ]
[ div [ class "four wide column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
[ text "User"
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[ div
[ classActive (model.currentTab == Just ChangePassTab) "link icon item"
, onClick (SetTab ChangePassTab)
]
[ i [ class "user secret icon" ] []
, text "Change Password"
]
]
]
]
, div [ class "twelve wide column" ]
[ div [ class "" ]
(case model.currentTab of
Just ChangePassTab ->
viewChangePassword model
Nothing ->
[]
)
]
]
viewChangePassword: Model -> List (Html Msg)
viewChangePassword : Model -> List (Html Msg)
viewChangePassword model =
[h2 [class "ui header"]
[i [class "ui user secret icon"][]
,div [class "content"]
[text "Change Password"
[ h2 [ class "ui header" ]
[ i [ class "ui user secret icon" ] []
, div [ class "content" ]
[ text "Change Password"
]
]
,Html.map ChangePassMsg (Comp.ChangePasswordForm.view model.changePassModel)
, Html.map ChangePassMsg (Comp.ChangePasswordForm.view model.changePassModel)
]

14
modules/webapp/src/main/elm/Ports.elm
View File

@ -2,10 +2,14 @@ port module Ports exposing (..)
import Api.Model.AuthResult exposing (AuthResult)
port initElements: () -> Cmd msg
port setAccount: AuthResult -> Cmd msg
port removeAccount: () -> Cmd msg
port setAccount : AuthResult -> Cmd msg
port setProgress: (String, Int) -> Cmd msg
port setAllProgress: (String, Int) -> Cmd msg
port removeAccount : () -> Cmd msg
port setProgress : ( String, Int ) -> Cmd msg
port setAllProgress : ( String, Int ) -> Cmd msg

5
modules/webapp/src/main/elm/Util/Address.elm
View File

@ -1,8 +1,9 @@
module Util.Address exposing (..)
module Util.Address exposing (toString)
import Api.Model.Address exposing (Address)
toString: Address -> String
toString : Address -> String
toString a =
[ a.street, a.zip, a.city, a.country ]
|> List.filter (String.isEmpty >> not)

5
modules/webapp/src/main/elm/Util/Contact.elm
View File

@ -1,8 +1,9 @@
module Util.Contact exposing (..)
module Util.Contact exposing (toString)
import Api.Model.Contact exposing (Contact)
toString: List Contact -> String
toString : List Contact -> String
toString contacts =
List.map (\c -> c.kind ++ ": " ++ c.value) contacts
|> List.intersperse ", "

47
modules/webapp/src/main/elm/Util/Duration.elm
View File

@ -2,46 +2,65 @@ module Util.Duration exposing (Duration, toHuman)
-- 486ms -> 12s -> 1:05 -> 59:45 -> 1:02:12
type alias Duration = Int
toHuman: Duration -> String
type alias Duration =
Int
toHuman : Duration -> String
toHuman dur =
fromMillis dur
-- implementation
fromMillis: Int -> String
fromMillis : Int -> String
fromMillis ms =
case ms // 1000 of
0 ->
(String.fromInt ms) ++ "ms"
String.fromInt ms ++ "ms"
n ->
fromSeconds n
fromSeconds: Int -> String
fromSeconds : Int -> String
fromSeconds sec =
case sec // 60 of
0 ->
(String.fromInt sec) ++ "s"
String.fromInt sec ++ "s"
n ->
let
s = sec - (n * 60)
s =
sec - (n * 60)
in
(fromMinutes n) ++ ":" ++ (num s)
fromMinutes n ++ ":" ++ num s
fromMinutes: Int -> String
fromMinutes : Int -> String
fromMinutes min =
case min // 60 of
0 ->
(num min)
num min
n ->
let
m = min - (n * 60)
m =
min - (n * 60)
in
(num n) ++ ":" ++ (num m)
num n ++ ":" ++ num m
num: Int -> String
num : Int -> String
num n =
String.fromInt n
|> (++) (if n < 10 then "0" else "")
|> (++)
(if n < 10 then
"0"
else
""
)

9
modules/webapp/src/main/elm/Util/File.elm
View File

@ -1,9 +1,12 @@
module Util.File exposing (..)
module Util.File exposing (makeFileId)
import File exposing (File)
import Util.String
makeFileId: File -> String
makeFileId : File -> String
makeFileId file =
(File.name file) ++ "-" ++ (File.size file |> String.fromInt)
File.name file
++ "-"
++ (File.size file |> String.fromInt)
|> Util.String.crazyEncode

58
modules/webapp/src/main/elm/Util/Html.elm
View File

@ -1,10 +1,17 @@
module Util.Html exposing (..)
module Util.Html exposing
( KeyCode(..)
, classActive
, intToKeyCode
, onClickk
, onKeyUp
)
import Html exposing (Attribute)
import Html.Attributes exposing (class)
import Html.Events exposing (on, keyCode)
import Html.Events exposing (keyCode, on)
import Json.Decode as Decode
type KeyCode
= Up
| Down
@ -12,29 +19,52 @@ type KeyCode
| Right
| Enter
intToKeyCode: Int -> Maybe KeyCode
intToKeyCode : Int -> Maybe KeyCode
intToKeyCode code =
case code of
38 -> Just Up
40 -> Just Down
39 -> Just Right
37 -> Just Left
13 -> Just Enter
_ -> Nothing
38 ->
Just Up
40 ->
Just Down
39 ->
Just Right
37 ->
Just Left
13 ->
Just Enter
_ ->
Nothing
onKeyUp : (Int -> msg) -> Attribute msg
onKeyUp tagger =
on "keyup" (Decode.map tagger keyCode)
on "keyup" (Decode.map tagger keyCode)
onClickk : msg -> Attribute msg
onClickk msg =
Html.Events.preventDefaultOn "click" (Decode.map alwaysPreventDefault (Decode.succeed msg))
Html.Events.preventDefaultOn "click" (Decode.map alwaysPreventDefault (Decode.succeed msg))
alwaysPreventDefault : msg -> ( msg, Bool )
alwaysPreventDefault msg =
( msg, True )
( msg, True )
classActive: Bool -> String -> Attribute msg
classActive : Bool -> String -> Attribute msg
classActive active classes =
class (classes ++ (if active then " active" else ""))
class
(classes
++ (if active then
" active"
else
""
)
)

174
modules/webapp/src/main/elm/Util/Http.elm
View File

@ -1,37 +1,55 @@
module Util.Http exposing (..)
module Util.Http exposing
( authDelete
, authGet
, authPost
, authPostTrack
, authPut
, authTask
, errorToString
, executeIn
, jsonResolver
)
import Api.Model.AuthResult exposing (AuthResult)
import Http
import Json.Decode as D
import Process
import Task exposing (Task)
import Api.Model.AuthResult exposing (AuthResult)
import Json.Decode as D
-- Authenticated Requests
authReq: {url: String
,account: AuthResult
,method: String
,headers: List Http.Header
,body: Http.Body
,expect: Http.Expect msg
,tracker: Maybe String
} -> Cmd msg
authReq :
{ url : String
, account : AuthResult
, method : String
, headers : List Http.Header
, body : Http.Body
, expect : Http.Expect msg
, tracker : Maybe String
}
-> Cmd msg
authReq req =
Http.request
{ url = req.url
, method = req.method
, headers = (Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token)) :: req.headers
, headers = Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token) :: req.headers
, expect = req.expect
, body = req.body
, timeout = Nothing
, tracker = req.tracker
}
authPost: {url: String
,account: AuthResult
,body: Http.Body
,expect: Http.Expect msg
} -> Cmd msg
authPost :
{ url : String
, account : AuthResult
, body : Http.Body
, expect : Http.Expect msg
}
-> Cmd msg
authPost req =
authReq
{ url = req.url
@ -43,12 +61,15 @@ authPost req =
, tracker = Nothing
}
authPostTrack: {url: String
,account: AuthResult
,body: Http.Body
,expect: Http.Expect msg
,tracker: String
} -> Cmd msg
authPostTrack :
{ url : String
, account : AuthResult
, body : Http.Body
, expect : Http.Expect msg
, tracker : String
}
-> Cmd msg
authPostTrack req =
authReq
{ url = req.url
@ -60,11 +81,14 @@ authPostTrack req =
, tracker = Just req.tracker
}
authPut: {url: String
,account: AuthResult
,body: Http.Body
,expect: Http.Expect msg
} -> Cmd msg
authPut :
{ url : String
, account : AuthResult
, body : Http.Body
, expect : Http.Expect msg
}
-> Cmd msg
authPut req =
authReq
{ url = req.url
@ -76,10 +100,13 @@ authPut req =
, tracker = Nothing
}
authGet: {url: String
,account: AuthResult
,expect: Http.Expect msg
} -> Cmd msg
authGet :
{ url : String
, account : AuthResult
, expect : Http.Expect msg
}
-> Cmd msg
authGet req =
authReq
{ url = req.url
@ -91,10 +118,13 @@ authGet req =
, tracker = Nothing
}
authDelete: {url: String
,account: AuthResult
,expect: Http.Expect msg
} -> Cmd msg
authDelete :
{ url : String
, account : AuthResult
, expect : Http.Expect msg
}
-> Cmd msg
authDelete req =
authReq
{ url = req.url
@ -110,69 +140,81 @@ authDelete req =
-- Error Utilities
errorToStringStatus: Http.Error -> (Int -> String) -> String
errorToStringStatus : Http.Error -> (Int -> String) -> String
errorToStringStatus error statusString =
case error of
Http.BadUrl url ->
"There is something wrong with this url: " ++ url
Http.Timeout ->
"There was a network timeout."
Http.NetworkError ->
"There was a network error."
Http.BadStatus status ->
statusString status
Http.BadBody str ->
"There was an error decoding the response: " ++ str
errorToString: Http.Error -> String
errorToString : Http.Error -> String
errorToString error =
let
f sc = case sc of
404 ->
"The requested resource doesn't exist."
_ ->
"There was an invalid response status: " ++ (String.fromInt sc)
f sc =
case sc of
404 ->
"The requested resource doesn't exist."
_ ->
"There was an invalid response status: " ++ String.fromInt sc
in
errorToStringStatus error f
errorToStringStatus error f
-- Http.Task Utilities
jsonResolver : D.Decoder a -> Http.Resolver Http.Error a
jsonResolver : D.Decoder a -> Http.Resolver Http.Error a
jsonResolver decoder =
Http.stringResolver <|
\response ->
case response of
Http.BadUrl_ url ->
Err (Http.BadUrl url)
Http.stringResolver <|
\response ->
case response of
Http.BadUrl_ url ->
Err (Http.BadUrl url)
Http.Timeout_ ->
Err Http.Timeout
Http.Timeout_ ->
Err Http.Timeout
Http.NetworkError_ ->
Err Http.NetworkError
Http.NetworkError_ ->
Err Http.NetworkError
Http.BadStatus_ metadata body ->
Err (Http.BadStatus metadata.statusCode)
Http.BadStatus_ metadata body ->
Err (Http.BadStatus metadata.statusCode)
Http.GoodStatus_ metadata body ->
case D.decodeString decoder body of
Ok value ->
Ok value
Http.GoodStatus_ metadata body ->
case D.decodeString decoder body of
Ok value ->
Ok value
Err err ->
Err (Http.BadBody (D.errorToString err))
Err err ->
Err (Http.BadBody (D.errorToString err))
executeIn: Float -> ((Result Http.Error a) -> msg) -> Task Http.Error a -> Cmd msg
executeIn : Float -> (Result Http.Error a -> msg) -> Task Http.Error a -> Cmd msg
executeIn delay receive task =
Process.sleep delay
|> Task.andThen (\_ -> task)
|> Task.attempt receive
authTask:
authTask :
{ method : String
, headers : List Http.Header
, account: AuthResult
, account : AuthResult
, url : String
, body : Http.Body
, resolver : Http.Resolver x a
@ -182,7 +224,7 @@ authTask:
authTask req =
Http.task
{ method = req.method
, headers = (Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token)) :: req.headers
, headers = Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token) :: req.headers
, url = req.url
, body = req.body
, resolver = req.resolver

83
modules/webapp/src/main/elm/Util/List.elm
View File

@ -1,51 +1,80 @@
module Util.List exposing ( find
, findIndexed
, get
, distinct
, findNext
, findPrev
)
module Util.List exposing
( distinct
, find
, findIndexed
, findNext
, findPrev
, get
)
get: List a -> Int -> Maybe a
get : List a -> Int -> Maybe a
get list index =
if index < 0 then Nothing
else case list of
[] ->
Nothing
x :: xs ->
if index == 0
then Just x
else get xs (index - 1)
if index < 0 then
Nothing
find: (a -> Bool) -> List a -> Maybe a
else
case list of
[] ->
Nothing
x :: xs ->
if index == 0 then
Just x
else
get xs (index - 1)
find : (a -> Bool) -> List a -> Maybe a
find pred list =
findIndexed pred list |> Maybe.map Tuple.first
findIndexed: (a -> Bool) -> List a -> Maybe (a, Int)
findIndexed : (a -> Bool) -> List a -> Maybe ( a, Int )
findIndexed pred list =
findIndexed1 pred list 0
findIndexed1: (a -> Bool) -> List a -> Int -> Maybe (a, Int)
findIndexed1 : (a -> Bool) -> List a -> Int -> Maybe ( a, Int )
findIndexed1 pred list index =
case list of
[] -> Nothing
x :: xs ->
if pred x then Just (x, index)
else findIndexed1 pred xs (index + 1)
[] ->
Nothing
distinct: List a -> List a
x :: xs ->
if pred x then
Just ( x, index )
else
findIndexed1 pred xs (index + 1)
distinct : List a -> List a
distinct list =
List.reverse <|
List.foldl (\a -> \r -> if (List.member a r) then r else a :: r) [] list
List.foldl
(\a ->
\r ->
if List.member a r then
r
findPrev: (a -> Bool) -> List a -> Maybe a
else
a :: r
)
[]
list
findPrev : (a -> Bool) -> List a -> Maybe a
findPrev pred list =
findIndexed pred list
|> Maybe.map Tuple.second
|> Maybe.map (\i -> i - 1)
|> Maybe.andThen (get list)
findNext: (a -> Bool) -> List a -> Maybe a
findNext : (a -> Bool) -> List a -> Maybe a
findNext pred list =
findIndexed pred list
|> Maybe.map Tuple.second

41
modules/webapp/src/main/elm/Util/Maybe.elm
View File

@ -1,23 +1,40 @@
module Util.Maybe exposing (..)
module Util.Maybe exposing
( isEmpty
, nonEmpty
, or
, withDefault
)
nonEmpty: Maybe a -> Bool
nonEmpty : Maybe a -> Bool
nonEmpty ma =
Maybe.map (\_ -> True) ma
|> Maybe.withDefault False
not (isEmpty ma)
isEmpty: Maybe a -> Bool
isEmpty : Maybe a -> Bool
isEmpty ma =
not (nonEmpty ma)
ma == Nothing
withDefault: Maybe a -> Maybe a -> Maybe a
withDefault : Maybe a -> Maybe a -> Maybe a
withDefault ma1 ma2 =
if isEmpty ma2 then ma1 else ma2
if isEmpty ma2 then
ma1
or: List (Maybe a) -> Maybe a
else
ma2
or : List (Maybe a) -> Maybe a
or listma =
case listma of
[] -> Nothing
[] ->
Nothing
el :: els ->
case el of
Just _ -> el
Nothing -> or els
Just _ ->
el
Nothing ->
or els

64
modules/webapp/src/main/elm/Util/Size.elm
View File

@ -1,24 +1,60 @@
module Util.Size exposing (..)
module Util.Size exposing
( SizeUnit(..)
, bytesReadable
)
type SizeUnit = G|M|K|B
prettyNumber: Float -> String
type SizeUnit
= G
| M
| K
| B
prettyNumber : Float -> String
prettyNumber n =
let
parts = String.split "." (String.fromFloat n)
parts =
String.split "." (String.fromFloat n)
in
case parts of
n0 :: d :: [] -> n0 ++ "." ++ (String.left 2 d)
_ -> String.join "." parts
case parts of
n0 :: d :: [] ->
n0 ++ "." ++ String.left 2 d
bytesReadable: SizeUnit -> Float -> String
_ ->
String.join "." parts
bytesReadable : SizeUnit -> Float -> String
bytesReadable unit n =
let
k = n / 1024
num = prettyNumber n
k =
n / 1024
num =
prettyNumber n
in
case unit of
G -> num ++ "G"
M -> if k > 1 then (bytesReadable G k) else num ++ "M"
K -> if k > 1 then (bytesReadable M k) else num ++ "K"
B -> if k > 1 then (bytesReadable K k) else num ++ "B"
G ->
num ++ "G"
M ->
if k > 1 then
bytesReadable G k
else
num ++ "M"
K ->
if k > 1 then
bytesReadable M k
else
num ++ "K"
B ->
if k > 1 then
bytesReadable K k
else
num ++ "B"

49
modules/webapp/src/main/elm/Util/String.elm
View File

@ -1,28 +1,45 @@
module Util.String exposing (..)
module Util.String exposing
( crazyEncode
, ellipsis
, withDefault
)
import Base64
crazyEncode: String -> String
crazyEncode : String -> String
crazyEncode str =
let
b64 = Base64.encode str
len = String.length b64
b64 =
Base64.encode str
len =
String.length b64
in
case (String.right 2 b64 |> String.toList) of
'=' :: '=' :: [] ->
(String.dropRight 2 b64) ++ "0"
case String.right 2 b64 |> String.toList of
'=' :: '=' :: [] ->
String.dropRight 2 b64 ++ "0"
_ :: '=' :: [] ->
(String.dropRight 1 b64) ++ "1"
_ :: '=' :: [] ->
String.dropRight 1 b64 ++ "1"
_ ->
b64
_ ->
b64
ellipsis: Int -> String -> String
ellipsis : Int -> String -> String
ellipsis len str =
if String.length str <= len then str
else (String.left (len - 3) str) ++ "..."
if String.length str <= len then
str
withDefault: String -> String -> String
else
String.left (len - 3) str ++ "..."
withDefault : String -> String -> String
withDefault default str =
if str == "" then default else str
if str == "" then
default
else
str

52
modules/webapp/src/main/elm/Util/Time.elm
View File

@ -1,4 +1,9 @@
module Util.Time exposing (..)
module Util.Time exposing
( formatDate
, formatDateShort
, formatDateTime
, formatIsoDateTime
)
import DateFormat
import Time exposing (Posix, Zone, utc)
@ -16,7 +21,8 @@ dateFormatter =
, DateFormat.yearNumber
]
dateFormatterShort: Zone -> Posix -> String
dateFormatterShort : Zone -> Posix -> String
dateFormatterShort =
DateFormat.format
[ DateFormat.yearNumber
@ -26,7 +32,8 @@ dateFormatterShort =
, DateFormat.dayOfMonthFixed
]
timeFormatter: Zone -> Posix -> String
timeFormatter : Zone -> Posix -> String
timeFormatter =
DateFormat.format
[ DateFormat.hourMilitaryNumber
@ -34,7 +41,8 @@ timeFormatter =
, DateFormat.minuteFixed
]
isoDateTimeFormatter: Zone -> Posix -> String
isoDateTimeFormatter : Zone -> Posix -> String
isoDateTimeFormatter =
DateFormat.format
[ DateFormat.yearNumber
@ -51,37 +59,49 @@ isoDateTimeFormatter =
]
timeZone: Zone
timeZone : Zone
timeZone =
utc
{- Format millis into "Wed, 10. Jan 2018, 18:57"
-}
formatDateTime: Int -> String
formatDateTime millis =
(formatDate millis) ++ ", " ++ (formatTime millis)
formatIsoDateTime: Int -> String
{- Format millis into "Wed, 10. Jan 2018, 18:57" -}
formatDateTime : Int -> String
formatDateTime millis =
formatDate millis ++ ", " ++ formatTime millis
formatIsoDateTime : Int -> String
formatIsoDateTime millis =
Time.millisToPosix millis
|> isoDateTimeFormatter timeZone
{- Format millis into "18:57". The current time (not the duration of
the millis).
-}
formatTime: Int -> String
formatTime : Int -> String
formatTime millis =
Time.millisToPosix millis
|> timeFormatter timeZone
{- Format millis into "Wed, 10. Jan 2018"
-}
formatDate: Int -> String
{- Format millis into "Wed, 10. Jan 2018" -}
formatDate : Int -> String
formatDate millis =
Time.millisToPosix millis
|> dateFormatter timeZone
formatDateShort: Int -> String
formatDateShort : Int -> String
formatDateShort millis =
Time.millisToPosix millis
|> dateFormatterShort timeZone

17
modules/webapp/src/main/elm/Util/Update.elm
View File

@ -1,15 +1,18 @@
module Util.Update exposing (..)
module Util.Update exposing (andThen1)
andThen1: List (a -> (a, Cmd b)) -> a -> (a, Cmd b)
andThen1 : List (a -> ( a, Cmd b )) -> a -> ( a, Cmd b )
andThen1 fs a =
let
init = (a, [])
init =
( a, [] )
update el tuple =
let
(a2, c2) = el (Tuple.first tuple)
( a2, c2 ) =
el (Tuple.first tuple)
in
(a2, c2 :: (Tuple.second tuple))
( a2, c2 :: Tuple.second tuple )
in
List.foldl update init fs
|> Tuple.mapSecond Cmd.batch
List.foldl update init fs
|> Tuple.mapSecond Cmd.batch

7
modules/webapp/src/main/webjar/docspell.js
View File

@ -5,13 +5,6 @@ var elmApp = Elm.Main.init({
flags: elmFlags
});
elmApp.ports.initElements.subscribe(function() {
// console.log("Initialsing elements …");
// $('.ui.dropdown').dropdown();
// $('.ui.checkbox').checkbox();
// $('.ui.accordion').accordion();
});
elmApp.ports.setAccount.subscribe(function(authResult) {
console.log("Add account from local storage");
localStorage.setItem("account", JSON.stringify(authResult));