TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-03-28 09:45:07 +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", "type": "application",
"source-directories": [ "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", "elm-version": "0.19.1",
"dependencies": { "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.AuthResult exposing (AuthResult)
import Api.Model.BasicResult exposing (BasicResult) import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Collective exposing (Collective) 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.UserList exposing (UserList)
import Api.Model.UserPass exposing (UserPass) import Api.Model.UserPass exposing (UserPass)
import Api.Model.VersionInfo exposing (VersionInfo) 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 = upload flags sourceId meta files receive =
let let
metaStr = JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta) metaStr =
JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta)
mkReq file = mkReq file =
let let
fid = Util.File.makeFileId file fid =
path = Maybe.map ((++) "/api/v1/open/upload/item/") sourceId Util.File.makeFileId file
|> 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 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 = uploadSingle flags sourceId meta track files receive =
let let
metaStr = JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta) metaStr =
fileParts = List.map (\f -> Http.filePart "file[]" f) files JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta)
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 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 = register flags reg receive =
Http.post Http.post
{ url = flags.config.baseUrl ++ "/api/v1/open/signup/register" { 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 , 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 = newInvite flags req receive =
Http.post Http.post
{ url = flags.config.baseUrl ++ "/api/v1/open/signup/newinvite" { 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 , 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 = login flags up receive =
Http.post Http.post
{ url = flags.config.baseUrl ++ "/api/v1/open/auth/login" { 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 , 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 = logout flags receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/auth/logout" { url = flags.config.baseUrl ++ "/api/v1/sec/auth/logout"
@ -113,7 +187,8 @@ logout flags receive =
, expect = Http.expectWhatever 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 = loginSession flags receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/auth/session" { url = flags.config.baseUrl ++ "/api/v1/sec/auth/session"
@ -122,28 +197,34 @@ loginSession flags receive =
, expect = Http.expectJson receive Api.Model.AuthResult.decoder , 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 = versionInfo flags receive =
Http.get Http.get
{ url = flags.config.baseUrl ++ "/api/info/version" { url = flags.config.baseUrl ++ "/api/info/version"
, expect = Http.expectJson receive Api.Model.VersionInfo.decoder , 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 = refreshSession flags receive =
case flags.account of case flags.account of
Just acc -> Just acc ->
if acc.success && acc.validMs > 30000 if acc.success && acc.validMs > 30000 then
then
let let
delay = Debug.log "Refresh session in " (acc.validMs - 30000) |> toFloat delay =
acc.validMs - 30000 |> toFloat
in in
Http2.executeIn delay receive (refreshSessionTask flags) Http2.executeIn delay receive (refreshSessionTask flags)
else Cmd.none
else
Cmd.none
Nothing -> Nothing ->
Cmd.none Cmd.none
refreshSessionTask: Flags -> Task.Task Http.Error AuthResult
refreshSessionTask : Flags -> Task.Task Http.Error AuthResult
refreshSessionTask flags = refreshSessionTask flags =
Http2.authTask Http2.authTask
{ url = flags.config.baseUrl ++ "/api/v1/sec/auth/session" { 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 = getInsights flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/collective/insights" { url = flags.config.baseUrl ++ "/api/v1/sec/collective/insights"
@ -164,7 +245,8 @@ getInsights flags receive =
, expect = Http.expectJson receive Api.Model.ItemInsights.decoder , 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 = getCollective flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/collective" { url = flags.config.baseUrl ++ "/api/v1/sec/collective"
@ -172,7 +254,8 @@ getCollective flags receive =
, expect = Http.expectJson receive Api.Model.Collective.decoder , 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 = getCollectiveSettings flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/collective/settings" { url = flags.config.baseUrl ++ "/api/v1/sec/collective/settings"
@ -180,7 +263,8 @@ getCollectiveSettings flags receive =
, expect = Http.expectJson receive Api.Model.CollectiveSettings.decoder , 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 = setCollectiveSettings flags settings receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/collective/settings" { 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 , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
-- Tags -- Tags
getTags: Flags -> ((Result Http.Error TagList) -> msg) -> Cmd msg
getTags : Flags -> (Result Http.Error TagList -> msg) -> Cmd msg
getTags flags receive = getTags flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/tag" { url = flags.config.baseUrl ++ "/api/v1/sec/tag"
@ -199,7 +286,8 @@ getTags flags receive =
, expect = Http.expectJson receive Api.Model.TagList.decoder , 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 = postTag flags tag receive =
let let
params = params =
@ -209,10 +297,14 @@ postTag flags tag receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
in in
if tag.id == "" then Http2.authPost params if tag.id == "" then
else Http2.authPut params 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 = deleteTag flags tag receive =
Http2.authDelete Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/tag/" ++ tag { 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 , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
-- Equipments -- Equipments
getEquipments: Flags -> ((Result Http.Error EquipmentList) -> msg) -> Cmd msg
getEquipments : Flags -> (Result Http.Error EquipmentList -> msg) -> Cmd msg
getEquipments flags receive = getEquipments flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/equipment" { url = flags.config.baseUrl ++ "/api/v1/sec/equipment"
@ -230,7 +325,8 @@ getEquipments flags receive =
, expect = Http.expectJson receive Api.Model.EquipmentList.decoder , 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 = postEquipment flags equip receive =
let let
params = params =
@ -240,10 +336,14 @@ postEquipment flags equip receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
in in
if equip.id == "" then Http2.authPost params if equip.id == "" then
else Http2.authPut params 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 = deleteEquip flags equip receive =
Http2.authDelete Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/equipment/" ++ equip { url = flags.config.baseUrl ++ "/api/v1/sec/equipment/" ++ equip
@ -252,9 +352,11 @@ deleteEquip flags equip receive =
} }
-- Organization -- Organization
getOrgLight: Flags -> ((Result Http.Error ReferenceList) -> msg) -> Cmd msg
getOrgLight : Flags -> (Result Http.Error ReferenceList -> msg) -> Cmd msg
getOrgLight flags receive = getOrgLight flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/organization" { url = flags.config.baseUrl ++ "/api/v1/sec/organization"
@ -262,7 +364,8 @@ getOrgLight flags receive =
, expect = Http.expectJson receive Api.Model.ReferenceList.decoder , 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 = getOrganizations flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/organization?full=true" { 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 , 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 = postOrg flags org receive =
let let
params = params =
@ -280,10 +384,14 @@ postOrg flags org receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
in in
if org.id == "" then Http2.authPost params if org.id == "" then
else Http2.authPut params 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 = deleteOrg flags org receive =
Http2.authDelete Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/organization/" ++ org { url = flags.config.baseUrl ++ "/api/v1/sec/organization/" ++ org
@ -292,10 +400,11 @@ deleteOrg flags org receive =
} }
-- Person -- Person
getPersonsLight: Flags -> ((Result Http.Error ReferenceList) -> msg) -> Cmd msg getPersonsLight : Flags -> (Result Http.Error ReferenceList -> msg) -> Cmd msg
getPersonsLight flags receive = getPersonsLight flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/person?full=false" { 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 , 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 = getPersons flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/person?full=true" { 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 , 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 = postPerson flags person receive =
let let
params = params =
@ -321,10 +432,14 @@ postPerson flags person receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
in in
if person.id == "" then Http2.authPost params if person.id == "" then
else Http2.authPut params 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 = deletePerson flags person receive =
Http2.authDelete Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/person/" ++ person { 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 , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
--- Sources --- Sources
getSources: Flags -> ((Result Http.Error SourceList) -> msg) -> Cmd msg
getSources : Flags -> (Result Http.Error SourceList -> msg) -> Cmd msg
getSources flags receive = getSources flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/source" { url = flags.config.baseUrl ++ "/api/v1/sec/source"
@ -342,7 +460,8 @@ getSources flags receive =
, expect = Http.expectJson receive Api.Model.SourceList.decoder , 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 = postSource flags source receive =
let let
params = params =
@ -352,10 +471,14 @@ postSource flags source receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
in in
if source.id == "" then Http2.authPost params if source.id == "" then
else Http2.authPut params 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 = deleteSource flags src receive =
Http2.authDelete Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/source/" ++ src { 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 , expect = Http.expectJson receive Api.Model.BasicResult.decoder
} }
-- Users -- Users
getUsers: Flags -> ((Result Http.Error UserList) -> msg) -> Cmd msg
getUsers : Flags -> (Result Http.Error UserList -> msg) -> Cmd msg
getUsers flags receive = getUsers flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/user" { url = flags.config.baseUrl ++ "/api/v1/sec/user"
@ -373,16 +499,18 @@ getUsers flags receive =
, expect = Http.expectJson receive Api.Model.UserList.decoder , 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 = postNewUser flags user receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/user" { url = flags.config.baseUrl ++ "/api/v1/sec/user"
, account = getAccount flags , account = getAccount flags
, body = Http.jsonBody (Api.Model.User.encode user) , body = Http.jsonBody (Api.Model.User.encode user)
, expect = Http.expectJson receive Api.Model.BasicResult.decoder , 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 = putUser flags user receive =
Http2.authPut Http2.authPut
{ url = flags.config.baseUrl ++ "/api/v1/sec/user" { url = flags.config.baseUrl ++ "/api/v1/sec/user"
@ -391,7 +519,8 @@ putUser flags user receive =
, expect = Http.expectJson receive Api.Model.BasicResult.decoder , 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 = changePassword flags cp receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/user/changePassword" { 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 , 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 = deleteUser flags user receive =
Http2.authDelete Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/user/" ++ user { url = flags.config.baseUrl ++ "/api/v1/sec/user/" ++ user
@ -409,9 +539,11 @@ deleteUser flags user receive =
} }
-- Job Queue -- 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 = cancelJob flags jobid receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/queue/" ++ jobid ++ "/cancel" { 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 , 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 = getJobQueueState flags receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/queue/state" { 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 = getJobQueueStateIn flags delay receive =
case flags.account of case flags.account of
Just acc -> Just acc ->
if acc.success && delay > 100 if acc.success && delay > 100 then
then Http2.executeIn delay receive (getJobQueueStateTask flags)
let
_ = Debug.log "Refresh job qeue state in " delay else
in Cmd.none
Http2.executeIn delay receive (getJobQueueStateTask flags)
else Cmd.none
Nothing -> Nothing ->
Cmd.none Cmd.none
getJobQueueStateTask: Flags -> Task.Task Http.Error JobQueueState
getJobQueueStateTask : Flags -> Task.Task Http.Error JobQueueState
getJobQueueStateTask flags = getJobQueueStateTask flags =
Http2.authTask Http2.authTask
{ url = flags.config.baseUrl ++ "/api/v1/sec/queue/state" { url = flags.config.baseUrl ++ "/api/v1/sec/queue/state"
@ -455,9 +588,12 @@ getJobQueueStateTask flags =
, timeout = Nothing , timeout = Nothing
} }
-- Item -- 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 = itemSearch flags search receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/search" { 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 , 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 = itemDetail flags id receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ id { 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 , 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 = setTags flags item tags receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/tags" { 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 , 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 = setDirection flags item dir receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/direction" { 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 , 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 = setCorrOrg flags item id receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/corrOrg" { 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 , 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 = setCorrPerson flags item id receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/corrPerson" { 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 , 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 = setConcPerson flags item id receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/concPerson" { 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 , 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 = setConcEquip flags item id receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/concEquipment" { 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 , 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 = setItemName flags item text receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/name" { 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 , 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 = setItemNotes flags item text receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/notes" { 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 , 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 = setItemDate flags item date receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/date" { 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 , 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 = setItemDueDate flags item date receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/duedate" { 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 , 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 = setConfirmed flags item receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/confirm" { 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 , 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 = setUnconfirmed flags item receive =
Http2.authPost Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/unconfirm" { 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 , 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 = deleteItem flags item receive =
Http2.authDelete Http2.authDelete
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item { 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 , 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 = getItemProposals flags item receive =
Http2.authGet Http2.authGet
{ url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/proposals" { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/proposals"
@ -599,8 +750,10 @@ getItemProposals flags item receive =
} }
-- Helper -- Helper
getAccount: Flags -> AuthResult
getAccount : Flags -> AuthResult
getAccount flags = getAccount flags =
Maybe.withDefault Api.Model.AuthResult.empty flags.account 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 exposing (UrlRequest)
import Browser.Navigation exposing (Key) import Browser.Navigation exposing (Key)
import Url exposing (Url)
import Http
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Api.Model.VersionInfo exposing (VersionInfo) import Http
import Api.Model.AuthResult exposing (AuthResult)
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.CollectiveSettings.Data
import Page.Home.Data import Page.Home.Data
import Page.Login.Data import Page.Login.Data
import Page.ManageData.Data import Page.ManageData.Data
import Page.CollectiveSettings.Data import Page.NewInvite.Data
import Page.UserSettings.Data
import Page.Queue.Data import Page.Queue.Data
import Page.Register.Data import Page.Register.Data
import Page.Upload.Data import Page.Upload.Data
import Page.NewInvite.Data import Page.UserSettings.Data
import Url exposing (Url)
type alias Model = type alias Model =
{ flags: Flags { flags : Flags
, key: Key , key : Key
, page: Page , page : Page
, version: VersionInfo , version : VersionInfo
, homeModel: Page.Home.Data.Model , homeModel : Page.Home.Data.Model
, loginModel: Page.Login.Data.Model , loginModel : Page.Login.Data.Model
, manageDataModel: Page.ManageData.Data.Model , manageDataModel : Page.ManageData.Data.Model
, collSettingsModel: Page.CollectiveSettings.Data.Model , collSettingsModel : Page.CollectiveSettings.Data.Model
, userSettingsModel: Page.UserSettings.Data.Model , userSettingsModel : Page.UserSettings.Data.Model
, queueModel: Page.Queue.Data.Model , queueModel : Page.Queue.Data.Model
, registerModel: Page.Register.Data.Model , registerModel : Page.Register.Data.Model
, uploadModel: Page.Upload.Data.Model , uploadModel : Page.Upload.Data.Model
, newInviteModel: Page.NewInvite.Data.Model , newInviteModel : Page.NewInvite.Data.Model
, navMenuOpen: Bool , navMenuOpen : Bool
, subs: Sub Msg , subs : Sub Msg
} }
init: Key -> Url -> Flags -> Model
init : Key -> Url -> Flags -> Model
init key url flags = init key url flags =
let let
page = Page.fromUrl url page =
|> Maybe.withDefault (defaultPage flags) Page.fromUrl url
|> Maybe.withDefault (defaultPage flags)
in in
{ flags = flags { flags = flags
, key = key , key = key
, page = page , page = page
, version = Api.Model.VersionInfo.empty , version = Api.Model.VersionInfo.empty
, homeModel = Page.Home.Data.emptyModel , homeModel = Page.Home.Data.emptyModel
, loginModel = Page.Login.Data.emptyModel , loginModel = Page.Login.Data.emptyModel
, manageDataModel = Page.ManageData.Data.emptyModel , manageDataModel = Page.ManageData.Data.emptyModel
, collSettingsModel = Page.CollectiveSettings.Data.emptyModel , collSettingsModel = Page.CollectiveSettings.Data.emptyModel
, userSettingsModel = Page.UserSettings.Data.emptyModel , userSettingsModel = Page.UserSettings.Data.emptyModel
, queueModel = Page.Queue.Data.emptyModel , queueModel = Page.Queue.Data.emptyModel
, registerModel = Page.Register.Data.emptyModel , registerModel = Page.Register.Data.emptyModel
, uploadModel = Page.Upload.Data.emptyModel , uploadModel = Page.Upload.Data.emptyModel
, newInviteModel = Page.NewInvite.Data.emptyModel , newInviteModel = Page.NewInvite.Data.emptyModel
, navMenuOpen = False , navMenuOpen = False
, subs = Sub.none , subs = Sub.none
} }
type Msg type Msg
= NavRequest UrlRequest = NavRequest UrlRequest
@ -77,18 +87,30 @@ type Msg
| SessionCheckResp (Result Http.Error AuthResult) | SessionCheckResp (Result Http.Error AuthResult)
| ToggleNavMenu | ToggleNavMenu
isSignedIn: Flags -> Bool
isSignedIn : Flags -> Bool
isSignedIn flags = isSignedIn flags =
flags.account flags.account
|> Maybe.map .success |> Maybe.map .success
|> Maybe.withDefault False |> 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 = 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 Api
import Ports import App.Data exposing (..)
import Browser exposing (UrlRequest(..)) import Browser exposing (UrlRequest(..))
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Url
import Data.Flags import Data.Flags
import App.Data exposing (..)
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.CollectiveSettings.Data
import Page.CollectiveSettings.Update
import Page.Home.Data import Page.Home.Data
import Page.Home.Update import Page.Home.Update
import Page.Login.Data import Page.Login.Data
import Page.Login.Update import Page.Login.Update
import Page.ManageData.Data import Page.ManageData.Data
import Page.ManageData.Update import Page.ManageData.Update
import Page.CollectiveSettings.Data import Page.NewInvite.Data
import Page.CollectiveSettings.Update import Page.NewInvite.Update
import Page.UserSettings.Data
import Page.UserSettings.Update
import Page.Queue.Data import Page.Queue.Data
import Page.Queue.Update import Page.Queue.Update
import Page.Register.Data import Page.Register.Data
import Page.Register.Update import Page.Register.Update
import Page.Upload.Data import Page.Upload.Data
import Page.Upload.Update import Page.Upload.Update
import Page.NewInvite.Data import Page.UserSettings.Data
import Page.NewInvite.Update import Page.UserSettings.Update
import Ports
import Url
import Util.Update import Util.Update
update: Msg -> Model -> (Model, Cmd Msg)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
let let
(m, c, s) = updateWithSub msg model ( m, c, s ) =
updateWithSub msg model
in 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 case msg of
HomeMsg lm -> HomeMsg lm ->
updateHome lm model |> noSub updateHome lm model |> noSub
@ -66,49 +72,75 @@ updateWithSub msg model =
updateNewInvite m model |> noSub updateNewInvite m model |> noSub
VersionResp (Ok info) -> VersionResp (Ok info) ->
({model|version = info}, Cmd.none) |> noSub ( { model | version = info }, Cmd.none ) |> noSub
VersionResp (Err err) -> VersionResp (Err _) ->
(model, Cmd.none, Sub.none) ( model, Cmd.none, Sub.none )
Logout -> Logout ->
(model ( model
, Cmd.batch , Cmd.batch
[ Api.logout model.flags LogoutResp [ Api.logout model.flags LogoutResp
, Ports.removeAccount () , Ports.removeAccount ()
] ]
, Sub.none) , Sub.none
)
LogoutResp _ -> 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 -> SessionCheckResp res ->
case res of case res of
Ok lr -> Ok lr ->
let let
newFlags = if lr.success then Data.Flags.withAccount model.flags lr newFlags =
else Data.Flags.withoutAccount model.flags if lr.success then
command = if lr.success then Api.refreshSession newFlags SessionCheckResp Data.Flags.withAccount model.flags lr
else Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)]
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 in
({model | flags = newFlags}, command, Sub.none) ( { model | flags = newFlags }, command, Sub.none )
Err _ -> 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 -> NavRequest req ->
case req of case req of
Internal url -> Internal url ->
let let
newPage = Page.fromUrl url newPage =
Page.fromUrl url
isCurrent = isCurrent =
Page.fromUrl url |> Page.fromUrl url
Maybe.map (\p -> p == model.page) |> |> Maybe.map (\p -> p == model.page)
Maybe.withDefault True |> Maybe.withDefault True
in in
( model ( model
, if isCurrent then Cmd.none else Nav.pushUrl model.key (Url.toString url) , if isCurrent then
, Sub.none Cmd.none
)
else
Nav.pushUrl model.key (Url.toString url)
, Sub.none
)
External url -> External url ->
( model ( model
@ -118,111 +150,148 @@ updateWithSub msg model =
NavChange url -> NavChange url ->
let let
page = Page.fromUrl url page =
|> Maybe.withDefault (defaultPage model.flags) Page.fromUrl url
check = checkPage model.flags page |> Maybe.withDefault (defaultPage model.flags)
(m, c) = initPage model page
check =
checkPage model.flags page
( m, c ) =
initPage model page
in in
if check == page then ( { m | page = page }, c, Sub.none ) if check == page then
else (model, Page.goto check, Sub.none) ( { m | page = page }, c, Sub.none )
else
( model, Page.goto check, Sub.none )
ToggleNavMenu -> 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 = updateNewInvite lmsg model =
let let
(lm, lc) = Page.NewInvite.Update.update model.flags lmsg model.newInviteModel ( lm, lc ) =
Page.NewInvite.Update.update model.flags lmsg model.newInviteModel
in in
( {model | newInviteModel = lm } ( { model | newInviteModel = lm }
, Cmd.map NewInviteMsg lc , 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 = updateUpload lmsg model =
let 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 in
( { model | uploadModel = lm } ( { model | uploadModel = lm }
, Cmd.map UploadMsg lc , Cmd.map UploadMsg lc
, Sub.map UploadMsg ls , 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 = updateRegister lmsg model =
let let
(lm, lc) = Page.Register.Update.update model.flags lmsg model.registerModel ( lm, lc ) =
Page.Register.Update.update model.flags lmsg model.registerModel
in in
( { model | registerModel = lm } ( { model | registerModel = lm }
, Cmd.map RegisterMsg lc , 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 = updateQueue lmsg model =
let let
(lm, lc) = Page.Queue.Update.update model.flags lmsg model.queueModel ( lm, lc ) =
Page.Queue.Update.update model.flags lmsg model.queueModel
in in
( { model | queueModel = lm } ( { model | queueModel = lm }
, Cmd.map QueueMsg lc , 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 = updateUserSettings lmsg model =
let let
(lm, lc) = Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel ( lm, lc ) =
Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel
in in
( { model | userSettingsModel = lm } ( { model | userSettingsModel = lm }
, Cmd.map UserSettingsMsg lc , 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 = updateCollSettings lmsg model =
let let
(lm, lc) = Page.CollectiveSettings.Update.update model.flags lmsg model.collSettingsModel ( lm, lc ) =
Page.CollectiveSettings.Update.update model.flags
lmsg
model.collSettingsModel
in in
( { model | collSettingsModel = lm } ( { model | collSettingsModel = lm }
, Cmd.map CollSettingsMsg lc , 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 = updateLogin lmsg model =
let let
(lm, lc, ar) = Page.Login.Update.update (Page.loginPageReferrer model.page) model.flags lmsg model.loginModel ( lm, lc, ar ) =
newFlags = Maybe.map (Data.Flags.withAccount model.flags) ar Page.Login.Update.update (Page.loginPageReferrer model.page)
|> Maybe.withDefault model.flags model.flags
in lmsg
({model | loginModel = lm, flags = newFlags} model.loginModel
,Cmd.map LoginMsg lc
)
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 = updateHome lmsg model =
let let
(lm, lc) = Page.Home.Update.update model.flags lmsg model.homeModel ( lm, lc ) =
Page.Home.Update.update model.flags lmsg model.homeModel
in in
( {model | homeModel = lm } ( { model | homeModel = lm }
, Cmd.map HomeMsg lc , 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 = updateManageData lmsg model =
let let
(lm, lc) = Page.ManageData.Update.update model.flags lmsg model.manageDataModel ( lm, lc ) =
Page.ManageData.Update.update model.flags lmsg model.manageDataModel
in in
({ model | manageDataModel = lm } ( { model | manageDataModel = lm }
,Cmd.map ManageDataMsg lc , Cmd.map ManageDataMsg lc
) )
initPage: Model -> Page -> (Model, Cmd Msg)
initPage : Model -> Page -> ( Model, Cmd Msg )
initPage model page = initPage model page =
case page of case page of
HomePage -> HomePage ->
Util.Update.andThen1 Util.Update.andThen1
[updateHome Page.Home.Data.Init [ updateHome Page.Home.Data.Init
,updateQueue Page.Queue.Data.StopRefresh , updateQueue Page.Queue.Data.StopRefresh
] model ]
model
LoginPage _ -> LoginPage _ ->
updateQueue Page.Queue.Data.StopRefresh model updateQueue Page.Queue.Data.StopRefresh model
@ -232,9 +301,10 @@ initPage model page =
CollectiveSettingPage -> CollectiveSettingPage ->
Util.Update.andThen1 Util.Update.andThen1
[updateQueue Page.Queue.Data.StopRefresh [ updateQueue Page.Queue.Data.StopRefresh
,updateCollSettings Page.CollectiveSettings.Data.Init , updateCollSettings Page.CollectiveSettings.Data.Init
] model ]
model
UserSettingPage -> UserSettingPage ->
updateQueue Page.Queue.Data.StopRefresh model updateQueue Page.Queue.Data.StopRefresh model
@ -252,6 +322,6 @@ initPage model page =
updateQueue Page.Queue.Data.StopRefresh model updateQueue Page.Queue.Data.StopRefresh model
noSub: (Model, Cmd Msg) -> (Model, Cmd Msg, Sub Msg) noSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg )
noSub (m, c) = noSub ( m, c ) =
(m, c, Sub.none) ( m, c, Sub.none )

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

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

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

@ -1,32 +1,36 @@
module Comp.AddressForm exposing ( Model module Comp.AddressForm exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update , getAddress
, getAddress) , update
, view
)
import Api.Model.Address exposing (Address)
import Comp.Dropdown
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onInput) import Html.Events exposing (onInput)
import Data.Flags exposing (Flags)
import Api.Model.Address exposing (Address)
import Comp.Dropdown
import Util.List import Util.List
type alias Model = type alias Model =
{ address: Address { address : Address
, street: String , street : String
, zip: String , zip : String
, city: String , city : String
, country: Comp.Dropdown.Model Country , country : Comp.Dropdown.Model Country
} }
type alias Country = type alias Country =
{ code: String { code : String
, label: String , label : String
} }
countries: List Country
countries : List Country
countries = countries =
[ Country "DE" "Germany" [ Country "DE" "Germany"
, Country "CH" "Switzerland" , Country "CH" "Switzerland"
@ -35,22 +39,24 @@ countries =
, Country "AU" "Austria" , Country "AU" "Austria"
] ]
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ address = Api.Model.Address.empty { address = Api.Model.Address.empty
, street = "" , street = ""
, zip = "" , zip = ""
, city = "" , city = ""
, country = Comp.Dropdown.makeSingleList , country =
{ makeOption = \c -> { value = c.code, text = c.label } Comp.Dropdown.makeSingleList
, placeholder = "Select Country" { makeOption = \c -> { value = c.code, text = c.label }
, options = countries , placeholder = "Select Country"
, selected = Nothing , options = countries
} , selected = Nothing
}
} }
getAddress: Model -> Address getAddress : Model -> Address
getAddress model = getAddress model =
{ street = model.street { street = model.street
, zip = model.zip , zip = model.zip
@ -58,6 +64,7 @@ getAddress model =
, country = Comp.Dropdown.getSelected model.country |> List.head |> Maybe.map .code |> Maybe.withDefault "" , country = Comp.Dropdown.getSelected model.country |> List.head |> Maybe.map .code |> Maybe.withDefault ""
} }
type Msg type Msg
= SetStreet String = SetStreet String
| SetCity String | SetCity String
@ -65,65 +72,80 @@ type Msg
| SetAddress Address | SetAddress Address
| CountryMsg (Comp.Dropdown.Msg Country) | CountryMsg (Comp.Dropdown.Msg Country)
update: Msg -> Model -> (Model, Cmd Msg)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case msg of case msg of
SetAddress a -> SetAddress a ->
let let
selection = Util.List.find (\c -> c.code == a.country) countries selection =
|> Maybe.map List.singleton Util.List.find (\c -> c.code == a.country) countries
|> Maybe.withDefault [] |> Maybe.map List.singleton
(m2, c2) = Comp.Dropdown.update (Comp.Dropdown.SetSelection selection) model.country |> Maybe.withDefault []
( m2, c2 ) =
Comp.Dropdown.update (Comp.Dropdown.SetSelection selection) model.country
in 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 -> SetStreet n ->
({model | street = n}, Cmd.none) ( { model | street = n }, Cmd.none )
SetCity c -> SetCity c ->
({model | city = c }, Cmd.none) ( { model | city = c }, Cmd.none )
SetZip z -> SetZip z ->
({model | zip = z }, Cmd.none) ( { model | zip = z }, Cmd.none )
CountryMsg m -> CountryMsg m ->
let let
(m1, c1) = Comp.Dropdown.update m model.country ( m1, c1 ) =
Comp.Dropdown.update m model.country
in 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 = view model =
div [class "ui form"] div [ class "ui form" ]
[div [class "field" [ div
] [ class "field"
[label [][text "Street"] ]
,input [type_ "text" [ label [] [ text "Street" ]
,onInput SetStreet , input
,placeholder "Street" [ type_ "text"
,value model.street , onInput SetStreet
][] , placeholder "Street"
] , value model.street
,div [class "field" ]
] []
[label [][text "Zip Code"] ]
,input [type_ "text" , div
,onInput SetZip [ class "field"
,placeholder "Zip" ]
,value model.zip [ label [] [ text "Zip Code" ]
][] , input
] [ type_ "text"
,div [class "field" , onInput SetZip
] , placeholder "Zip"
[label [][text "City"] , value model.zip
,input [type_ "text" ]
,onInput SetCity []
,placeholder "City" ]
,value model.city , div
][] [ class "field"
] ]
,div [class "field"] [ label [] [ text "City" ]
[label [][text "Country"] , input
,Html.map CountryMsg (Comp.Dropdown.view model.country) [ 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 module Comp.ChangePasswordForm exposing
,emptyModel ( Model
,Msg(..) , Msg(..)
,update , emptyModel
,view , update
) , view
import Http )
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onClick)
import Api import Api
import Api.Model.PasswordChange exposing (PasswordChange)
import Util.Http
import Api.Model.BasicResult exposing (BasicResult) import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.PasswordChange exposing (PasswordChange)
import Data.Flags exposing (Flags) 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 = type alias Model =
{ current: String { current : String
, newPass1: String , newPass1 : String
, newPass2: String , newPass2 : String
, showCurrent: Bool , showCurrent : Bool
, showPass1: Bool , showPass1 : Bool
, showPass2: Bool , showPass2 : Bool
, errors: List String , errors : List String
, loading: Bool , loading : Bool
, successMsg: String , successMsg : String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
validateModel validateModel
{ current = "" { current = ""
, newPass1 = "" , newPass1 = ""
, newPass2 = "" , newPass2 = ""
, showCurrent = False , showCurrent = False
, showPass1 = False , showPass1 = False
, showPass2 = False , showPass2 = False
, errors = [] , errors = []
, loading = False , loading = False
, successMsg = "" , successMsg = ""
} }
type Msg type Msg
= SetCurrent String = SetCurrent String
@ -52,147 +56,205 @@ type Msg
| SubmitResp (Result Http.Error BasicResult) | SubmitResp (Result Http.Error BasicResult)
validate: Model -> List String validate : Model -> List String
validate model = validate model =
List.concat List.concat
[ if model.newPass1 /= "" && model.newPass2 /= "" && model.newPass1 /= model.newPass2 [ if model.newPass1 /= "" && model.newPass2 /= "" && model.newPass1 /= model.newPass2 then
then ["New passwords do not match."] [ "New passwords do not match." ]
else []
, if model.newPass1 == "" || model.newPass2 == "" || model.current == "" else
then ["Please fill in required fields."] []
else [] , if model.newPass1 == "" || model.newPass2 == "" || model.current == "" then
[ "Please fill in required fields." ]
else
[]
] ]
validateModel: Model -> Model
validateModel : Model -> Model
validateModel model = validateModel model =
let let
err = validate model err =
validate model
in in
{model | errors = err, successMsg = if err == [] then model.successMsg else "" } { model
| errors = err
, successMsg =
if err == [] then
model.successMsg
else
""
}
-- Update -- Update
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetCurrent s -> SetCurrent s ->
(validateModel {model | current = s}, Cmd.none) ( validateModel { model | current = s }, Cmd.none )
SetNew1 s -> SetNew1 s ->
(validateModel {model | newPass1 = s}, Cmd.none) ( validateModel { model | newPass1 = s }, Cmd.none )
SetNew2 s -> SetNew2 s ->
(validateModel {model | newPass2 = s}, Cmd.none) ( validateModel { model | newPass2 = s }, Cmd.none )
ToggleShowCurrent -> ToggleShowCurrent ->
({model | showCurrent = not model.showCurrent}, Cmd.none) ( { model | showCurrent = not model.showCurrent }, Cmd.none )
ToggleShowPass1 -> ToggleShowPass1 ->
({model | showPass1 = not model.showPass1}, Cmd.none) ( { model | showPass1 = not model.showPass1 }, Cmd.none )
ToggleShowPass2 -> ToggleShowPass2 ->
({model | showPass2 = not model.showPass2}, Cmd.none) ( { model | showPass2 = not model.showPass2 }, Cmd.none )
Submit -> Submit ->
let let
valid = validate model valid =
cp = PasswordChange model.current model.newPass1 validate model
cp =
PasswordChange model.current model.newPass1
in in
if List.isEmpty valid then if List.isEmpty valid then
({model | loading = True, errors = [], successMsg = ""}, Api.changePassword flags cp SubmitResp) ( { model | loading = True, errors = [], successMsg = "" }, Api.changePassword flags cp SubmitResp )
else
(model, Cmd.none) else
( model, Cmd.none )
SubmitResp (Ok res) -> SubmitResp (Ok res) ->
let let
em = { emptyModel | errors = [], successMsg = "Password has been changed."} em =
{ emptyModel | errors = [], successMsg = "Password has been changed." }
in in
if res.success then if res.success then
(em, Cmd.none) ( em, Cmd.none )
else
({model | errors = [res.message], loading = False, successMsg = ""}, Cmd.none) else
( { model | errors = [ res.message ], loading = False, successMsg = "" }, Cmd.none )
SubmitResp (Err err) -> SubmitResp (Err err) ->
let let
str = Util.Http.errorToString err str =
Util.Http.errorToString err
in in
({model | errors = [str], loading = False, successMsg = ""}, Cmd.none) ( { model | errors = [ str ], loading = False, successMsg = "" }, Cmd.none )
-- View -- View
view: Model -> Html Msg
view : Model -> Html Msg
view model = view model =
div [classList [("ui form", True) div
,("error", List.isEmpty model.errors |> not) [ classList
,("success", model.successMsg /= "") [ ( "ui form", True )
] , ( "error", List.isEmpty model.errors |> not )
] , ( "success", model.successMsg /= "" )
[div [classList [("field", True) ]
,("error", model.current == "") ]
] [ div
] [ classList
[label [][text "Current Password*"] [ ( "field", True )
,div [class "ui action input"] , ( "error", model.current == "" )
[input [type_ <| if model.showCurrent then "text" else "password" ]
,onInput SetCurrent ]
,value model.current [ label [] [ text "Current Password*" ]
][] , div [ class "ui action input" ]
,button [class "ui icon button", onClick ToggleShowCurrent] [ input
[i [class "eye icon"][] [ type_ <|
] if model.showCurrent then
] "text"
]
,div [classList [("field", True) else
,("error", model.newPass1 == "") "password"
] , onInput SetCurrent
] , value model.current
[label [][text "New Password*"] ]
,div [class "ui action input"] []
[input [type_ <| if model.showPass1 then "text" else "password" , button [ class "ui icon button", onClick ToggleShowCurrent ]
,onInput SetNew1 [ i [ class "eye icon" ] []
,value model.newPass1 ]
][] ]
,button [class "ui icon button", onClick ToggleShowPass1] ]
[i [class "eye icon"][] , div
] [ classList
] [ ( "field", True )
] , ( "error", model.newPass1 == "" )
,div [classList [("field", True) ]
,("error", model.newPass2 == "") ]
] [ label [] [ text "New Password*" ]
] , div [ class "ui action input" ]
[label [][text "New Password (repeat)*"] [ input
,div [class "ui action input"] [ type_ <|
[input [type_ <| if model.showPass2 then "text" else "password" if model.showPass1 then
,onInput SetNew2 "text"
,value model.newPass2
][] else
,button [class "ui icon button", onClick ToggleShowPass2] "password"
[i [class "eye icon"][] , onInput SetNew1
] , value model.newPass1
] ]
] []
,div [class "ui horizontal divider"][] , button [ class "ui icon button", onClick ToggleShowPass1 ]
,div [class "ui success message"] [ i [ class "eye icon" ] []
[text model.successMsg ]
] ]
,div [class "ui error message"] ]
[case model.errors of , div
a :: [] -> [ classList
text a [ ( "field", True )
_ -> , ( "error", model.newPass2 == "" )
ul [class "ui list"] ]
(List.map (\em -> li[][text em]) model.errors) ]
] [ label [] [ text "New Password (repeat)*" ]
,div [class "ui horizontal divider"][] , div [ class "ui action input" ]
,button [class "ui primary button", onClick Submit] [ input
[text "Submit" [ type_ <|
] if model.showPass2 then
,div [classList [("ui dimmer", True) "text"
,("active", model.loading)
]] else
[div [class "ui loader"][] "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 module Comp.ContactField exposing
,emptyModel ( Model
,getContacts , Msg(..)
,Msg(..) , emptyModel
,update , getContacts
,view , update
) , view
)
import Api.Model.Contact exposing (Contact)
import Comp.Dropdown
import Data.ContactType exposing (ContactType)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onClick) import Html.Events exposing (onClick, onInput)
import Api.Model.Contact exposing (Contact)
import Data.ContactType exposing (ContactType)
import Comp.Dropdown
type alias Model = type alias Model =
{ items: List Contact { items : List Contact
, kind: Comp.Dropdown.Model ContactType , kind : Comp.Dropdown.Model ContactType
, value: String , value : String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ items = [] { items = []
, kind = Comp.Dropdown.makeSingleList , kind =
{ makeOption = \ct -> { value = Data.ContactType.toString ct, text = Data.ContactType.toString ct } Comp.Dropdown.makeSingleList
, placeholder = "" { makeOption =
, options = Data.ContactType.all \ct ->
, selected = List.head Data.ContactType.all { value = Data.ContactType.toString ct
} , text = Data.ContactType.toString ct
}
, placeholder = ""
, options = Data.ContactType.all
, selected = List.head Data.ContactType.all
}
, value = "" , value = ""
} }
getContacts: Model -> List Contact
getContacts : Model -> List Contact
getContacts model = getContacts model =
List.filter (\c -> c.value /= "") model.items List.filter (\c -> c.value /= "") model.items
type Msg type Msg
= SetValue String = SetValue String
| TypeMsg (Comp.Dropdown.Msg ContactType) | TypeMsg (Comp.Dropdown.Msg ContactType)
@ -42,76 +52,89 @@ type Msg
| Select Contact | Select Contact
| SetItems (List Contact) | SetItems (List Contact)
update: Msg -> Model -> (Model, Cmd Msg)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case msg of case msg of
SetItems contacts -> SetItems contacts ->
({model | items = contacts, value = "" }, Cmd.none) ( { model | items = contacts, value = "" }, Cmd.none )
SetValue v -> SetValue v ->
({model | value = v}, Cmd.none) ( { model | value = v }, Cmd.none )
TypeMsg m -> TypeMsg m ->
let let
(m1, c1) = Comp.Dropdown.update m model.kind ( m1, c1 ) =
Comp.Dropdown.update m model.kind
in in
({model|kind = m1}, Cmd.map TypeMsg c1) ( { model | kind = m1 }, Cmd.map TypeMsg c1 )
AddContact -> AddContact ->
if model.value == "" then (model, Cmd.none) if model.value == "" then
( model, Cmd.none )
else else
let let
kind = Comp.Dropdown.getSelected model.kind kind =
|> List.head Comp.Dropdown.getSelected model.kind
|> Maybe.map Data.ContactType.toString |> List.head
|> Maybe.withDefault "" |> Maybe.map Data.ContactType.toString
|> Maybe.withDefault ""
in 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 -> Select contact ->
let let
newItems = List.filter (\c -> c /= contact) model.items newItems =
(m1, c1) = Data.ContactType.fromString contact.kind List.filter (\c -> c /= contact) model.items
|> 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 ( 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 = view model =
div [] div []
[div [class "fields"] [ div [ class "fields" ]
[div [class "four wide field"] [ div [ class "four wide field" ]
[Html.map TypeMsg (Comp.Dropdown.view model.kind) [ Html.map TypeMsg (Comp.Dropdown.view model.kind)
] ]
,div [class "twelve wide field"] , div [ class "twelve wide field" ]
[div [class "ui action input"] [ div [ class "ui action input" ]
[input [type_ "text" [ input
,onInput SetValue [ type_ "text"
,value model.value , onInput SetValue
][] , value model.value
,a [class "ui button", onClick AddContact, href ""]
[text "Add"
]
]
]
]
,div [classList [("field", True)
,("invisible", List.isEmpty model.items)
] ]
] []
[div [class "ui vertical secondary fluid menu"] , a [ class "ui button", onClick AddContact, href "" ]
(List.map renderItem model.items) [ text "Add"
] ]
] ]
]
]
renderItem: Contact -> Html Msg , div
renderItem contact = [ classList
div [class "link item", onClick (Select contact) ] [ ( "field", True )
[i [class "delete icon"][] , ( "invisible", List.isEmpty model.items )
,div [class "ui blue label"] ]
[text contact.kind ]
[ 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 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 = init =
DatePicker.init DatePicker.init
emptyModel: DatePicker
emptyModel : DatePicker
emptyModel = emptyModel =
DatePicker.initFromDate (Date.fromCalendarDate 2019 Aug 21) DatePicker.initFromDate (Date.fromCalendarDate 2019 Aug 21)
defaultSettings: Settings
defaultSettings : Settings
defaultSettings = defaultSettings =
let let
ds = DatePicker.defaultSettings ds =
DatePicker.defaultSettings
in 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 = update settings msg model =
DatePicker.update settings msg model DatePicker.update settings msg model
updateDefault: Msg -> DatePicker -> (DatePicker, DateEvent)
updateDefault : Msg -> DatePicker -> ( DatePicker, DateEvent )
updateDefault msg model = updateDefault msg model =
DatePicker.update defaultSettings msg model DatePicker.update defaultSettings msg model
view : Maybe Date -> Settings -> DatePicker -> Html Msg view : Maybe Date -> Settings -> DatePicker -> Html Msg
view md settings model = view md settings model =
DatePicker.view md settings model DatePicker.view md settings model
viewTime : Maybe Int -> Settings -> DatePicker -> Html Msg viewTime : Maybe Int -> Settings -> DatePicker -> Html Msg
viewTime md settings model = viewTime md settings model =
let let
date = Maybe.map Time.millisToPosix md date =
Maybe.map Time.millisToPosix md
|> Maybe.map (Date.fromPosix Time.utc) |> Maybe.map (Date.fromPosix Time.utc)
in in
view date settings model view date settings model
viewTimeDefault: Maybe Int -> DatePicker -> Html Msg
viewTimeDefault : Maybe Int -> DatePicker -> Html Msg
viewTimeDefault md model = viewTimeDefault md model =
viewTime md defaultSettings model viewTime md defaultSettings model
startOfDay: Date -> Int startOfDay : Date -> Int
startOfDay date = startOfDay date =
let let
unix0 = Date.fromPosix Time.utc (Time.millisToPosix 0) unix0 =
days = Date.diff Date.Days unix0 date Date.fromPosix Time.utc (Time.millisToPosix 0)
days =
Date.diff Date.Days unix0 date
in in
days * 24 * 60 * 60 * 1000 days * 24 * 60 * 60 * 1000
endOfDay: Date -> Int
endOfDay : Date -> Int
endOfDay date = endOfDay date =
(startOfDay date) + ((24 * 60) - 1) * 60 * 1000 startOfDay date + ((24 * 60) - 1) * 60 * 1000
midOfDay: Date -> Int
midOfDay : Date -> Int
midOfDay date = 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 module Comp.Dropdown exposing
, Option ( Model
, makeModel , Msg(..)
, makeSingle , Option
, makeSingleList , getSelected
, makeMultiple , isDropdownChangeMsg
, update , makeModel
, isDropdownChangeMsg , makeMultiple
, view , makeSingle
, getSelected , makeSingleList
, Msg(..)) , update
, view
)
import Http
import Task
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onClick, onFocus, onBlur) import Html.Events exposing (onClick, onInput)
import Json.Decode as Decode
import Simple.Fuzzy import Simple.Fuzzy
import Util.Html exposing (onKeyUp) import Util.Html exposing (onKeyUp)
import Util.List import Util.List
type alias Option = type alias Option =
{ value: String { value : String
, text: String , text : String
} }
type alias Item a = type alias Item a =
{ value: a { value : a
, option: Option , option : Option
, visible: Bool , visible : Bool
, selected: Bool , selected : Bool
, active: Bool , active : Bool
} }
makeItem: Model a -> a -> Item a
makeItem : Model a -> a -> Item a
makeItem model val = makeItem model val =
{ value = val { value = val
, option = model.makeOption val , option = model.makeOption val
@ -42,25 +44,28 @@ makeItem model val =
, active = False , active = False
} }
type alias Model a = type alias Model a =
{ multiple: Bool { multiple : Bool
, selected: List (Item a) , selected : List (Item a)
, available: List (Item a) , available : List (Item a)
, makeOption: a -> Option , makeOption : a -> Option
, menuOpen: Bool , menuOpen : Bool
, filterString: String , filterString : String
, labelColor: a -> String , labelColor : a -> String
, searchable: Int -> Bool , searchable : Int -> Bool
, placeholder: String , placeholder : String
} }
makeModel:
{ multiple: Bool makeModel :
, searchable: Int -> Bool { multiple : Bool
, makeOption: a -> Option , searchable : Int -> Bool
, labelColor: a -> String , makeOption : a -> Option
, placeholder: String , labelColor : a -> String
} -> Model a , placeholder : String
}
-> Model a
makeModel input = makeModel input =
{ multiple = input.multiple { multiple = input.multiple
, searchable = input.searchable , searchable = input.searchable
@ -73,10 +78,12 @@ makeModel input =
, placeholder = input.placeholder , placeholder = input.placeholder
} }
makeSingle:
{ makeOption: a -> Option makeSingle :
, placeholder: String { makeOption : a -> Option
} -> Model a , placeholder : String
}
-> Model a
makeSingle opts = makeSingle opts =
makeModel makeModel
{ multiple = False { multiple = False
@ -86,26 +93,35 @@ makeSingle opts =
, placeholder = opts.placeholder , placeholder = opts.placeholder
} }
makeSingleList:
{ makeOption: a -> Option makeSingleList :
, placeholder: String { makeOption : a -> Option
, options: List a , placeholder : String
, selected: Maybe a , options : List a
} -> Model a , selected : Maybe a
}
-> Model a
makeSingleList opts = makeSingleList opts =
let let
m = makeSingle {makeOption = opts.makeOption, placeholder = opts.placeholder} m =
m2 = {m | available = List.map (makeItem m) opts.options} makeSingle { makeOption = opts.makeOption, placeholder = opts.placeholder }
m3 = Maybe.map (makeItem m2) opts.selected
|> Maybe.map (selectItem m2)
|> Maybe.withDefault m2
in
m3
makeMultiple: m2 =
{ makeOption: a -> Option { m | available = List.map (makeItem m) opts.options }
, labelColor: a -> String
} -> Model a 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 = makeMultiple opts =
makeModel makeModel
{ multiple = True { multiple = True
@ -115,10 +131,12 @@ makeMultiple opts =
, placeholder = "" , placeholder = ""
} }
getSelected: Model a -> List a
getSelected : Model a -> List a
getSelected model = getSelected model =
List.map .value model.selected List.map .value model.selected
type Msg a type Msg a
= SetOptions (List a) = SetOptions (List a)
| SetSelection (List a) | SetSelection (List a)
@ -129,265 +147,367 @@ type Msg a
| ShowMenu Bool | ShowMenu Bool
| KeyPress Int | 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 = isSearchable model =
List.length model.available |> model.searchable List.length model.available |> model.searchable
-- Update -- Update
deselectItem: Model a -> Item a -> Model a
deselectItem : Model a -> Item a -> Model a
deselectItem model item = deselectItem model item =
let let
value = item.option.value value =
sel = if model.multiple then List.filter (\e -> e.option.value /= value) model.selected item.option.value
else []
show e = if e.option.value == value then {e | selected = False } else e sel =
avail = List.map show model.available 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 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 = selectItem model item =
let let
value = item.option.value value =
sel = if model.multiple item.option.value
then List.concat [ model.selected, [ item ] ]
else [ item ]
hide e = if e.option.value == value sel =
then {e | selected = True } if model.multiple then
else if model.multiple then e else {e | selected = False} List.concat [ model.selected, [ item ] ]
avail = List.map hide model.available
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 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 = 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 = applyFilter str model =
{ model | filterString = str, available = filterOptions str model.available } { 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 = makeNextActive nextEl model =
let let
opts = getOptions model opts =
current = Util.List.findIndexed .active opts getOptions model
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 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 = selectActive model =
let let
current = getOptions model |> Util.List.find .active current =
getOptions model |> Util.List.find .active
in in
case current of case current of
Just item -> Just item ->
selectItem model item |> applyFilter "" selectItem model item |> applyFilter ""
Nothing ->
model
clearActive: Model a -> Model a Nothing ->
model
clearActive : Model a -> Model a
clearActive model = 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 -- TODO enhance update function to return this info
isDropdownChangeMsg: Msg a -> Bool
isDropdownChangeMsg : Msg a -> Bool
isDropdownChangeMsg cm = isDropdownChangeMsg cm =
case cm of case cm of
AddItem _ -> True AddItem _ ->
RemoveItem _ -> True True
RemoveItem _ ->
True
KeyPress code -> KeyPress code ->
Util.Html.intToKeyCode code Util.Html.intToKeyCode code
|> Maybe.map (\c -> c == Util.Html.Enter) |> Maybe.map (\c -> c == Util.Html.Enter)
|> Maybe.withDefault False |> Maybe.withDefault False
_ -> 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 = update msg model =
case msg of case msg of
SetOptions list -> SetOptions list ->
({model | available = List.map (makeItem model) list}, Cmd.none) ( { model | available = List.map (makeItem model) list }, Cmd.none )
SetSelection list -> SetSelection list ->
let let
m0 = List.foldl (\item -> \m -> deselectItem m item) model model.selected m0 =
m1 = List.map (makeItem model) list List.foldl (\item -> \m -> deselectItem m item) model model.selected
|> List.foldl (\item -> \m -> selectItem m item) m0
m1 =
List.map (makeItem model) list
|> List.foldl (\item -> \m -> selectItem m item) m0
in in
(m1, Cmd.none) ( m1, Cmd.none )
ToggleMenu -> ToggleMenu ->
({model | menuOpen = not model.menuOpen}, Cmd.none) ( { model | menuOpen = not model.menuOpen }, Cmd.none )
AddItem e -> AddItem e ->
let let
m = selectItem model e |> applyFilter "" m =
selectItem model e |> applyFilter ""
in in
({ m | menuOpen = False }, Cmd.none) ( { m | menuOpen = False }, Cmd.none )
RemoveItem e -> RemoveItem e ->
let let
m = deselectItem model e |> applyFilter "" m =
deselectItem model e |> applyFilter ""
in in
({ m | menuOpen = False }, Cmd.none) ( { m | menuOpen = False }, Cmd.none )
Filter str -> Filter str ->
let let
m = applyFilter str model m =
applyFilter str model
in in
({ m | menuOpen = True}, Cmd.none) ( { m | menuOpen = True }, Cmd.none )
ShowMenu flag -> ShowMenu flag ->
({ model | menuOpen = flag }, Cmd.none) ( { model | menuOpen = flag }, Cmd.none )
KeyPress code -> KeyPress code ->
case Util.Html.intToKeyCode code of case Util.Html.intToKeyCode code of
Just Util.Html.Up -> Just Util.Html.Up ->
(makeNextActive (\n -> n - 1) model, Cmd.none) ( makeNextActive (\n -> n - 1) model, Cmd.none )
Just Util.Html.Down -> Just Util.Html.Down ->
(makeNextActive ((+) 1) model, Cmd.none) ( makeNextActive ((+) 1) model, Cmd.none )
Just Util.Html.Enter -> Just Util.Html.Enter ->
let let
m = selectActive model m =
selectActive model
in in
({m | menuOpen = False }, Cmd.none) ( { m | menuOpen = False }, Cmd.none )
_ -> _ ->
(model, Cmd.none) ( model, Cmd.none )
-- View -- View
view: Model a -> Html (Msg a)
view : Model a -> Html (Msg a)
view model = 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 = viewSingle model =
let let
renderClosed item = renderClosed item =
div [class "message" div
,style "display" "inline-block !important" [ class "message"
,onClick ToggleMenu , style "display" "inline-block !important"
, onClick ToggleMenu
] ]
[i [class "delete icon", onClick (RemoveItem item)][] [ i [ class "delete icon", onClick (RemoveItem item) ] []
,text item.option.text , text item.option.text
] ]
renderDefault = renderDefault =
[ List.head model.selected |> Maybe.map renderClosed |> Maybe.withDefault (renderPlaceholder model) [ List.head model.selected |> Maybe.map renderClosed |> Maybe.withDefault (renderPlaceholder model)
, renderMenu model , renderMenu model
] ]
openSearch = 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…" , placeholder "Search…"
, onInput Filter , onInput Filter
, onKeyUp KeyPress , onKeyUp KeyPress
, value model.filterString , 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 = renderMenu model =
div [classList [( "menu", True ) div
,( "transition visible", model.menuOpen ) [ classList
] [ ( "menu", True )
] (getOptions model |> List.map renderOption) , ( "transition visible", model.menuOpen )
]
]
(getOptions model |> List.map renderOption)
renderPlaceholder : Model a -> Html (Msg a)
renderPlaceholder: Model a -> Html (Msg a)
renderPlaceholder model = renderPlaceholder model =
div [classList [ ("placeholder-message", True) div
, ("text", model.multiple) [ classList
] [ ( "placeholder-message", True )
,style "display" "inline-block !important" , ( "text", model.multiple )
,onClick ToggleMenu ]
, 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 = renderOption item =
div [classList [ ("item", True) div
, ("active", item.active || item.selected) [ classList
] [ ( "item", True )
,onClick (AddItem item) , ( "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 -- inspired from here: https://ellie-app.com/3T5mNms7SwKa1
module Comp.Dropzone exposing ( view
, Settings
, defaultSettings module Comp.Dropzone exposing
, update ( Model
, setActive , Msg(..)
, Model , Settings
, init , defaultSettings
, Msg(..) , init
) , setActive
, update
, view
)
import File exposing (File) import File exposing (File)
import File.Select import File.Select
import Json.Decode as D
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Json.Decode as D
type alias State = type alias State =
{ hover: Bool { hover : Bool
, active: Bool , active : Bool
} }
type alias Settings = type alias Settings =
{ classList: State -> List (String, Bool) { classList : State -> List ( String, Bool )
, contentTypes: List String , contentTypes : List String
} }
defaultSettings: Settings
defaultSettings : Settings
defaultSettings = defaultSettings =
{ classList = \m -> [("ui placeholder segment", True)] { classList = \_ -> [ ( "ui placeholder segment", True ) ]
, contentTypes = [ "application/pdf" ] , contentTypes = [ "application/pdf" ]
} }
type alias Model = type alias Model =
{ state: State { state : State
, settings: Settings , settings : Settings
} }
init: Settings -> Model
init : Settings -> Model
init settings = init settings =
{ state = State False True { state = State False True
, settings = settings , settings = settings
} }
type Msg type Msg
= DragEnter = DragEnter
| DragLeave | DragLeave
@ -50,45 +59,55 @@ type Msg
| PickFiles | PickFiles
| SetActive Bool | SetActive Bool
setActive: Bool -> Msg
setActive : Bool -> Msg
setActive flag = setActive flag =
SetActive flag SetActive flag
update: Msg -> Model -> (Model, Cmd Msg, List File)
update : Msg -> Model -> ( Model, Cmd Msg, List File )
update msg model = update msg model =
case msg of case msg of
SetActive flag -> SetActive flag ->
let let
ns = { hover = model.state.hover, active = flag } ns =
{ hover = model.state.hover, active = flag }
in in
({ model | state = ns }, Cmd.none, []) ( { model | state = ns }, Cmd.none, [] )
PickFiles -> PickFiles ->
(model, File.Select.files model.settings.contentTypes GotFiles, []) ( model, File.Select.files model.settings.contentTypes GotFiles, [] )
DragEnter -> DragEnter ->
let let
ns = {hover = True, active = model.state.active} ns =
{ hover = True, active = model.state.active }
in in
({model| state = ns}, Cmd.none, []) ( { model | state = ns }, Cmd.none, [] )
DragLeave -> DragLeave ->
let let
ns = {hover = False, active = model.state.active} ns =
{ hover = False, active = model.state.active }
in in
({model | state = ns}, Cmd.none, []) ( { model | state = ns }, Cmd.none, [] )
GotFiles file files -> GotFiles file files ->
let let
ns = {hover = False, active = model.state.active} ns =
newFiles = if model.state.active then filterMime model.settings (file :: files) { hover = False, active = model.state.active }
else []
newFiles =
if model.state.active then
filterMime model.settings (file :: files)
else
[]
in in
({model | state = ns}, Cmd.none, newFiles) ( { model | state = ns }, Cmd.none, newFiles )
view : Model -> Html Msg
view: Model -> Html Msg
view model = view model =
div div
[ classList (model.settings.classList model.state) [ classList (model.settings.classList model.state)
@ -97,46 +116,51 @@ view model =
, hijackOn "dragleave" (D.succeed DragLeave) , hijackOn "dragleave" (D.succeed DragLeave)
, hijackOn "drop" dropDecoder , hijackOn "drop" dropDecoder
] ]
[div [class "ui icon header"] [ div [ class "ui icon header" ]
[i [class "mouse pointer icon"][] [ i [ class "mouse pointer icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Drop files here" [ text "Drop files here"
,div [class "sub header"] , div [ class "sub header" ]
[text "PDF files only" [ text "PDF files only"
] ]
] ]
] ]
,div [class "ui horizontal divider"] , div [ class "ui horizontal divider" ]
[text "Or" [ 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 = filterMime settings files =
let let
pred f = pred f =
List.member (File.mime f) settings.contentTypes List.member (File.mime f) settings.contentTypes
in in
List.filter pred files List.filter pred files
dropDecoder : D.Decoder Msg dropDecoder : D.Decoder Msg
dropDecoder = 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 : String -> D.Decoder msg -> Attribute msg
hijackOn event decoder = 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 = 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 module Comp.EquipmentForm exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update , getEquipment
, isValid , isValid
, getEquipment) , update
, view
)
import Api.Model.Equipment exposing (Equipment)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onInput) import Html.Events exposing (onInput)
import Data.Flags exposing (Flags)
import Api.Model.Equipment exposing (Equipment)
type alias Model = type alias Model =
{ equipment: Equipment { equipment : Equipment
, name: String , name : String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ equipment = Api.Model.Equipment.empty { equipment = Api.Model.Equipment.empty
, name = "" , name = ""
} }
isValid: Model -> Bool
isValid : Model -> Bool
isValid model = isValid model =
model.name /= "" model.name /= ""
getEquipment: Model -> Equipment
getEquipment : Model -> Equipment
getEquipment model = getEquipment model =
Equipment model.equipment.id model.name model.equipment.created Equipment model.equipment.id model.name model.equipment.created
type Msg type Msg
= SetName String = SetName String
| SetEquipment Equipment | SetEquipment Equipment
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetEquipment t -> SetEquipment t ->
({model | equipment = t, name = t.name }, Cmd.none) ( { model | equipment = t, name = t.name }, Cmd.none )
SetName n -> SetName n ->
({model | name = n}, Cmd.none) ( { model | name = n }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
div [class "ui form"] div [ class "ui form" ]
[div [classList [("field", True) [ div
,("error", not (isValid model)) [ classList
] [ ( "field", True )
] , ( "error", not (isValid model) )
[label [][text "Name*"] ]
,input [type_ "text" ]
,onInput SetName [ label [] [ text "Name*" ]
,placeholder "Name" , input
,value model.name [ 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 module Comp.EquipmentManage exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Http
import Api 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit) import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags) import Http
import Comp.EquipmentTable
import Comp.EquipmentForm
import Comp.YesNoDimmer
import Api.Model.Equipment
import Api.Model.EquipmentList exposing (EquipmentList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Util.Http import Util.Http
import Util.Maybe
type alias Model = type alias Model =
{ tableModel: Comp.EquipmentTable.Model { tableModel : Comp.EquipmentTable.Model
, formModel: Comp.EquipmentForm.Model , formModel : Comp.EquipmentForm.Model
, viewMode: ViewMode , viewMode : ViewMode
, formError: Maybe String , formError : Maybe String
, loading: Bool , loading : Bool
, deleteConfirm: Comp.YesNoDimmer.Model , deleteConfirm : Comp.YesNoDimmer.Model
} }
type ViewMode = Table | Form
emptyModel: Model type ViewMode
= Table
| Form
emptyModel : Model
emptyModel = emptyModel =
{ tableModel = Comp.EquipmentTable.emptyModel { tableModel = Comp.EquipmentTable.emptyModel
, formModel = Comp.EquipmentForm.emptyModel , formModel = Comp.EquipmentForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel , deleteConfirm = Comp.YesNoDimmer.emptyModel
} }
type Msg type Msg
= TableMsg Comp.EquipmentTable.Msg = TableMsg Comp.EquipmentTable.Msg
| FormMsg Comp.EquipmentForm.Msg | FormMsg Comp.EquipmentForm.Msg
@ -52,155 +60,210 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg | YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete | RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
TableMsg m -> TableMsg m ->
let let
(tm, tc) = Comp.EquipmentTable.update flags m model.tableModel ( tm, tc ) =
(m2, c2) = ({model | tableModel = tm Comp.EquipmentTable.update flags m model.tableModel
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError ( m2, c2 ) =
} ( { model
, Cmd.map TableMsg tc | tableModel = tm
) , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
(m3, c3) = case tm.selected of , formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
( m3, c3 ) =
case tm.selected of
Just equipment -> Just equipment ->
update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) m2 update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) m2
Nothing -> Nothing ->
(m2, Cmd.none) ( m2, Cmd.none )
in in
(m3, Cmd.batch [c2, c3]) ( m3, Cmd.batch [ c2, c3 ] )
FormMsg m -> FormMsg m ->
let let
(m2, c2) = Comp.EquipmentForm.update flags m model.formModel ( m2, c2 ) =
Comp.EquipmentForm.update flags m model.formModel
in in
({model | formModel = m2}, Cmd.map FormMsg c2) ( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadEquipments -> LoadEquipments ->
({model| loading = True}, Api.getEquipments flags EquipmentResp) ( { model | loading = True }, Api.getEquipments flags EquipmentResp )
EquipmentResp (Ok equipments) -> EquipmentResp (Ok equipments) ->
let let
m2 = {model|viewMode = Table, loading = False} m2 =
{ model | viewMode = Table, loading = False }
in in
update flags (TableMsg (Comp.EquipmentTable.SetEquipments equipments.items)) m2 update flags (TableMsg (Comp.EquipmentTable.SetEquipments equipments.items)) m2
EquipmentResp (Err err) -> EquipmentResp (Err _) ->
({model|loading = False}, Cmd.none) ( { model | loading = False }, Cmd.none )
SetViewMode m -> SetViewMode m ->
let let
m2 = {model | viewMode = m } m2 =
{ model | viewMode = m }
in in
case m of case m of
Table -> Table ->
update flags (TableMsg Comp.EquipmentTable.Deselect) m2 update flags (TableMsg Comp.EquipmentTable.Deselect) m2
Form ->
(m2, Cmd.none) Form ->
( m2, Cmd.none )
InitNewEquipment -> InitNewEquipment ->
let let
nm = {model | viewMode = Form, formError = Nothing } nm =
equipment = Api.Model.Equipment.empty { model | viewMode = Form, formError = Nothing }
equipment =
Api.Model.Equipment.empty
in in
update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) nm update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) nm
Submit -> Submit ->
let let
equipment = Comp.EquipmentForm.getEquipment model.formModel equipment =
valid = Comp.EquipmentForm.isValid model.formModel Comp.EquipmentForm.getEquipment model.formModel
in if valid then
({model|loading = True}, Api.postEquipment flags equipment SubmitResp) valid =
else Comp.EquipmentForm.isValid model.formModel
({model|formError = Just "Please correct the errors in the form."}, Cmd.none) 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) -> SubmitResp (Ok res) ->
if res.success then if res.success then
let let
(m2, c2) = update flags (SetViewMode Table) model ( m2, c2 ) =
(m3, c3) = update flags LoadEquipments m2 update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadEquipments m2
in in
({m3|loading = False}, Cmd.batch [c2,c3]) ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else else
({model | formError = Just res.message, loading = False }, Cmd.none) ( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) -> 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 -> RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model update flags (YesNoMsg Comp.YesNoDimmer.activate) model
YesNoMsg m -> YesNoMsg m ->
let let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm ( cm, confirmed ) =
equip = Comp.EquipmentForm.getEquipment model.formModel Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.deleteEquip flags equip.id SubmitResp else Cmd.none
equip =
Comp.EquipmentForm.getEquipment model.formModel
cmd =
if confirmed then
Api.deleteEquip flags equip.id SubmitResp
else
Cmd.none
in in
({model | deleteConfirm = cm}, cmd) ( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model = view model =
if model.viewMode == Table then viewTable model if model.viewMode == Table then
else viewForm model viewTable model
viewTable: Model -> Html Msg else
viewForm model
viewTable : Model -> Html Msg
viewTable model = viewTable model =
div [] div []
[button [class "ui basic button", onClick InitNewEquipment] [ button [ class "ui basic button", onClick InitNewEquipment ]
[i [class "plus icon"][] [ i [ class "plus icon" ] []
,text "Create new" , text "Create new"
] ]
,Html.map TableMsg (Comp.EquipmentTable.view model.tableModel) , Html.map TableMsg (Comp.EquipmentTable.view model.tableModel)
,div [classList [("ui dimmer", True) , div
,("active", model.loading) [ classList
]] [ ( "ui dimmer", True )
[div [class "ui loader"][] , ( "active", model.loading )
]
]
[ div [ class "ui loader" ] []
] ]
] ]
viewForm: Model -> Html Msg
viewForm : Model -> Html Msg
viewForm model = viewForm model =
let let
newEquipment = model.formModel.equipment.id == "" newEquipment =
model.formModel.equipment.id == ""
in in
Html.form [class "ui segment", onSubmit Submit] Html.form [ class "ui segment", onSubmit Submit ]
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
,if newEquipment then , if newEquipment then
h3 [class "ui dividing header"] h3 [ class "ui dividing header" ]
[text "Create new equipment" [ text "Create new equipment"
]
else
h3 [class "ui dividing header"]
[text ("Edit equipment: " ++ model.formModel.equipment.name)
,div [class "sub header"]
[text "Id: "
,text model.formModel.equipment.id
]
]
,Html.map FormMsg (Comp.EquipmentForm.view model.formModel)
,div [classList [("ui error message", True)
,("invisible", Util.Maybe.isEmpty model.formError)
]
]
[Maybe.withDefault "" model.formError |> text
]
,div [class "ui horizontal divider"][]
,button [class "ui primary button", type_ "submit"]
[text "Submit"
] ]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel" 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 module Comp.EquipmentTable exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Api.Model.Equipment exposing (Equipment)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Api.Model.Equipment exposing (Equipment)
type alias Model = type alias Model =
{ equips: List Equipment { equips : List Equipment
, selected: Maybe Equipment , selected : Maybe Equipment
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ equips = [] { equips = []
, selected = Nothing , selected = Nothing
} }
type Msg type Msg
= SetEquipments (List Equipment) = SetEquipments (List Equipment)
| Select Equipment | Select Equipment
| Deselect | Deselect
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetEquipments list -> SetEquipments list ->
({model | equips = list, selected = Nothing }, Cmd.none) ( { model | equips = list, selected = Nothing }, Cmd.none )
Select equip -> Select equip ->
({model | selected = Just equip}, Cmd.none) ( { model | selected = Just equip }, Cmd.none )
Deselect -> Deselect ->
({model | selected = Nothing}, Cmd.none) ( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
table [class "ui selectable table"] table [ class "ui selectable table" ]
[thead [] [ thead []
[tr [] [ tr []
[th [][text "Name"] [ th [] [ text "Name" ]
] ]
] ]
,tbody [] , tbody []
(List.map (renderEquipmentLine model) model.equips) (List.map (renderEquipmentLine model) model.equips)
] ]
renderEquipmentLine: Model -> Equipment -> Html Msg
renderEquipmentLine : Model -> Equipment -> Html Msg
renderEquipmentLine model equip = renderEquipmentLine model equip =
tr [classList [("active", model.selected == Just equip)] tr
,onClick (Select equip) [ classList [ ( "active", model.selected == Just equip ) ]
] , onClick (Select equip)
[td [] ]
[text equip.name [ 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 module Comp.ItemList exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, prevItem , emptyModel
, nextItem , nextItem
, update , prevItem
, view) , 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Api.Model.ItemLightList exposing (ItemLightList) import Set exposing (Set)
import Api.Model.ItemLightGroup exposing (ItemLightGroup)
import Api.Model.ItemLight exposing (ItemLight)
import Data.Flags exposing (Flags)
import Data.Direction
import Util.List import Util.List
import Util.Maybe
import Util.String import Util.String
import Util.Time import Util.Time
import Util.Maybe
type alias Model = type alias Model =
{ results: ItemLightList { results : ItemLightList
, openGroups: Set String , openGroups : Set String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ results = Api.Model.ItemLightList.empty { results = Api.Model.ItemLightList.empty
, openGroups = Set.empty , openGroups = Set.empty
} }
type Msg type Msg
= SetResults ItemLightList = SetResults ItemLightList
| ToggleGroupState ItemLightGroup | ToggleGroupState ItemLightGroup
@ -38,198 +43,243 @@ type Msg
| ExpandAll | ExpandAll
| SelectItem ItemLight | SelectItem ItemLight
nextItem: Model -> String -> Maybe ItemLight
nextItem : Model -> String -> Maybe ItemLight
nextItem model id = nextItem model id =
List.concatMap .items model.results.groups List.concatMap .items model.results.groups
|> Util.List.findNext (\i -> i.id == id) |> Util.List.findNext (\i -> i.id == id)
prevItem: Model -> String -> Maybe ItemLight
prevItem : Model -> String -> Maybe ItemLight
prevItem model id = prevItem model id =
List.concatMap .items model.results.groups List.concatMap .items model.results.groups
|> Util.List.findPrev (\i -> i.id == id) |> Util.List.findPrev (\i -> i.id == id)
openAllGroups: Model -> Set String
openAllGroups : Model -> Set String
openAllGroups model = openAllGroups model =
List.foldl List.foldl
(\g -> \set -> Set.insert g.name set) (\g -> \set -> Set.insert g.name set)
model.openGroups model.openGroups
model.results.groups 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 = update flags msg model =
case msg of case msg of
SetResults list -> SetResults list ->
let let
newModel = { model | results = list, openGroups = Set.empty } newModel =
{ model | results = list, openGroups = Set.empty }
in in
({newModel|openGroups = openAllGroups newModel}, Cmd.none, Nothing) ( { newModel | openGroups = openAllGroups newModel }, Cmd.none, Nothing )
ToggleGroupState group -> ToggleGroupState group ->
let let
m2 = if isGroupOpen model group then closeGroup model group m2 =
else openGroup model group if isGroupOpen model group then
closeGroup model group
else
openGroup model group
in in
(m2, Cmd.none, Nothing) ( m2, Cmd.none, Nothing )
CollapseAll -> CollapseAll ->
({model | openGroups = Set.empty }, Cmd.none, Nothing) ( { model | openGroups = Set.empty }, Cmd.none, Nothing )
ExpandAll -> ExpandAll ->
let let
open = openAllGroups model open =
openAllGroups model
in in
({model | openGroups = open }, Cmd.none, Nothing) ( { model | openGroups = open }, Cmd.none, Nothing )
SelectItem item -> SelectItem item ->
(model, Cmd.none, Just item) ( model, Cmd.none, Just item )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
div [] div []
[div [class "ui ablue-comp menu"] [ div [ class "ui ablue-comp menu" ]
[div [class "right floated menu"] [ div [ class "right floated menu" ]
[a [class "item" [ a
,title "Expand all" [ class "item"
,onClick ExpandAll , title "Expand all"
,href "" , onClick ExpandAll
] , href ""
[i [class "double angle down icon"][] ]
] [ i [ class "double angle down icon" ] []
,a [class "item" ]
,title "Collapse all" , a
,onClick CollapseAll [ class "item"
,href "" , title "Collapse all"
] , onClick CollapseAll
[i [class "double angle up icon"][] , href ""
] ]
] [ i [ class "double angle up icon" ] []
] ]
,div [class "ui middle aligned very relaxed divided basic list segment"] ]
]
, div [ class "ui middle aligned very relaxed divided basic list segment" ]
(List.map (viewGroup model) model.results.groups) (List.map (viewGroup model) model.results.groups)
] ]
isGroupOpen: Model -> ItemLightGroup -> Bool isGroupOpen : Model -> ItemLightGroup -> Bool
isGroupOpen model group = isGroupOpen model group =
Set.member group.name model.openGroups Set.member group.name model.openGroups
openGroup: Model -> ItemLightGroup -> Model
openGroup : Model -> ItemLightGroup -> Model
openGroup model group = openGroup model group =
{ model | openGroups = Set.insert group.name model.openGroups } { model | openGroups = Set.insert group.name model.openGroups }
closeGroup: Model -> ItemLightGroup -> Model
closeGroup : Model -> ItemLightGroup -> Model
closeGroup model group = closeGroup model group =
{ model | openGroups = Set.remove group.name model.openGroups } { model | openGroups = Set.remove group.name model.openGroups }
viewGroup: Model -> ItemLightGroup -> Html Msg
viewGroup : Model -> ItemLightGroup -> Html Msg
viewGroup model group = viewGroup model group =
let let
groupOpen = isGroupOpen model group groupOpen =
isGroupOpen model group
children = children =
[i [classList [("large middle aligned icon", True) [ i
,("caret right", not groupOpen) [ classList
,("caret down", groupOpen) [ ( "large middle aligned icon", True )
]][] , ( "caret right", not groupOpen )
,div [class "content"] , ( "caret down", groupOpen )
[div [class "right floated content"] ]
[div [class "ui blue label"] ]
[List.length group.items |> String.fromInt |> text []
] , div [ class "content" ]
] [ div [ class "right floated content" ]
,a [class "header" [ div [ class "ui blue label" ]
,onClick (ToggleGroupState group) [ List.length group.items |> String.fromInt |> text
,href "" ]
] ]
[text group.name , a
] [ class "header"
,div [class "description"] , onClick (ToggleGroupState group)
[makeSummary group |> text , href ""
]
[ text group.name
]
, div [ class "description" ]
[ makeSummary group |> text
] ]
] ]
] ]
itemTable = itemTable =
div [class "ui basic content segment no-margin"] div [ class "ui basic content segment no-margin" ]
[(renderItemTable model group.items) [ renderItemTable model group.items
] ]
in in
if isGroupOpen model group then if isGroupOpen model group then
div [class "item"] div [ class "item" ]
(List.append children [itemTable]) (List.append children [ itemTable ])
else
div [class "item"] else
children div [ class "item" ]
children
renderItemTable: Model -> List ItemLight -> Html Msg renderItemTable : Model -> List ItemLight -> Html Msg
renderItemTable model items = renderItemTable model items =
table [class "ui selectable padded table"] table [ class "ui selectable padded table" ]
[thead [] [ thead []
[tr [] [ tr []
[th [class "collapsing"][] [ th [ class "collapsing" ] []
,th [class "collapsing"][text "Name"] , th [ class "collapsing" ] [ text "Name" ]
,th [class "collapsing"][text "Date"] , th [ class "collapsing" ] [ text "Date" ]
,th [class "collapsing"][text "Source"] , th [ class "collapsing" ] [ text "Source" ]
,th [][text "Correspondent"] , th [] [ text "Correspondent" ]
,th [][text "Concerning"] , th [] [ text "Concerning" ]
] ]
] ]
,tbody[] , tbody []
(List.map (renderItemLine model) items) (List.map (renderItemLine model) items)
] ]
renderItemLine: Model -> ItemLight -> Html Msg
renderItemLine : Model -> ItemLight -> Html Msg
renderItemLine model item = renderItemLine model item =
let let
dirIcon = i [class (Data.Direction.iconFromMaybe item.direction)][] dirIcon =
corr = List.filterMap identity [item.corrOrg, item.corrPerson] i [ class (Data.Direction.iconFromMaybe item.direction) ] []
|> List.map .name
|> List.intersperse ", " corr =
|> String.concat List.filterMap identity [ item.corrOrg, item.corrPerson ]
conc = List.filterMap identity [item.concPerson, item.concEquip] |> List.map .name
|> List.map .name |> List.intersperse ", "
|> List.intersperse ", " |> String.concat
|> String.concat
conc =
List.filterMap identity [ item.concPerson, item.concEquip ]
|> List.map .name
|> List.intersperse ", "
|> String.concat
in in
tr [onClick (SelectItem item)] tr [ onClick (SelectItem item) ]
[td [class "collapsing"] [ td [ class "collapsing" ]
[div [classList [("ui teal ribbon label", True) [ div
,("invisible", item.state /= "created") [ classList
] [ ( "ui teal ribbon label", True )
][text "New" , ( "invisible", item.state /= "created" )
]
]
,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] [ text "New"
,td [][text corr] ]
,td [][text conc]
] ]
, 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 = makeSummary group =
let let
corrOrgs = List.filterMap .corrOrg group.items corrOrgs =
corrPers = List.filterMap .corrPerson group.items List.filterMap .corrOrg group.items
concPers = List.filterMap .concPerson group.items
concEqui = List.filterMap .concEquip group.items corrPers =
all = List.concat [corrOrgs, corrPers, concPers, concEqui] 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 in
List.map .name all List.map .name all
|> Util.List.distinct |> Util.List.distinct
|> List.intersperse ", " |> List.intersperse ", "
|> String.concat |> String.concat

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

@ -1,28 +1,32 @@
module Comp.OrgForm exposing ( Model module Comp.OrgForm exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update , getOrg
, isValid , isValid
, getOrg) , 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 Api.Model.Organization exposing (Organization)
import Comp.AddressForm import Comp.AddressForm
import Comp.ContactField import Comp.ContactField
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
type alias Model = type alias Model =
{ org: Organization { org : Organization
, name: String , name : String
, addressModel: Comp.AddressForm.Model , addressModel : Comp.AddressForm.Model
, contactModel: Comp.ContactField.Model , contactModel : Comp.ContactField.Model
, notes: Maybe String , notes : Maybe String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ org = Api.Model.Organization.empty { org = Api.Model.Organization.empty
, name = "" , name = ""
@ -31,20 +35,25 @@ emptyModel =
, notes = Nothing , notes = Nothing
} }
isValid: Model -> Bool
isValid : Model -> Bool
isValid model = isValid model =
model.name /= "" model.name /= ""
getOrg: Model -> Organization
getOrg : Model -> Organization
getOrg model = getOrg model =
let let
o = model.org o =
model.org
in in
{ o | name = model.name { o
, address = Comp.AddressForm.getAddress model.addressModel | name = model.name
, contacts = Comp.ContactField.getContacts model.contactModel , address = Comp.AddressForm.getAddress model.addressModel
, notes = model.notes , contacts = Comp.ContactField.getContacts model.contactModel
} , notes = model.notes
}
type Msg type Msg
= SetName String = SetName String
@ -53,61 +62,80 @@ type Msg
| ContactMsg Comp.ContactField.Msg | ContactMsg Comp.ContactField.Msg
| SetNotes String | SetNotes String
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetOrg t -> SetOrg t ->
let let
(m1, c1) = update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model ( m1, c1 ) =
(m2, c2) = update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1 update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model
( m2, c2 ) =
update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1
in 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 -> AddressMsg am ->
let let
(m1, c1) = Comp.AddressForm.update am model.addressModel ( m1, c1 ) =
Comp.AddressForm.update am model.addressModel
in in
({model | addressModel = m1}, Cmd.map AddressMsg c1) ( { model | addressModel = m1 }, Cmd.map AddressMsg c1 )
ContactMsg m -> ContactMsg m ->
let let
(m1, c1) = Comp.ContactField.update m model.contactModel ( m1, c1 ) =
Comp.ContactField.update m model.contactModel
in in
({model | contactModel = m1}, Cmd.map ContactMsg c1) ( { model | contactModel = m1 }, Cmd.map ContactMsg c1 )
SetName n -> SetName n ->
({model | name = n}, Cmd.none) ( { model | name = n }, Cmd.none )
SetNotes str -> 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 = view model =
div [class "ui form"] div [ class "ui form" ]
[div [classList [("field", True) [ div
,("error", not (isValid model)) [ classList
] [ ( "field", True )
] , ( "error", not (isValid model) )
[label [][text "Name*"] ]
,input [type_ "text"
,onInput SetName
,placeholder "Name"
,value model.name
][]
]
,h3 [class "ui dividing header"]
[text "Address"
] ]
,Html.map AddressMsg (Comp.AddressForm.view model.addressModel) [ label [] [ text "Name*" ]
,h3 [class "ui dividing header"] , input
[text "Contacts" [ type_ "text"
, onInput SetName
, placeholder "Name"
, value model.name
]
[]
] ]
,Html.map ContactMsg (Comp.ContactField.view model.contactModel) , h3 [ class "ui dividing header" ]
,h3 [class "ui dividing header"] [ text "Address"
[text "Notes"
] ]
,div [class "field"] , Html.map AddressMsg (Comp.AddressForm.view model.addressModel)
[textarea [onInput SetNotes][Maybe.withDefault "" model.notes |> text ] , 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 module Comp.OrgManage exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Http
import Api 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit) import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags) import Http
import Comp.OrgTable
import Comp.OrgForm
import Comp.YesNoDimmer
import Api.Model.Organization
import Api.Model.OrganizationList exposing (OrganizationList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Util.Http import Util.Http
import Util.Maybe
type alias Model = type alias Model =
{ tableModel: Comp.OrgTable.Model { tableModel : Comp.OrgTable.Model
, formModel: Comp.OrgForm.Model , formModel : Comp.OrgForm.Model
, viewMode: ViewMode , viewMode : ViewMode
, formError: Maybe String , formError : Maybe String
, loading: Bool , loading : Bool
, deleteConfirm: Comp.YesNoDimmer.Model , deleteConfirm : Comp.YesNoDimmer.Model
} }
type ViewMode = Table | Form
emptyModel: Model type ViewMode
= Table
| Form
emptyModel : Model
emptyModel = emptyModel =
{ tableModel = Comp.OrgTable.emptyModel { tableModel = Comp.OrgTable.emptyModel
, formModel = Comp.OrgForm.emptyModel , formModel = Comp.OrgForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel , deleteConfirm = Comp.YesNoDimmer.emptyModel
} }
type Msg type Msg
= TableMsg Comp.OrgTable.Msg = TableMsg Comp.OrgTable.Msg
| FormMsg Comp.OrgForm.Msg | FormMsg Comp.OrgForm.Msg
@ -52,155 +60,210 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg | YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete | RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
TableMsg m -> TableMsg m ->
let let
(tm, tc) = Comp.OrgTable.update flags m model.tableModel ( tm, tc ) =
(m2, c2) = ({model | tableModel = tm Comp.OrgTable.update flags m model.tableModel
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError ( m2, c2 ) =
} ( { model
, Cmd.map TableMsg tc | tableModel = tm
) , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
(m3, c3) = case tm.selected of , formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
( m3, c3 ) =
case tm.selected of
Just org -> Just org ->
update flags (FormMsg (Comp.OrgForm.SetOrg org)) m2 update flags (FormMsg (Comp.OrgForm.SetOrg org)) m2
Nothing -> Nothing ->
(m2, Cmd.none) ( m2, Cmd.none )
in in
(m3, Cmd.batch [c2, c3]) ( m3, Cmd.batch [ c2, c3 ] )
FormMsg m -> FormMsg m ->
let let
(m2, c2) = Comp.OrgForm.update flags m model.formModel ( m2, c2 ) =
Comp.OrgForm.update flags m model.formModel
in in
({model | formModel = m2}, Cmd.map FormMsg c2) ( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadOrgs -> LoadOrgs ->
({model| loading = True}, Api.getOrganizations flags OrgResp) ( { model | loading = True }, Api.getOrganizations flags OrgResp )
OrgResp (Ok orgs) -> OrgResp (Ok orgs) ->
let let
m2 = {model|viewMode = Table, loading = False} m2 =
{ model | viewMode = Table, loading = False }
in in
update flags (TableMsg (Comp.OrgTable.SetOrgs orgs.items)) m2 update flags (TableMsg (Comp.OrgTable.SetOrgs orgs.items)) m2
OrgResp (Err err) -> OrgResp (Err _) ->
({model|loading = False}, Cmd.none) ( { model | loading = False }, Cmd.none )
SetViewMode m -> SetViewMode m ->
let let
m2 = {model | viewMode = m } m2 =
{ model | viewMode = m }
in in
case m of case m of
Table -> Table ->
update flags (TableMsg Comp.OrgTable.Deselect) m2 update flags (TableMsg Comp.OrgTable.Deselect) m2
Form ->
(m2, Cmd.none) Form ->
( m2, Cmd.none )
InitNewOrg -> InitNewOrg ->
let let
nm = {model | viewMode = Form, formError = Nothing } nm =
org = Api.Model.Organization.empty { model | viewMode = Form, formError = Nothing }
org =
Api.Model.Organization.empty
in in
update flags (FormMsg (Comp.OrgForm.SetOrg org)) nm update flags (FormMsg (Comp.OrgForm.SetOrg org)) nm
Submit -> Submit ->
let let
org = Comp.OrgForm.getOrg model.formModel org =
valid = Comp.OrgForm.isValid model.formModel Comp.OrgForm.getOrg model.formModel
in if valid then
({model|loading = True}, Api.postOrg flags org SubmitResp) valid =
else Comp.OrgForm.isValid model.formModel
({model|formError = Just "Please correct the errors in the form."}, Cmd.none) 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) -> SubmitResp (Ok res) ->
if res.success then if res.success then
let let
(m2, c2) = update flags (SetViewMode Table) model ( m2, c2 ) =
(m3, c3) = update flags LoadOrgs m2 update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadOrgs m2
in in
({m3|loading = False}, Cmd.batch [c2,c3]) ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else else
({model | formError = Just res.message, loading = False }, Cmd.none) ( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) -> 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 -> RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model update flags (YesNoMsg Comp.YesNoDimmer.activate) model
YesNoMsg m -> YesNoMsg m ->
let let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm ( cm, confirmed ) =
org = Comp.OrgForm.getOrg model.formModel Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.deleteOrg flags org.id SubmitResp else Cmd.none
org =
Comp.OrgForm.getOrg model.formModel
cmd =
if confirmed then
Api.deleteOrg flags org.id SubmitResp
else
Cmd.none
in in
({model | deleteConfirm = cm}, cmd) ( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model = view model =
if model.viewMode == Table then viewTable model if model.viewMode == Table then
else viewForm model viewTable model
viewTable: Model -> Html Msg else
viewForm model
viewTable : Model -> Html Msg
viewTable model = viewTable model =
div [] div []
[button [class "ui basic button", onClick InitNewOrg] [ button [ class "ui basic button", onClick InitNewOrg ]
[i [class "plus icon"][] [ i [ class "plus icon" ] []
,text "Create new" , text "Create new"
] ]
,Html.map TableMsg (Comp.OrgTable.view model.tableModel) , Html.map TableMsg (Comp.OrgTable.view model.tableModel)
,div [classList [("ui dimmer", True) , div
,("active", model.loading) [ classList
]] [ ( "ui dimmer", True )
[div [class "ui loader"][] , ( "active", model.loading )
]
]
[ div [ class "ui loader" ] []
] ]
] ]
viewForm: Model -> Html Msg
viewForm : Model -> Html Msg
viewForm model = viewForm model =
let let
newOrg = model.formModel.org.id == "" newOrg =
model.formModel.org.id == ""
in in
Html.form [class "ui segment", onSubmit Submit] Html.form [ class "ui segment", onSubmit Submit ]
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
,if newOrg then , if newOrg then
h3 [class "ui dividing header"] h3 [ class "ui dividing header" ]
[text "Create new organization" [ text "Create new organization"
]
else
h3 [class "ui dividing header"]
[text ("Edit org: " ++ model.formModel.org.name)
,div [class "sub header"]
[text "Id: "
,text model.formModel.org.id
]
]
,Html.map FormMsg (Comp.OrgForm.view model.formModel)
,div [classList [("ui error message", True)
,("invisible", Util.Maybe.isEmpty model.formError)
]
]
[Maybe.withDefault "" model.formError |> text
]
,div [class "ui horizontal divider"][]
,button [class "ui primary button", type_ "submit"]
[text "Submit"
] ]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel" 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 module Comp.OrgTable exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Api.Model.Organization exposing (Organization)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) 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.Address
import Util.Contact import Util.Contact
type alias Model = type alias Model =
{ equips: List Organization { equips : List Organization
, selected: Maybe Organization , selected : Maybe Organization
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ equips = [] { equips = []
, selected = Nothing , selected = Nothing
} }
type Msg type Msg
= SetOrgs (List Organization) = SetOrgs (List Organization)
| Select Organization | Select Organization
| Deselect | Deselect
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetOrgs list -> SetOrgs list ->
({model | equips = list, selected = Nothing }, Cmd.none) ( { model | equips = list, selected = Nothing }, Cmd.none )
Select equip -> Select equip ->
({model | selected = Just equip}, Cmd.none) ( { model | selected = Just equip }, Cmd.none )
Deselect -> Deselect ->
({model | selected = Nothing}, Cmd.none) ( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
table [class "ui selectable table"] table [ class "ui selectable table" ]
[thead [] [ thead []
[tr [] [ tr []
[th [class "collapsing"][text "Name"] [ th [ class "collapsing" ] [ text "Name" ]
,th [][text "Address"] , th [] [ text "Address" ]
,th [][text "Contact"] , th [] [ text "Contact" ]
] ]
] ]
,tbody [] , tbody []
(List.map (renderOrgLine model) model.equips) (List.map (renderOrgLine model) model.equips)
] ]
renderOrgLine: Model -> Organization -> Html Msg
renderOrgLine : Model -> Organization -> Html Msg
renderOrgLine model org = renderOrgLine model org =
tr [classList [("active", model.selected == Just org)] tr
,onClick (Select org) [ classList [ ( "active", model.selected == Just org ) ]
] , onClick (Select org)
[td [class "collapsing"] ]
[text org.name [ td [ class "collapsing" ]
] [ text org.name
,td []
[Util.Address.toString org.address |> text
] ]
,td [] , td []
[Util.Contact.toString org.contacts |> text [ 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 module Comp.PersonForm exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update , getPerson
, isValid , isValid
, getPerson) , 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 Api.Model.Person exposing (Person)
import Comp.AddressForm import Comp.AddressForm
import Comp.ContactField 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 = type alias Model =
{ org: Person { org : Person
, name: String , name : String
, addressModel: Comp.AddressForm.Model , addressModel : Comp.AddressForm.Model
, contactModel: Comp.ContactField.Model , contactModel : Comp.ContactField.Model
, notes: Maybe String , notes : Maybe String
, concerning: Bool , concerning : Bool
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ org = Api.Model.Person.empty { org = Api.Model.Person.empty
, name = "" , name = ""
@ -34,21 +37,26 @@ emptyModel =
, concerning = False , concerning = False
} }
isValid: Model -> Bool
isValid : Model -> Bool
isValid model = isValid model =
model.name /= "" model.name /= ""
getPerson: Model -> Person
getPerson : Model -> Person
getPerson model = getPerson model =
let let
o = model.org o =
model.org
in in
{ o | name = model.name { o
, address = Comp.AddressForm.getAddress model.addressModel | name = model.name
, contacts = Comp.ContactField.getContacts model.contactModel , address = Comp.AddressForm.getAddress model.addressModel
, notes = model.notes , contacts = Comp.ContactField.getContacts model.contactModel
, concerning = model.concerning , notes = model.notes
} , concerning = model.concerning
}
type Msg type Msg
= SetName String = SetName String
@ -58,72 +66,101 @@ type Msg
| SetNotes String | SetNotes String
| SetConcerning Bool | SetConcerning Bool
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetPerson t -> SetPerson t ->
let let
(m1, c1) = update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model ( m1, c1 ) =
(m2, c2) = update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1 update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model
( m2, c2 ) =
update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1
in 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 -> AddressMsg am ->
let let
(m1, c1) = Comp.AddressForm.update am model.addressModel ( m1, c1 ) =
Comp.AddressForm.update am model.addressModel
in in
({model | addressModel = m1}, Cmd.map AddressMsg c1) ( { model | addressModel = m1 }, Cmd.map AddressMsg c1 )
ContactMsg m -> ContactMsg m ->
let let
(m1, c1) = Comp.ContactField.update m model.contactModel ( m1, c1 ) =
Comp.ContactField.update m model.contactModel
in in
({model | contactModel = m1}, Cmd.map ContactMsg c1) ( { model | contactModel = m1 }, Cmd.map ContactMsg c1 )
SetName n -> SetName n ->
({model | name = n}, Cmd.none) ( { model | name = n }, Cmd.none )
SetNotes str -> SetNotes str ->
({model | notes = if str == "" then Nothing else Just str}, Cmd.none) ( { model
| notes =
if str == "" then
Nothing
SetConcerning flag -> else
({model | concerning = not model.concerning}, Cmd.none) Just str
}
, Cmd.none
)
SetConcerning _ ->
( { model | concerning = not model.concerning }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
div [class "ui form"] div [ class "ui form" ]
[div [classList [("field", True) [ div
,("error", not (isValid model)) [ classList
] [ ( "field", True )
] , ( "error", not (isValid model) )
[label [][text "Name*"] ]
,input [type_ "text"
,onInput SetName
,placeholder "Name"
,value model.name
][]
]
,div [class "inline field"]
[div [class "ui checkbox"]
[input [type_ "checkbox"
, checked model.concerning
, onCheck SetConcerning][]
,label [][text "Use for concerning person suggestion only"]
]
] ]
,h3 [class "ui dividing header"] [ label [] [ text "Name*" ]
[text "Address" , input
[ type_ "text"
, onInput SetName
, placeholder "Name"
, value model.name
]
[]
] ]
,Html.map AddressMsg (Comp.AddressForm.view model.addressModel) , div [ class "inline field" ]
,h3 [class "ui dividing header"] [ div [ class "ui checkbox" ]
[text "Contacts" [ 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" ]
,h3 [class "ui dividing header"] [ text "Address"
[text "Notes"
] ]
,div [class "field"] , Html.map AddressMsg (Comp.AddressForm.view model.addressModel)
[textarea [onInput SetNotes][Maybe.withDefault "" model.notes |> text ] , 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 module Comp.PersonManage exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Http
import Api 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit) import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags) import Http
import Comp.PersonTable
import Comp.PersonForm
import Comp.YesNoDimmer
import Api.Model.Person
import Api.Model.PersonList exposing (PersonList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Util.Http import Util.Http
import Util.Maybe
type alias Model = type alias Model =
{ tableModel: Comp.PersonTable.Model { tableModel : Comp.PersonTable.Model
, formModel: Comp.PersonForm.Model , formModel : Comp.PersonForm.Model
, viewMode: ViewMode , viewMode : ViewMode
, formError: Maybe String , formError : Maybe String
, loading: Bool , loading : Bool
, deleteConfirm: Comp.YesNoDimmer.Model , deleteConfirm : Comp.YesNoDimmer.Model
} }
type ViewMode = Table | Form
emptyModel: Model type ViewMode
= Table
| Form
emptyModel : Model
emptyModel = emptyModel =
{ tableModel = Comp.PersonTable.emptyModel { tableModel = Comp.PersonTable.emptyModel
, formModel = Comp.PersonForm.emptyModel , formModel = Comp.PersonForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel , deleteConfirm = Comp.YesNoDimmer.emptyModel
} }
type Msg type Msg
= TableMsg Comp.PersonTable.Msg = TableMsg Comp.PersonTable.Msg
| FormMsg Comp.PersonForm.Msg | FormMsg Comp.PersonForm.Msg
@ -52,156 +60,210 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg | YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete | RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
TableMsg m -> TableMsg m ->
let let
(tm, tc) = Comp.PersonTable.update flags m model.tableModel ( tm, tc ) =
(m2, c2) = ({model | tableModel = tm Comp.PersonTable.update flags m model.tableModel
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError ( m2, c2 ) =
} ( { model
, Cmd.map TableMsg tc | tableModel = tm
) , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
(m3, c3) = case tm.selected of , formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
( m3, c3 ) =
case tm.selected of
Just org -> Just org ->
update flags (FormMsg (Comp.PersonForm.SetPerson org)) m2 update flags (FormMsg (Comp.PersonForm.SetPerson org)) m2
Nothing -> Nothing ->
(m2, Cmd.none) ( m2, Cmd.none )
in in
(m3, Cmd.batch [c2, c3]) ( m3, Cmd.batch [ c2, c3 ] )
FormMsg m -> FormMsg m ->
let let
(m2, c2) = Comp.PersonForm.update flags m model.formModel ( m2, c2 ) =
Comp.PersonForm.update flags m model.formModel
in in
({model | formModel = m2}, Cmd.map FormMsg c2) ( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadPersons -> LoadPersons ->
({model| loading = True}, Api.getPersons flags PersonResp) ( { model | loading = True }, Api.getPersons flags PersonResp )
PersonResp (Ok orgs) -> PersonResp (Ok orgs) ->
let let
m2 = {model|viewMode = Table, loading = False} m2 =
{ model | viewMode = Table, loading = False }
in in
update flags (TableMsg (Comp.PersonTable.SetPersons orgs.items)) m2 update flags (TableMsg (Comp.PersonTable.SetPersons orgs.items)) m2
PersonResp (Err err) -> PersonResp (Err _) ->
({model|loading = False}, Cmd.none) ( { model | loading = False }, Cmd.none )
SetViewMode m -> SetViewMode m ->
let let
m2 = {model | viewMode = m } m2 =
{ model | viewMode = m }
in in
case m of case m of
Table -> Table ->
update flags (TableMsg Comp.PersonTable.Deselect) m2 update flags (TableMsg Comp.PersonTable.Deselect) m2
Form ->
(m2, Cmd.none) Form ->
( m2, Cmd.none )
InitNewPerson -> InitNewPerson ->
let let
nm = {model | viewMode = Form, formError = Nothing } nm =
org = Api.Model.Person.empty { model | viewMode = Form, formError = Nothing }
org =
Api.Model.Person.empty
in in
update flags (FormMsg (Comp.PersonForm.SetPerson org)) nm update flags (FormMsg (Comp.PersonForm.SetPerson org)) nm
Submit -> Submit ->
let let
person = Comp.PersonForm.getPerson model.formModel person =
valid = Comp.PersonForm.isValid model.formModel Comp.PersonForm.getPerson model.formModel
in if valid then
({model|loading = True}, Api.postPerson flags person SubmitResp) valid =
else Comp.PersonForm.isValid model.formModel
({model|formError = Just "Please correct the errors in the form."}, Cmd.none) 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) -> SubmitResp (Ok res) ->
if res.success then if res.success then
let let
(m2, c2) = update flags (SetViewMode Table) model ( m2, c2 ) =
(m3, c3) = update flags LoadPersons m2 update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadPersons m2
in in
({m3|loading = False}, Cmd.batch [c2,c3]) ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else else
({model | formError = Just res.message, loading = False }, Cmd.none) ( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) -> 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 -> RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model update flags (YesNoMsg Comp.YesNoDimmer.activate) model
YesNoMsg m -> YesNoMsg m ->
let let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm ( cm, confirmed ) =
person = Comp.PersonForm.getPerson model.formModel Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.deletePerson flags person.id SubmitResp else Cmd.none
person =
Comp.PersonForm.getPerson model.formModel
cmd =
if confirmed then
Api.deletePerson flags person.id SubmitResp
else
Cmd.none
in in
({model | deleteConfirm = cm}, cmd) ( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
if model.viewMode == Table then viewTable model if model.viewMode == Table then
else viewForm model viewTable model
viewTable: Model -> Html Msg else
viewForm model
viewTable : Model -> Html Msg
viewTable model = viewTable model =
div [] div []
[button [class "ui basic button", onClick InitNewPerson] [ button [ class "ui basic button", onClick InitNewPerson ]
[i [class "plus icon"][] [ i [ class "plus icon" ] []
,text "Create new" , text "Create new"
] ]
,Html.map TableMsg (Comp.PersonTable.view model.tableModel) , Html.map TableMsg (Comp.PersonTable.view model.tableModel)
,div [classList [("ui dimmer", True) , div
,("active", model.loading) [ classList
]] [ ( "ui dimmer", True )
[div [class "ui loader"][] , ( "active", model.loading )
]
]
[ div [ class "ui loader" ] []
] ]
] ]
viewForm: Model -> Html Msg
viewForm : Model -> Html Msg
viewForm model = viewForm model =
let let
newPerson = model.formModel.org.id == "" newPerson =
model.formModel.org.id == ""
in in
Html.form [class "ui segment", onSubmit Submit] Html.form [ class "ui segment", onSubmit Submit ]
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
,if newPerson then , if newPerson then
h3 [class "ui dividing header"] h3 [ class "ui dividing header" ]
[text "Create new person" [ text "Create new person"
]
else
h3 [class "ui dividing header"]
[text ("Edit org: " ++ model.formModel.org.name)
,div [class "sub header"]
[text "Id: "
,text model.formModel.org.id
]
]
,Html.map FormMsg (Comp.PersonForm.view model.formModel)
,div [classList [("ui error message", True)
,("invisible", Util.Maybe.isEmpty model.formError)
]
]
[Maybe.withDefault "" model.formError |> text
]
,div [class "ui horizontal divider"][]
,button [class "ui primary button", type_ "submit"]
[text "Submit"
] ]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel" 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 module Comp.PersonTable exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Api.Model.Person exposing (Person)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) 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.Address
import Util.Contact import Util.Contact
type alias Model = type alias Model =
{ equips: List Person { equips : List Person
, selected: Maybe Person , selected : Maybe Person
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ equips = [] { equips = []
, selected = Nothing , selected = Nothing
} }
type Msg type Msg
= SetPersons (List Person) = SetPersons (List Person)
| Select Person | Select Person
| Deselect | Deselect
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetPersons list -> SetPersons list ->
({model | equips = list, selected = Nothing }, Cmd.none) ( { model | equips = list, selected = Nothing }, Cmd.none )
Select equip -> Select equip ->
({model | selected = Just equip}, Cmd.none) ( { model | selected = Just equip }, Cmd.none )
Deselect -> Deselect ->
({model | selected = Nothing}, Cmd.none) ( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
table [class "ui selectable table"] table [ class "ui selectable table" ]
[thead [] [ thead []
[tr [] [ tr []
[th [class "collapsing"][text "Name"] [ th [ class "collapsing" ] [ text "Name" ]
,th [class "collapsing"][text "Concerning"] , th [ class "collapsing" ] [ text "Concerning" ]
,th [][text "Address"] , th [] [ text "Address" ]
,th [][text "Contact"] , th [] [ text "Contact" ]
] ]
] ]
,tbody [] , tbody []
(List.map (renderPersonLine model) model.equips) (List.map (renderPersonLine model) model.equips)
] ]
renderPersonLine: Model -> Person -> Html Msg
renderPersonLine : Model -> Person -> Html Msg
renderPersonLine model person = renderPersonLine model person =
tr [classList [("active", model.selected == Just person)] tr
,onClick (Select person) [ classList [ ( "active", model.selected == Just person ) ]
] , onClick (Select person)
[td [class "collapsing"] ]
[text person.name [ td [ class "collapsing" ]
] [ text person.name
,td [class "collapsing"]
[if person.concerning then
i [class "check square outline icon"][]
else
i [class "minus square outline icon"][]
] ]
,td [] , td [ class "collapsing" ]
[Util.Address.toString person.address |> text [ if person.concerning then
i [ class "check square outline icon" ] []
else
i [ class "minus square outline icon" ] []
] ]
,td [] , td []
[Util.Contact.toString person.contacts |> text [ 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 module Comp.SearchMenu exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, update , NextState
, NextState , emptyModel
, view , getItemSearch
, 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onInput) import Html.Events exposing (onCheck, onInput)
import Data.Direction exposing (Direction) import Http
import Data.Flags exposing (Flags)
import Comp.Dropdown exposing (isDropdownChangeMsg)
import Comp.DatePicker
import DatePicker exposing (DatePicker)
import Api
import Api.Model.IdName exposing (IdName)
import Api.Model.ItemSearch exposing (ItemSearch)
import Api.Model.TagList exposing (TagList)
import Api.Model.Tag exposing (Tag)
import Api.Model.Equipment exposing (Equipment)
import Api.Model.ReferenceList exposing (ReferenceList)
import Api.Model.EquipmentList exposing (EquipmentList)
import Util.Maybe import Util.Maybe
import Util.Update import Util.Update
-- Data Model -- Data Model
type alias Model = type alias Model =
{ tagInclModel: Comp.Dropdown.Model Tag { tagInclModel : Comp.Dropdown.Model Tag
, tagExclModel: Comp.Dropdown.Model Tag , tagExclModel : Comp.Dropdown.Model Tag
, directionModel: Comp.Dropdown.Model Direction , directionModel : Comp.Dropdown.Model Direction
, orgModel: Comp.Dropdown.Model IdName , orgModel : Comp.Dropdown.Model IdName
, corrPersonModel: Comp.Dropdown.Model IdName , corrPersonModel : Comp.Dropdown.Model IdName
, concPersonModel: Comp.Dropdown.Model IdName , concPersonModel : Comp.Dropdown.Model IdName
, concEquipmentModel: Comp.Dropdown.Model Equipment , concEquipmentModel : Comp.Dropdown.Model Equipment
, inboxCheckbox: Bool , inboxCheckbox : Bool
, fromDateModel: DatePicker , fromDateModel : DatePicker
, fromDate: Maybe Int , fromDate : Maybe Int
, untilDateModel: DatePicker , untilDateModel : DatePicker
, untilDate: Maybe Int , untilDate : Maybe Int
, fromDueDateModel: DatePicker , fromDueDateModel : DatePicker
, fromDueDate: Maybe Int , fromDueDate : Maybe Int
, untilDueDateModel: DatePicker , untilDueDateModel : DatePicker
, untilDueDate: Maybe Int , untilDueDate : Maybe Int
, nameModel: Maybe String , nameModel : Maybe String
} }
emptyModel: Model emptyModel : Model
emptyModel = emptyModel =
{ tagInclModel = makeTagModel { tagInclModel = makeTagModel
, tagExclModel = makeTagModel , tagExclModel = makeTagModel
, directionModel = Comp.Dropdown.makeSingleList , directionModel =
{ makeOption = \entry -> {value = Data.Direction.toString entry, text = Data.Direction.toString entry} Comp.Dropdown.makeSingleList
, options = Data.Direction.all { makeOption = \entry -> { value = Data.Direction.toString entry, text = Data.Direction.toString entry }
, placeholder = "Choose a direction…" , options = Data.Direction.all
, selected = Nothing , placeholder = "Choose a direction…"
} , selected = Nothing
, orgModel = Comp.Dropdown.makeModel }
{ multiple = False , orgModel =
, searchable = \n -> n > 5 Comp.Dropdown.makeModel
, makeOption = \e -> {value = e.id, text = e.name} { multiple = False
, labelColor = \_ -> "" , searchable = \n -> n > 5
, placeholder = "Choose an organization" , makeOption = \e -> { value = e.id, text = e.name }
} , labelColor = \_ -> ""
, corrPersonModel = Comp.Dropdown.makeSingle , placeholder = "Choose an organization"
{ makeOption = \e -> {value = e.id, text = e.name} }
, placeholder = "Choose a person" , corrPersonModel =
} Comp.Dropdown.makeSingle
, concPersonModel = Comp.Dropdown.makeSingle { makeOption = \e -> { value = e.id, text = e.name }
{ makeOption = \e -> {value = e.id, text = e.name} , placeholder = "Choose a person"
, placeholder = "Choose a person" }
} , concPersonModel =
, concEquipmentModel = Comp.Dropdown.makeModel Comp.Dropdown.makeSingle
{ multiple = False { makeOption = \e -> { value = e.id, text = e.name }
, searchable = \n -> n > 5 , placeholder = "Choose a person"
, makeOption = \e -> {value = e.id, text = e.name} }
, labelColor = \_ -> "" , concEquipmentModel =
, placeholder = "Choosa an equipment" Comp.Dropdown.makeModel
} { multiple = False
, searchable = \n -> n > 5
, makeOption = \e -> { value = e.id, text = e.name }
, labelColor = \_ -> ""
, placeholder = "Choosa an equipment"
}
, inboxCheckbox = False , inboxCheckbox = False
, fromDateModel = Comp.DatePicker.emptyModel , fromDateModel = Comp.DatePicker.emptyModel
, fromDate = Nothing , fromDate = Nothing
@ -94,6 +103,7 @@ emptyModel =
, nameModel = Nothing , nameModel = Nothing
} }
type Msg type Msg
= Init = Init
| TagIncMsg (Comp.Dropdown.Msg Tag) | TagIncMsg (Comp.Dropdown.Msg Tag)
@ -115,315 +125,386 @@ type Msg
| SetName String | SetName String
makeTagModel: Comp.Dropdown.Model Tag makeTagModel : Comp.Dropdown.Model Tag
makeTagModel = makeTagModel =
Comp.Dropdown.makeModel Comp.Dropdown.makeModel
{ multiple = True { multiple = True
, searchable = \n -> n > 4 , searchable = \n -> n > 4
, makeOption = \tag -> { value = tag.id, text = tag.name } , 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…" , placeholder = "Choose a tag…"
} }
getDirection: Model -> Maybe Direction
getDirection : Model -> Maybe Direction
getDirection model = getDirection model =
let let
selection = Comp.Dropdown.getSelected model.directionModel selection =
Comp.Dropdown.getSelected model.directionModel
in in
case selection of case selection of
[d] -> Just d [ d ] ->
_ -> Nothing Just d
getItemSearch: Model -> ItemSearch _ ->
Nothing
getItemSearch : Model -> ItemSearch
getItemSearch model = getItemSearch model =
let e = Api.Model.ItemSearch.empty in let
{ e | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id e =
, tagsExclude = Comp.Dropdown.getSelected model.tagExclModel |> List.map .id Api.Model.ItemSearch.empty
, corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head in
, corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head { e
, concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id
, concEquip = Comp.Dropdown.getSelected model.concEquipmentModel |> List.map .id |> List.head , tagsExclude = Comp.Dropdown.getSelected model.tagExclModel |> List.map .id
, direction = Comp.Dropdown.getSelected model.directionModel |> List.head |> Maybe.map Data.Direction.toString , corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head
, inbox = model.inboxCheckbox , corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head
, dateFrom = model.fromDate , concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head
, dateUntil = model.untilDate , concEquip = Comp.Dropdown.getSelected model.concEquipmentModel |> List.map .id |> List.head
, dueDateFrom = model.fromDueDate , direction = Comp.Dropdown.getSelected model.directionModel |> List.head |> Maybe.map Data.Direction.toString
, dueDateUntil = model.untilDueDate , inbox = model.inboxCheckbox
, name = model.nameModel , dateFrom = model.fromDate
, dateUntil = model.untilDate
, dueDateFrom = model.fromDueDate
, dueDateUntil = model.untilDueDate
, name = model.nameModel
} }
-- Update -- 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 = noChange p =
NextState p False NextState p False
update: Flags -> Msg -> Model -> NextState
update : Flags -> Msg -> Model -> NextState
update flags msg model = update flags msg model =
case msg of case msg of
Init -> Init ->
let let
(dp, dpc) = Comp.DatePicker.init ( dp, dpc ) =
Comp.DatePicker.init
in in
noChange ({model|untilDateModel = dp, fromDateModel = dp, untilDueDateModel = dp, fromDueDateModel = dp} noChange
, Cmd.batch ( { model | untilDateModel = dp, fromDateModel = dp, untilDueDateModel = dp, fromDueDateModel = dp }
[Api.getTags flags GetTagsResp , Cmd.batch
,Api.getOrgLight flags GetOrgResp [ Api.getTags flags GetTagsResp
,Api.getEquipments flags GetEquipResp , Api.getOrgLight flags GetOrgResp
,Api.getPersonsLight flags GetPersonResp , Api.getEquipments flags GetEquipResp
,Cmd.map UntilDateMsg dpc , Api.getPersonsLight flags GetPersonResp
,Cmd.map FromDateMsg dpc , Cmd.map UntilDateMsg dpc
,Cmd.map UntilDueDateMsg dpc , Cmd.map FromDateMsg dpc
,Cmd.map FromDueDateMsg dpc , Cmd.map UntilDueDateMsg dpc
] , Cmd.map FromDueDateMsg dpc
) ]
)
GetTagsResp (Ok tags) -> GetTagsResp (Ok tags) ->
let let
tagList = Comp.Dropdown.SetOptions tags.items tagList =
Comp.Dropdown.SetOptions tags.items
in in
noChange <| noChange <|
Util.Update.andThen1 Util.Update.andThen1
[ update flags (TagIncMsg tagList) >> .modelCmd [ update flags (TagIncMsg tagList) >> .modelCmd
, update flags (TagExcMsg tagList) >> .modelCmd , update flags (TagExcMsg tagList) >> .modelCmd
] ]
model model
GetTagsResp (Err err) -> GetTagsResp (Err _) ->
noChange (model, Cmd.none) noChange ( model, Cmd.none )
GetEquipResp (Ok equips) -> GetEquipResp (Ok equips) ->
let let
opts = Comp.Dropdown.SetOptions equips.items opts =
Comp.Dropdown.SetOptions equips.items
in in
update flags (ConcEquipmentMsg opts) model update flags (ConcEquipmentMsg opts) model
GetEquipResp (Err err) -> GetEquipResp (Err _) ->
noChange (model, Cmd.none) noChange ( model, Cmd.none )
GetOrgResp (Ok orgs) -> GetOrgResp (Ok orgs) ->
let let
opts = Comp.Dropdown.SetOptions orgs.items opts =
Comp.Dropdown.SetOptions orgs.items
in in
update flags (OrgMsg opts) model update flags (OrgMsg opts) model
GetOrgResp (Err err) -> GetOrgResp (Err _) ->
noChange (model, Cmd.none) noChange ( model, Cmd.none )
GetPersonResp (Ok ps) -> GetPersonResp (Ok ps) ->
let let
opts = Comp.Dropdown.SetOptions ps.items opts =
Comp.Dropdown.SetOptions ps.items
in in
noChange <| noChange <|
Util.Update.andThen1 Util.Update.andThen1
[ update flags (CorrPersonMsg opts) >> .modelCmd [ update flags (CorrPersonMsg opts) >> .modelCmd
, update flags (ConcPersonMsg opts) >> .modelCmd , update flags (ConcPersonMsg opts) >> .modelCmd
] ]
model model
GetPersonResp (Err err) -> GetPersonResp (Err _) ->
noChange (model, Cmd.none) noChange ( model, Cmd.none )
TagIncMsg m -> TagIncMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.tagInclModel ( m2, c2 ) =
Comp.Dropdown.update m model.tagInclModel
in in
NextState ({model|tagInclModel = m2}, Cmd.map TagIncMsg c2) (isDropdownChangeMsg m) NextState ( { model | tagInclModel = m2 }, Cmd.map TagIncMsg c2 ) (isDropdownChangeMsg m)
TagExcMsg m -> TagExcMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.tagExclModel ( m2, c2 ) =
Comp.Dropdown.update m model.tagExclModel
in in
NextState ({model|tagExclModel = m2}, Cmd.map TagExcMsg c2) (isDropdownChangeMsg m) NextState ( { model | tagExclModel = m2 }, Cmd.map TagExcMsg c2 ) (isDropdownChangeMsg m)
DirectionMsg m -> DirectionMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.directionModel ( m2, c2 ) =
Comp.Dropdown.update m model.directionModel
in in
NextState ({model|directionModel = m2}, Cmd.map DirectionMsg c2) (isDropdownChangeMsg m) NextState ( { model | directionModel = m2 }, Cmd.map DirectionMsg c2 ) (isDropdownChangeMsg m)
OrgMsg m -> OrgMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.orgModel ( m2, c2 ) =
Comp.Dropdown.update m model.orgModel
in in
NextState ({model|orgModel = m2}, Cmd.map OrgMsg c2) (isDropdownChangeMsg m) NextState ( { model | orgModel = m2 }, Cmd.map OrgMsg c2 ) (isDropdownChangeMsg m)
CorrPersonMsg m -> CorrPersonMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.corrPersonModel ( m2, c2 ) =
Comp.Dropdown.update m model.corrPersonModel
in in
NextState ({model|corrPersonModel = m2}, Cmd.map CorrPersonMsg c2) (isDropdownChangeMsg m) NextState ( { model | corrPersonModel = m2 }, Cmd.map CorrPersonMsg c2 ) (isDropdownChangeMsg m)
ConcPersonMsg m -> ConcPersonMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.concPersonModel ( m2, c2 ) =
Comp.Dropdown.update m model.concPersonModel
in in
NextState ({model|concPersonModel = m2}, Cmd.map ConcPersonMsg c2) (isDropdownChangeMsg m) NextState ( { model | concPersonModel = m2 }, Cmd.map ConcPersonMsg c2 ) (isDropdownChangeMsg m)
ConcEquipmentMsg m -> ConcEquipmentMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.concEquipmentModel ( m2, c2 ) =
Comp.Dropdown.update m model.concEquipmentModel
in in
NextState ({model|concEquipmentModel = m2}, Cmd.map ConcEquipmentMsg c2) (isDropdownChangeMsg m) NextState ( { model | concEquipmentModel = m2 }, Cmd.map ConcEquipmentMsg c2 ) (isDropdownChangeMsg m)
ToggleInbox -> ToggleInbox ->
let let
current = model.inboxCheckbox current =
model.inboxCheckbox
in in
NextState ({model | inboxCheckbox = not current }, Cmd.none) True NextState ( { model | inboxCheckbox = not current }, Cmd.none ) True
FromDateMsg m -> FromDateMsg m ->
let let
(dp, event) = Comp.DatePicker.updateDefault m model.fromDateModel ( dp, event ) =
nextDate = case event of Comp.DatePicker.updateDefault m model.fromDateModel
DatePicker.Picked date ->
Just (Comp.DatePicker.startOfDay date) nextDate =
_ -> case event of
Nothing DatePicker.Picked date ->
Just (Comp.DatePicker.startOfDay date)
_ ->
Nothing
in 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 -> UntilDateMsg m ->
let let
(dp, event) = Comp.DatePicker.updateDefault m model.untilDateModel ( dp, event ) =
nextDate = case event of Comp.DatePicker.updateDefault m model.untilDateModel
DatePicker.Picked date ->
Just (Comp.DatePicker.endOfDay date) nextDate =
_ -> case event of
Nothing DatePicker.Picked date ->
Just (Comp.DatePicker.endOfDay date)
_ ->
Nothing
in 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 -> FromDueDateMsg m ->
let let
(dp, event) = Comp.DatePicker.updateDefault m model.fromDueDateModel ( dp, event ) =
nextDate = case event of Comp.DatePicker.updateDefault m model.fromDueDateModel
DatePicker.Picked date ->
Just (Comp.DatePicker.startOfDay date) nextDate =
_ -> case event of
Nothing DatePicker.Picked date ->
Just (Comp.DatePicker.startOfDay date)
_ ->
Nothing
in 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 -> UntilDueDateMsg m ->
let let
(dp, event) = Comp.DatePicker.updateDefault m model.untilDueDateModel ( dp, event ) =
nextDate = case event of Comp.DatePicker.updateDefault m model.untilDueDateModel
DatePicker.Picked date ->
Just (Comp.DatePicker.endOfDay date) nextDate =
_ -> case event of
Nothing DatePicker.Picked date ->
Just (Comp.DatePicker.endOfDay date)
_ ->
Nothing
in 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 -> SetName str ->
let let
next = if str == "" then Nothing else Just str next =
if str == "" then
Nothing
else
Just str
in in
NextState ({model|nameModel = next}, Cmd.none) (model.nameModel /= next) NextState ( { model | nameModel = next }, Cmd.none ) (model.nameModel /= next)
-- View -- View
view : Model -> Html Msg
view: Model -> Html Msg
view model = view model =
div [class "ui form"] div [ class "ui form" ]
[div [class "inline field"] [ div [ class "inline field" ]
[div [class "ui checkbox"] [ div [ class "ui checkbox" ]
[input [type_ "checkbox" [ input
, onCheck (\_ -> ToggleInbox) [ type_ "checkbox"
, checked model.inboxCheckbox][] , onCheck (\_ -> ToggleInbox)
,label [][text "Only New" , checked model.inboxCheckbox
] ]
] []
] , label []
,div [class "field"] [ text "Only New"
[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"] , div [ class "field" ]
[label [][text "Include (and)"] [ label [] [ text "Name" ]
,Html.map TagIncMsg (Comp.Dropdown.view model.tagInclModel) , input
] [ type_ "text"
,div [class "field"] , onInput SetName
[label [][text "Exclude (or)"] , model.nameModel |> Maybe.withDefault "" |> value
,Html.map TagExcMsg (Comp.Dropdown.view model.tagExclModel) ]
] []
,h3 [class "ui header"] , 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 [ case getDirection model of
Just Data.Direction.Incoming -> text "Sender" Just Data.Direction.Incoming ->
Just Data.Direction.Outgoing -> text "Recipient" text "Sender"
Nothing -> text "Correspondent"
Just Data.Direction.Outgoing ->
text "Recipient"
Nothing ->
text "Correspondent"
] ]
,div [class "field"] , div [ class "field" ]
[label [][text "Organization"] [ label [] [ text "Organization" ]
,Html.map OrgMsg (Comp.Dropdown.view model.orgModel) , 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"] , div [ class "field" ]
[label [][text "Person"] [ label [] [ text "Person" ]
,Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel) , Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel)
]
,div [class "field"]
[label [][text "Equipment"]
,Html.map ConcEquipmentMsg (Comp.Dropdown.view model.concEquipmentModel)
]
,h3 [class "ui header"]
[text "Date"
] ]
,div [class "fields"] , h3 [ class "ui header" ]
[div [class "field"] [ text "Concerned"
[label [][text "From" ]
] , div [ class "field" ]
,Html.map FromDateMsg (Comp.DatePicker.viewTimeDefault model.fromDate model.fromDateModel) [ label [] [ text "Person" ]
] , Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel)
,div [class "field"] ]
[label [][text "To" , div [ class "field" ]
] [ label [] [ text "Equipment" ]
,Html.map UntilDateMsg (Comp.DatePicker.viewTimeDefault model.untilDate model.untilDateModel) , Html.map ConcEquipmentMsg (Comp.Dropdown.view model.concEquipmentModel)
] ]
] , h3 [ class "ui header" ]
,h3 [class "ui header"] [ text "Date"
[text "Due 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 exposing (..)
import Html.Attributes 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 = type alias Model =
{ langModel: Comp.Dropdown.Model Language { langModel : Comp.Dropdown.Model Language
, initSettings: CollectiveSettings , initSettings : CollectiveSettings
} }
init: CollectiveSettings -> Model
init : CollectiveSettings -> Model
init settings = init settings =
let let
lang = Data.Language.fromString settings.language |> Maybe.withDefault Data.Language.German lang =
Data.Language.fromString settings.language
|> Maybe.withDefault Data.Language.German
in in
{ langModel = Comp.Dropdown.makeSingleList { langModel =
{ makeOption = \l -> { value = Data.Language.toIso3 l, text = Data.Language.toName l } Comp.Dropdown.makeSingleList
, placeholder = "" { makeOption =
, options = Data.Language.all \l ->
, selected = Just lang { value = Data.Language.toIso3 l
} , text = Data.Language.toName l
, initSettings = settings }
} , placeholder = ""
, options = Data.Language.all
, selected = Just lang
}
, initSettings = settings
}
getSettings: Model -> CollectiveSettings
getSettings : Model -> CollectiveSettings
getSettings model = getSettings model =
CollectiveSettings CollectiveSettings
(Comp.Dropdown.getSelected model.langModel (Comp.Dropdown.getSelected model.langModel
|> List.head |> List.head
|> Maybe.map Data.Language.toIso3 |> Maybe.map Data.Language.toIso3
|> Maybe.withDefault model.initSettings.language |> Maybe.withDefault model.initSettings.language
) )
type Msg type Msg
= LangDropdownMsg (Comp.Dropdown.Msg Language) = 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 = update flags msg model =
case msg of case msg of
LangDropdownMsg m -> LangDropdownMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.langModel ( m2, c2 ) =
nextModel = {model|langModel = m2} Comp.Dropdown.update m model.langModel
nextSettings = if Comp.Dropdown.isDropdownChangeMsg m then Just (getSettings nextModel)
else Nothing nextModel =
{ model | langModel = m2 }
nextSettings =
if Comp.Dropdown.isDropdownChangeMsg m then
Just (getSettings nextModel)
else
Nothing
in in
(nextModel, Cmd.map LangDropdownMsg c2, nextSettings) ( nextModel, Cmd.map LangDropdownMsg c2, nextSettings )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
div [class "ui form"] div [ class "ui form" ]
[div [class "field"] [ div [ class "field" ]
[label [][text "Document Language"] [ label [] [ text "Document Language" ]
,Html.map LangDropdownMsg (Comp.Dropdown.view model.langModel) , 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 module Comp.SourceForm exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update , getSource
, isValid , isValid
, getSource) , 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onCheck) import Html.Events exposing (onCheck, onInput)
import Data.Flags exposing (Flags)
import Data.SourceState exposing (SourceState)
import Data.Priority exposing (Priority)
import Comp.Dropdown
import Api.Model.Source exposing (Source)
import Util.Maybe
type alias Model = type alias Model =
{ source: Source { source : Source
, abbrev: String , abbrev : String
, description: Maybe String , description : Maybe String
, priority: Comp.Dropdown.Model Priority , priority : Comp.Dropdown.Model Priority
, enabled: Bool , enabled : Bool
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ source = Api.Model.Source.empty { source = Api.Model.Source.empty
, abbrev = "" , abbrev = ""
, description = Nothing , description = Nothing
, priority = Comp.Dropdown.makeSingleList , priority =
{ makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p } Comp.Dropdown.makeSingleList
, placeholder = "" { makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p }
, options = Data.Priority.all , placeholder = ""
, selected = Nothing , options = Data.Priority.all
} , selected = Nothing
}
, enabled = False , enabled = False
} }
isValid: Model -> Bool
isValid : Model -> Bool
isValid model = isValid model =
model.abbrev /= "" model.abbrev /= ""
getSource: Model -> Source
getSource : Model -> Source
getSource model = getSource model =
let let
s = model.source s =
model.source
in in
{s | abbrev = model.abbrev { s
, description = model.description | abbrev = model.abbrev
, enabled = model.enabled , description = model.description
, priority = Comp.Dropdown.getSelected model.priority , enabled = model.enabled
|> List.head , priority =
|> Maybe.map Data.Priority.toName Comp.Dropdown.getSelected model.priority
|> Maybe.withDefault s.priority |> List.head
} |> Maybe.map Data.Priority.toName
|> Maybe.withDefault s.priority
}
type Msg type Msg
@ -64,105 +72,138 @@ type Msg
| ToggleEnabled | ToggleEnabled
| PrioDropdownMsg (Comp.Dropdown.Msg Priority) | PrioDropdownMsg (Comp.Dropdown.Msg Priority)
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetSource t -> SetSource t ->
let let
post = model.source post =
np = {post | id = t.id model.source
, abbrev = t.abbrev
, description = t.description np =
, priority = t.priority { post
, enabled = t.enabled | id = t.id
} , abbrev = t.abbrev
, description = t.description
, priority = t.priority
, enabled = t.enabled
}
in in
({model | source = np ( { model
, abbrev = t.abbrev | source = np
, description = t.description , abbrev = t.abbrev
, priority = Comp.Dropdown.makeSingleList , description = t.description
{ makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p } , priority =
, placeholder = "" Comp.Dropdown.makeSingleList
, options = Data.Priority.all { makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p }
, selected = Data.Priority.fromString t.priority , placeholder = ""
} , options = Data.Priority.all
, enabled = t.enabled }, Cmd.none) , selected = Data.Priority.fromString t.priority
}
, enabled = t.enabled
}
, Cmd.none
)
ToggleEnabled -> ToggleEnabled ->
let ( { model | enabled = not model.enabled }, Cmd.none )
_ = Debug.log "got" model.enabled
in
({model | enabled = not model.enabled}, Cmd.none)
SetAbbrev n -> SetAbbrev n ->
({model | abbrev = n}, Cmd.none) ( { model | abbrev = n }, Cmd.none )
SetDescr d -> 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 -> PrioDropdownMsg m ->
let let
(m2, c2) = Comp.Dropdown.update m model.priority ( m2, c2 ) =
Comp.Dropdown.update m model.priority
in 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 = view flags model =
div [class "ui form"] div [ class "ui form" ]
[div [classList [("field", True) [ div
,("error", not (isValid model)) [ classList
] [ ( "field", True )
] , ( "error", not (isValid model) )
[label [][text "Abbrev*"] ]
,input [type_ "text"
,onInput SetAbbrev
,placeholder "Abbrev"
,value model.abbrev
][]
]
,div [class "field"]
[label [][text "Description"]
,textarea [onInput SetDescr][model.description |> Maybe.withDefault "" |> text]
] ]
,div [class "inline field"] [ label [] [ text "Abbrev*" ]
[div [class "ui checkbox"] , input
[input [type_ "checkbox" [ type_ "text"
, onCheck (\_ -> ToggleEnabled) , onInput SetAbbrev
, checked model.enabled][] , placeholder "Abbrev"
,label [][text "Enabled"] , value model.abbrev
] ]
] []
,div [class "field"]
[label [][text "Priority"]
,Html.map PrioDropdownMsg (Comp.Dropdown.view model.priority)
] ]
,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 = urlInfoMessage flags model =
div [classList [("ui info icon message", True) div
,("hidden", not model.enabled || model.source.id == "") [ classList
]] [ ( "ui info icon message", True )
[i [class "info icon"][] , ( "hidden", not model.enabled || model.source.id == "" )
,div [class "content"] ]
[div [class "header"] ]
[text "Public Uploads" [ i [ class "info icon" ] []
] , div [ class "content" ]
,p [][text "This source defines URLs that can be used by anyone to send files to " [ div [ class "header" ]
,text "you. There is a web page that you can share or tha API url can be used " [ text "Public Uploads"
,text "with other clients." ]
] , p []
,dl [class "ui list"] [ text "This source defines URLs that can be used by anyone to send files to "
[dt [][text "Public Upload Page"] , text "you. There is a web page that you can share or tha API url can be used "
,dd [][let , text "with other clients."
url = flags.config.baseUrl ++ "/app/index.html#/upload/" ++ model.source.id ]
in , dl [ class "ui list" ]
a [href url, target "_blank"][code [][text url]] [ dt [] [ text "Public Upload Page" ]
] , dd []
,dt [][text "Public API Upload URL"] [ let
,dd [][code [][text (flags.config.baseUrl ++ "/api/v1/open/upload/item/" ++ model.source.id)] 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 module Comp.SourceManage exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Http
import Api 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit) import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags) import Http
import Comp.SourceTable
import Comp.SourceForm
import Comp.YesNoDimmer
import Api.Model.Source
import Api.Model.SourceList exposing (SourceList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Util.Http import Util.Http
import Util.Maybe
type alias Model = type alias Model =
{ tableModel: Comp.SourceTable.Model { tableModel : Comp.SourceTable.Model
, formModel: Comp.SourceForm.Model , formModel : Comp.SourceForm.Model
, viewMode: ViewMode , viewMode : ViewMode
, formError: Maybe String , formError : Maybe String
, loading: Bool , loading : Bool
, deleteConfirm: Comp.YesNoDimmer.Model , deleteConfirm : Comp.YesNoDimmer.Model
} }
type ViewMode = Table | Form
emptyModel: Model type ViewMode
= Table
| Form
emptyModel : Model
emptyModel = emptyModel =
{ tableModel = Comp.SourceTable.emptyModel { tableModel = Comp.SourceTable.emptyModel
, formModel = Comp.SourceForm.emptyModel , formModel = Comp.SourceForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel , deleteConfirm = Comp.YesNoDimmer.emptyModel
} }
type Msg type Msg
= TableMsg Comp.SourceTable.Msg = TableMsg Comp.SourceTable.Msg
| FormMsg Comp.SourceForm.Msg | FormMsg Comp.SourceForm.Msg
@ -52,156 +60,211 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg | YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete | RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
TableMsg m -> TableMsg m ->
let let
(tm, tc) = Comp.SourceTable.update flags m model.tableModel ( tm, tc ) =
(m2, c2) = ({model | tableModel = tm Comp.SourceTable.update flags m model.tableModel
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError ( m2, c2 ) =
} ( { model
, Cmd.map TableMsg tc | tableModel = tm
) , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
(m3, c3) = case tm.selected of , formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
( m3, c3 ) =
case tm.selected of
Just source -> Just source ->
update flags (FormMsg (Comp.SourceForm.SetSource source)) m2 update flags (FormMsg (Comp.SourceForm.SetSource source)) m2
Nothing -> Nothing ->
(m2, Cmd.none) ( m2, Cmd.none )
in in
(m3, Cmd.batch [c2, c3]) ( m3, Cmd.batch [ c2, c3 ] )
FormMsg m -> FormMsg m ->
let let
(m2, c2) = Comp.SourceForm.update flags m model.formModel ( m2, c2 ) =
Comp.SourceForm.update flags m model.formModel
in in
({model | formModel = m2}, Cmd.map FormMsg c2) ( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadSources -> LoadSources ->
({model| loading = True}, Api.getSources flags SourceResp) ( { model | loading = True }, Api.getSources flags SourceResp )
SourceResp (Ok sources) -> SourceResp (Ok sources) ->
let let
m2 = {model|viewMode = Table, loading = False} m2 =
{ model | viewMode = Table, loading = False }
in in
update flags (TableMsg (Comp.SourceTable.SetSources sources.items)) m2 update flags (TableMsg (Comp.SourceTable.SetSources sources.items)) m2
SourceResp (Err err) -> SourceResp (Err _) ->
({model|loading = False}, Cmd.none) ( { model | loading = False }, Cmd.none )
SetViewMode m -> SetViewMode m ->
let let
m2 = {model | viewMode = m } m2 =
{ model | viewMode = m }
in in
case m of case m of
Table -> Table ->
update flags (TableMsg Comp.SourceTable.Deselect) m2 update flags (TableMsg Comp.SourceTable.Deselect) m2
Form ->
(m2, Cmd.none) Form ->
( m2, Cmd.none )
InitNewSource -> InitNewSource ->
let let
nm = {model | viewMode = Form, formError = Nothing } nm =
source = Api.Model.Source.empty { model | viewMode = Form, formError = Nothing }
source =
Api.Model.Source.empty
in in
update flags (FormMsg (Comp.SourceForm.SetSource source)) nm update flags (FormMsg (Comp.SourceForm.SetSource source)) nm
Submit -> Submit ->
let let
source = Comp.SourceForm.getSource model.formModel source =
valid = Comp.SourceForm.isValid model.formModel Comp.SourceForm.getSource model.formModel
in if valid then
({model|loading = True}, Api.postSource flags source SubmitResp) valid =
else Comp.SourceForm.isValid model.formModel
({model|formError = Just "Please correct the errors in the form."}, Cmd.none) 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) -> SubmitResp (Ok res) ->
if res.success then if res.success then
let let
(m2, c2) = update flags (SetViewMode Table) model ( m2, c2 ) =
(m3, c3) = update flags LoadSources m2 update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadSources m2
in in
({m3|loading = False}, Cmd.batch [c2,c3]) ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else else
({model | formError = Just res.message, loading = False }, Cmd.none) ( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) -> 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 -> RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model update flags (YesNoMsg Comp.YesNoDimmer.activate) model
YesNoMsg m -> YesNoMsg m ->
let let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm ( cm, confirmed ) =
src = Comp.SourceForm.getSource model.formModel Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.deleteSource flags src.id SubmitResp else Cmd.none
src =
Comp.SourceForm.getSource model.formModel
cmd =
if confirmed then
Api.deleteSource flags src.id SubmitResp
else
Cmd.none
in in
({model | deleteConfirm = cm}, cmd) ( { model | deleteConfirm = cm }, cmd )
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model = view flags model =
if model.viewMode == Table then viewTable model if model.viewMode == Table then
else div [](viewForm flags model) viewTable model
viewTable: Model -> Html Msg else
div [] (viewForm flags model)
viewTable : Model -> Html Msg
viewTable model = viewTable model =
div [] div []
[button [class "ui basic button", onClick InitNewSource] [ button [ class "ui basic button", onClick InitNewSource ]
[i [class "plus icon"][] [ i [ class "plus icon" ] []
,text "Create new" , text "Create new"
] ]
,Html.map TableMsg (Comp.SourceTable.view model.tableModel) , Html.map TableMsg (Comp.SourceTable.view model.tableModel)
,div [classList [("ui dimmer", True) , div
,("active", model.loading) [ classList
]] [ ( "ui dimmer", True )
[div [class "ui loader"][] , ( "active", model.loading )
]
]
[ div [ class "ui loader" ] []
] ]
] ]
viewForm: Flags -> Model -> List (Html Msg)
viewForm : Flags -> Model -> List (Html Msg)
viewForm flags model = viewForm flags model =
let let
newSource = model.formModel.source.id == "" newSource =
model.formModel.source.id == ""
in in
[if newSource then [ if newSource then
h3 [class "ui top attached header"] h3 [ class "ui top attached header" ]
[text "Create new source" [ text "Create new source"
] ]
else
h3 [class "ui top attached header"] else
[text ("Edit: " ++ model.formModel.source.abbrev) h3 [ class "ui top attached header" ]
,div [class "sub header"] [ text ("Edit: " ++ model.formModel.source.abbrev)
[text "Id: " , div [ class "sub header" ]
,text model.formModel.source.id [ text "Id: "
] , text model.formModel.source.id
]
,Html.form [class "ui attached segment", onSubmit Submit]
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
,Html.map FormMsg (Comp.SourceForm.view flags model.formModel)
,div [classList [("ui error message", True)
,("invisible", Util.Maybe.isEmpty model.formError)
]
]
[Maybe.withDefault "" model.formError |> text
]
,div [class "ui horizontal divider"][]
,button [class "ui primary button", type_ "submit"]
[text "Submit"
] ]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""] ]
[text "Cancel" , 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] [ Maybe.withDefault "" model.formError |> text
[text "Delete"] ]
else , div [ class "ui horizontal divider" ] []
span[][] , button [ class "ui primary button", type_ "submit" ]
,div [classList [("ui dimmer", True) [ text "Submit"
,("active", model.loading) ]
]] , a [ class "ui secondary button", onClick (SetViewMode Table), href "" ]
[div [class "ui loader"][] [ 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 module Comp.SourceTable exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Api.Model.Source exposing (Source)
import Data.Flags exposing (Flags)
import Data.Priority
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Data.Priority exposing (Priority)
import Api.Model.Source exposing (Source)
type alias Model = type alias Model =
{ sources: List Source { sources : List Source
, selected: Maybe Source , selected : Maybe Source
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ sources = [] { sources = []
, selected = Nothing , selected = Nothing
} }
type Msg type Msg
= SetSources (List Source) = SetSources (List Source)
| Select Source | Select Source
| Deselect | Deselect
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetSources list -> SetSources list ->
({model | sources = list, selected = Nothing }, Cmd.none) ( { model | sources = list, selected = Nothing }, Cmd.none )
Select source -> Select source ->
({model | selected = Just source}, Cmd.none) ( { model | selected = Just source }, Cmd.none )
Deselect -> Deselect ->
({model | selected = Nothing}, Cmd.none) ( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
table [class "ui selectable table"] table [ class "ui selectable table" ]
[thead [] [ thead []
[tr [] [ tr []
[th [class "collapsing"][text "Abbrev"] [ th [ class "collapsing" ] [ text "Abbrev" ]
,th [class "collapsing"][text "Enabled"] , th [ class "collapsing" ] [ text "Enabled" ]
,th [class "collapsing"][text "Counter"] , th [ class "collapsing" ] [ text "Counter" ]
,th [class "collapsing"][text "Priority"] , th [ class "collapsing" ] [ text "Priority" ]
,th [][text "Id"] , th [] [ text "Id" ]
] ]
] ]
,tbody [] , tbody []
(List.map (renderSourceLine model) model.sources) (List.map (renderSourceLine model) model.sources)
] ]
renderSourceLine: Model -> Source -> Html Msg
renderSourceLine : Model -> Source -> Html Msg
renderSourceLine model source = renderSourceLine model source =
tr [classList [("active", model.selected == Just source)] tr
,onClick (Select source) [ classList [ ( "active", model.selected == Just source ) ]
] , onClick (Select source)
[td [class "collapsing"] ]
[text source.abbrev [ td [ class "collapsing" ]
] [ text source.abbrev
,td [class "collapsing"]
[if source.enabled then
i [class "check square outline icon"][]
else
i [class "minus square outline icon"][]
] ]
,td [class "collapsing"] , td [ class "collapsing" ]
[source.counter |> String.fromInt |> text [ if source.enabled then
i [ class "check square outline icon" ] []
else
i [ class "minus square outline icon" ] []
] ]
,td [class "collapsing"] , td [ class "collapsing" ]
[Data.Priority.fromString source.priority [ source.counter |> String.fromInt |> text
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault source.priority
|> text
] ]
,td [] , td [ class "collapsing" ]
[text source.id [ 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 module Comp.TagForm exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update , getTag
, isValid , isValid
, getTag) , update
, view
)
import Api.Model.Tag exposing (Tag)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onInput) import Html.Events exposing (onInput)
import Data.Flags exposing (Flags)
import Api.Model.Tag exposing (Tag)
type alias Model = type alias Model =
{ tag: Tag { tag : Tag
, name: String , name : String
, category: Maybe String , category : Maybe String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ tag = Api.Model.Tag.empty { tag = Api.Model.Tag.empty
, name = "" , name = ""
, category = Nothing , category = Nothing
} }
isValid: Model -> Bool
isValid : Model -> Bool
isValid model = isValid model =
model.name /= "" model.name /= ""
getTag: Model -> Tag
getTag : Model -> Tag
getTag model = getTag model =
Tag model.tag.id model.name model.category 0 Tag model.tag.id model.name model.category 0
type Msg type Msg
= SetName String = SetName String
| SetCategory String | SetCategory String
| SetTag Tag | SetTag Tag
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetTag t -> 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 -> SetName n ->
({model | name = n}, Cmd.none) ( { model | name = n }, Cmd.none )
SetCategory n -> SetCategory n ->
({model | category = Just n}, Cmd.none) ( { model | category = Just n }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
div [class "ui form"] div [ class "ui form" ]
[div [classList [("field", True) [ div
,("error", not (isValid model)) [ classList
] [ ( "field", True )
] , ( "error", not (isValid model) )
[label [][text "Name*"] ]
,input [type_ "text" ]
,onInput SetName [ label [] [ text "Name*" ]
,placeholder "Name" , input
,value model.name [ type_ "text"
][] , onInput SetName
] , placeholder "Name"
,div [class "field"] , value model.name
[label [][text "Category"] ]
,input [type_ "text" []
,onInput SetCategory ]
,placeholder "Category (optional)" , div [ class "field" ]
,value (Maybe.withDefault "" model.category) [ 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 module Comp.TagManage exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Http
import Api 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit) import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags) import Http
import Comp.TagTable
import Comp.TagForm
import Comp.YesNoDimmer
import Api.Model.Tag
import Api.Model.TagList exposing (TagList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Util.Http import Util.Http
import Util.Maybe
type alias Model = type alias Model =
{ tagTableModel: Comp.TagTable.Model { tagTableModel : Comp.TagTable.Model
, tagFormModel: Comp.TagForm.Model , tagFormModel : Comp.TagForm.Model
, viewMode: ViewMode , viewMode : ViewMode
, formError: Maybe String , formError : Maybe String
, loading: Bool , loading : Bool
, deleteConfirm: Comp.YesNoDimmer.Model , deleteConfirm : Comp.YesNoDimmer.Model
} }
type ViewMode = Table | Form
emptyModel: Model type ViewMode
= Table
| Form
emptyModel : Model
emptyModel = emptyModel =
{ tagTableModel = Comp.TagTable.emptyModel { tagTableModel = Comp.TagTable.emptyModel
, tagFormModel = Comp.TagForm.emptyModel , tagFormModel = Comp.TagForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel , deleteConfirm = Comp.YesNoDimmer.emptyModel
} }
type Msg type Msg
= TableMsg Comp.TagTable.Msg = TableMsg Comp.TagTable.Msg
| FormMsg Comp.TagForm.Msg | FormMsg Comp.TagForm.Msg
@ -52,155 +60,210 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg | YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete | RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
TableMsg m -> TableMsg m ->
let let
(tm, tc) = Comp.TagTable.update flags m model.tagTableModel ( tm, tc ) =
(m2, c2) = ({model | tagTableModel = tm Comp.TagTable.update flags m model.tagTableModel
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError ( m2, c2 ) =
} ( { model
, Cmd.map TableMsg tc | tagTableModel = tm
) , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
(m3, c3) = case tm.selected of , formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
( m3, c3 ) =
case tm.selected of
Just tag -> Just tag ->
update flags (FormMsg (Comp.TagForm.SetTag tag)) m2 update flags (FormMsg (Comp.TagForm.SetTag tag)) m2
Nothing -> Nothing ->
(m2, Cmd.none) ( m2, Cmd.none )
in in
(m3, Cmd.batch [c2, c3]) ( m3, Cmd.batch [ c2, c3 ] )
FormMsg m -> FormMsg m ->
let let
(m2, c2) = Comp.TagForm.update flags m model.tagFormModel ( m2, c2 ) =
Comp.TagForm.update flags m model.tagFormModel
in in
({model | tagFormModel = m2}, Cmd.map FormMsg c2) ( { model | tagFormModel = m2 }, Cmd.map FormMsg c2 )
LoadTags -> LoadTags ->
({model| loading = True}, Api.getTags flags TagResp) ( { model | loading = True }, Api.getTags flags TagResp )
TagResp (Ok tags) -> TagResp (Ok tags) ->
let let
m2 = {model|viewMode = Table, loading = False} m2 =
{ model | viewMode = Table, loading = False }
in in
update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2 update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2
TagResp (Err err) -> TagResp (Err _) ->
({model|loading = False}, Cmd.none) ( { model | loading = False }, Cmd.none )
SetViewMode m -> SetViewMode m ->
let let
m2 = {model | viewMode = m } m2 =
{ model | viewMode = m }
in in
case m of case m of
Table -> Table ->
update flags (TableMsg Comp.TagTable.Deselect) m2 update flags (TableMsg Comp.TagTable.Deselect) m2
Form ->
(m2, Cmd.none) Form ->
( m2, Cmd.none )
InitNewTag -> InitNewTag ->
let let
nm = {model | viewMode = Form, formError = Nothing } nm =
tag = Api.Model.Tag.empty { model | viewMode = Form, formError = Nothing }
tag =
Api.Model.Tag.empty
in in
update flags (FormMsg (Comp.TagForm.SetTag tag)) nm update flags (FormMsg (Comp.TagForm.SetTag tag)) nm
Submit -> Submit ->
let let
tag = Comp.TagForm.getTag model.tagFormModel tag =
valid = Comp.TagForm.isValid model.tagFormModel Comp.TagForm.getTag model.tagFormModel
in if valid then
({model|loading = True}, Api.postTag flags tag SubmitResp) valid =
else Comp.TagForm.isValid model.tagFormModel
({model|formError = Just "Please correct the errors in the form."}, Cmd.none) 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) -> SubmitResp (Ok res) ->
if res.success then if res.success then
let let
(m2, c2) = update flags (SetViewMode Table) model ( m2, c2 ) =
(m3, c3) = update flags LoadTags m2 update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadTags m2
in in
({m3|loading = False}, Cmd.batch [c2,c3]) ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else else
({model | formError = Just res.message, loading = False }, Cmd.none) ( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) -> 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 -> RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model update flags (YesNoMsg Comp.YesNoDimmer.activate) model
YesNoMsg m -> YesNoMsg m ->
let let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm ( cm, confirmed ) =
tag = Comp.TagForm.getTag model.tagFormModel Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.deleteTag flags tag.id SubmitResp else Cmd.none
tag =
Comp.TagForm.getTag model.tagFormModel
cmd =
if confirmed then
Api.deleteTag flags tag.id SubmitResp
else
Cmd.none
in in
({model | deleteConfirm = cm}, cmd) ( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model = view model =
if model.viewMode == Table then viewTable model if model.viewMode == Table then
else viewForm model viewTable model
viewTable: Model -> Html Msg else
viewForm model
viewTable : Model -> Html Msg
viewTable model = viewTable model =
div [] div []
[button [class "ui basic button", onClick InitNewTag] [ button [ class "ui basic button", onClick InitNewTag ]
[i [class "plus icon"][] [ i [ class "plus icon" ] []
,text "Create new" , text "Create new"
] ]
,Html.map TableMsg (Comp.TagTable.view model.tagTableModel) , Html.map TableMsg (Comp.TagTable.view model.tagTableModel)
,div [classList [("ui dimmer", True) , div
,("active", model.loading) [ classList
]] [ ( "ui dimmer", True )
[div [class "ui loader"][] , ( "active", model.loading )
]
]
[ div [ class "ui loader" ] []
] ]
] ]
viewForm: Model -> Html Msg
viewForm : Model -> Html Msg
viewForm model = viewForm model =
let let
newTag = model.tagFormModel.tag.id == "" newTag =
model.tagFormModel.tag.id == ""
in in
Html.form [class "ui segment", onSubmit Submit] Html.form [ class "ui segment", onSubmit Submit ]
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
,if newTag then , if newTag then
h3 [class "ui dividing header"] h3 [ class "ui dividing header" ]
[text "Create new tag" [ text "Create new tag"
]
else
h3 [class "ui dividing header"]
[text ("Edit tag: " ++ model.tagFormModel.tag.name)
,div [class "sub header"]
[text "Id: "
,text model.tagFormModel.tag.id
]
]
,Html.map FormMsg (Comp.TagForm.view model.tagFormModel)
,div [classList [("ui error message", True)
,("invisible", Util.Maybe.isEmpty model.formError)
]
]
[Maybe.withDefault "" model.formError |> text
]
,div [class "ui horizontal divider"][]
,button [class "ui primary button", type_ "submit"]
[text "Submit"
] ]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel" 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 module Comp.TagTable exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Api.Model.Tag exposing (Tag)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Api.Model.Tag exposing (Tag)
type alias Model = type alias Model =
{ tags: List Tag { tags : List Tag
, selected: Maybe Tag , selected : Maybe Tag
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ tags = [] { tags = []
, selected = Nothing , selected = Nothing
} }
type Msg type Msg
= SetTags (List Tag) = SetTags (List Tag)
| Select Tag | Select Tag
| Deselect | Deselect
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetTags list -> SetTags list ->
({model | tags = list, selected = Nothing }, Cmd.none) ( { model | tags = list, selected = Nothing }, Cmd.none )
Select tag -> Select tag ->
({model | selected = Just tag}, Cmd.none) ( { model | selected = Just tag }, Cmd.none )
Deselect -> Deselect ->
({model | selected = Nothing}, Cmd.none) ( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
table [class "ui selectable table"] table [ class "ui selectable table" ]
[thead [] [ thead []
[tr [] [ tr []
[th [][text "Name"] [ th [] [ text "Name" ]
,th [][text "Category"] , th [] [ text "Category" ]
] ]
] ]
,tbody [] , tbody []
(List.map (renderTagLine model) model.tags) (List.map (renderTagLine model) model.tags)
] ]
renderTagLine: Model -> Tag -> Html Msg
renderTagLine : Model -> Tag -> Html Msg
renderTagLine model tag = renderTagLine model tag =
tr [classList [("active", model.selected == Just tag)] tr
,onClick (Select tag) [ classList [ ( "active", model.selected == Just tag ) ]
] , onClick (Select tag)
[td [] ]
[text tag.name [ td []
] [ text tag.name
,td [] ]
[Maybe.withDefault "-" tag.category |> text , 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 module Comp.UserForm exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update , getUser
, isValid , isNewUser
, isNewUser , isValid
, getUser) , update
, view
)
import Html exposing (..) import Api.Model.User exposing (User)
import Html.Attributes exposing (..) import Comp.Dropdown
import Html.Events exposing (onInput, onCheck)
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Data.UserState exposing (UserState) 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 Util.Maybe
import Comp.Dropdown
type alias Model = type alias Model =
{ user: User { user : User
, login: String , login : String
, email: Maybe String , email : Maybe String
, state: Comp.Dropdown.Model UserState , state : Comp.Dropdown.Model UserState
, password: Maybe String , password : Maybe String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ user = Api.Model.User.empty { user = Api.Model.User.empty
, login = "" , login = ""
, email = Nothing , email = Nothing
, password = Nothing , password = Nothing
, state = Comp.Dropdown.makeSingleList , state =
{ makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s } Comp.Dropdown.makeSingleList
, placeholder = "" { makeOption =
, options = Data.UserState.all \s ->
, selected = List.head Data.UserState.all { 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 = isValid model =
if model.user.login == "" then if model.user.login == "" then
model.login /= "" && Util.Maybe.nonEmpty model.password model.login /= "" && Util.Maybe.nonEmpty model.password
else else
True True
isNewUser: Model -> Bool
isNewUser : Model -> Bool
isNewUser model = isNewUser model =
model.user.login == "" model.user.login == ""
getUser: Model -> User
getUser : Model -> User
getUser model = getUser model =
let let
s = model.user s =
state = Comp.Dropdown.getSelected model.state model.user
state =
Comp.Dropdown.getSelected model.state
|> List.head |> List.head
|> Maybe.withDefault Data.UserState.Active |> Maybe.withDefault Data.UserState.Active
|> Data.UserState.toString |> Data.UserState.toString
in in
{s | login = model.login { s
, email = model.email | login = model.login
, state = state , email = model.email
, password = model.password , state = state
} , password = model.password
}
type Msg type Msg
@ -72,79 +89,115 @@ type Msg
| StateMsg (Comp.Dropdown.Msg UserState) | StateMsg (Comp.Dropdown.Msg UserState)
| SetPassword String | SetPassword String
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetUser t -> SetUser t ->
let let
state = Comp.Dropdown.makeSingleList state =
Comp.Dropdown.makeSingleList
{ makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s } { makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s }
, placeholder = "" , placeholder = ""
, options = Data.UserState.all , options = Data.UserState.all
, selected = Data.UserState.fromString t.state , selected =
|> Maybe.map (\u -> List.filter ((==) u) Data.UserState.all) Data.UserState.fromString t.state
|> Maybe.andThen List.head |> Maybe.map (\u -> List.filter ((==) u) Data.UserState.all)
|> Util.Maybe.withDefault (List.head Data.UserState.all) |> Maybe.andThen List.head
|> Util.Maybe.withDefault (List.head Data.UserState.all)
} }
in in
({model | user = t ( { model
, login = t.login | user = t
, email = t.email , login = t.login
, password = t.password , email = t.email
, state = state }, Cmd.none) , password = t.password
, state = state
}
, Cmd.none
)
StateMsg m -> StateMsg m ->
let let
(m1, c1) = Comp.Dropdown.update m model.state ( m1, c1 ) =
Comp.Dropdown.update m model.state
in in
({model | state = m1}, Cmd.map StateMsg c1) ( { model | state = m1 }, Cmd.map StateMsg c1 )
SetLogin n -> SetLogin n ->
({model | login = n}, Cmd.none) ( { model | login = n }, Cmd.none )
SetEmail e -> 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 -> 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 = view model =
div [class "ui form"] div [ class "ui form" ]
[div [classList [("field", True) [ div
,("error", model.login == "") [ classList
,("invisible", model.user.login /= "") [ ( "field", True )
] , ( "error", model.login == "" )
] , ( "invisible", model.user.login /= "" )
[label [][text "Login*"] ]
,input [type_ "text"
,onInput SetLogin
,placeholder "Login"
,value model.login
][]
]
,div [class "field"]
[label [][text "E-Mail"]
,input [ onInput SetEmail
, model.email |> Maybe.withDefault "" |> value
, placeholder "E-Mail"
][]
] ]
,div [class "field"] [ label [] [ text "Login*" ]
[label [][text "State"] , input
,Html.map StateMsg (Comp.Dropdown.view model.state) [ type_ "text"
, onInput SetLogin
, placeholder "Login"
, value model.login
]
[]
] ]
,div [classList [("field", True) , div [ class "field" ]
,("invisible", model.user.login /= "") [ label [] [ text "E-Mail" ]
,("error", Util.Maybe.isEmpty model.password) , input
] [ onInput SetEmail
] , model.email |> Maybe.withDefault "" |> value
[label [][text "Password*"] , placeholder "E-Mail"
,input [type_ "text" ]
, onInput SetPassword []
, placeholder "Password" ]
, Maybe.withDefault "" model.password |> value , 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 module Comp.UserManage exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Http
import Api 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit) import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags) import Http
import Comp.UserTable
import Comp.UserForm
import Comp.YesNoDimmer
import Api.Model.User
import Api.Model.UserList exposing (UserList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Util.Http import Util.Http
import Util.Maybe
type alias Model = type alias Model =
{ tableModel: Comp.UserTable.Model { tableModel : Comp.UserTable.Model
, formModel: Comp.UserForm.Model , formModel : Comp.UserForm.Model
, viewMode: ViewMode , viewMode : ViewMode
, formError: Maybe String , formError : Maybe String
, loading: Bool , loading : Bool
, deleteConfirm: Comp.YesNoDimmer.Model , deleteConfirm : Comp.YesNoDimmer.Model
} }
type ViewMode = Table | Form
emptyModel: Model type ViewMode
= Table
| Form
emptyModel : Model
emptyModel = emptyModel =
{ tableModel = Comp.UserTable.emptyModel { tableModel = Comp.UserTable.emptyModel
, formModel = Comp.UserForm.emptyModel , formModel = Comp.UserForm.emptyModel
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel , deleteConfirm = Comp.YesNoDimmer.emptyModel
} }
type Msg type Msg
= TableMsg Comp.UserTable.Msg = TableMsg Comp.UserTable.Msg
| FormMsg Comp.UserForm.Msg | FormMsg Comp.UserForm.Msg
@ -52,154 +60,213 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg | YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete | RequestDelete
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
TableMsg m -> TableMsg m ->
let let
(tm, tc) = Comp.UserTable.update flags m model.tableModel ( tm, tc ) =
(m2, c2) = ({model | tableModel = tm Comp.UserTable.update flags m model.tableModel
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError ( m2, c2 ) =
} ( { model
, Cmd.map TableMsg tc | tableModel = tm
) , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
(m3, c3) = case tm.selected of , formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
( m3, c3 ) =
case tm.selected of
Just user -> Just user ->
update flags (FormMsg (Comp.UserForm.SetUser user)) m2 update flags (FormMsg (Comp.UserForm.SetUser user)) m2
Nothing -> Nothing ->
(m2, Cmd.none) ( m2, Cmd.none )
in in
(m3, Cmd.batch [c2, c3]) ( m3, Cmd.batch [ c2, c3 ] )
FormMsg m -> FormMsg m ->
let let
(m2, c2) = Comp.UserForm.update flags m model.formModel ( m2, c2 ) =
Comp.UserForm.update flags m model.formModel
in in
({model | formModel = m2}, Cmd.map FormMsg c2) ( { model | formModel = m2 }, Cmd.map FormMsg c2 )
LoadUsers -> LoadUsers ->
({model| loading = True}, Api.getUsers flags UserResp) ( { model | loading = True }, Api.getUsers flags UserResp )
UserResp (Ok users) -> UserResp (Ok users) ->
let let
m2 = {model|viewMode = Table, loading = False} m2 =
{ model | viewMode = Table, loading = False }
in in
update flags (TableMsg (Comp.UserTable.SetUsers users.items)) m2 update flags (TableMsg (Comp.UserTable.SetUsers users.items)) m2
UserResp (Err err) -> UserResp (Err _) ->
({model|loading = False}, Cmd.none) ( { model | loading = False }, Cmd.none )
SetViewMode m -> SetViewMode m ->
let let
m2 = {model | viewMode = m } m2 =
{ model | viewMode = m }
in in
case m of case m of
Table -> Table ->
update flags (TableMsg Comp.UserTable.Deselect) m2 update flags (TableMsg Comp.UserTable.Deselect) m2
Form ->
(m2, Cmd.none) Form ->
( m2, Cmd.none )
InitNewUser -> InitNewUser ->
let let
nm = {model | viewMode = Form, formError = Nothing } nm =
user = Api.Model.User.empty { model | viewMode = Form, formError = Nothing }
user =
Api.Model.User.empty
in in
update flags (FormMsg (Comp.UserForm.SetUser user)) nm update flags (FormMsg (Comp.UserForm.SetUser user)) nm
Submit -> Submit ->
let let
user = Comp.UserForm.getUser model.formModel user =
valid = Comp.UserForm.isValid model.formModel Comp.UserForm.getUser model.formModel
cmd = if Comp.UserForm.isNewUser model.formModel
then Api.postNewUser flags user SubmitResp valid =
else Api.putUser flags user SubmitResp Comp.UserForm.isValid model.formModel
in if valid then
({model|loading = True}, cmd) cmd =
else if Comp.UserForm.isNewUser model.formModel then
({model|formError = Just "Please correct the errors in the form."}, Cmd.none) 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) -> SubmitResp (Ok res) ->
if res.success then if res.success then
let let
(m2, c2) = update flags (SetViewMode Table) model ( m2, c2 ) =
(m3, c3) = update flags LoadUsers m2 update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadUsers m2
in in
({m3|loading = False}, Cmd.batch [c2,c3]) ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else else
({model | formError = Just res.message, loading = False }, Cmd.none) ( { model | formError = Just res.message, loading = False }, Cmd.none )
SubmitResp (Err err) -> 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 -> RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model update flags (YesNoMsg Comp.YesNoDimmer.activate) model
YesNoMsg m -> YesNoMsg m ->
let let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm ( cm, confirmed ) =
user = Comp.UserForm.getUser model.formModel Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.deleteUser flags user.login SubmitResp else Cmd.none
user =
Comp.UserForm.getUser model.formModel
cmd =
if confirmed then
Api.deleteUser flags user.login SubmitResp
else
Cmd.none
in in
({model | deleteConfirm = cm}, cmd) ( { model | deleteConfirm = cm }, cmd )
view: Model -> Html Msg
view : Model -> Html Msg
view model = view model =
if model.viewMode == Table then viewTable model if model.viewMode == Table then
else viewForm model viewTable model
viewTable: Model -> Html Msg else
viewForm model
viewTable : Model -> Html Msg
viewTable model = viewTable model =
div [] div []
[button [class "ui basic button", onClick InitNewUser] [ button [ class "ui basic button", onClick InitNewUser ]
[i [class "plus icon"][] [ i [ class "plus icon" ] []
,text "Create new" , text "Create new"
] ]
,Html.map TableMsg (Comp.UserTable.view model.tableModel) , Html.map TableMsg (Comp.UserTable.view model.tableModel)
,div [classList [("ui dimmer", True) , div
,("active", model.loading) [ classList
]] [ ( "ui dimmer", True )
[div [class "ui loader"][] , ( "active", model.loading )
]
]
[ div [ class "ui loader" ] []
] ]
] ]
viewForm: Model -> Html Msg
viewForm : Model -> Html Msg
viewForm model = viewForm model =
let let
newUser = Comp.UserForm.isNewUser model.formModel newUser =
Comp.UserForm.isNewUser model.formModel
in in
Html.form [class "ui segment", onSubmit Submit] Html.form [ class "ui segment", onSubmit Submit ]
[Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
,if newUser then , if newUser then
h3 [class "ui dividing header"] h3 [ class "ui dividing header" ]
[text "Create new user" [ text "Create new user"
]
else
h3 [class "ui dividing header"]
[text ("Edit user: " ++ model.formModel.user.login)
]
,Html.map FormMsg (Comp.UserForm.view model.formModel)
,div [classList [("ui error message", True)
,("invisible", Util.Maybe.isEmpty model.formError)
]
]
[Maybe.withDefault "" model.formError |> text
]
,div [class "ui horizontal divider"][]
,button [class "ui primary button", type_ "submit"]
[text "Submit"
] ]
,a [class "ui secondary button", onClick (SetViewMode Table), href ""]
[text "Cancel" 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 module Comp.UserTable exposing
, emptyModel ( Model
, Msg(..) , Msg(..)
, view , emptyModel
, update) , update
, view
)
import Api.Model.User exposing (User)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Api.Model.User exposing (User)
import Util.Time exposing (formatDateTime) import Util.Time exposing (formatDateTime)
type alias Model = type alias Model =
{ users: List User { users : List User
, selected: Maybe User , selected : Maybe User
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ users = [] { users = []
, selected = Nothing , selected = Nothing
} }
type Msg type Msg
= SetUsers (List User) = SetUsers (List User)
| Select User | Select User
| Deselect | Deselect
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetUsers list -> SetUsers list ->
({model | users = list, selected = Nothing }, Cmd.none) ( { model | users = list, selected = Nothing }, Cmd.none )
Select user -> Select user ->
({model | selected = Just user}, Cmd.none) ( { model | selected = Just user }, Cmd.none )
Deselect -> Deselect ->
({model | selected = Nothing}, Cmd.none) ( { model | selected = Nothing }, Cmd.none )
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
table [class "ui selectable table"] table [ class "ui selectable table" ]
[thead [] [ thead []
[tr [] [ tr []
[th [class "collapsing"][text "Login"] [ th [ class "collapsing" ] [ text "Login" ]
,th [class "collapsing"][text "State"] , th [ class "collapsing" ] [ text "State" ]
,th [class "collapsing"][text "Email"] , th [ class "collapsing" ] [ text "Email" ]
,th [class "collapsing"][text "Logins"] , th [ class "collapsing" ] [ text "Logins" ]
,th [class "collapsing"][text "Last Login"] , th [ class "collapsing" ] [ text "Last Login" ]
,th [class "collapsing"][text "Created"] , th [ class "collapsing" ] [ text "Created" ]
] ]
] ]
,tbody [] , tbody []
(List.map (renderUserLine model) model.users) (List.map (renderUserLine model) model.users)
] ]
renderUserLine: Model -> User -> Html Msg
renderUserLine : Model -> User -> Html Msg
renderUserLine model user = renderUserLine model user =
tr [classList [("active", model.selected == Just user)] tr
,onClick (Select user) [ classList [ ( "active", model.selected == Just user ) ]
] , onClick (Select user)
[td [class "collapsing"] ]
[text user.login [ td [ class "collapsing" ]
] [ text user.login
,td [class "collapsing"]
[text user.state
] ]
,td [class "collapsing"] , td [ class "collapsing" ]
[Maybe.withDefault "" user.email |> text [ text user.state
] ]
,td [class "collapsing"] , td [ class "collapsing" ]
[String.fromInt user.loginCount |> text [ Maybe.withDefault "" user.email |> text
] ]
,td [class "collapsing"] , td [ class "collapsing" ]
[Maybe.map formatDateTime user.lastLogin |> Maybe.withDefault "" |> text [ String.fromInt user.loginCount |> text
] ]
,td [class "collapsing"] , td [ class "collapsing" ]
[formatDateTime user.created |> text [ 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 module Comp.YesNoDimmer exposing
, Msg(..) ( Model
, emptyModel , Msg(..)
, update , Settings
, view , activate
, view2 , defaultSettings
, activate , disable
, disable , emptyModel
, Settings , update
, defaultSettings , view
) , view2
)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
type alias Model = type alias Model =
{ active: Bool { active : Bool
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ active = False { active = False
} }
type Msg type Msg
= Activate = Activate
| Disable | Disable
| ConfirmDelete | ConfirmDelete
type alias Settings = type alias Settings =
{ message: String { message : String
, headerIcon: String , headerIcon : String
, headerClass: String , headerClass : String
, confirmButton: String , confirmButton : String
, cancelButton: String , cancelButton : String
, invertedDimmer: Bool , invertedDimmer : Bool
} }
defaultSettings: Settings
defaultSettings : Settings
defaultSettings = defaultSettings =
{ message = "Delete this item permanently?" { message = "Delete this item permanently?"
, headerIcon = "exclamation icon" , headerIcon = "exclamation icon"
@ -48,48 +54,62 @@ defaultSettings =
} }
activate: Msg activate : Msg
activate = Activate activate =
Activate
disable: Msg
disable = Disable
update: Msg -> Model -> (Model, Bool) disable : Msg
disable =
Disable
update : Msg -> Model -> ( Model, Bool )
update msg model = update msg model =
case msg of case msg of
Activate -> Activate ->
({model | active = True}, False) ( { model | active = True }, False )
Disable ->
({model | active = False}, False)
ConfirmDelete ->
({model | active = False}, True)
view: Model -> Html Msg Disable ->
( { model | active = False }, False )
ConfirmDelete ->
( { model | active = False }, True )
view : Model -> Html Msg
view model = view model =
view2 True defaultSettings model view2 True defaultSettings model
view2: Bool -> Settings -> Model -> Html Msg
view2 : Bool -> Settings -> Model -> Html Msg
view2 active settings model = view2 active settings model =
div [classList [("ui dimmer", True) div
,("inverted", settings.invertedDimmer) [ classList
,("active", (active && model.active)) [ ( "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][] [ div [ class "content" ]
,text settings.message [ h3 [ class settings.headerClass ]
] [ if settings.headerIcon == "" then
] span [] []
,div [class "content"]
[div [class "ui buttons"] else
[a [class "ui primary button", onClick ConfirmDelete, href ""] i [ class settings.headerIcon ] []
[text settings.confirmButton , text settings.message
] ]
,div [class "or"][] ]
,a [class "ui secondary button", onClick Disable, href ""] , div [ class "content" ]
[text settings.cancelButton [ 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 type ContactType
= Phone = Phone
@ -9,28 +15,54 @@ type ContactType
| Website | Website
fromString: String -> Maybe ContactType fromString : String -> Maybe ContactType
fromString str = fromString str =
case String.toLower str of case String.toLower str of
"phone" -> Just Phone "phone" ->
"mobile" -> Just Mobile Just Phone
"fax" -> Just Fax
"email" -> Just Email
"docspell" -> Just Docspell
"website" -> Just Website
_ -> Nothing
toString: ContactType -> String "mobile" ->
Just Mobile
"fax" ->
Just Fax
"email" ->
Just Email
"docspell" ->
Just Docspell
"website" ->
Just Website
_ ->
Nothing
toString : ContactType -> String
toString ct = toString ct =
case ct of case ct of
Phone -> "Phone" Phone ->
Mobile -> "Mobile" "Phone"
Fax -> "Fax"
Email -> "Email"
Docspell -> "Docspell"
Website -> "Website"
all: List ContactType Mobile ->
"Mobile"
Fax ->
"Fax"
Email ->
"Email"
Docspell ->
"Docspell"
Website ->
"Website"
all : List ContactType
all = all =
[ Mobile [ Mobile
, Phone , 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 type Direction
= Incoming = Incoming
| Outgoing | Outgoing
fromString: String -> Maybe Direction
fromString : String -> Maybe Direction
fromString str = fromString str =
case String.toLower str of case String.toLower str of
"outgoing" -> Just Outgoing "outgoing" ->
"incoming" -> Just Incoming Just Outgoing
_ -> Nothing
all: List Direction "incoming" ->
Just Incoming
_ ->
Nothing
all : List Direction
all = all =
[ Incoming [ Incoming
, Outgoing , Outgoing
] ]
toString: Direction -> String
toString : Direction -> String
toString dir = toString dir =
case dir of case dir of
Incoming -> "Incoming" Incoming ->
Outgoing -> "Outgoing" "Incoming"
icon: Direction -> String Outgoing ->
"Outgoing"
icon : Direction -> String
icon dir = icon dir =
case dir of case dir of
Incoming -> "level down alternate icon" Incoming ->
Outgoing -> "level up alternate icon" "level down alternate icon"
unknownIcon: String Outgoing ->
"level up alternate icon"
unknownIcon : String
unknownIcon = unknownIcon =
"question circle outline icon" "question circle outline icon"
iconFromString: String -> String
iconFromString : String -> String
iconFromString dir = iconFromString dir =
fromString dir fromString dir
|> Maybe.map icon |> Maybe.map icon
|> Maybe.withDefault unknownIcon |> Maybe.withDefault unknownIcon
iconFromMaybe: Maybe String -> String
iconFromMaybe : Maybe String -> String
iconFromMaybe ms = iconFromMaybe ms =
Maybe.map iconFromString ms Maybe.map iconFromString ms
|> Maybe.withDefault unknownIcon |> 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) import Api.Model.AuthResult exposing (AuthResult)
type alias Config = type alias Config =
{ appName: String { appName : String
, baseUrl: String , baseUrl : String
, signupMode: String , signupMode : String
, docspellAssetPath: String , docspellAssetPath : String
} }
type alias Flags = type alias Flags =
{ account: Maybe AuthResult { account : Maybe AuthResult
, config: Config , config : Config
} }
getToken: Flags -> Maybe String
getToken : Flags -> Maybe String
getToken flags = getToken flags =
flags.account flags.account
|> Maybe.andThen (\a -> a.token) |> Maybe.andThen (\a -> a.token)
withAccount: Flags -> AuthResult -> Flags
withAccount : Flags -> AuthResult -> Flags
withAccount flags acc = withAccount flags acc =
{ flags | account = Just acc } { flags | account = Just acc }
withoutAccount: Flags -> Flags
withoutAccount : Flags -> Flags
withoutAccount flags = withoutAccount flags =
{ flags | account = Nothing } { 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 type Language
= German = German
| English | 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 = toIso3 lang =
case lang of case lang of
German -> "deu" German ->
English -> "eng" "deu"
toName: Language -> String English ->
"eng"
toName : Language -> String
toName lang = toName lang =
case lang of case lang of
German -> "German" German ->
English -> "English" "German"
all: List Language English ->
"English"
all : List Language
all = all =
[ German, English ] [ 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 type Priority
= High = High
| Low | Low
fromString: String -> Maybe Priority
fromString : String -> Maybe Priority
fromString str = fromString str =
let let
s = String.toLower str s =
String.toLower str
in in
case s of case s of
"low" -> Just Low "low" ->
"high" -> Just High Just Low
_ -> Nothing
toName: Priority -> String "high" ->
Just High
_ ->
Nothing
toName : Priority -> String
toName lang = toName lang =
case lang of case lang of
Low -> "Low" Low ->
High-> "High" "Low"
all: List Priority High ->
"High"
all : List Priority
all = all =
[ Low, High ] [ 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 type SourceState
= Active = Active
| Disabled | Disabled
fromString: String -> Maybe SourceState
fromString : String -> Maybe SourceState
fromString str = fromString str =
case String.toLower str of case String.toLower str of
"active" -> Just Active "active" ->
"disabled" -> Just Disabled Just Active
_ -> Nothing
all: List SourceState "disabled" ->
Just Disabled
_ ->
Nothing
all : List SourceState
all = all =
[ Active [ Active
, Disabled , Disabled
] ]
toString: SourceState -> String
toString : SourceState -> String
toString dir = toString dir =
case dir of case dir of
Active -> "Active" Active ->
Disabled -> "Disabled" "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 type UserState
= Active = Active
| Disabled | Disabled
fromString: String -> Maybe UserState
fromString : String -> Maybe UserState
fromString str = fromString str =
case String.toLower str of case String.toLower str of
"active" -> Just Active "active" ->
"disabled" -> Just Disabled Just Active
_ -> Nothing
all: List UserState "disabled" ->
Just Disabled
_ ->
Nothing
all : List UserState
all = all =
[ Active [ Active
, Disabled , Disabled
] ]
toString: UserState -> String
toString : UserState -> String
toString dir = toString dir =
case dir of case dir of
Active -> "Active" Active ->
Disabled -> "Disabled" "Active"
Disabled ->
"Disabled"

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

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

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

@ -1,25 +1,26 @@
module Page exposing ( Page(..) module Page exposing
, href ( Page(..)
, goto , fromUrl
, pageToString , goto
, pageFromString , href
, pageName , isOpen
, loginPage , isSecured
, loginPageReferrer , loginPage
, uploadId , loginPageReferrer
, fromUrl , pageFromString
, isSecured , pageName
, isOpen , pageToString
) , uploadId
)
import Url exposing (Url) import Browser.Navigation as Nav
import Url.Parser as Parser exposing ((</>), (<?>), Parser, oneOf, s, string)
import Url.Parser.Query as Query
import Html exposing (Attribute) import Html exposing (Attribute)
import Html.Attributes as Attr 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 import Util.Maybe
type Page type Page
= HomePage = HomePage
| LoginPage (Maybe String) | LoginPage (Maybe String)
@ -32,108 +33,178 @@ type Page
| NewInvitePage | NewInvitePage
isSecured: Page -> Bool isSecured : Page -> Bool
isSecured page = isSecured page =
case page of case page of
HomePage -> True HomePage ->
LoginPage _ -> False True
ManageDataPage -> True
CollectiveSettingPage -> True LoginPage _ ->
UserSettingPage -> True False
QueuePage -> True
RegisterPage -> False ManageDataPage ->
NewInvitePage -> False True
CollectiveSettingPage ->
True
UserSettingPage ->
True
QueuePage ->
True
RegisterPage ->
False
NewInvitePage ->
False
UploadPage arg -> UploadPage arg ->
Util.Maybe.isEmpty arg Util.Maybe.isEmpty arg
isOpen: Page -> Bool
isOpen : Page -> Bool
isOpen page = isOpen page =
not (isSecured page) not (isSecured page)
loginPage: Page -> Page
loginPage : Page -> Page
loginPage p = loginPage p =
case p of case p of
LoginPage _ -> LoginPage Nothing LoginPage _ ->
_ -> LoginPage (Just (pageToString p |> String.dropLeft 2)) LoginPage Nothing
_ ->
LoginPage (Just (pageToString p |> String.dropLeft 2))
pageName: Page -> String pageName : Page -> String
pageName page = pageName page =
case page of case page of
HomePage -> "Home" HomePage ->
LoginPage _ -> "Login" "Home"
ManageDataPage -> "Manage Data"
CollectiveSettingPage -> "Collective Settings" LoginPage _ ->
UserSettingPage -> "User Settings" "Login"
QueuePage -> "Processing"
RegisterPage -> "Register" ManageDataPage ->
NewInvitePage -> "New Invite" "Manage Data"
CollectiveSettingPage ->
"Collective Settings"
UserSettingPage ->
"User Settings"
QueuePage ->
"Processing"
RegisterPage ->
"Register"
NewInvitePage ->
"New Invite"
UploadPage arg -> UploadPage arg ->
case arg of case arg of
Just _ -> "Anonymous Upload" Just _ ->
Nothing -> "Upload" "Anonymous Upload"
loginPageReferrer: Page -> Maybe Page Nothing ->
"Upload"
loginPageReferrer : Page -> Maybe Page
loginPageReferrer page = loginPageReferrer page =
case page of case page of
LoginPage r -> Maybe.andThen pageFromString r LoginPage r ->
_ -> Nothing Maybe.andThen pageFromString r
uploadId: Page -> Maybe String _ ->
Nothing
uploadId : Page -> Maybe String
uploadId page = uploadId page =
case page of case page of
UploadPage id -> id UploadPage id ->
_ -> Nothing id
pageToString: Page -> String _ ->
Nothing
pageToString : Page -> String
pageToString page = pageToString page =
case page of case page of
HomePage -> "#/home" HomePage ->
"#/home"
LoginPage referer -> LoginPage referer ->
Maybe.map (\p -> "/" ++ p) referer Maybe.map (\p -> "/" ++ p) referer
|> Maybe.withDefault "" |> Maybe.withDefault ""
|> (++) "#/login" |> (++) "#/login"
ManageDataPage -> "#/manageData"
CollectiveSettingPage -> "#/collectiveSettings" ManageDataPage ->
UserSettingPage -> "#/userSettings" "#/manageData"
QueuePage -> "#/queue"
RegisterPage -> "#/register" CollectiveSettingPage ->
"#/collectiveSettings"
UserSettingPage ->
"#/userSettings"
QueuePage ->
"#/queue"
RegisterPage ->
"#/register"
UploadPage sourceId -> UploadPage sourceId ->
Maybe.map (\id -> "/" ++ id) sourceId Maybe.map (\id -> "/" ++ id) sourceId
|> Maybe.withDefault "" |> Maybe.withDefault ""
|> (++) "#/upload" |> (++) "#/upload"
NewInvitePage -> "#/newinvite"
pageFromString: String -> Maybe Page NewInvitePage ->
"#/newinvite"
pageFromString : String -> Maybe Page
pageFromString str = pageFromString str =
let let
url = Url.Url Url.Http "" Nothing str Nothing Nothing url =
Url.Url Url.Http "" Nothing str Nothing Nothing
in in
Parser.parse parser url Parser.parse parser url
href: Page -> Attribute msg
href : Page -> Attribute msg
href page = href page =
Attr.href (pageToString page) Attr.href (pageToString page)
goto: Page -> Cmd msg
goto : Page -> Cmd msg
goto page = goto page =
Nav.load (pageToString page) Nav.load (pageToString page)
parser: Parser (Page -> a) a
parser : Parser (Page -> a) a
parser = parser =
oneOf oneOf
[ Parser.map HomePage (oneOf [s"", s "home"]) [ Parser.map HomePage (oneOf [ s "", s "home" ])
, Parser.map (\s -> LoginPage (Just s)) (s "login" </> string) , Parser.map (\s -> LoginPage (Just s)) (s "login" </> string)
, Parser.map (LoginPage Nothing) (s "login") , Parser.map (LoginPage Nothing) (s "login")
, Parser.map ManageDataPage (s "manageData") , Parser.map ManageDataPage (s "manageData")
, Parser.map CollectiveSettingPage (s "collectiveSettings") , Parser.map CollectiveSettingPage (s "collectiveSettings")
, Parser.map UserSettingPage (s "userSettings") , Parser.map UserSettingPage (s "userSettings")
, Parser.map QueuePage (s "queue") , Parser.map QueuePage (s "queue")
, Parser.map RegisterPage (s "register") , Parser.map RegisterPage (s "register")
, Parser.map (\s -> UploadPage (Just s)) (s "upload" </> string) , Parser.map (\s -> UploadPage (Just s)) (s "upload" </> string)
, Parser.map (UploadPage Nothing) (s "upload") , Parser.map (UploadPage Nothing) (s "upload")
, Parser.map NewInvitePage (s "newinvite") , Parser.map NewInvitePage (s "newinvite")
] ]
fromUrl : Url -> Maybe Page fromUrl : Url -> Maybe Page
fromUrl url = 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.BasicResult exposing (BasicResult)
import Api.Model.CollectiveSettings exposing (CollectiveSettings) import Api.Model.CollectiveSettings exposing (CollectiveSettings)
import Api.Model.ItemInsights exposing (ItemInsights) import Api.Model.ItemInsights exposing (ItemInsights)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Http
type alias Model = type alias Model =
{ currentTab: Maybe Tab { currentTab : Maybe Tab
, sourceModel: Comp.SourceManage.Model , sourceModel : Comp.SourceManage.Model
, userModel: Comp.UserManage.Model , userModel : Comp.UserManage.Model
, settingsModel: Comp.Settings.Model , settingsModel : Comp.Settings.Model
, insights: ItemInsights , insights : ItemInsights
, submitResult: Maybe BasicResult , submitResult : Maybe BasicResult
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ currentTab = Just InsightsTab { currentTab = Just InsightsTab
, sourceModel = Comp.SourceManage.emptyModel , sourceModel = Comp.SourceManage.emptyModel
@ -28,12 +34,14 @@ emptyModel =
, submitResult = Nothing , submitResult = Nothing
} }
type Tab type Tab
= SourceTab = SourceTab
| UserTab | UserTab
| InsightsTab | InsightsTab
| SettingsTab | SettingsTab
type Msg type Msg
= SetTab Tab = SetTab Tab
| SourceMsg Comp.SourceManage.Msg | 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
import Api.Model.BasicResult exposing (BasicResult) import Api.Model.BasicResult exposing (BasicResult)
import Page.CollectiveSettings.Data exposing (..) import Comp.Settings
import Data.Flags exposing (Flags)
import Comp.SourceManage import Comp.SourceManage
import Comp.UserManage import Comp.UserManage
import Comp.Settings import Data.Flags exposing (Flags)
import Page.CollectiveSettings.Data exposing (..)
import Util.Http import Util.Http
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetTab t -> SetTab t ->
let let
m = { model | currentTab = Just t } m =
{ model | currentTab = Just t }
in in
case t of case t of
SourceTab -> SourceTab ->
update flags (SourceMsg Comp.SourceManage.LoadSources) m update flags (SourceMsg Comp.SourceManage.LoadSources) m
UserTab -> UserTab ->
update flags (UserMsg Comp.UserManage.LoadUsers) m update flags (UserMsg Comp.UserManage.LoadUsers) m
InsightsTab -> InsightsTab ->
update flags Init m update flags Init m
SettingsTab -> SettingsTab ->
update flags Init m update flags Init m
SourceMsg m -> SourceMsg m ->
let let
(m2, c2) = Comp.SourceManage.update flags m model.sourceModel ( m2, c2 ) =
Comp.SourceManage.update flags m model.sourceModel
in in
({model | sourceModel = m2}, Cmd.map SourceMsg c2) ( { model | sourceModel = m2 }, Cmd.map SourceMsg c2 )
UserMsg m -> UserMsg m ->
let let
(m2, c2) = Comp.UserManage.update flags m model.userModel ( m2, c2 ) =
Comp.UserManage.update flags m model.userModel
in in
({model | userModel = m2}, Cmd.map UserMsg c2) ( { model | userModel = m2 }, Cmd.map UserMsg c2 )
SettingsMsg m -> SettingsMsg m ->
let let
(m2, c2, msett) = Comp.Settings.update flags m model.settingsModel ( m2, c2, msett ) =
cmd = case msett of Comp.Settings.update flags m model.settingsModel
Nothing -> Cmd.none
Just sett -> cmd =
Api.setCollectiveSettings flags sett SubmitResp case msett of
Nothing ->
Cmd.none
Just sett ->
Api.setCollectiveSettings flags sett SubmitResp
in 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 -> Init ->
({model|submitResult = Nothing} ( { model | submitResult = Nothing }
,Cmd.batch , Cmd.batch
[ Api.getInsights flags GetInsightsResp [ Api.getInsights flags GetInsightsResp
, Api.getCollectiveSettings flags CollectiveSettingsResp , Api.getCollectiveSettings flags CollectiveSettingsResp
] ]
) )
GetInsightsResp (Ok data) -> GetInsightsResp (Ok data) ->
({model|insights = data}, Cmd.none) ( { model | insights = data }, Cmd.none )
GetInsightsResp (Err err) -> GetInsightsResp (Err _) ->
(model, Cmd.none) ( model, Cmd.none )
CollectiveSettingsResp (Ok data) -> CollectiveSettingsResp (Ok data) ->
({model | settingsModel = Comp.Settings.init data }, Cmd.none) ( { model | settingsModel = Comp.Settings.init data }, Cmd.none )
CollectiveSettingsResp (Err err) -> CollectiveSettingsResp (Err _) ->
(model, Cmd.none) ( model, Cmd.none )
SubmitResp (Ok res) -> SubmitResp (Ok res) ->
({model | submitResult = Just res}, Cmd.none) ( { model | submitResult = Just res }, Cmd.none )
SubmitResp (Err err) -> SubmitResp (Err err) ->
let let
res = BasicResult False (Util.Http.errorToString err) res =
BasicResult False (Util.Http.errorToString err)
in 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) 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) 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 Page.CollectiveSettings.Data exposing (..)
import Comp.SourceManage import Util.Html exposing (classActive)
import Comp.UserManage
import Comp.Settings
import Util.Size
import Util.Maybe import Util.Maybe
import Util.Size
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model = view flags model =
div [class "collectivesetting-page ui padded grid"] div [ class "collectivesetting-page ui padded grid" ]
[div [class "four wide column"] [ div [ class "four wide column" ]
[h4 [class "ui top attached ablue-comp header"] [ h4 [ class "ui top attached ablue-comp header" ]
[text "Collective" [ text "Collective"
] ]
,div [class "ui attached fluid segment"] , div [ class "ui attached fluid segment" ]
[div [class "ui fluid vertical secondary menu"] [ div [ class "ui fluid vertical secondary menu" ]
[div [classActive (model.currentTab == Just InsightsTab) "link icon item" [ div
,onClick (SetTab InsightsTab) [ 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)
] ]
[i [class "language icon"][] [ i [ class "chart bar outline icon" ] []
,text "Document Language" , text "Insights"
] ]
,div [classActive (model.currentTab == Just UserTab) "link icon item" , div
,onClick (SetTab UserTab) [ classActive (model.currentTab == Just SourceTab) "link icon item"
] , onClick (SetTab SourceTab)
[i [class "user icon"][] ]
,text "Users" [ i [ class "upload icon" ] []
] , text "Sources"
] ]
] , div
] [ classActive (model.currentTab == Just SettingsTab) "link icon item"
,div [class "twelve wide column"] , onClick (SetTab SettingsTab)
[div [class ""] ]
(case model.currentTab of [ i [ class "language icon" ] []
Just SourceTab -> viewSources flags model , text "Document Language"
Just UserTab -> viewUsers model ]
Just InsightsTab -> viewInsights model , div
Just SettingsTab -> viewSettings model [ classActive (model.currentTab == Just UserTab) "link icon item"
Nothing -> [] , 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 = viewInsights model =
[h1 [class "ui header"] [ h1 [ class "ui header" ]
[i [class "chart bar outline icon"][] [ i [ class "chart bar outline icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Insights" [ 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 = makeTagStats nc =
div [class "ui statistic"] div [ class "ui statistic" ]
[div [class "value"] [ div [ class "value" ]
[String.fromInt nc.count |> text [ String.fromInt nc.count |> text
] ]
,div [class "label"] , div [ class "label" ]
[text nc.name [ text nc.name
] ]
] ]
viewSources: Flags -> Model -> List (Html Msg) viewSources : Flags -> Model -> List (Html Msg)
viewSources flags model = viewSources flags model =
[h2 [class "ui header"] [ h2 [ class "ui header" ]
[i [class "ui upload icon"][] [ i [ class "ui upload icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Sources" [ 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 = viewUsers model =
[h2 [class "ui header"] [ h2 [ class "ui header" ]
[i [class "ui user icon"][] [ i [ class "ui user icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Users" [ 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 = viewSettings model =
[div [class "ui grid"] [ div [ class "ui grid" ]
[div [class "row"] [ div [ class "row" ]
[div [class "sixteen wide colum"] [ div [ class "sixteen wide colum" ]
[h2 [class "ui header"] [ h2 [ class "ui header" ]
[i [class "ui language icon"][] [ i [ class "ui language icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Document Language" [ text "Document Language"
]
] ]
] ]
] ]
,div [class "row"] ]
[div [class "six wide column"] , div [ class "row" ]
[div [class "ui basic segment"] [ div [ class "six wide column" ]
[text "The language of your documents. This helps text recognition (OCR) and text analysis." [ 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 )
] ]
] ]
] [ Maybe.map .message model.submitResult
,div [class "row"] |> Maybe.withDefault ""
[div [class "six wide column"] |> text
[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
]
]
]
] ]
] ]

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.ItemDetail exposing (ItemDetail)
import Api.Model.ItemLightList exposing (ItemLightList)
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Http
type alias Model = type alias Model =
{ searchMenuModel: Comp.SearchMenu.Model { searchMenuModel : Comp.SearchMenu.Model
, itemListModel: Comp.ItemList.Model , itemListModel : Comp.ItemList.Model
, searchInProgress: Bool , searchInProgress : Bool
, itemDetailModel: Comp.ItemDetail.Model , itemDetailModel : Comp.ItemDetail.Model
, viewMode: ViewMode , viewMode : ViewMode
} }
emptyModel: Model
emptyModel = emptyModel : Model
emptyModel =
{ searchMenuModel = Comp.SearchMenu.emptyModel { searchMenuModel = Comp.SearchMenu.emptyModel
, itemListModel = Comp.ItemList.emptyModel , itemListModel = Comp.ItemList.emptyModel
, itemDetailModel = Comp.ItemDetail.emptyModel , itemDetailModel = Comp.ItemDetail.emptyModel
@ -24,6 +31,7 @@ emptyModel =
, viewMode = Listing , viewMode = Listing
} }
type Msg type Msg
= Init = Init
| SearchMenuMsg Comp.SearchMenu.Msg | SearchMenuMsg Comp.SearchMenu.Msg
@ -33,4 +41,7 @@ type Msg
| ItemDetailMsg Comp.ItemDetail.Msg | ItemDetailMsg Comp.ItemDetail.Msg
| ItemDetailResp (Result Http.Error ItemDetail) | 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) module Page.Home.Update exposing (update)
import Api import Api
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Page.Home.Data exposing (..) import Page.Home.Data exposing (..)
import Comp.SearchMenu
import Comp.ItemList
import Comp.ItemDetail
import Util.Update import Util.Update
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
Init -> Init ->
@ -21,80 +22,108 @@ update flags msg model =
SearchMenuMsg m -> SearchMenuMsg m ->
let let
nextState = Comp.SearchMenu.update flags m model.searchMenuModel nextState =
newModel = {model | searchMenuModel = Tuple.first nextState.modelCmd} Comp.SearchMenu.update flags m model.searchMenuModel
(m2, c2) = if nextState.stateChange then doSearch flags newModel else (newModel, Cmd.none)
newModel =
{ model | searchMenuModel = Tuple.first nextState.modelCmd }
( m2, c2 ) =
if nextState.stateChange then
doSearch flags newModel
else
( newModel, Cmd.none )
in 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 -> ItemListMsg m ->
let let
(m2, c2, mitem) = Comp.ItemList.update flags m model.itemListModel ( m2, c2, mitem ) =
cmd = case mitem of Comp.ItemList.update flags m model.itemListModel
Just item ->
Api.itemDetail flags item.id ItemDetailResp cmd =
Nothing -> case mitem of
Cmd.none Just item ->
Api.itemDetail flags item.id ItemDetailResp
Nothing ->
Cmd.none
in in
({model | itemListModel = m2}, Cmd.batch [ Cmd.map ItemListMsg c2, cmd ]) ( { model | itemListModel = m2 }, Cmd.batch [ Cmd.map ItemListMsg c2, cmd ] )
ItemSearchResp (Ok list) -> ItemSearchResp (Ok list) ->
let let
m = {model|searchInProgress = False, viewMode = Listing} m =
{ model | searchInProgress = False, viewMode = Listing }
in in
update flags (ItemListMsg (Comp.ItemList.SetResults list)) m update flags (ItemListMsg (Comp.ItemList.SetResults list)) m
ItemSearchResp (Err err) -> ItemSearchResp (Err _) ->
({model|searchInProgress = False}, Cmd.none) ( { model | searchInProgress = False }, Cmd.none )
DoSearch -> DoSearch ->
doSearch flags model doSearch flags model
ItemDetailMsg m -> ItemDetailMsg m ->
let let
(m2, c2, nav) = Comp.ItemDetail.update flags m model.itemDetailModel ( m2, c2, nav ) =
newModel = {model | itemDetailModel = m2} Comp.ItemDetail.update flags m model.itemDetailModel
newCmd = Cmd.map ItemDetailMsg c2
newModel =
{ model | itemDetailModel = m2 }
newCmd =
Cmd.map ItemDetailMsg c2
in in
case nav of case nav of
Comp.ItemDetail.NavBack -> Comp.ItemDetail.NavBack ->
doSearch flags newModel doSearch flags newModel
Comp.ItemDetail.NavPrev ->
case Comp.ItemList.prevItem model.itemListModel m2.item.id of Comp.ItemDetail.NavPrev ->
Just n -> case Comp.ItemList.prevItem model.itemListModel m2.item.id of
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp]) Just n ->
Nothing -> ( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
(newModel, newCmd)
Comp.ItemDetail.NavNext -> Nothing ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of ( newModel, newCmd )
Just n ->
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp]) Comp.ItemDetail.NavNext ->
Nothing -> case Comp.ItemList.nextItem model.itemListModel m2.item.id of
(newModel, newCmd) Just n ->
Comp.ItemDetail.NavNextOrBack -> ( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n -> Nothing ->
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp]) ( newModel, newCmd )
Nothing ->
doSearch flags newModel Comp.ItemDetail.NavNextOrBack ->
Comp.ItemDetail.NavNone -> case Comp.ItemList.nextItem model.itemListModel m2.item.id of
(newModel, newCmd) Just n ->
( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
Nothing ->
doSearch flags newModel
Comp.ItemDetail.NavNone ->
( newModel, newCmd )
ItemDetailResp (Ok item) -> ItemDetailResp (Ok item) ->
let let
m = {model | viewMode = Detail} m =
{ model | viewMode = Detail }
in in
update flags (ItemDetailMsg (Comp.ItemDetail.SetItem item)) m update flags (ItemDetailMsg (Comp.ItemDetail.SetItem item)) m
ItemDetailResp (Err err) -> ItemDetailResp (Err _) ->
let ( model, Cmd.none )
_ = Debug.log "Error" err
in
(model, Cmd.none)
doSearch: Flags -> Model -> (Model, Cmd Msg)
doSearch : Flags -> Model -> ( Model, Cmd Msg )
doSearch flags model = doSearch flags model =
let let
mask = Comp.SearchMenu.getItemSearch model.searchMenuModel mask =
Comp.SearchMenu.getItemSearch model.searchMenuModel
in 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) module Page.Home.View exposing (view)
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.Home.Data exposing (..) 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 = view model =
div [class "home-page ui padded grid"] div [ class "home-page ui padded grid" ]
[div [class "four wide column"] [ div [ class "four wide column" ]
[div [class "ui top attached ablue-comp menu"] [ div [ class "ui top attached ablue-comp menu" ]
[h4 [class "header item"] [ h4 [ class "header item" ]
[text "Search" [ text "Search"
] ]
,div [class "right floated menu"] , div [ class "right floated menu" ]
[a [class "item" [ a
,onClick DoSearch [ class "item"
,href "" , onClick DoSearch
] , href ""
[i [class "ui search icon"][] ]
] [ i [ class "ui search icon" ] []
] ]
] ]
,div [class "ui attached fluid segment"] ]
[(Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel)) , div [ class "ui attached fluid segment" ]
] [ Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel)
] ]
,div [class "twelve wide column"] ]
[case model.viewMode of , div [ class "twelve wide column" ]
Listing -> [ case model.viewMode of
if model.searchInProgress then resultPlaceholder Listing ->
else (Html.map ItemListMsg (Comp.ItemList.view model.itemListModel)) if model.searchInProgress then
Detail -> resultPlaceholder
Html.map ItemDetailMsg (Comp.ItemDetail.view model.itemDetailModel)
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 = resultPlaceholder =
div [class "ui basic segment"] div [ class "ui basic segment" ]
[div [class "ui active inverted dimmer"] [ div [ class "ui active inverted dimmer" ]
[div [class "ui medium text loader"] [ div [ class "ui medium text loader" ]
[text "Searching …" [ text "Searching …"
] ]
] ]
,div [class "ui middle aligned very relaxed divided basic list segment"] , div [ class "ui middle aligned very relaxed divided basic list segment" ]
[div [class "item"] [ div [ class "item" ]
[div [class "ui fluid placeholder"] [ div [ class "ui fluid placeholder" ]
[div [class "full line"][] [ div [ class "full line" ] []
,div [class "full line"][] , div [ class "full line" ] []
] ]
] ]
,div [class "item"] , div [ class "item" ]
[div [class "ui fluid placeholder"] [ div [ class "ui fluid placeholder" ]
[div [class "full line"][] [ div [ class "full line" ] []
,div [class "full line"][] , div [ class "full line" ] []
] ]
] ]
,div [class "item"] , div [ class "item" ]
[div [class "ui fluid placeholder"] [ div [ class "ui fluid placeholder" ]
[div [class "full line"][] [ div [ class "full line" ] []
,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 Http
import Page exposing (Page(..)) import Page exposing (Page(..))
import Api.Model.AuthResult exposing (AuthResult)
type alias Model = type alias Model =
{ username: String { username : String
, password: String , password : String
, result: Maybe AuthResult , result : Maybe AuthResult
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ username = "" { username = ""
, password = "" , password = ""
, result = Nothing , result = Nothing
} }
type Msg type Msg
= SetUsername String = SetUsername String
| SetPassword 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) module Page.Login.Update exposing (update)
import Api import Api
import Ports import Api.Model.AuthResult exposing (AuthResult)
import Api.Model.UserPass exposing (UserPass)
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.Login.Data exposing (..) import Page.Login.Data exposing (..)
import Api.Model.UserPass exposing (UserPass) import Ports
import Api.Model.AuthResult exposing (AuthResult)
import Util.Http 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 = update referrer flags msg model =
case msg of case msg of
SetUsername str -> SetUsername str ->
({model | username = str}, Cmd.none, Nothing) ( { model | username = str }, Cmd.none, Nothing )
SetPassword str -> SetPassword str ->
({model | password = str}, Cmd.none, Nothing) ( { model | password = str }, Cmd.none, Nothing )
Authenticate -> 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) -> AuthResp (Ok lr) ->
let let
gotoRef = Maybe.withDefault HomePage referrer |> Page.goto gotoRef =
Maybe.withDefault HomePage referrer |> Page.goto
in in
if lr.success if lr.success then
then ({model|result = Just lr, password = ""}, Cmd.batch [setAccount lr, gotoRef], Just lr) ( { model | result = Just lr, password = "" }, Cmd.batch [ setAccount lr, gotoRef ], Just lr )
else ({model|result = Just lr, password = ""}, Ports.removeAccount (), Just lr)
else
( { model | result = Just lr, password = "" }, Ports.removeAccount (), Just lr )
AuthResp (Err err) -> AuthResp (Err err) ->
let let
empty = Api.Model.AuthResult.empty empty =
lr = {empty|message = Util.Http.errorToString err} Api.Model.AuthResult.empty
in
({model|password = "", result = Just lr}, Ports.removeAccount (), Just 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 = setAccount result =
if result.success if result.success then
then Ports.setAccount result Ports.setAccount result
else Ports.removeAccount ()
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) module Page.Login.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit) import Html.Events exposing (onInput, onSubmit)
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.Login.Data exposing (..) import Page.Login.Data exposing (..)
import Data.Flags exposing (Flags)
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model = view flags model =
div [class "login-page"] div [ class "login-page" ]
[div [class "ui centered grid"] [ div [ class "ui centered grid" ]
[div [class "row"] [ div [ class "row" ]
[div [class "six wide column ui segment login-view"] [ div [ class "six wide column ui segment login-view" ]
[h1 [class "ui center aligned icon header"] [ h1 [ class "ui center aligned icon header" ]
[img [class "ui image" [ img
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png") [ class "ui image"
][] , src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
,div [class "content"]
[text "Sign in to Docspell"
]
] ]
,Html.form [ class "ui large error raised form segment" []
, onSubmit Authenticate , div [ class "content" ]
, autocomplete False [ text "Sign in to Docspell"
] ]
[div [class "field"] ]
[label [][text "Username"] , Html.form
,div [class "ui left icon input"] [ class "ui large error raised form segment"
[input [type_ "text" , onSubmit Authenticate
,autocomplete False , autocomplete False
,onInput SetUsername ]
,value model.username [ div [ class "field" ]
,placeholder "Collective / Login" [ label [] [ text "Username" ]
,autofocus True , div [ class "ui left icon input" ]
][] [ input
,i [class "user icon"][] [ type_ "text"
] , autocomplete False
] , onInput SetUsername
,div [class "field"] , value model.username
[label [][text "Password"] , placeholder "Collective / Login"
,div [class "ui left icon input"] , autofocus True
[input [type_ "password"
,autocomplete False
,onInput SetPassword
,value model.password
,placeholder "Password"
][]
,i [class "lock icon"][]
] ]
] []
,button [class "ui primary fluid button" , i [ class "user icon" ] []
,type_ "submit"
]
[text "Login"
] ]
] ]
,(resultMessage model) , div [ class "field" ]
,div[class "ui very basic right aligned segment"] [ label [] [ text "Password" ]
[text "No account? " , div [ class "ui left icon input" ]
,a [class "ui icon link", Page.href RegisterPage] [ input
[i [class "edit icon"][] [ type_ "password"
,text "Sign up!" , 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 = resultMessage model =
case model.result of case model.result of
Just r -> Just r ->
if r.success if r.success then
then div [ class "ui success message" ]
div [class "ui success message"] [ text "Login successful."
[text "Login successful."
] ]
else else
div [class "ui error message"] div [ class "ui error message" ]
[text r.message [ text r.message
] ]
Nothing -> 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.EquipmentManage
import Comp.OrgManage import Comp.OrgManage
import Comp.PersonManage import Comp.PersonManage
import Comp.TagManage
type alias Model = type alias Model =
{ currentTab: Maybe Tab { currentTab : Maybe Tab
, tagManageModel: Comp.TagManage.Model , tagManageModel : Comp.TagManage.Model
, equipManageModel: Comp.EquipmentManage.Model , equipManageModel : Comp.EquipmentManage.Model
, orgManageModel: Comp.OrgManage.Model , orgManageModel : Comp.OrgManage.Model
, personManageModel: Comp.PersonManage.Model , personManageModel : Comp.PersonManage.Model
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ currentTab = Nothing { currentTab = Nothing
, tagManageModel = Comp.TagManage.emptyModel , tagManageModel = Comp.TagManage.emptyModel
@ -22,12 +29,14 @@ emptyModel =
, personManageModel = Comp.PersonManage.emptyModel , personManageModel = Comp.PersonManage.emptyModel
} }
type Tab type Tab
= TagTab = TagTab
| EquipTab | EquipTab
| OrgTab | OrgTab
| PersonTab | PersonTab
type Msg type Msg
= SetTab Tab = SetTab Tab
| TagManageMsg Comp.TagManage.Msg | 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) module Page.ManageData.Update exposing (update)
import Page.ManageData.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.TagManage
import Comp.EquipmentManage import Comp.EquipmentManage
import Comp.OrgManage import Comp.OrgManage
import Comp.PersonManage 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 = update flags msg model =
case msg of case msg of
SetTab t -> SetTab t ->
let let
m = { model | currentTab = Just t } m =
{ model | currentTab = Just t }
in in
case t of case t of
TagTab -> TagTab ->
update flags (TagManageMsg Comp.TagManage.LoadTags) m update flags (TagManageMsg Comp.TagManage.LoadTags) m
EquipTab -> EquipTab ->
update flags (EquipManageMsg Comp.EquipmentManage.LoadEquipments) m update flags (EquipManageMsg Comp.EquipmentManage.LoadEquipments) m
OrgTab -> OrgTab ->
update flags (OrgManageMsg Comp.OrgManage.LoadOrgs) m update flags (OrgManageMsg Comp.OrgManage.LoadOrgs) m
PersonTab -> PersonTab ->
update flags (PersonManageMsg Comp.PersonManage.LoadPersons) m update flags (PersonManageMsg Comp.PersonManage.LoadPersons) m
TagManageMsg m -> TagManageMsg m ->
let let
(m2, c2) = Comp.TagManage.update flags m model.tagManageModel ( m2, c2 ) =
Comp.TagManage.update flags m model.tagManageModel
in in
({model | tagManageModel = m2}, Cmd.map TagManageMsg c2) ( { model | tagManageModel = m2 }, Cmd.map TagManageMsg c2 )
EquipManageMsg m -> EquipManageMsg m ->
let let
(m2, c2) = Comp.EquipmentManage.update flags m model.equipManageModel ( m2, c2 ) =
Comp.EquipmentManage.update flags m model.equipManageModel
in in
({model | equipManageModel = m2}, Cmd.map EquipManageMsg c2) ( { model | equipManageModel = m2 }, Cmd.map EquipManageMsg c2 )
OrgManageMsg m -> OrgManageMsg m ->
let let
(m2, c2) = Comp.OrgManage.update flags m model.orgManageModel ( m2, c2 ) =
Comp.OrgManage.update flags m model.orgManageModel
in in
({model | orgManageModel = m2}, Cmd.map OrgManageMsg c2) ( { model | orgManageModel = m2 }, Cmd.map OrgManageMsg c2 )
PersonManageMsg m -> PersonManageMsg m ->
let let
(m2, c2) = Comp.PersonManage.update flags m model.personManageModel ( m2, c2 ) =
Comp.PersonManage.update flags m model.personManageModel
in 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) 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.EquipmentManage
import Comp.OrgManage import Comp.OrgManage
import Comp.PersonManage 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 = view model =
div [class "managedata-page ui padded grid"] div [ class "managedata-page ui padded grid" ]
[div [class "four wide column"] [ div [ class "four wide column" ]
[h4 [class "ui top attached ablue-comp header"] [ h4 [ class "ui top attached ablue-comp header" ]
[text "Manage Data" [ text "Manage Data"
] ]
,div [class "ui attached fluid segment"] , div [ class "ui attached fluid segment" ]
[div [class "ui fluid vertical secondary menu"] [ div [ class "ui fluid vertical secondary menu" ]
[div [classActive (model.currentTab == Just TagTab) "link icon item" [ div
,onClick (SetTab TagTab) [ classActive (model.currentTab == Just TagTab) "link icon item"
] , onClick (SetTab TagTab)
[i [class "tag icon"][] ]
,text "Tag" [ i [ class "tag icon" ] []
] , text "Tag"
,div [classActive (model.currentTab == Just EquipTab) "link icon item" ]
,onClick (SetTab EquipTab) , div
] [ classActive (model.currentTab == Just EquipTab) "link icon item"
[i [class "box icon"][] , onClick (SetTab EquipTab)
,text "Equipment" ]
] [ i [ class "box icon" ] []
,div [classActive (model.currentTab == Just OrgTab) "link icon item" , text "Equipment"
,onClick (SetTab OrgTab) ]
] , div
[i [class "factory icon"][] [ classActive (model.currentTab == Just OrgTab) "link icon item"
,text "Organization" , onClick (SetTab OrgTab)
] ]
,div [classActive (model.currentTab == Just PersonTab) "link icon item" [ i [ class "factory icon" ] []
,onClick (SetTab PersonTab) , text "Organization"
] ]
[i [class "user icon"][] , div
,text "Person" [ 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 , div [ class "twelve wide column" ]
Just OrgTab -> viewOrg model [ div [ class "" ]
Just PersonTab -> viewPerson model (case model.currentTab of
Nothing -> [] 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 = viewTags model =
[h2 [class "ui header"] [ h2 [ class "ui header" ]
[i [class "ui tag icon"][] [ i [ class "ui tag icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Tags" [ 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 = viewEquip model =
[h2 [class "ui header"] [ h2 [ class "ui header" ]
[i [class "ui box icon"][] [ i [ class "ui box icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Equipment" [ 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 = viewOrg model =
[h2 [class "ui header"] [ h2 [ class "ui header" ]
[i [class "ui factory icon"][] [ i [ class "ui factory icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Organizations" [ 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 = viewPerson model =
[h2 [class "ui header"] [ h2 [ class "ui header" ]
[i [class "ui user icon"][] [ i [ class "ui user icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Person" [ 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 Api.Model.InviteResult exposing (InviteResult)
import Http
type alias Model = type alias Model =
{ password: String { password : String
, result: State , result : State
} }
type State type State
= Empty = Empty
| Failed String | Failed String
| Success InviteResult | Success InviteResult
isFailed: State -> Bool isFailed : State -> Bool
isFailed state = isFailed state =
case state of case state of
Failed _ -> True Failed _ ->
_ -> False True
isSuccess: State -> Bool _ ->
False
isSuccess : State -> Bool
isSuccess state = isSuccess state =
case state of case state of
Success _ -> True Success _ ->
_ -> False True
emptyModel: Model _ ->
False
emptyModel : Model
emptyModel = emptyModel =
{ password = "" { password = ""
, result = Empty , result = Empty
} }
type Msg type Msg
= SetPassword String = SetPassword String
| GenerateInvite | GenerateInvite

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

@ -1,27 +1,30 @@
module Page.NewInvite.Update exposing (update) module Page.NewInvite.Update exposing (update)
import Api import Api
import Api.Model.GenInvite exposing (GenInvite)
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Page.NewInvite.Data exposing (..) import Page.NewInvite.Data exposing (..)
import Api.Model.GenInvite exposing (GenInvite)
import Api.Model.InviteResult
import Util.Http import Util.Http
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetPassword str -> SetPassword str ->
({model|password = str}, Cmd.none) ( { model | password = str }, Cmd.none )
Reset -> Reset ->
(emptyModel, Cmd.none) ( emptyModel, Cmd.none )
GenerateInvite -> GenerateInvite ->
(model, Api.newInvite flags (GenInvite model.password) InviteResp) ( model, Api.newInvite flags (GenInvite model.password) InviteResp )
InviteResp (Ok res) -> InviteResp (Ok res) ->
if res.success then ({model | result = (Success res)}, Cmd.none) if res.success then
else ({model | result = (Failed res.message)}, Cmd.none) ( { model | result = Success res }, Cmd.none )
else
( { model | result = Failed res.message }, Cmd.none )
InviteResp (Err err) -> 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) module Page.NewInvite.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit) import Html.Events exposing (onClick, onInput, onSubmit)
import Data.Flags exposing (Flags)
import Page.NewInvite.Data exposing (..) 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 = view flags model =
div [class "newinvite-page"] div [ class "newinvite-page" ]
[div [class "ui centered grid"] [ div [ class "ui centered grid" ]
[div [class "row"] [ div [ class "row" ]
[div [class "eight wide column ui segment newinvite-view"] [ div [ class "eight wide column ui segment newinvite-view" ]
[h1 [class "ui cener aligned icon header"] [ h1 [ class "ui cener aligned icon header" ]
[img [class "ui image" [ img
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png") [ class "ui image"
][] , src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
,div [class "content"] ]
[text "Create new invitations" []
, 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 , button
,Html.form [classList [("ui large form raised segment", True) [ class "ui primary button"
,("error", isFailed model.result) , type_ "submit"
,("success", isSuccess model.result) ]
] [ text "Submit"
, onSubmit GenerateInvite] ]
[div [class "required field"] , a [ class "ui right floated button", href "", onClick Reset ]
[label [][text "New Invitation Password"] [ text "Reset"
,div [class "ui left icon input"] ]
[input [type_ "password" , resultMessage model
,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
]
]
]
]
] ]
resultMessage: Model -> Html Msg
resultMessage : Model -> Html Msg
resultMessage model = resultMessage model =
div [classList [("ui message", True) div
,("error", isFailed model.result) [ classList
,("success", isSuccess model.result) [ ( "ui message", True )
,("hidden", model.result == Empty) , ( "error", isFailed model.result )
]] , ( "success", isSuccess model.result )
[case model.result of , ( "hidden", model.result == Empty )
Failed m -> ]
div [class "content"] ]
[div [class "header"][text "Error"] [ case model.result of
,p [][text m] Failed m ->
] div [ class "content" ]
Success r -> [ div [ class "header" ] [ text "Error" ]
div [class "content"] , p [] [ text m ]
[div [class "header"][text "Success"] ]
,p [][text r.message]
,p [][text "Invitation Key:"] Success r ->
,pre[][Maybe.withDefault "" r.key |> text div [ class "content" ]
] [ div [ class "header" ] [ text "Success" ]
] , p [] [ text r.message ]
Empty -> , p [] [ text "Invitation Key:" ]
span[][] , 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 create these invites here and send them to friends so
they can signup with docspell.""" they can signup with docspell."""
]
] , p []
,p [][text [ text
"""Each invite can only be used once. You'll need to
"""Each invite can only be used once. You'll need to
create one key for each person you want to invite.""" create one key for each person you want to invite."""
]
] , p []
,p [][text [ text
"""Creating an invite requires providing the password
"""Creating an invite requires providing the password
from the configuration.""" 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.BasicResult exposing (BasicResult)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobQueueState exposing (JobQueueState)
import Comp.YesNoDimmer
import Http
import Time import Time
import Util.Duration import Util.Duration
import Util.Maybe import Util.Maybe
import Comp.YesNoDimmer
type alias Model = type alias Model =
{ state: JobQueueState { state : JobQueueState
, error: String , error : String
, pollingInterval: Float , pollingInterval : Float
, init: Bool , init : Bool
, stopRefresh: Bool , stopRefresh : Bool
, currentMillis: Int , currentMillis : Int
, showLog: Maybe JobDetail , showLog : Maybe JobDetail
, deleteConfirm: Comp.YesNoDimmer.Model , deleteConfirm : Comp.YesNoDimmer.Model
, cancelJobRequest: Maybe String , cancelJobRequest : Maybe String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ state = Api.Model.JobQueueState.empty { state = Api.Model.JobQueueState.empty
, error = "" , error = ""
@ -34,6 +42,7 @@ emptyModel =
, cancelJobRequest = Nothing , cancelJobRequest = Nothing
} }
type Msg type Msg
= Init = Init
| StateResp (Result Http.Error JobQueueState) | StateResp (Result Http.Error JobQueueState)
@ -45,35 +54,45 @@ type Msg
| DimmerMsg JobDetail Comp.YesNoDimmer.Msg | DimmerMsg JobDetail Comp.YesNoDimmer.Msg
| CancelResp (Result Http.Error BasicResult) | CancelResp (Result Http.Error BasicResult)
getRunningTime: Model -> JobDetail -> Maybe String
getRunningTime : Model -> JobDetail -> Maybe String
getRunningTime model job = getRunningTime model job =
let let
mkTime: Int -> Int -> Maybe String mkTime : Int -> Int -> Maybe String
mkTime start end = mkTime start end =
if start < end then Just <| Util.Duration.toHuman (end - start) if start < end then
else Nothing Just <| Util.Duration.toHuman (end - start)
in
case (job.started, job.finished) of
(Just sn, Just fn) ->
Util.Maybe.or
[ mkTime sn fn
, mkTime sn model.currentMillis
]
(Just sn, Nothing) -> else
mkTime sn model.currentMillis
(Nothing, _) ->
Nothing 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 = getSubmittedTime model job =
if model.currentMillis > job.submitted then if model.currentMillis > job.submitted then
Just <| Util.Duration.toHuman (model.currentMillis - job.submitted) Just <| Util.Duration.toHuman (model.currentMillis - job.submitted)
else else
Nothing Nothing
getDuration: Model -> JobDetail -> Maybe String
getDuration : Model -> JobDetail -> Maybe String
getDuration model job = getDuration model job =
if job.state == "stuck" then getSubmittedTime model job if job.state == "stuck" then
else Util.Maybe.or [ (getRunningTime model job), (getSubmittedTime model job) ] 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) module Page.Queue.Update exposing (update)
import Api 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 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 = update flags msg model =
case msg of case msg of
Init -> Init ->
let let
start = if model.init start =
then Cmd.none if model.init then
else Cmd.batch Cmd.none
[Api.getJobQueueState flags StateResp
,getNewTime else
Cmd.batch
[ Api.getJobQueueState flags StateResp
, getNewTime
] ]
in in
({model|init = True, stopRefresh = False}, start) ( { model | init = True, stopRefresh = False }, start )
StateResp (Ok s) -> StateResp (Ok s) ->
let let
progressCmd = progressCmd =
List.map (\job -> Ports.setProgress (job.id, job.progress)) s.progress List.map (\job -> Ports.setProgress ( job.id, job.progress )) s.progress
_ = Debug.log "stopRefresh" model.stopRefresh
refresh = refresh =
if model.pollingInterval <= 0 || model.stopRefresh then Cmd.none if model.pollingInterval <= 0 || model.stopRefresh then
else Cmd.batch Cmd.none
[Api.getJobQueueStateIn flags model.pollingInterval StateResp
,getNewTime else
] Cmd.batch
[ Api.getJobQueueStateIn flags model.pollingInterval StateResp
, getNewTime
]
in in
({model | state = s, stopRefresh = False}, Cmd.batch (refresh :: progressCmd)) ( { model | state = s, stopRefresh = False }, Cmd.batch (refresh :: progressCmd) )
StateResp (Err err) -> StateResp (Err err) ->
({model | error = Util.Http.errorToString err }, Cmd.none) ( { model | error = Util.Http.errorToString err }, Cmd.none )
StopRefresh -> StopRefresh ->
({model | stopRefresh = True, init = False }, Cmd.none) ( { model | stopRefresh = True, init = False }, Cmd.none )
NewTime t -> NewTime t ->
({model | currentMillis = Time.posixToMillis t}, Cmd.none) ( { model | currentMillis = Time.posixToMillis t }, Cmd.none )
ShowLog job -> ShowLog job ->
({model | showLog = Just job}, Cmd.none) ( { model | showLog = Just job }, Cmd.none )
QuitShowLog -> QuitShowLog ->
({model | showLog = Nothing}, Cmd.none) ( { model | showLog = Nothing }, Cmd.none )
RequestCancelJob job -> RequestCancelJob job ->
let let
newModel = {model|cancelJobRequest = Just job.id} newModel =
{ model | cancelJobRequest = Just job.id }
in in
update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel
DimmerMsg job m -> DimmerMsg job m ->
let let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm ( cm, confirmed ) =
cmd = if confirmed then Api.cancelJob flags job.id CancelResp else Cmd.none Comp.YesNoDimmer.update m model.deleteConfirm
in
({model | deleteConfirm = cm}, cmd)
CancelResp (Ok r) -> cmd =
(model, Cmd.none) if confirmed then
CancelResp (Err err) -> Api.cancelJob flags job.id CancelResp
(model, Cmd.none)
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
CancelResp (Ok _) ->
( model, Cmd.none )
CancelResp (Err _) ->
( model, Cmd.none )
getNewTime : Cmd Msg getNewTime : Cmd Msg
getNewTime = 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) 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Page.Queue.Data exposing (..) 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.Time exposing (formatDateTime, formatIsoDateTime)
import Util.Duration
view: Model -> Html Msg
view : Model -> Html Msg
view model = view model =
div [class "queue-page ui grid container"] <| div [ class "queue-page ui grid container" ] <|
List.concat List.concat
[ case model.showLog of [ case model.showLog of
Just job -> Just job ->
[renderJobLog job] [ renderJobLog job ]
Nothing ->
List.map (renderProgressCard model) model.state.progress Nothing ->
|> List.map (\el -> div [class "row"][div [class "column"][el]]) List.map (renderProgressCard model) model.state.progress
, [div [class "two column row"] |> List.map (\el -> div [ class "row" ] [ div [ class "column" ] [ el ] ])
[renderWaiting model , [ div [ class "two column row" ]
,renderCompleted model [ renderWaiting model
, renderCompleted model
] ]
] ]
] ]
renderJobLog: JobDetail -> Html Msg
renderJobLog : JobDetail -> Html Msg
renderJobLog job = renderJobLog job =
div [class "ui fluid card"] div [ class "ui fluid card" ]
[div [class "content"] [ div [ class "content" ]
[i [class "delete link icon", onClick QuitShowLog][] [ i [ class "delete link icon", onClick QuitShowLog ] []
,text job.name , text job.name
] ]
,div [class "content"] , div [ class "content" ]
[div [class "job-log"] [ div [ class "job-log" ]
(List.map renderLogLine job.logs) (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"
]
]
] ]
] ]
renderLogLine: JobLogEvent -> Html Msg
renderLogLine log = renderWaiting : Model -> Html Msg
span [class (String.toLower log.level)] renderWaiting model =
[formatIsoDateTime log.time |> text div [ class "column" ]
,text ": " [ div [ class "ui center aligned basic segment" ]
,text log.message [ i [ class "ui large angle double up icon" ] []
, br[][] ]
, 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 renderCompleted : Model -> Html Msg
dimmerSettings = renderCompleted model =
let div [ class "column" ]
defaults = Comp.YesNoDimmer.defaultSettings [ div [ class "ui center aligned basic segment" ]
in [ i [ class "ui large angle double down icon" ] []
{ defaults | headerClass = "ui inverted header", headerIcon = "", message = "Cancel/Delete this job?"} ]
, div [ class "ui centered cards" ]
renderInfoCard: Model -> JobDetail -> Html Msg (List.map (renderInfoCard model) model.state.completed)
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"] renderProgressCard : Model -> JobDetail -> Html Msg
[if isFinal job || job.state == "stuck" then renderProgressCard model job =
span [onClick (ShowLog job)] div [ class "ui fluid card" ]
[i [class "file link icon", title "Show log"][] [ 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[][] , div [ class "ui basic label" ]
,i [class "delete link icon", title "Remove", onClick (RequestCancelJob job)][] [ i [ class "clock icon" ] []
] , div [ class "detail" ]
,if isFinal job then [ getDuration model job |> Maybe.withDefault "-:-" |> text
span [class "invisible"][] ]
else ]
div [class "right floated"] ]
[div [class "meta"] , i [ class "asterisk loading icon" ] []
[getDuration model job |> Maybe.withDefault "-:-" |> text , text job.name
] ]
] , div [ class "content" ]
,i [classList [("check icon", job.state == "success") [ div [ class "job-log" ]
,("redo icon", job.state == "stuck") (List.map renderLogLine job.logs)
,("bolt icon", job.state == "failed") ]
,("meh outline icon", job.state == "canceled") , div [ class "meta" ]
,("cog icon", not (isFinal job) && job.state /= "stuck") [ div [ class "right floated" ]
] [ button [ class "ui button", onClick (RequestCancelJob job) ]
][] [ text "Cancel"
,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
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 = jobStateColor job =
case job.state of case job.state of
"success" -> "green" "success" ->
"failed" -> "red" "green"
"canceled" -> "orange"
"stuck" -> "purple"
"scheduled" -> "blue"
"waiting" -> "grey"
_ -> ""
jobStateLabel: JobDetail -> Html Msg "failed" ->
"red"
"canceled" ->
"orange"
"stuck" ->
"purple"
"scheduled" ->
"blue"
"waiting" ->
"grey"
_ ->
""
jobStateLabel : JobDetail -> Html Msg
jobStateLabel job = jobStateLabel job =
let let
col = jobStateColor job col =
jobStateColor job
in in
div [class ("ui label " ++ col)] div [ class ("ui label " ++ col) ]
[text job.state [ 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 Api.Model.BasicResult exposing (BasicResult)
import Http
type alias Model = type alias Model =
{ result: Maybe BasicResult { result : Maybe BasicResult
, collId: String , collId : String
, login: String , login : String
, pass1: String , pass1 : String
, pass2: String , pass2 : String
, showPass1: Bool , showPass1 : Bool
, showPass2: Bool , showPass2 : Bool
, errorMsg: List String , errorMsg : List String
, loading: Bool , loading : Bool
, successMsg: String , successMsg : String
, invite: Maybe String , invite : Maybe String
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ result = Nothing { result = Nothing
, collId = "" , collId = ""
@ -32,6 +38,7 @@ emptyModel =
, invite = Nothing , invite = Nothing
} }
type Msg type Msg
= SetCollId String = SetCollId String
| SetLogin 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) module Page.Register.Update exposing (update)
import Api import Api
import Api.Model.Registration exposing (Registration)
import Page.Register.Data exposing (..)
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Page exposing (Page(..)) 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 = update flags msg model =
case msg of case msg of
RegisterSubmit -> RegisterSubmit ->
case model.errorMsg of case model.errorMsg of
[] -> [] ->
let let
reg = { collectiveName = model.collId reg =
, login = model.login { collectiveName = model.collId
, password = model.pass1 , login = model.login
, invite = model.invite , password = model.pass1
} , invite = model.invite
}
in in
(model, Api.register flags reg SubmitResp) ( model, Api.register flags reg SubmitResp )
_ -> _ ->
(model, Cmd.none) ( model, Cmd.none )
SetCollId str -> SetCollId str ->
let let
m = {model|collId = str} m =
err = validateForm m { model | collId = str }
err =
validateForm m
in in
({m|errorMsg = err}, Cmd.none) ( { m | errorMsg = err }, Cmd.none )
SetLogin str -> SetLogin str ->
let let
m = {model|login = str} m =
err = validateForm m { model | login = str }
err =
validateForm m
in in
({m|errorMsg = err}, Cmd.none) ( { m | errorMsg = err }, Cmd.none )
SetPass1 str -> SetPass1 str ->
let let
m = {model|pass1 = str} m =
err = validateForm m { model | pass1 = str }
err =
validateForm m
in in
({m|errorMsg = err}, Cmd.none) ( { m | errorMsg = err }, Cmd.none )
SetPass2 str -> SetPass2 str ->
let let
m = {model|pass2 = str} m =
err = validateForm m { model | pass2 = str }
err =
validateForm m
in in
({m|errorMsg = err}, Cmd.none) ( { m | errorMsg = err }, Cmd.none )
SetInvite str -> 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 -> ToggleShowPass1 ->
({model|showPass1 = not model.showPass1}, Cmd.none) ( { model | showPass1 = not model.showPass1 }, Cmd.none )
ToggleShowPass2 -> ToggleShowPass2 ->
({model|showPass2 = not model.showPass2}, Cmd.none) ( { model | showPass2 = not model.showPass2 }, Cmd.none )
SubmitResp (Ok r) -> SubmitResp (Ok r) ->
let let
m = emptyModel m =
cmd = if r.success then Page.goto (LoginPage Nothing) else Cmd.none emptyModel
cmd =
if r.success then
Page.goto (LoginPage Nothing)
else
Cmd.none
in 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) -> SubmitResp (Err err) ->
(model, Cmd.none) ( model, Cmd.none )
validateForm: Model -> List String
validateForm : Model -> List String
validateForm model = validateForm model =
if model.collId == "" || if
model.login == "" || model.collId
model.pass1 == "" || == ""
model.pass2 == "" then || model.login
[ "All fields are required!"] == ""
|| model.pass1
== ""
|| model.pass2
== ""
then
[ "All fields are required!" ]
else if model.pass1 /= model.pass2 then else if model.pass1 /= model.pass2 then
["The passwords do not match."] [ "The passwords do not match." ]
else else
[] []

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

@ -1,131 +1,164 @@
module Page.Register.View exposing (view) module Page.Register.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit) import Html.Events exposing (onClick, onInput, onSubmit)
import Data.Flags exposing (Flags)
import Page.Register.Data exposing (..)
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.Register.Data exposing (..)
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model = view flags model =
div [class "register-page"] div [ class "register-page" ]
[div [class "ui centered grid"] [ div [ class "ui centered grid" ]
[div [class "row"] [ div [ class "row" ]
[div [class "six wide column ui segment register-view"] [ div [ class "six wide column ui segment register-view" ]
[h1 [class "ui cener aligned icon header"] [ h1 [ class "ui cener aligned icon header" ]
[img [class "ui image" [ img
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")][] [ class "ui image"
,div [class "content"] , src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
[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 "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 = resultMessage model =
case model.result of case model.result of
Just r -> Just r ->
if r.success if r.success then
then div [ class "ui success message" ]
div [class "ui success message"] [ text "Registration successful."
[text "Registration successful."
] ]
else else
div [class "ui error message"] div [ class "ui error message" ]
[text r.message [ text r.message
] ]
Nothing -> Nothing ->
if List.isEmpty model.errorMsg then if List.isEmpty model.errorMsg then
span [class "invisible"][] span [ class "invisible" ] []
else else
div [class "ui error message"] div [ class "ui error message" ]
(List.map (\s -> div[][text s]) model.errorMsg) (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 Http
import Set exposing (Set) import Set exposing (Set)
import File exposing (File)
import Api.Model.BasicResult exposing (BasicResult)
import Util.File exposing (makeFileId) import Util.File exposing (makeFileId)
import Comp.Dropzone
type alias Model = type alias Model =
{ incoming: Bool { incoming : Bool
, singleItem: Bool , singleItem : Bool
, files: List File , files : List File
, completed: Set String , completed : Set String
, errored: Set String , errored : Set String
, loading: Set String , loading : Set String
, dropzone: Comp.Dropzone.Model , dropzone : Comp.Dropzone.Model
} }
dropzoneSettings: Comp.Dropzone.Settings
dropzoneSettings : Comp.Dropzone.Settings
dropzoneSettings = dropzoneSettings =
let let
ds = Comp.Dropzone.defaultSettings ds =
Comp.Dropzone.defaultSettings
in in
{ds | classList = (\m -> [("ui attached blue placeholder segment dropzone", True) { ds
,("dragging", m.hover) | classList =
,("disabled", not m.active) \m ->
]) [ ( "ui attached blue placeholder segment dropzone", True )
} , ( "dragging", m.hover )
, ( "disabled", not m.active )
]
}
emptyModel: Model emptyModel : Model
emptyModel = emptyModel =
{ incoming = True { incoming = True
, singleItem = False , singleItem = False
@ -40,6 +58,7 @@ emptyModel =
, dropzone = Comp.Dropzone.init dropzoneSettings , dropzone = Comp.Dropzone.init dropzoneSettings
} }
type Msg type Msg
= SubmitUpload = SubmitUpload
| SingleUploadResp String (Result Http.Error BasicResult) | SingleUploadResp String (Result Http.Error BasicResult)
@ -50,42 +69,50 @@ type Msg
| DropzoneMsg Comp.Dropzone.Msg | DropzoneMsg Comp.Dropzone.Msg
isLoading: Model -> File -> Bool isLoading : Model -> File -> Bool
isLoading model file = 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 = 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 = isError model file =
Set.member (makeFileId file) model.errored Set.member (makeFileId file) model.errored
isIdle: Model -> File -> Bool
isIdle : Model -> File -> Bool
isIdle model file = isIdle model file =
not (isLoading model file || isCompleted model file || isError model file) not (isLoading model file || isCompleted model file || isError model file)
uploadAllTracker: String
uploadAllTracker : String
uploadAllTracker = uploadAllTracker =
"upload-all" "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 = isDone model =
List.map makeFileId model.files List.map makeFileId model.files
|> List.all (\id -> Set.member id model.completed || Set.member id model.errored) |> List.all (\id -> Set.member id model.completed || Set.member id model.errored)
isSuccessAll: Model -> Bool
isSuccessAll : Model -> Bool
isSuccessAll model = isSuccessAll model =
List.map makeFileId model.files List.map makeFileId model.files
|> List.all (\id -> Set.member id model.completed) |> List.all (\id -> Set.member id model.completed)
hasErrors: Model -> Bool
hasErrors : Model -> Bool
hasErrors model = hasErrors model =
not (Set.isEmpty model.errored) 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) module Page.Upload.Update exposing (update)
import Api 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 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.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 = update sourceId flags msg model =
case msg of case msg of
ToggleIncoming -> ToggleIncoming ->
({model|incoming = not model.incoming}, Cmd.none, Sub.none) ( { model | incoming = not model.incoming }, Cmd.none, Sub.none )
ToggleSingleItem -> ToggleSingleItem ->
({model|singleItem = not model.singleItem}, Cmd.none, Sub.none) ( { model | singleItem = not model.singleItem }, Cmd.none, Sub.none )
SubmitUpload -> SubmitUpload ->
let let
emptyMeta = Api.Model.ItemUploadMeta.empty emptyMeta =
meta = {emptyMeta | multiple = not model.singleItem Api.Model.ItemUploadMeta.empty
, direction = if model.incoming then Just "incoming" else Just "outgoing"
} meta =
fileids = List.map makeFileId model.files { emptyMeta
uploads = if model.singleItem then Api.uploadSingle flags sourceId meta uploadAllTracker model.files (SingleUploadResp uploadAllTracker) | multiple = not model.singleItem
else Cmd.batch (Api.upload flags sourceId meta model.files SingleUploadResp) , direction =
tracker = if model.singleItem then Http.track uploadAllTracker (GotProgress uploadAllTracker) if model.incoming then
else Sub.batch <| List.map (\id -> Http.track id (GotProgress id)) fileids Just "incoming"
(cm2, _, _) = Comp.Dropzone.update (Comp.Dropzone.setActive False) model.dropzone
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 in
({model|loading = Set.fromList fileids, dropzone = cm2}, uploads, tracker) ( { model | loading = Set.fromList fileids, dropzone = cm2 }, uploads, tracker )
SingleUploadResp fileid (Ok res) -> SingleUploadResp fileid (Ok res) ->
let let
compl = if res.success then setCompleted model fileid compl =
else model.completed if res.success then
errs = if not res.success then setErrored model fileid setCompleted 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
)
SingleUploadResp fileid (Err err) -> else
let model.completed
_ = Debug.log "error" err
errs = setErrored model fileid errs =
load = if fileid == uploadAllTracker then Set.empty if not res.success then
else Set.remove fileid model.loading setErrored model fileid
else
model.errored
load =
if fileid == uploadAllTracker then
Set.empty
else
Set.remove fileid model.loading
in 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 -> GotProgress fileid progress ->
let let
percent = case progress of percent =
Http.Sending p -> case progress of
Http.fractionSent p Http.Sending p ->
|> (*) 100 Http.fractionSent p
|> round |> (*) 100
_ -> 0 |> round
updateBars = if percent == 0 then Cmd.none
else if model.singleItem then Ports.setAllProgress (uploadAllTracker, percent) _ ->
else Ports.setProgress (fileid, percent) 0
updateBars =
if percent == 0 then
Cmd.none
else if model.singleItem then
Ports.setAllProgress ( uploadAllTracker, percent )
else
Ports.setProgress ( fileid, percent )
in in
(model, updateBars, Sub.none) ( model, updateBars, Sub.none )
Clear -> Clear ->
(emptyModel, Cmd.none, Sub.none) ( emptyModel, Cmd.none, Sub.none )
DropzoneMsg m -> DropzoneMsg m ->
let let
(m2, c2, files) = Comp.Dropzone.update m model.dropzone ( m2, c2, files ) =
nextFiles = List.append model.files files Comp.Dropzone.update m model.dropzone
nextFiles =
List.append model.files files
in 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 = setCompleted model fileid =
if fileid == uploadAllTracker then List.map makeFileId model.files |> Set.fromList if fileid == uploadAllTracker then
else Set.insert fileid model.completed 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 = setErrored model fileid =
if fileid == uploadAllTracker then List.map makeFileId model.files |> Set.fromList if fileid == uploadAllTracker then
else Set.insert fileid model.errored 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) module Page.Upload.View exposing (view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onCheck)
import Comp.Dropzone import Comp.Dropzone
import File exposing (File) import File exposing (File)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick)
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.Upload.Data exposing (..) import Page.Upload.Data exposing (..)
import Util.File exposing (makeFileId) import Util.File exposing (makeFileId)
import Util.Maybe import Util.Maybe
import Util.Size import Util.Size
view: (Maybe String) -> Model -> Html Msg
view : Maybe String -> Model -> Html Msg
view mid model = view mid model =
div [class "upload-page ui grid container"] div [ class "upload-page ui grid container" ]
[div [class "row"] [ div [ class "row" ]
[div [class "sixteen wide column"] [ div [ class "sixteen wide column" ]
[div [class "ui top attached segment"] [ div [ class "ui top attached segment" ]
[renderForm model [ renderForm model
] ]
,Html.map DropzoneMsg (Comp.Dropzone.view model.dropzone) , Html.map DropzoneMsg (Comp.Dropzone.view model.dropzone)
,div [class "ui bottom attached segment"] , div [ class "ui bottom attached segment" ]
[a [class "ui primary button", href "", onClick SubmitUpload] [ a [ class "ui primary button", href "", onClick SubmitUpload ]
[text "Submit" [ text "Submit"
] ]
,a [class "ui secondary button", href "", onClick Clear] , a [ class "ui secondary button", href "", onClick Clear ]
[text "Reset" [ 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"]
[]
]
] ]
] ]
] ]
, if isDone model && hasErrors model then
renderErrorMsg model
else
span [ class "invisible" ] []
, if List.isEmpty model.files then
span [] []
renderForm: Model -> Html Msg else if isSuccessAll model then
renderForm model = renderSuccessMsg (Util.Maybe.nonEmpty mid) model
div [class "row"]
[Html.form [class "ui form"] else
[div [class "grouped fields"] renderUploads model
[div [class "field"] ]
[div [class "ui radio checkbox"]
[input [type_ "radio", checked model.incoming, onCheck (\_ ->ToggleIncoming)][]
,label [][text "Incoming"] renderErrorMsg : Model -> Html Msg
] renderErrorMsg model =
] div [ class "row" ]
,div [class "field"] [ div [ class "sixteen wide column" ]
[div [class "ui radio checkbox"] [ div [ class "ui large error message" ]
[input [type_ "radio", checked (not model.incoming), onCheck (\_ -> ToggleIncoming)][] [ h3 [ class "ui header" ]
,label [][text "Outgoing"] [ i [ class "meh outline icon" ] []
] , text "Some files failed to upload"
] ]
] , text "There were errors uploading some files."
,div [class "inline field"] ]
[div [class "ui checkbox"] ]
[input [type_ "checkbox", checked model.singleItem, onCheck (\_ -> ToggleSingleItem)][] ]
,label [][text "All files are one single item"]
]
] 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 import Comp.ChangePasswordForm
type alias Model = type alias Model =
{ currentTab: Maybe Tab { currentTab : Maybe Tab
, changePassModel: Comp.ChangePasswordForm.Model , changePassModel : Comp.ChangePasswordForm.Model
} }
emptyModel: Model
emptyModel : Model
emptyModel = emptyModel =
{ currentTab = Nothing { currentTab = Nothing
, changePassModel = Comp.ChangePasswordForm.emptyModel , changePassModel = Comp.ChangePasswordForm.emptyModel
} }
type Tab = ChangePassTab
type Tab
= ChangePassTab
type Msg type Msg
= SetTab Tab = SetTab Tab

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

@ -1,20 +1,23 @@
module Page.UserSettings.Update exposing (update) module Page.UserSettings.Update exposing (update)
import Page.UserSettings.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.ChangePasswordForm 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 = update flags msg model =
case msg of case msg of
SetTab t -> SetTab t ->
let let
m = { model | currentTab = Just t } m =
{ model | currentTab = Just t }
in in
(m, Cmd.none) ( m, Cmd.none )
ChangePassMsg m -> ChangePassMsg m ->
let let
(m2, c2) = Comp.ChangePasswordForm.update flags m model.changePassModel ( m2, c2 ) =
Comp.ChangePasswordForm.update flags m model.changePassModel
in 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) module Page.UserSettings.View exposing (view)
import Comp.ChangePasswordForm
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Page.UserSettings.Data exposing (..)
import Util.Html exposing (classActive) import Util.Html exposing (classActive)
import Page.UserSettings.Data exposing (..)
import Comp.ChangePasswordForm
view: Model -> Html Msg view : Model -> Html Msg
view model = view model =
div [class "usersetting-page ui padded grid"] div [ class "usersetting-page ui padded grid" ]
[div [class "four wide column"] [ div [ class "four wide column" ]
[h4 [class "ui top attached ablue-comp header"] [ h4 [ class "ui top attached ablue-comp header" ]
[text "User" [ text "User"
] ]
,div [class "ui attached fluid segment"] , div [ class "ui attached fluid segment" ]
[div [class "ui fluid vertical secondary menu"] [ div [ class "ui fluid vertical secondary menu" ]
[div [classActive (model.currentTab == Just ChangePassTab) "link icon item" [ div
,onClick (SetTab ChangePassTab) [ classActive (model.currentTab == Just ChangePassTab) "link icon item"
] , onClick (SetTab ChangePassTab)
[i [class "user secret icon"][] ]
,text "Change Password" [ i [ class "user secret icon" ] []
] , text "Change Password"
] ]
] ]
] ]
,div [class "twelve wide column"] ]
[div [class ""] , div [ class "twelve wide column" ]
(case model.currentTab of [ div [ class "" ]
Just ChangePassTab -> viewChangePassword model (case model.currentTab of
Nothing -> [] Just ChangePassTab ->
) viewChangePassword model
Nothing ->
[]
)
] ]
] ]
viewChangePassword: Model -> List (Html Msg)
viewChangePassword : Model -> List (Html Msg)
viewChangePassword model = viewChangePassword model =
[h2 [class "ui header"] [ h2 [ class "ui header" ]
[i [class "ui user secret icon"][] [ i [ class "ui user secret icon" ] []
,div [class "content"] , div [ class "content" ]
[text "Change Password" [ 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) import Api.Model.AuthResult exposing (AuthResult)
port initElements: () -> Cmd msg
port setAccount: AuthResult -> Cmd msg port setAccount : AuthResult -> Cmd msg
port removeAccount: () -> 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) import Api.Model.Address exposing (Address)
toString: Address -> String
toString : Address -> String
toString a = toString a =
[ a.street, a.zip, a.city, a.country ] [ a.street, a.zip, a.city, a.country ]
|> List.filter (String.isEmpty >> not) |> 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) import Api.Model.Contact exposing (Contact)
toString: List Contact -> String
toString : List Contact -> String
toString contacts = toString contacts =
List.map (\c -> c.kind ++ ": " ++ c.value) contacts List.map (\c -> c.kind ++ ": " ++ c.value) contacts
|> List.intersperse ", " |> 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 -- 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 = toHuman dur =
fromMillis dur fromMillis dur
-- implementation -- implementation
fromMillis: Int -> String
fromMillis : Int -> String
fromMillis ms = fromMillis ms =
case ms // 1000 of case ms // 1000 of
0 -> 0 ->
(String.fromInt ms) ++ "ms" String.fromInt ms ++ "ms"
n -> n ->
fromSeconds n fromSeconds n
fromSeconds: Int -> String
fromSeconds : Int -> String
fromSeconds sec = fromSeconds sec =
case sec // 60 of case sec // 60 of
0 -> 0 ->
(String.fromInt sec) ++ "s" String.fromInt sec ++ "s"
n -> n ->
let let
s = sec - (n * 60) s =
sec - (n * 60)
in in
(fromMinutes n) ++ ":" ++ (num s) fromMinutes n ++ ":" ++ num s
fromMinutes: Int -> String
fromMinutes : Int -> String
fromMinutes min = fromMinutes min =
case min // 60 of case min // 60 of
0 -> 0 ->
(num min) num min
n -> n ->
let let
m = min - (n * 60) m =
min - (n * 60)
in in
(num n) ++ ":" ++ (num m) num n ++ ":" ++ num m
num: Int -> String
num : Int -> String
num n = num n =
String.fromInt 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 File exposing (File)
import Util.String import Util.String
makeFileId: File -> String
makeFileId : File -> String
makeFileId file = makeFileId file =
(File.name file) ++ "-" ++ (File.size file |> String.fromInt) File.name file
++ "-"
++ (File.size file |> String.fromInt)
|> Util.String.crazyEncode |> 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 exposing (Attribute)
import Html.Attributes exposing (class) import Html.Attributes exposing (class)
import Html.Events exposing (on, keyCode) import Html.Events exposing (keyCode, on)
import Json.Decode as Decode import Json.Decode as Decode
type KeyCode type KeyCode
= Up = Up
| Down | Down
@ -12,29 +19,52 @@ type KeyCode
| Right | Right
| Enter | Enter
intToKeyCode: Int -> Maybe KeyCode
intToKeyCode : Int -> Maybe KeyCode
intToKeyCode code = intToKeyCode code =
case code of case code of
38 -> Just Up 38 ->
40 -> Just Down Just Up
39 -> Just Right
37 -> Just Left 40 ->
13 -> Just Enter Just Down
_ -> Nothing
39 ->
Just Right
37 ->
Just Left
13 ->
Just Enter
_ ->
Nothing
onKeyUp : (Int -> msg) -> Attribute msg onKeyUp : (Int -> msg) -> Attribute msg
onKeyUp tagger = onKeyUp tagger =
on "keyup" (Decode.map tagger keyCode) on "keyup" (Decode.map tagger keyCode)
onClickk : msg -> Attribute msg onClickk : msg -> Attribute msg
onClickk 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, Bool )
alwaysPreventDefault msg = alwaysPreventDefault msg =
( msg, True ) ( msg, True )
classActive: Bool -> String -> Attribute msg
classActive : Bool -> String -> Attribute msg
classActive active classes = 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 Http
import Json.Decode as D
import Process import Process
import Task exposing (Task) import Task exposing (Task)
import Api.Model.AuthResult exposing (AuthResult)
import Json.Decode as D
-- Authenticated Requests -- Authenticated Requests
authReq: {url: String
,account: AuthResult authReq :
,method: String { url : String
,headers: List Http.Header , account : AuthResult
,body: Http.Body , method : String
,expect: Http.Expect msg , headers : List Http.Header
,tracker: Maybe String , body : Http.Body
} -> Cmd msg , expect : Http.Expect msg
, tracker : Maybe String
}
-> Cmd msg
authReq req = authReq req =
Http.request Http.request
{ url = req.url { url = req.url
, method = req.method , 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 , expect = req.expect
, body = req.body , body = req.body
, timeout = Nothing , timeout = Nothing
, tracker = req.tracker , tracker = req.tracker
} }
authPost: {url: String
,account: AuthResult authPost :
,body: Http.Body { url : String
,expect: Http.Expect msg , account : AuthResult
} -> Cmd msg , body : Http.Body
, expect : Http.Expect msg
}
-> Cmd msg
authPost req = authPost req =
authReq authReq
{ url = req.url { url = req.url
@ -43,12 +61,15 @@ authPost req =
, tracker = Nothing , tracker = Nothing
} }
authPostTrack: {url: String
,account: AuthResult authPostTrack :
,body: Http.Body { url : String
,expect: Http.Expect msg , account : AuthResult
,tracker: String , body : Http.Body
} -> Cmd msg , expect : Http.Expect msg
, tracker : String
}
-> Cmd msg
authPostTrack req = authPostTrack req =
authReq authReq
{ url = req.url { url = req.url
@ -60,11 +81,14 @@ authPostTrack req =
, tracker = Just req.tracker , tracker = Just req.tracker
} }
authPut: {url: String
,account: AuthResult authPut :
,body: Http.Body { url : String
,expect: Http.Expect msg , account : AuthResult
} -> Cmd msg , body : Http.Body
, expect : Http.Expect msg
}
-> Cmd msg
authPut req = authPut req =
authReq authReq
{ url = req.url { url = req.url
@ -76,10 +100,13 @@ authPut req =
, tracker = Nothing , tracker = Nothing
} }
authGet: {url: String
,account: AuthResult authGet :
,expect: Http.Expect msg { url : String
} -> Cmd msg , account : AuthResult
, expect : Http.Expect msg
}
-> Cmd msg
authGet req = authGet req =
authReq authReq
{ url = req.url { url = req.url
@ -91,10 +118,13 @@ authGet req =
, tracker = Nothing , tracker = Nothing
} }
authDelete: {url: String
,account: AuthResult authDelete :
,expect: Http.Expect msg { url : String
} -> Cmd msg , account : AuthResult
, expect : Http.Expect msg
}
-> Cmd msg
authDelete req = authDelete req =
authReq authReq
{ url = req.url { url = req.url
@ -110,69 +140,81 @@ authDelete req =
-- Error Utilities -- Error Utilities
errorToStringStatus: Http.Error -> (Int -> String) -> String
errorToStringStatus : Http.Error -> (Int -> String) -> String
errorToStringStatus error statusString = errorToStringStatus error statusString =
case error of case error of
Http.BadUrl url -> Http.BadUrl url ->
"There is something wrong with this url: " ++ url "There is something wrong with this url: " ++ url
Http.Timeout -> Http.Timeout ->
"There was a network timeout." "There was a network timeout."
Http.NetworkError -> Http.NetworkError ->
"There was a network error." "There was a network error."
Http.BadStatus status -> Http.BadStatus status ->
statusString status statusString status
Http.BadBody str -> Http.BadBody str ->
"There was an error decoding the response: " ++ str "There was an error decoding the response: " ++ str
errorToString: Http.Error -> String
errorToString : Http.Error -> String
errorToString error = errorToString error =
let let
f sc = case sc of f sc =
404 -> case sc of
"The requested resource doesn't exist." 404 ->
_ -> "The requested resource doesn't exist."
"There was an invalid response status: " ++ (String.fromInt sc)
_ ->
"There was an invalid response status: " ++ String.fromInt sc
in in
errorToStringStatus error f errorToStringStatus error f
-- Http.Task Utilities -- Http.Task Utilities
jsonResolver : D.Decoder a -> Http.Resolver Http.Error a
jsonResolver : D.Decoder a -> Http.Resolver Http.Error a
jsonResolver decoder = jsonResolver decoder =
Http.stringResolver <| Http.stringResolver <|
\response -> \response ->
case response of case response of
Http.BadUrl_ url -> Http.BadUrl_ url ->
Err (Http.BadUrl url) Err (Http.BadUrl url)
Http.Timeout_ -> Http.Timeout_ ->
Err Http.Timeout Err Http.Timeout
Http.NetworkError_ -> Http.NetworkError_ ->
Err Http.NetworkError Err Http.NetworkError
Http.BadStatus_ metadata body -> Http.BadStatus_ metadata body ->
Err (Http.BadStatus metadata.statusCode) Err (Http.BadStatus metadata.statusCode)
Http.GoodStatus_ metadata body -> Http.GoodStatus_ metadata body ->
case D.decodeString decoder body of case D.decodeString decoder body of
Ok value -> Ok value ->
Ok value Ok value
Err err -> Err err ->
Err (Http.BadBody (D.errorToString 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 = executeIn delay receive task =
Process.sleep delay Process.sleep delay
|> Task.andThen (\_ -> task) |> Task.andThen (\_ -> task)
|> Task.attempt receive |> Task.attempt receive
authTask:
authTask :
{ method : String { method : String
, headers : List Http.Header , headers : List Http.Header
, account: AuthResult , account : AuthResult
, url : String , url : String
, body : Http.Body , body : Http.Body
, resolver : Http.Resolver x a , resolver : Http.Resolver x a
@ -182,7 +224,7 @@ authTask:
authTask req = authTask req =
Http.task Http.task
{ method = req.method { 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 , url = req.url
, body = req.body , body = req.body
, resolver = req.resolver , resolver = req.resolver

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

@ -1,51 +1,80 @@
module Util.List exposing ( find module Util.List exposing
, findIndexed ( distinct
, get , find
, distinct , findIndexed
, findNext , findNext
, findPrev , findPrev
) , get
)
get: List a -> Int -> Maybe a
get : List a -> Int -> Maybe a
get list index = get list index =
if index < 0 then Nothing if index < 0 then
else case list of Nothing
[] ->
Nothing
x :: xs ->
if index == 0
then Just x
else get xs (index - 1)
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 = find pred list =
findIndexed pred list |> Maybe.map Tuple.first 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 = findIndexed pred list =
findIndexed1 pred list 0 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 = findIndexed1 pred list index =
case list of case list of
[] -> Nothing [] ->
x :: xs -> Nothing
if pred x then Just (x, index)
else findIndexed1 pred xs (index + 1)
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 = distinct list =
List.reverse <| 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 = findPrev pred list =
findIndexed pred list findIndexed pred list
|> Maybe.map Tuple.second |> Maybe.map Tuple.second
|> Maybe.map (\i -> i - 1) |> Maybe.map (\i -> i - 1)
|> Maybe.andThen (get list) |> Maybe.andThen (get list)
findNext: (a -> Bool) -> List a -> Maybe a
findNext : (a -> Bool) -> List a -> Maybe a
findNext pred list = findNext pred list =
findIndexed pred list findIndexed pred list
|> Maybe.map Tuple.second |> 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 = nonEmpty ma =
Maybe.map (\_ -> True) ma not (isEmpty ma)
|> Maybe.withDefault False
isEmpty: Maybe a -> Bool
isEmpty : Maybe a -> Bool
isEmpty ma = isEmpty ma =
not (nonEmpty ma) ma == Nothing
withDefault: Maybe a -> Maybe a -> Maybe a
withDefault : Maybe a -> Maybe a -> Maybe a
withDefault ma1 ma2 = 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 = or listma =
case listma of case listma of
[] -> Nothing [] ->
Nothing
el :: els -> el :: els ->
case el of case el of
Just _ -> el Just _ ->
Nothing -> or els 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 = prettyNumber n =
let let
parts = String.split "." (String.fromFloat n) parts =
String.split "." (String.fromFloat n)
in in
case parts of case parts of
n0 :: d :: [] -> n0 ++ "." ++ (String.left 2 d) n0 :: d :: [] ->
_ -> String.join "." parts n0 ++ "." ++ String.left 2 d
bytesReadable: SizeUnit -> Float -> String _ ->
String.join "." parts
bytesReadable : SizeUnit -> Float -> String
bytesReadable unit n = bytesReadable unit n =
let let
k = n / 1024 k =
num = prettyNumber n n / 1024
num =
prettyNumber n
in in
case unit of case unit of
G -> num ++ "G" G ->
M -> if k > 1 then (bytesReadable G k) else num ++ "M" num ++ "G"
K -> if k > 1 then (bytesReadable M k) else num ++ "K"
B -> if k > 1 then (bytesReadable K k) else num ++ "B" 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 import Base64
crazyEncode: String -> String
crazyEncode : String -> String
crazyEncode str = crazyEncode str =
let let
b64 = Base64.encode str b64 =
len = String.length b64 Base64.encode str
len =
String.length b64
in in
case (String.right 2 b64 |> String.toList) of case String.right 2 b64 |> String.toList of
'=' :: '=' :: [] -> '=' :: '=' :: [] ->
(String.dropRight 2 b64) ++ "0" 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 = ellipsis len str =
if String.length str <= len then str if String.length str <= len then
else (String.left (len - 3) str) ++ "..." str
withDefault: String -> String -> String else
String.left (len - 3) str ++ "..."
withDefault : String -> String -> String
withDefault default str = 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 DateFormat
import Time exposing (Posix, Zone, utc) import Time exposing (Posix, Zone, utc)
@ -16,7 +21,8 @@ dateFormatter =
, DateFormat.yearNumber , DateFormat.yearNumber
] ]
dateFormatterShort: Zone -> Posix -> String
dateFormatterShort : Zone -> Posix -> String
dateFormatterShort = dateFormatterShort =
DateFormat.format DateFormat.format
[ DateFormat.yearNumber [ DateFormat.yearNumber
@ -26,7 +32,8 @@ dateFormatterShort =
, DateFormat.dayOfMonthFixed , DateFormat.dayOfMonthFixed
] ]
timeFormatter: Zone -> Posix -> String
timeFormatter : Zone -> Posix -> String
timeFormatter = timeFormatter =
DateFormat.format DateFormat.format
[ DateFormat.hourMilitaryNumber [ DateFormat.hourMilitaryNumber
@ -34,7 +41,8 @@ timeFormatter =
, DateFormat.minuteFixed , DateFormat.minuteFixed
] ]
isoDateTimeFormatter: Zone -> Posix -> String
isoDateTimeFormatter : Zone -> Posix -> String
isoDateTimeFormatter = isoDateTimeFormatter =
DateFormat.format DateFormat.format
[ DateFormat.yearNumber [ DateFormat.yearNumber
@ -51,37 +59,49 @@ isoDateTimeFormatter =
] ]
timeZone: Zone timeZone : Zone
timeZone = timeZone =
utc 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 = formatIsoDateTime millis =
Time.millisToPosix millis Time.millisToPosix millis
|> isoDateTimeFormatter timeZone |> isoDateTimeFormatter timeZone
{- Format millis into "18:57". The current time (not the duration of {- Format millis into "18:57". The current time (not the duration of
the millis). the millis).
-} -}
formatTime: Int -> String
formatTime : Int -> String
formatTime millis = formatTime millis =
Time.millisToPosix millis Time.millisToPosix millis
|> timeFormatter timeZone |> timeFormatter timeZone
{- Format millis into "Wed, 10. Jan 2018"
-}
formatDate: Int -> String {- Format millis into "Wed, 10. Jan 2018" -}
formatDate : Int -> String
formatDate millis = formatDate millis =
Time.millisToPosix millis Time.millisToPosix millis
|> dateFormatter timeZone |> dateFormatter timeZone
formatDateShort: Int -> String
formatDateShort : Int -> String
formatDateShort millis = formatDateShort millis =
Time.millisToPosix millis Time.millisToPosix millis
|> dateFormatterShort timeZone |> 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 = andThen1 fs a =
let let
init = (a, []) init =
( a, [] )
update el tuple = update el tuple =
let let
(a2, c2) = el (Tuple.first tuple) ( a2, c2 ) =
el (Tuple.first tuple)
in in
(a2, c2 :: (Tuple.second tuple)) ( a2, c2 :: Tuple.second tuple )
in in
List.foldl update init fs List.foldl update init fs
|> Tuple.mapSecond Cmd.batch |> 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 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) { elmApp.ports.setAccount.subscribe(function(authResult) {
console.log("Add account from local storage"); console.log("Add account from local storage");
localStorage.setItem("account", JSON.stringify(authResult)); localStorage.setItem("account", JSON.stringify(authResult));