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",
"source-directories": [
"modules/webapp/target/elm-src",
"modules/webapp/src/main/elm"
"modules/webapp/src/main/elm",
"modules/webapp/target/elm-src"
],
"elm-version": "0.19.1",
"dependencies": {

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

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

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

@ -1,22 +1,29 @@
module App.Data exposing (..)
module App.Data exposing
( Model
, Msg(..)
, checkPage
, defaultPage
, init
)
import Api.Model.AuthResult exposing (AuthResult)
import Api.Model.VersionInfo exposing (VersionInfo)
import Browser exposing (UrlRequest)
import Browser.Navigation exposing (Key)
import Url exposing (Url)
import Http
import Data.Flags exposing (Flags)
import Api.Model.VersionInfo exposing (VersionInfo)
import Api.Model.AuthResult exposing (AuthResult)
import Http
import Page exposing (Page(..))
import Page.CollectiveSettings.Data
import Page.Home.Data
import Page.Login.Data
import Page.ManageData.Data
import Page.CollectiveSettings.Data
import Page.UserSettings.Data
import Page.NewInvite.Data
import Page.Queue.Data
import Page.Register.Data
import Page.Upload.Data
import Page.NewInvite.Data
import Page.UserSettings.Data
import Url exposing (Url)
type alias Model =
{ flags : Flags
@ -36,10 +43,12 @@ type alias Model =
, subs : Sub Msg
}
init : Key -> Url -> Flags -> Model
init key url flags =
let
page = Page.fromUrl url
page =
Page.fromUrl url
|> Maybe.withDefault (defaultPage flags)
in
{ flags = flags
@ -59,6 +68,7 @@ init key url flags =
, subs = Sub.none
}
type Msg
= NavRequest UrlRequest
| NavChange Url
@ -77,18 +87,30 @@ type Msg
| SessionCheckResp (Result Http.Error AuthResult)
| ToggleNavMenu
isSignedIn : Flags -> Bool
isSignedIn flags =
flags.account
|> Maybe.map .success
|> Maybe.withDefault False
checkPage : Flags -> Page -> Page
checkPage flags page =
if Page.isSecured page && isSignedIn flags then page
else if Page.isOpen page then page
else Page.loginPage page
if Page.isSecured page && isSignedIn flags then
page
else if Page.isOpen page then
page
else
Page.loginPage page
defaultPage : Flags -> Page
defaultPage flags =
if isSignedIn flags then HomePage else (LoginPage Nothing)
if isSignedIn flags then
HomePage
else
LoginPage Nothing

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

@ -1,40 +1,46 @@
module App.Update exposing (update, initPage)
module App.Update exposing
( initPage
, update
)
import Api
import Ports
import App.Data exposing (..)
import Browser exposing (UrlRequest(..))
import Browser.Navigation as Nav
import Url
import Data.Flags
import App.Data exposing (..)
import Page exposing (Page(..))
import Page.CollectiveSettings.Data
import Page.CollectiveSettings.Update
import Page.Home.Data
import Page.Home.Update
import Page.Login.Data
import Page.Login.Update
import Page.ManageData.Data
import Page.ManageData.Update
import Page.CollectiveSettings.Data
import Page.CollectiveSettings.Update
import Page.UserSettings.Data
import Page.UserSettings.Update
import Page.NewInvite.Data
import Page.NewInvite.Update
import Page.Queue.Data
import Page.Queue.Update
import Page.Register.Data
import Page.Register.Update
import Page.Upload.Data
import Page.Upload.Update
import Page.NewInvite.Data
import Page.NewInvite.Update
import Page.UserSettings.Data
import Page.UserSettings.Update
import Ports
import Url
import Util.Update
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
let
(m, c, s) = updateWithSub msg model
( m, c, s ) =
updateWithSub msg model
in
( { m | subs = s }, c )
updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
updateWithSub msg model =
case msg of
@ -68,7 +74,7 @@ updateWithSub msg model =
VersionResp (Ok info) ->
( { model | version = info }, Cmd.none ) |> noSub
VersionResp (Err err) ->
VersionResp (Err _) ->
( model, Cmd.none, Sub.none )
Logout ->
@ -77,7 +83,8 @@ updateWithSub msg model =
[ Api.logout model.flags LogoutResp
, Ports.removeAccount ()
]
, Sub.none)
, Sub.none
)
LogoutResp _ ->
( { model | loginModel = Page.Login.Data.emptyModel }, Page.goto (LoginPage Nothing), Sub.none )
@ -86,27 +93,52 @@ updateWithSub msg model =
case res of
Ok lr ->
let
newFlags = if lr.success then Data.Flags.withAccount model.flags lr
else Data.Flags.withoutAccount model.flags
command = if lr.success then Api.refreshSession newFlags SessionCheckResp
else Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)]
newFlags =
if lr.success then
Data.Flags.withAccount model.flags lr
else
Data.Flags.withoutAccount model.flags
command =
if lr.success then
Api.refreshSession newFlags SessionCheckResp
else
Cmd.batch
[ Ports.removeAccount ()
, Page.goto (Page.loginPage model.page)
]
in
( { model | flags = newFlags }, command, Sub.none )
Err _ ->
(model, Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)], Sub.none)
( model
, Cmd.batch
[ Ports.removeAccount ()
, Page.goto (Page.loginPage model.page)
]
, Sub.none
)
NavRequest req ->
case req of
Internal url ->
let
newPage = Page.fromUrl url
newPage =
Page.fromUrl url
isCurrent =
Page.fromUrl url |>
Maybe.map (\p -> p == model.page) |>
Maybe.withDefault True
Page.fromUrl url
|> Maybe.map (\p -> p == model.page)
|> Maybe.withDefault True
in
( model
, if isCurrent then Cmd.none else Nav.pushUrl model.key (Url.toString url)
, if isCurrent then
Cmd.none
else
Nav.pushUrl model.key (Url.toString url)
, Sub.none
)
@ -118,13 +150,21 @@ updateWithSub msg model =
NavChange url ->
let
page = Page.fromUrl url
page =
Page.fromUrl url
|> Maybe.withDefault (defaultPage model.flags)
check = checkPage model.flags page
(m, c) = initPage model page
check =
checkPage model.flags page
( m, c ) =
initPage model page
in
if check == page then ( { m | page = page }, c, Sub.none )
else (model, Page.goto check, Sub.none)
if check == page then
( { m | page = page }, c, Sub.none )
else
( model, Page.goto check, Sub.none )
ToggleNavMenu ->
( { model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none )
@ -133,35 +173,46 @@ updateWithSub msg model =
updateNewInvite : Page.NewInvite.Data.Msg -> Model -> ( Model, Cmd Msg )
updateNewInvite lmsg model =
let
(lm, lc) = Page.NewInvite.Update.update model.flags lmsg model.newInviteModel
( lm, lc ) =
Page.NewInvite.Update.update model.flags lmsg model.newInviteModel
in
( { model | newInviteModel = lm }
, Cmd.map NewInviteMsg lc
)
updateUpload : Page.Upload.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
updateUpload lmsg model =
let
(lm, lc, ls) = Page.Upload.Update.update (Page.uploadId model.page) model.flags lmsg model.uploadModel
( lm, lc, ls ) =
Page.Upload.Update.update
(Page.uploadId model.page)
model.flags
lmsg
model.uploadModel
in
( { model | uploadModel = lm }
, Cmd.map UploadMsg lc
, Sub.map UploadMsg ls
)
updateRegister : Page.Register.Data.Msg -> Model -> ( Model, Cmd Msg )
updateRegister lmsg model =
let
(lm, lc) = Page.Register.Update.update model.flags lmsg model.registerModel
( lm, lc ) =
Page.Register.Update.update model.flags lmsg model.registerModel
in
( { model | registerModel = lm }
, Cmd.map RegisterMsg lc
)
updateQueue : Page.Queue.Data.Msg -> Model -> ( Model, Cmd Msg )
updateQueue lmsg model =
let
(lm, lc) = Page.Queue.Update.update model.flags lmsg model.queueModel
( lm, lc ) =
Page.Queue.Update.update model.flags lmsg model.queueModel
in
( { model | queueModel = lm }
, Cmd.map QueueMsg lc
@ -171,50 +222,67 @@ updateQueue lmsg model =
updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg )
updateUserSettings lmsg model =
let
(lm, lc) = Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel
( lm, lc ) =
Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel
in
( { model | userSettingsModel = lm }
, Cmd.map UserSettingsMsg lc
)
updateCollSettings : Page.CollectiveSettings.Data.Msg -> Model -> ( Model, Cmd Msg )
updateCollSettings lmsg model =
let
(lm, lc) = Page.CollectiveSettings.Update.update model.flags lmsg model.collSettingsModel
( lm, lc ) =
Page.CollectiveSettings.Update.update model.flags
lmsg
model.collSettingsModel
in
( { model | collSettingsModel = lm }
, Cmd.map CollSettingsMsg lc
)
updateLogin : Page.Login.Data.Msg -> Model -> ( Model, Cmd Msg )
updateLogin lmsg model =
let
(lm, lc, ar) = Page.Login.Update.update (Page.loginPageReferrer model.page) model.flags lmsg model.loginModel
newFlags = Maybe.map (Data.Flags.withAccount model.flags) ar
( lm, lc, ar ) =
Page.Login.Update.update (Page.loginPageReferrer model.page)
model.flags
lmsg
model.loginModel
newFlags =
Maybe.map (Data.Flags.withAccount model.flags) ar
|> Maybe.withDefault model.flags
in
( { model | loginModel = lm, flags = newFlags }
, Cmd.map LoginMsg lc
)
updateHome : Page.Home.Data.Msg -> Model -> ( Model, Cmd Msg )
updateHome lmsg model =
let
(lm, lc) = Page.Home.Update.update model.flags lmsg model.homeModel
( lm, lc ) =
Page.Home.Update.update model.flags lmsg model.homeModel
in
( { model | homeModel = lm }
, Cmd.map HomeMsg lc
)
updateManageData : Page.ManageData.Data.Msg -> Model -> ( Model, Cmd Msg )
updateManageData lmsg model =
let
(lm, lc) = Page.ManageData.Update.update model.flags lmsg model.manageDataModel
( lm, lc ) =
Page.ManageData.Update.update model.flags lmsg model.manageDataModel
in
( { model | manageDataModel = lm }
, Cmd.map ManageDataMsg lc
)
initPage : Model -> Page -> ( Model, Cmd Msg )
initPage model page =
case page of
@ -222,7 +290,8 @@ initPage model page =
Util.Update.andThen1
[ updateHome Page.Home.Data.Init
, updateQueue Page.Queue.Data.StopRefresh
] model
]
model
LoginPage _ ->
updateQueue Page.Queue.Data.StopRefresh model
@ -234,7 +303,8 @@ initPage model page =
Util.Update.andThen1
[ updateQueue Page.Queue.Data.StopRefresh
, updateCollSettings Page.CollectiveSettings.Data.Init
] model
]
model
UserSettingPage ->
updateQueue Page.Queue.Data.StopRefresh model

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

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

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

@ -1,18 +1,20 @@
module Comp.AddressForm exposing ( Model
, emptyModel
module Comp.AddressForm exposing
( Model
, Msg(..)
, view
, emptyModel
, getAddress
, update
, getAddress)
, view
)
import Api.Model.Address exposing (Address)
import Comp.Dropdown
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
import Data.Flags exposing (Flags)
import Api.Model.Address exposing (Address)
import Comp.Dropdown
import Util.List
type alias Model =
{ address : Address
, street : String
@ -21,11 +23,13 @@ type alias Model =
, country : Comp.Dropdown.Model Country
}
type alias Country =
{ code : String
, label : String
}
countries : List Country
countries =
[ Country "DE" "Germany"
@ -35,13 +39,15 @@ countries =
, Country "AU" "Austria"
]
emptyModel : Model
emptyModel =
{ address = Api.Model.Address.empty
, street = ""
, zip = ""
, city = ""
, country = Comp.Dropdown.makeSingleList
, country =
Comp.Dropdown.makeSingleList
{ makeOption = \c -> { value = c.code, text = c.label }
, placeholder = "Select Country"
, options = countries
@ -58,6 +64,7 @@ getAddress model =
, country = Comp.Dropdown.getSelected model.country |> List.head |> Maybe.map .code |> Maybe.withDefault ""
}
type Msg
= SetStreet String
| SetCity String
@ -65,15 +72,19 @@ type Msg
| SetAddress Address
| CountryMsg (Comp.Dropdown.Msg Country)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SetAddress a ->
let
selection = Util.List.find (\c -> c.code == a.country) countries
selection =
Util.List.find (\c -> c.code == a.country) countries
|> Maybe.map List.singleton
|> Maybe.withDefault []
(m2, c2) = Comp.Dropdown.update (Comp.Dropdown.SetSelection selection) model.country
( m2, c2 ) =
Comp.Dropdown.update (Comp.Dropdown.SetSelection selection) model.country
in
( { model | address = a, street = a.street, city = a.city, zip = a.zip, country = m2 }, Cmd.map CountryMsg c2 )
@ -88,39 +99,50 @@ update msg model =
CountryMsg m ->
let
(m1, c1) = Comp.Dropdown.update m model.country
( m1, c1 ) =
Comp.Dropdown.update m model.country
in
( { model | country = m1 }, Cmd.map CountryMsg c1 )
view : Model -> Html Msg
view model =
div [ class "ui form" ]
[div [class "field"
[ div
[ class "field"
]
[ label [] [ text "Street" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetStreet
, placeholder "Street"
, value model.street
][]
]
,div [class "field"
[]
]
, div
[ class "field"
]
[ label [] [ text "Zip Code" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetZip
, placeholder "Zip"
, value model.zip
][]
]
,div [class "field"
[]
]
, div
[ class "field"
]
[ label [] [ text "City" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetCity
, placeholder "City"
, value model.city
][]
]
[]
]
, div [ class "field" ]
[ label [] [ text "Country" ]

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

@ -1,19 +1,21 @@
module Comp.ChangePasswordForm exposing (Model
,emptyModel
module Comp.ChangePasswordForm exposing
( Model
, Msg(..)
, emptyModel
, update
, view
)
import Http
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onClick)
import Api
import Api.Model.PasswordChange exposing (PasswordChange)
import Util.Http
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.PasswordChange exposing (PasswordChange)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput)
import Http
import Util.Http
type alias Model =
{ current : String
@ -27,6 +29,7 @@ type alias Model =
, successMsg : String
}
emptyModel : Model
emptyModel =
validateModel
@ -41,6 +44,7 @@ emptyModel =
, successMsg = ""
}
type Msg
= SetCurrent String
| SetNew1 String
@ -55,23 +59,40 @@ type Msg
validate : Model -> List String
validate model =
List.concat
[ if model.newPass1 /= "" && model.newPass2 /= "" && model.newPass1 /= model.newPass2
then ["New passwords do not match."]
else []
, if model.newPass1 == "" || model.newPass2 == "" || model.current == ""
then ["Please fill in required fields."]
else []
[ if model.newPass1 /= "" && model.newPass2 /= "" && model.newPass1 /= model.newPass2 then
[ "New passwords do not match." ]
else
[]
, if model.newPass1 == "" || model.newPass2 == "" || model.current == "" then
[ "Please fill in required fields." ]
else
[]
]
validateModel : Model -> Model
validateModel model =
let
err = validate model
err =
validate model
in
{model | errors = err, successMsg = if err == [] then model.successMsg else "" }
{ model
| errors = err
, successMsg =
if err == [] then
model.successMsg
else
""
}
-- Update
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -93,82 +114,119 @@ update flags msg model =
ToggleShowPass2 ->
( { model | showPass2 = not model.showPass2 }, Cmd.none )
Submit ->
let
valid = validate model
cp = PasswordChange model.current model.newPass1
valid =
validate model
cp =
PasswordChange model.current model.newPass1
in
if List.isEmpty valid then
( { model | loading = True, errors = [], successMsg = "" }, Api.changePassword flags cp SubmitResp )
else
( model, Cmd.none )
SubmitResp (Ok res) ->
let
em = { emptyModel | errors = [], successMsg = "Password has been changed."}
em =
{ emptyModel | errors = [], successMsg = "Password has been changed." }
in
if res.success then
( em, Cmd.none )
else
( { model | errors = [ res.message ], loading = False, successMsg = "" }, Cmd.none )
SubmitResp (Err err) ->
let
str = Util.Http.errorToString err
str =
Util.Http.errorToString err
in
( { model | errors = [ str ], loading = False, successMsg = "" }, Cmd.none )
-- View
view : Model -> Html Msg
view model =
div [classList [("ui form", True)
div
[ classList
[ ( "ui form", True )
, ( "error", List.isEmpty model.errors |> not )
, ( "success", model.successMsg /= "" )
]
]
[div [classList [("field", True)
[ div
[ classList
[ ( "field", True )
, ( "error", model.current == "" )
]
]
[ label [] [ text "Current Password*" ]
, div [ class "ui action input" ]
[input [type_ <| if model.showCurrent then "text" else "password"
[ input
[ type_ <|
if model.showCurrent then
"text"
else
"password"
, onInput SetCurrent
, value model.current
][]
]
[]
, button [ class "ui icon button", onClick ToggleShowCurrent ]
[ i [ class "eye icon" ] []
]
]
]
,div [classList [("field", True)
, div
[ classList
[ ( "field", True )
, ( "error", model.newPass1 == "" )
]
]
[ label [] [ text "New Password*" ]
, div [ class "ui action input" ]
[input [type_ <| if model.showPass1 then "text" else "password"
[ input
[ type_ <|
if model.showPass1 then
"text"
else
"password"
, onInput SetNew1
, value model.newPass1
][]
]
[]
, button [ class "ui icon button", onClick ToggleShowPass1 ]
[ i [ class "eye icon" ] []
]
]
]
,div [classList [("field", True)
, div
[ classList
[ ( "field", True )
, ( "error", model.newPass2 == "" )
]
]
[ label [] [ text "New Password (repeat)*" ]
, div [ class "ui action input" ]
[input [type_ <| if model.showPass2 then "text" else "password"
[ input
[ type_ <|
if model.showPass2 then
"text"
else
"password"
, onInput SetNew2
, value model.newPass2
][]
]
[]
, button [ class "ui icon button", onClick ToggleShowPass2 ]
[ i [ class "eye icon" ] []
]
@ -182,6 +240,7 @@ view model =
[ case model.errors of
a :: [] ->
text a
_ ->
ul [ class "ui list" ]
(List.map (\em -> li [] [ text em ]) model.errors)
@ -190,9 +249,12 @@ view model =
, button [ class "ui primary button", onClick Submit ]
[ text "Submit"
]
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]

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

@ -1,17 +1,19 @@
module Comp.ContactField exposing (Model
module Comp.ContactField exposing
( Model
, Msg(..)
, emptyModel
, getContacts
,Msg(..)
, update
, view
)
import Api.Model.Contact exposing (Contact)
import Comp.Dropdown
import Data.ContactType exposing (ContactType)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onClick)
import Api.Model.Contact exposing (Contact)
import Data.ContactType exposing (ContactType)
import Comp.Dropdown
import Html.Events exposing (onClick, onInput)
type alias Model =
{ items : List Contact
@ -19,11 +21,17 @@ type alias Model =
, value : String
}
emptyModel : Model
emptyModel =
{ items = []
, kind = Comp.Dropdown.makeSingleList
{ makeOption = \ct -> { value = Data.ContactType.toString ct, text = Data.ContactType.toString ct }
, kind =
Comp.Dropdown.makeSingleList
{ makeOption =
\ct ->
{ value = Data.ContactType.toString ct
, text = Data.ContactType.toString ct
}
, placeholder = ""
, options = Data.ContactType.all
, selected = List.head Data.ContactType.all
@ -31,10 +39,12 @@ emptyModel =
, value = ""
}
getContacts : Model -> List Contact
getContacts model =
List.filter (\c -> c.value /= "") model.items
type Msg
= SetValue String
| TypeMsg (Comp.Dropdown.Msg ContactType)
@ -42,6 +52,7 @@ type Msg
| Select Contact
| SetItems (List Contact)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
@ -53,30 +64,38 @@ update msg model =
TypeMsg m ->
let
(m1, c1) = Comp.Dropdown.update m model.kind
( m1, c1 ) =
Comp.Dropdown.update m model.kind
in
( { model | kind = m1 }, Cmd.map TypeMsg c1 )
AddContact ->
if model.value == "" then (model, Cmd.none)
if model.value == "" then
( model, Cmd.none )
else
let
kind = Comp.Dropdown.getSelected model.kind
kind =
Comp.Dropdown.getSelected model.kind
|> List.head
|> Maybe.map Data.ContactType.toString
|> Maybe.withDefault ""
in
({model| items = (Contact "" model.value kind) :: model.items, value = ""}, Cmd.none)
( { model | items = Contact "" model.value kind :: model.items, value = "" }, Cmd.none )
Select contact ->
let
newItems = List.filter (\c -> c /= contact) model.items
(m1, c1) = Data.ContactType.fromString contact.kind
newItems =
List.filter (\c -> c /= contact) model.items
( m1, c1 ) =
Data.ContactType.fromString contact.kind
|> Maybe.map (\ct -> update (TypeMsg (Comp.Dropdown.SetSelection [ ct ])) model)
|> Maybe.withDefault ( model, Cmd.none )
in
( { m1 | value = contact.value, items = newItems }, c1 )
view : Model -> Html Msg
view model =
div []
@ -86,17 +105,21 @@ view model =
]
, div [ class "twelve wide field" ]
[ div [ class "ui action input" ]
[input [type_ "text"
[ input
[ type_ "text"
, onInput SetValue
, value model.value
][]
]
[]
, a [ class "ui button", onClick AddContact, href "" ]
[ text "Add"
]
]
]
]
,div [classList [("field", True)
, div
[ classList
[ ( "field", True )
, ( "invisible", List.isEmpty model.items )
]
]

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

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

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

@ -1,30 +1,31 @@
module Comp.Dropdown exposing ( Model
module Comp.Dropdown exposing
( Model
, Msg(..)
, Option
, getSelected
, isDropdownChangeMsg
, makeModel
, makeMultiple
, makeSingle
, makeSingleList
, makeMultiple
, update
, isDropdownChangeMsg
, view
, getSelected
, Msg(..))
)
import Http
import Task
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onClick, onFocus, onBlur)
import Json.Decode as Decode
import Html.Events exposing (onClick, onInput)
import Simple.Fuzzy
import Util.Html exposing (onKeyUp)
import Util.List
type alias Option =
{ value : String
, text : String
}
type alias Item a =
{ value : a
, option : Option
@ -33,6 +34,7 @@ type alias Item a =
, active : Bool
}
makeItem : Model a -> a -> Item a
makeItem model val =
{ value = val
@ -42,6 +44,7 @@ makeItem model val =
, active = False
}
type alias Model a =
{ multiple : Bool
, selected : List (Item a)
@ -54,13 +57,15 @@ type alias Model a =
, placeholder : String
}
makeModel :
{ multiple : Bool
, searchable : Int -> Bool
, makeOption : a -> Option
, labelColor : a -> String
, placeholder : String
} -> Model a
}
-> Model a
makeModel input =
{ multiple = input.multiple
, searchable = input.searchable
@ -73,10 +78,12 @@ makeModel input =
, placeholder = input.placeholder
}
makeSingle :
{ makeOption : a -> Option
, placeholder : String
} -> Model a
}
-> Model a
makeSingle opts =
makeModel
{ multiple = False
@ -86,26 +93,35 @@ makeSingle opts =
, placeholder = opts.placeholder
}
makeSingleList :
{ makeOption : a -> Option
, placeholder : String
, options : List a
, selected : Maybe a
} -> Model a
}
-> Model a
makeSingleList opts =
let
m = makeSingle {makeOption = opts.makeOption, placeholder = opts.placeholder}
m2 = {m | available = List.map (makeItem m) opts.options}
m3 = Maybe.map (makeItem m2) opts.selected
m =
makeSingle { makeOption = opts.makeOption, placeholder = opts.placeholder }
m2 =
{ m | available = List.map (makeItem m) opts.options }
m3 =
Maybe.map (makeItem m2) opts.selected
|> Maybe.map (selectItem m2)
|> Maybe.withDefault m2
in
m3
makeMultiple :
{ makeOption : a -> Option
, labelColor : a -> String
} -> Model a
}
-> Model a
makeMultiple opts =
makeModel
{ multiple = True
@ -115,10 +131,12 @@ makeMultiple opts =
, placeholder = ""
}
getSelected : Model a -> List a
getSelected model =
List.map .value model.selected
type Msg a
= SetOptions (List a)
| SetSelection (List a)
@ -129,42 +147,76 @@ type Msg a
| ShowMenu Bool
| KeyPress Int
getOptions : Model a -> List (Item a)
getOptions model =
if not model.multiple && isSearchable model && model.menuOpen
then List.filter .visible model.available
else List.filter (\e -> e.visible && (not e.selected)) model.available
if not model.multiple && isSearchable model && model.menuOpen then
List.filter .visible model.available
else
List.filter (\e -> e.visible && not e.selected) model.available
isSearchable : Model a -> Bool
isSearchable model =
List.length model.available |> model.searchable
-- Update
deselectItem : Model a -> Item a -> Model a
deselectItem model item =
let
value = item.option.value
sel = if model.multiple then List.filter (\e -> e.option.value /= value) model.selected
else []
value =
item.option.value
show e = if e.option.value == value then {e | selected = False } else e
avail = List.map show model.available
sel =
if model.multiple then
List.filter (\e -> e.option.value /= value) model.selected
else
[]
show e =
if e.option.value == value then
{ e | selected = False }
else
e
avail =
List.map show model.available
in
{ model | selected = sel, available = avail }
selectItem : Model a -> Item a -> Model a
selectItem model item =
let
value = item.option.value
sel = if model.multiple
then List.concat [ model.selected, [ item ] ]
else [ item ]
value =
item.option.value
hide e = if e.option.value == value
then {e | selected = True }
else if model.multiple then e else {e | selected = False}
avail = List.map hide model.available
sel =
if model.multiple then
List.concat [ model.selected, [ item ] ]
else
[ item ]
hide e =
if e.option.value == value then
{ e | selected = True }
else if model.multiple then
e
else
{ e | selected = False }
avail =
List.map hide model.available
in
{ model | selected = sel, available = avail }
@ -173,6 +225,7 @@ filterOptions: String -> List (Item a) -> List (Item a)
filterOptions str list =
List.map (\e -> { e | visible = Simple.Fuzzy.match str e.option.text, active = False }) list
applyFilter : String -> Model a -> Model a
applyFilter str model =
{ model | filterString = str, available = filterOptions str model.available }
@ -181,48 +234,75 @@ applyFilter str model =
makeNextActive : (Int -> Int) -> Model a -> Model a
makeNextActive nextEl model =
let
opts = getOptions model
current = Util.List.findIndexed .active opts
next = Maybe.map Tuple.second current
opts =
getOptions model
current =
Util.List.findIndexed .active opts
next =
Maybe.map Tuple.second current
|> Maybe.map nextEl
|> Maybe.andThen (Util.List.get opts)
merge item1 item2 = { item2 | active = item1.option.value == item2.option.value }
updateModel item = { model | available = List.map (merge item) model.available, menuOpen = True }
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
Just item ->
updateModel item
Nothing ->
case List.head opts of
Just item -> updateModel item
Nothing -> model
Just item ->
updateModel item
Nothing ->
model
selectActive : Model a -> Model a
selectActive model =
let
current = getOptions model |> Util.List.find .active
current =
getOptions model |> Util.List.find .active
in
case current of
Just item ->
selectItem model item |> applyFilter ""
Nothing ->
model
clearActive : Model a -> Model a
clearActive model =
{ model | available = List.map (\e -> { e | active = False }) model.available }
-- TODO enhance update function to return this info
isDropdownChangeMsg : Msg a -> Bool
isDropdownChangeMsg cm =
case cm of
AddItem _ -> True
RemoveItem _ -> True
AddItem _ ->
True
RemoveItem _ ->
True
KeyPress code ->
Util.Html.intToKeyCode code
|> Maybe.map (\c -> c == Util.Html.Enter)
|> Maybe.withDefault False
_ -> False
_ ->
False
update : Msg a -> Model a -> ( Model a, Cmd (Msg a) )
@ -233,8 +313,11 @@ update msg model =
SetSelection list ->
let
m0 = List.foldl (\item -> \m -> deselectItem m item) model model.selected
m1 = List.map (makeItem model) list
m0 =
List.foldl (\item -> \m -> deselectItem m item) model model.selected
m1 =
List.map (makeItem model) list
|> List.foldl (\item -> \m -> selectItem m item) m0
in
( m1, Cmd.none )
@ -244,19 +327,22 @@ update msg model =
AddItem e ->
let
m = selectItem model e |> applyFilter ""
m =
selectItem model e |> applyFilter ""
in
( { m | menuOpen = False }, Cmd.none )
RemoveItem e ->
let
m = deselectItem model e |> applyFilter ""
m =
deselectItem model e |> applyFilter ""
in
( { m | menuOpen = False }, Cmd.none )
Filter str ->
let
m = applyFilter str model
m =
applyFilter str model
in
( { m | menuOpen = True }, Cmd.none )
@ -267,60 +353,79 @@ update msg model =
case Util.Html.intToKeyCode code of
Just Util.Html.Up ->
( makeNextActive (\n -> n - 1) model, Cmd.none )
Just Util.Html.Down ->
( makeNextActive ((+) 1) model, Cmd.none )
Just Util.Html.Enter ->
let
m = selectActive model
m =
selectActive model
in
( { m | menuOpen = False }, Cmd.none )
_ ->
( model, Cmd.none )
-- View
view : Model a -> Html (Msg a)
view model =
if model.multiple then viewMultiple model else viewSingle model
if model.multiple then
viewMultiple model
else
viewSingle model
viewSingle : Model a -> Html (Msg a)
viewSingle model =
let
renderClosed item =
div [class "message"
div
[ class "message"
, style "display" "inline-block !important"
, onClick ToggleMenu
]
[ i [ class "delete icon", onClick (RemoveItem item) ] []
, text item.option.text
]
renderDefault =
[ List.head model.selected |> Maybe.map renderClosed |> Maybe.withDefault (renderPlaceholder model)
, renderMenu model
]
openSearch =
[ input [ class "search"
[ input
[ class "search"
, placeholder "Search…"
, onInput Filter
, onKeyUp KeyPress
, value model.filterString
][]
]
[]
, renderMenu model
]
in
div [classList [ ("ui search dropdown selection", True)
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
(List.append
[ i [ class "dropdown icon", onClick ToggleMenu ] []
]
<|
if model.menuOpen && isSearchable model then
openSearch
else
renderDefault
)
@ -329,7 +434,9 @@ viewMultiple model =
let
renderSelectMultiple : Item a -> Html (Msg a)
renderSelectMultiple item =
div [classList [ ("ui label", True)
div
[ classList
[ ( "ui label", True )
, ( model.labelColor item.value, True )
]
, style "display" "inline-block !important"
@ -339,7 +446,9 @@ viewMultiple model =
, i [ class "delete icon" ] []
]
in
div [classList [ ("ui search dropdown multiple selection", True)
div
[ classList
[ ( "ui search dropdown multiple selection", True )
, ( "open", model.menuOpen )
]
]
@ -348,32 +457,40 @@ viewMultiple model =
]
, List.map renderSelectMultiple model.selected
, if isSearchable model then
[ input [ class "search"
[ input
[ class "search"
, placeholder "Search…"
, onInput Filter
, onKeyUp KeyPress
, value model.filterString
][]
]
else []
[]
]
else
[]
, [ renderMenu model
]
])
]
)
renderMenu : Model a -> Html (Msg a)
renderMenu model =
div [classList [( "menu", True )
div
[ classList
[ ( "menu", True )
, ( "transition visible", model.menuOpen )
]
] (getOptions model |> List.map renderOption)
]
(getOptions model |> List.map renderOption)
renderPlaceholder : Model a -> Html (Msg a)
renderPlaceholder model =
div [classList [ ("placeholder-message", True)
div
[ classList
[ ( "placeholder-message", True )
, ( "text", model.multiple )
]
, style "display" "inline-block !important"
@ -382,9 +499,12 @@ renderPlaceholder model =
[ text model.placeholder
]
renderOption : Item a -> Html (Msg a)
renderOption item =
div [classList [ ("item", True)
div
[ classList
[ ( "item", True )
, ( "active", item.active || item.selected )
]
, onClick (AddItem item)

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

@ -1,19 +1,24 @@
-- inspired from here: https://ellie-app.com/3T5mNms7SwKa1
module Comp.Dropzone exposing ( view
module Comp.Dropzone exposing
( Model
, Msg(..)
, Settings
, defaultSettings
, update
, setActive
, Model
, init
, Msg(..)
, setActive
, update
, view
)
import File exposing (File)
import File.Select
import Json.Decode as D
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Decode as D
type alias State =
{ hover : Bool
@ -26,23 +31,27 @@ type alias Settings =
, contentTypes : List String
}
defaultSettings : Settings
defaultSettings =
{ classList = \m -> [("ui placeholder segment", True)]
{ classList = \_ -> [ ( "ui placeholder segment", True ) ]
, contentTypes = [ "application/pdf" ]
}
type alias Model =
{ state : State
, settings : Settings
}
init : Settings -> Model
init settings =
{ state = State False True
, settings = settings
}
type Msg
= DragEnter
| DragLeave
@ -50,16 +59,19 @@ type Msg
| PickFiles
| SetActive Bool
setActive : Bool -> Msg
setActive flag =
SetActive flag
update : Msg -> Model -> ( Model, Cmd Msg, List File )
update msg model =
case msg of
SetActive flag ->
let
ns = { hover = model.state.hover, active = flag }
ns =
{ hover = model.state.hover, active = flag }
in
( { model | state = ns }, Cmd.none, [] )
@ -68,26 +80,33 @@ update msg model =
DragEnter ->
let
ns = {hover = True, active = model.state.active}
ns =
{ hover = True, active = model.state.active }
in
( { model | state = ns }, Cmd.none, [] )
DragLeave ->
let
ns = {hover = False, active = model.state.active}
ns =
{ hover = False, active = model.state.active }
in
( { model | state = ns }, Cmd.none, [] )
GotFiles file files ->
let
ns = {hover = False, active = model.state.active}
newFiles = if model.state.active then filterMime model.settings (file :: files)
else []
ns =
{ hover = False, active = model.state.active }
newFiles =
if model.state.active then
filterMime model.settings (file :: files)
else
[]
in
( { model | state = ns }, Cmd.none, newFiles )
view : Model -> Html Msg
view model =
div
@ -109,16 +128,20 @@ view model =
, div [ class "ui horizontal divider" ]
[ text "Or"
]
,a [classList [("ui basic primary button", True)
, a
[ classList
[ ( "ui basic primary button", True )
, ( "disabled", not model.state.active )
]
, onClick PickFiles
, href ""]
, href ""
]
[ i [ class "folder open icon" ] []
, text "Select ..."
]
]
filterMime : Settings -> List File -> List File
filterMime settings files =
let
@ -127,6 +150,7 @@ filterMime settings files =
in
List.filter pred files
dropDecoder : D.Decoder Msg
dropDecoder =
D.at [ "dataTransfer", "files" ] (D.oneOrMore GotFiles File.decoder)

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

@ -1,40 +1,48 @@
module Comp.EquipmentForm exposing ( Model
, emptyModel
module Comp.EquipmentForm exposing
( Model
, Msg(..)
, view
, update
, emptyModel
, getEquipment
, isValid
, getEquipment)
, update
, view
)
import Api.Model.Equipment exposing (Equipment)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
import Data.Flags exposing (Flags)
import Api.Model.Equipment exposing (Equipment)
type alias Model =
{ equipment : Equipment
, name : String
}
emptyModel : Model
emptyModel =
{ equipment = Api.Model.Equipment.empty
, name = ""
}
isValid : Model -> Bool
isValid model =
model.name /= ""
getEquipment : Model -> Equipment
getEquipment model =
Equipment model.equipment.id model.name model.equipment.created
type Msg
= SetName String
| SetEquipment Equipment
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -48,15 +56,19 @@ update flags msg model =
view : Model -> Html Msg
view model =
div [ class "ui form" ]
[div [classList [("field", True)
[ div
[ classList
[ ( "field", True )
, ( "error", not (isValid model) )
]
]
[ label [] [ text "Name*" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetName
, placeholder "Name"
, value model.name
][]
]
[]
]
]

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

@ -1,23 +1,26 @@
module Comp.EquipmentManage exposing ( Model
, emptyModel
module Comp.EquipmentManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Equipment
import Api.Model.EquipmentList exposing (EquipmentList)
import Comp.EquipmentForm
import Comp.EquipmentTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags)
import Comp.EquipmentTable
import Comp.EquipmentForm
import Comp.YesNoDimmer
import Api.Model.Equipment
import Api.Model.EquipmentList exposing (EquipmentList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel : Comp.EquipmentTable.Model
@ -28,7 +31,11 @@ type alias Model =
, deleteConfirm : Comp.YesNoDimmer.Model
}
type ViewMode = Table | Form
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.EquipmentTable.Msg
| FormMsg Comp.EquipmentForm.Msg
@ -52,21 +60,34 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
TableMsg m ->
let
(tm, tc) = Comp.EquipmentTable.update flags m model.tableModel
(m2, c2) = ({model | tableModel = tm
( tm, tc ) =
Comp.EquipmentTable.update flags m model.tableModel
( m2, c2 ) =
( { model
| tableModel = tm
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
(m3, c3) = case tm.selected of
( m3, c3 ) =
case tm.selected of
Just equipment ->
update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) m2
Nothing ->
( m2, Cmd.none )
in
@ -74,7 +95,8 @@ update flags msg model =
FormMsg m ->
let
(m2, c2) = Comp.EquipmentForm.update flags m model.formModel
( m2, c2 ) =
Comp.EquipmentForm.update flags m model.formModel
in
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
@ -83,46 +105,61 @@ update flags msg model =
EquipmentResp (Ok equipments) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.EquipmentTable.SetEquipments equipments.items)) m2
EquipmentResp (Err err) ->
EquipmentResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.EquipmentTable.Deselect) m2
Form ->
( m2, Cmd.none )
InitNewEquipment ->
let
nm = {model | viewMode = Form, formError = Nothing }
equipment = Api.Model.Equipment.empty
nm =
{ model | viewMode = Form, formError = Nothing }
equipment =
Api.Model.Equipment.empty
in
update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) nm
Submit ->
let
equipment = Comp.EquipmentForm.getEquipment model.formModel
valid = Comp.EquipmentForm.isValid model.formModel
in if valid then
equipment =
Comp.EquipmentForm.getEquipment model.formModel
valid =
Comp.EquipmentForm.isValid model.formModel
in
if valid then
( { model | loading = True }, Api.postEquipment flags equipment SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
let
(m2, c2) = update flags (SetViewMode Table) model
(m3, c3) = update flags LoadEquipments m2
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadEquipments m2
in
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
@ -134,16 +171,30 @@ update flags msg model =
YesNoMsg m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
equip = Comp.EquipmentForm.getEquipment model.formModel
cmd = if confirmed then Api.deleteEquip flags equip.id SubmitResp else Cmd.none
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
equip =
Comp.EquipmentForm.getEquipment model.formModel
cmd =
if confirmed then
Api.deleteEquip flags equip.id SubmitResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
else
viewForm model
viewTable : Model -> Html Msg
viewTable model =
@ -153,17 +204,22 @@ viewTable model =
, text "Create new"
]
, Html.map TableMsg (Comp.EquipmentTable.view model.tableModel)
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]
viewForm : Model -> Html Msg
viewForm model =
let
newEquipment = model.formModel.equipment.id == ""
newEquipment =
model.formModel.equipment.id == ""
in
Html.form [ class "ui segment", onSubmit Submit ]
[ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
@ -171,6 +227,7 @@ viewForm model =
h3 [ class "ui dividing header" ]
[ text "Create new equipment"
]
else
h3 [ class "ui dividing header" ]
[ text ("Edit equipment: " ++ model.formModel.equipment.name)
@ -180,7 +237,9 @@ viewForm model =
]
]
, Html.map FormMsg (Comp.EquipmentForm.view model.formModel)
,div [classList [("ui error message", True)
, div
[ classList
[ ( "ui error message", True )
, ( "invisible", Util.Maybe.isEmpty model.formError )
]
]
@ -196,11 +255,15 @@ viewForm model =
, if not newEquipment then
a [ class "ui right floated red button", href "", onClick RequestDelete ]
[ text "Delete" ]
else
span [] []
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]

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

@ -1,31 +1,37 @@
module Comp.EquipmentTable exposing ( Model
, emptyModel
module Comp.EquipmentTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Api.Model.Equipment exposing (Equipment)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Api.Model.Equipment exposing (Equipment)
type alias Model =
{ equips : List Equipment
, selected : Maybe Equipment
}
emptyModel : Model
emptyModel =
{ equips = []
, selected = Nothing
}
type Msg
= SetEquipments (List Equipment)
| Select Equipment
| Deselect
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -51,9 +57,11 @@ view model =
(List.map (renderEquipmentLine model) model.equips)
]
renderEquipmentLine : Model -> Equipment -> Html Msg
renderEquipmentLine model equip =
tr [classList [("active", model.selected == Just equip)]
tr
[ classList [ ( "active", model.selected == Just equip ) ]
, onClick (Select equip)
]
[ td []

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

File diff suppressed because it is too large Load Diff

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

@ -1,36 +1,41 @@
module Comp.ItemList exposing (Model
, emptyModel
module Comp.ItemList exposing
( Model
, Msg(..)
, prevItem
, emptyModel
, nextItem
, prevItem
, update
, view)
, view
)
import Set exposing (Set)
import Api.Model.ItemLight exposing (ItemLight)
import Api.Model.ItemLightGroup exposing (ItemLightGroup)
import Api.Model.ItemLightList exposing (ItemLightList)
import Data.Direction
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Api.Model.ItemLightList exposing (ItemLightList)
import Api.Model.ItemLightGroup exposing (ItemLightGroup)
import Api.Model.ItemLight exposing (ItemLight)
import Data.Flags exposing (Flags)
import Data.Direction
import Set exposing (Set)
import Util.List
import Util.Maybe
import Util.String
import Util.Time
import Util.Maybe
type alias Model =
{ results : ItemLightList
, openGroups : Set String
}
emptyModel : Model
emptyModel =
{ results = Api.Model.ItemLightList.empty
, openGroups = Set.empty
}
type Msg
= SetResults ItemLightList
| ToggleGroupState ItemLightGroup
@ -38,16 +43,19 @@ type Msg
| ExpandAll
| SelectItem ItemLight
nextItem : Model -> String -> Maybe ItemLight
nextItem model id =
List.concatMap .items model.results.groups
|> Util.List.findNext (\i -> i.id == id)
prevItem : Model -> String -> Maybe ItemLight
prevItem model id =
List.concatMap .items model.results.groups
|> Util.List.findPrev (\i -> i.id == id)
openAllGroups : Model -> Set String
openAllGroups model =
List.foldl
@ -55,19 +63,25 @@ openAllGroups model =
model.openGroups
model.results.groups
update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe ItemLight )
update flags msg model =
case msg of
SetResults list ->
let
newModel = { model | results = list, openGroups = Set.empty }
newModel =
{ model | results = list, openGroups = Set.empty }
in
( { newModel | openGroups = openAllGroups newModel }, Cmd.none, Nothing )
ToggleGroupState group ->
let
m2 = if isGroupOpen model group then closeGroup model group
else openGroup model group
m2 =
if isGroupOpen model group then
closeGroup model group
else
openGroup model group
in
( m2, Cmd.none, Nothing )
@ -76,7 +90,8 @@ update flags msg model =
ExpandAll ->
let
open = openAllGroups model
open =
openAllGroups model
in
( { model | openGroups = open }, Cmd.none, Nothing )
@ -89,14 +104,16 @@ view model =
div []
[ div [ class "ui ablue-comp menu" ]
[ div [ class "right floated menu" ]
[a [class "item"
[ a
[ class "item"
, title "Expand all"
, onClick ExpandAll
, href ""
]
[ i [ class "double angle down icon" ] []
]
,a [class "item"
, a
[ class "item"
, title "Collapse all"
, onClick CollapseAll
, href ""
@ -114,30 +131,40 @@ isGroupOpen: Model -> ItemLightGroup -> Bool
isGroupOpen model group =
Set.member group.name model.openGroups
openGroup : Model -> ItemLightGroup -> Model
openGroup model group =
{ model | openGroups = Set.insert group.name model.openGroups }
closeGroup : Model -> ItemLightGroup -> Model
closeGroup model group =
{ model | openGroups = Set.remove group.name model.openGroups }
viewGroup : Model -> ItemLightGroup -> Html Msg
viewGroup model group =
let
groupOpen = isGroupOpen model group
groupOpen =
isGroupOpen model group
children =
[i [classList [("large middle aligned icon", True)
[ i
[ classList
[ ( "large middle aligned icon", True )
, ( "caret right", not groupOpen )
, ( "caret down", groupOpen )
]][]
]
]
[]
, div [ class "content" ]
[ div [ class "right floated content" ]
[ div [ class "ui blue label" ]
[ List.length group.items |> String.fromInt |> text
]
]
,a [class "header"
, a
[ class "header"
, onClick (ToggleGroupState group)
, href ""
]
@ -148,14 +175,16 @@ viewGroup model group =
]
]
]
itemTable =
div [ class "ui basic content segment no-margin" ]
[(renderItemTable model group.items)
[ renderItemTable model group.items
]
in
if isGroupOpen model group then
div [ class "item" ]
(List.append children [ itemTable ])
else
div [ class "item" ]
children
@ -178,25 +207,34 @@ renderItemTable model items =
(List.map (renderItemLine model) items)
]
renderItemLine : Model -> ItemLight -> Html Msg
renderItemLine model item =
let
dirIcon = i [class (Data.Direction.iconFromMaybe item.direction)][]
corr = List.filterMap identity [item.corrOrg, item.corrPerson]
dirIcon =
i [ class (Data.Direction.iconFromMaybe item.direction) ] []
corr =
List.filterMap identity [ item.corrOrg, item.corrPerson ]
|> List.map .name
|> List.intersperse ", "
|> String.concat
conc = List.filterMap identity [item.concPerson, item.concEquip]
conc =
List.filterMap identity [ item.concPerson, item.concEquip ]
|> List.map .name
|> List.intersperse ", "
|> String.concat
in
tr [ onClick (SelectItem item) ]
[ td [ class "collapsing" ]
[div [classList [("ui teal ribbon label", True)
[ div
[ classList
[ ( "ui teal ribbon label", True )
, ( "invisible", item.state /= "created" )
]
][text "New"
]
[ text "New"
]
]
, td [ class "collapsing" ]
@ -205,7 +243,9 @@ renderItemLine model item =
]
, td [ class "collapsing" ]
[ Util.Time.formatDateShort item.date |> text
,span [classList [("invisible", Util.Maybe.isEmpty item.dueDate)
, span
[ classList
[ ( "invisible", Util.Maybe.isEmpty item.dueDate )
]
]
[ text " "
@ -220,14 +260,24 @@ renderItemLine model item =
, td [] [ text conc ]
]
makeSummary : ItemLightGroup -> String
makeSummary group =
let
corrOrgs = List.filterMap .corrOrg group.items
corrPers = List.filterMap .corrPerson group.items
concPers = List.filterMap .concPerson group.items
concEqui = List.filterMap .concEquip group.items
all = List.concat [corrOrgs, corrPers, concPers, concEqui]
corrOrgs =
List.filterMap .corrOrg group.items
corrPers =
List.filterMap .corrPerson group.items
concPers =
List.filterMap .concPerson group.items
concEqui =
List.filterMap .concEquip group.items
all =
List.concat [ corrOrgs, corrPers, concPers, concEqui ]
in
List.map .name all
|> Util.List.distinct

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

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

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

@ -1,23 +1,26 @@
module Comp.OrgManage exposing ( Model
, emptyModel
module Comp.OrgManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Organization
import Api.Model.OrganizationList exposing (OrganizationList)
import Comp.OrgForm
import Comp.OrgTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags)
import Comp.OrgTable
import Comp.OrgForm
import Comp.YesNoDimmer
import Api.Model.Organization
import Api.Model.OrganizationList exposing (OrganizationList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel : Comp.OrgTable.Model
@ -28,7 +31,11 @@ type alias Model =
, deleteConfirm : Comp.YesNoDimmer.Model
}
type ViewMode = Table | Form
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.OrgTable.Msg
| FormMsg Comp.OrgForm.Msg
@ -52,21 +60,34 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
TableMsg m ->
let
(tm, tc) = Comp.OrgTable.update flags m model.tableModel
(m2, c2) = ({model | tableModel = tm
( tm, tc ) =
Comp.OrgTable.update flags m model.tableModel
( m2, c2 ) =
( { model
| tableModel = tm
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
(m3, c3) = case tm.selected of
( m3, c3 ) =
case tm.selected of
Just org ->
update flags (FormMsg (Comp.OrgForm.SetOrg org)) m2
Nothing ->
( m2, Cmd.none )
in
@ -74,7 +95,8 @@ update flags msg model =
FormMsg m ->
let
(m2, c2) = Comp.OrgForm.update flags m model.formModel
( m2, c2 ) =
Comp.OrgForm.update flags m model.formModel
in
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
@ -83,46 +105,61 @@ update flags msg model =
OrgResp (Ok orgs) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.OrgTable.SetOrgs orgs.items)) m2
OrgResp (Err err) ->
OrgResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.OrgTable.Deselect) m2
Form ->
( m2, Cmd.none )
InitNewOrg ->
let
nm = {model | viewMode = Form, formError = Nothing }
org = Api.Model.Organization.empty
nm =
{ model | viewMode = Form, formError = Nothing }
org =
Api.Model.Organization.empty
in
update flags (FormMsg (Comp.OrgForm.SetOrg org)) nm
Submit ->
let
org = Comp.OrgForm.getOrg model.formModel
valid = Comp.OrgForm.isValid model.formModel
in if valid then
org =
Comp.OrgForm.getOrg model.formModel
valid =
Comp.OrgForm.isValid model.formModel
in
if valid then
( { model | loading = True }, Api.postOrg flags org SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
let
(m2, c2) = update flags (SetViewMode Table) model
(m3, c3) = update flags LoadOrgs m2
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadOrgs m2
in
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
@ -134,16 +171,30 @@ update flags msg model =
YesNoMsg m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
org = Comp.OrgForm.getOrg model.formModel
cmd = if confirmed then Api.deleteOrg flags org.id SubmitResp else Cmd.none
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
org =
Comp.OrgForm.getOrg model.formModel
cmd =
if confirmed then
Api.deleteOrg flags org.id SubmitResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
else
viewForm model
viewTable : Model -> Html Msg
viewTable model =
@ -153,17 +204,22 @@ viewTable model =
, text "Create new"
]
, Html.map TableMsg (Comp.OrgTable.view model.tableModel)
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]
viewForm : Model -> Html Msg
viewForm model =
let
newOrg = model.formModel.org.id == ""
newOrg =
model.formModel.org.id == ""
in
Html.form [ class "ui segment", onSubmit Submit ]
[ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
@ -171,6 +227,7 @@ viewForm model =
h3 [ class "ui dividing header" ]
[ text "Create new organization"
]
else
h3 [ class "ui dividing header" ]
[ text ("Edit org: " ++ model.formModel.org.name)
@ -180,7 +237,9 @@ viewForm model =
]
]
, Html.map FormMsg (Comp.OrgForm.view model.formModel)
,div [classList [("ui error message", True)
, div
[ classList
[ ( "ui error message", True )
, ( "invisible", Util.Maybe.isEmpty model.formError )
]
]
@ -196,11 +255,15 @@ viewForm model =
, if not newOrg then
a [ class "ui right floated red button", href "", onClick RequestDelete ]
[ text "Delete" ]
else
span [] []
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]

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

@ -1,35 +1,39 @@
module Comp.OrgTable exposing ( Model
, emptyModel
module Comp.OrgTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Api.Model.Organization exposing (Organization)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Api.Model.Organization exposing (Organization)
import Api.Model.Address exposing (Address)
import Api.Model.Contact exposing (Contact)
import Util.Address
import Util.Contact
type alias Model =
{ equips : List Organization
, selected : Maybe Organization
}
emptyModel : Model
emptyModel =
{ equips = []
, selected = Nothing
}
type Msg
= SetOrgs (List Organization)
| Select Organization
| Deselect
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -57,9 +61,11 @@ view model =
(List.map (renderOrgLine model) model.equips)
]
renderOrgLine : Model -> Organization -> Html Msg
renderOrgLine model org =
tr [classList [("active", model.selected == Just org)]
tr
[ classList [ ( "active", model.selected == Just org ) ]
, onClick (Select org)
]
[ td [ class "collapsing" ]

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

@ -1,19 +1,21 @@
module Comp.PersonForm exposing ( Model
, emptyModel
module Comp.PersonForm exposing
( Model
, Msg(..)
, view
, update
, emptyModel
, getPerson
, 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 Comp.AddressForm
import Comp.ContactField
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onInput)
type alias Model =
{ org : Person
@ -24,6 +26,7 @@ type alias Model =
, concerning : Bool
}
emptyModel : Model
emptyModel =
{ org = Api.Model.Person.empty
@ -34,22 +37,27 @@ emptyModel =
, concerning = False
}
isValid : Model -> Bool
isValid model =
model.name /= ""
getPerson : Model -> Person
getPerson model =
let
o = model.org
o =
model.org
in
{ o | name = model.name
{ o
| name = model.name
, address = Comp.AddressForm.getAddress model.addressModel
, contacts = Comp.ContactField.getContacts model.contactModel
, notes = model.notes
, concerning = model.concerning
}
type Msg
= SetName String
| SetPerson Person
@ -58,25 +66,38 @@ type Msg
| SetNotes String
| SetConcerning Bool
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetPerson t ->
let
(m1, c1) = update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model
(m2, c2) = update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1
( m1, c1 ) =
update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model
( m2, c2 ) =
update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1
in
({m2 | org = t, name = t.name, notes = t.notes, concerning = t.concerning }, Cmd.none)
( { m2
| org = t
, name = t.name
, notes = t.notes
, concerning = t.concerning
}
, Cmd.batch [ c1, c2 ]
)
AddressMsg am ->
let
(m1, c1) = Comp.AddressForm.update am model.addressModel
( m1, c1 ) =
Comp.AddressForm.update am model.addressModel
in
( { model | addressModel = m1 }, Cmd.map AddressMsg c1 )
ContactMsg m ->
let
(m1, c1) = Comp.ContactField.update m model.contactModel
( m1, c1 ) =
Comp.ContactField.update m model.contactModel
in
( { model | contactModel = m1 }, Cmd.map ContactMsg c1 )
@ -84,31 +105,47 @@ update flags msg model =
( { model | name = n }, Cmd.none )
SetNotes str ->
({model | notes = if str == "" then Nothing else Just str}, Cmd.none)
( { model
| notes =
if str == "" then
Nothing
SetConcerning flag ->
else
Just str
}
, Cmd.none
)
SetConcerning _ ->
( { model | concerning = not model.concerning }, Cmd.none )
view : Model -> Html Msg
view model =
div [ class "ui form" ]
[div [classList [("field", True)
[ div
[ classList
[ ( "field", True )
, ( "error", not (isValid model) )
]
]
[ label [] [ text "Name*" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetName
, placeholder "Name"
, value model.name
][]
]
[]
]
, div [ class "inline field" ]
[ div [ class "ui checkbox" ]
[input [type_ "checkbox"
[ input
[ type_ "checkbox"
, checked model.concerning
, onCheck SetConcerning][]
, onCheck SetConcerning
]
[]
, label [] [ text "Use for concerning person suggestion only" ]
]
]

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

@ -1,23 +1,26 @@
module Comp.PersonManage exposing ( Model
, emptyModel
module Comp.PersonManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Person
import Api.Model.PersonList exposing (PersonList)
import Comp.PersonForm
import Comp.PersonTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags)
import Comp.PersonTable
import Comp.PersonForm
import Comp.YesNoDimmer
import Api.Model.Person
import Api.Model.PersonList exposing (PersonList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel : Comp.PersonTable.Model
@ -28,7 +31,11 @@ type alias Model =
, deleteConfirm : Comp.YesNoDimmer.Model
}
type ViewMode = Table | Form
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.PersonTable.Msg
| FormMsg Comp.PersonForm.Msg
@ -52,21 +60,34 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
TableMsg m ->
let
(tm, tc) = Comp.PersonTable.update flags m model.tableModel
(m2, c2) = ({model | tableModel = tm
( tm, tc ) =
Comp.PersonTable.update flags m model.tableModel
( m2, c2 ) =
( { model
| tableModel = tm
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
(m3, c3) = case tm.selected of
( m3, c3 ) =
case tm.selected of
Just org ->
update flags (FormMsg (Comp.PersonForm.SetPerson org)) m2
Nothing ->
( m2, Cmd.none )
in
@ -74,7 +95,8 @@ update flags msg model =
FormMsg m ->
let
(m2, c2) = Comp.PersonForm.update flags m model.formModel
( m2, c2 ) =
Comp.PersonForm.update flags m model.formModel
in
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
@ -83,46 +105,61 @@ update flags msg model =
PersonResp (Ok orgs) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.PersonTable.SetPersons orgs.items)) m2
PersonResp (Err err) ->
PersonResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.PersonTable.Deselect) m2
Form ->
( m2, Cmd.none )
InitNewPerson ->
let
nm = {model | viewMode = Form, formError = Nothing }
org = Api.Model.Person.empty
nm =
{ model | viewMode = Form, formError = Nothing }
org =
Api.Model.Person.empty
in
update flags (FormMsg (Comp.PersonForm.SetPerson org)) nm
Submit ->
let
person = Comp.PersonForm.getPerson model.formModel
valid = Comp.PersonForm.isValid model.formModel
in if valid then
person =
Comp.PersonForm.getPerson model.formModel
valid =
Comp.PersonForm.isValid model.formModel
in
if valid then
( { model | loading = True }, Api.postPerson flags person SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
let
(m2, c2) = update flags (SetViewMode Table) model
(m3, c3) = update flags LoadPersons m2
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadPersons m2
in
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
@ -134,17 +171,30 @@ update flags msg model =
YesNoMsg m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
person = Comp.PersonForm.getPerson model.formModel
cmd = if confirmed then Api.deletePerson flags person.id SubmitResp else Cmd.none
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
person =
Comp.PersonForm.getPerson model.formModel
cmd =
if confirmed then
Api.deletePerson flags person.id SubmitResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
else
viewForm model
viewTable : Model -> Html Msg
viewTable model =
@ -154,17 +204,22 @@ viewTable model =
, text "Create new"
]
, Html.map TableMsg (Comp.PersonTable.view model.tableModel)
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]
viewForm : Model -> Html Msg
viewForm model =
let
newPerson = model.formModel.org.id == ""
newPerson =
model.formModel.org.id == ""
in
Html.form [ class "ui segment", onSubmit Submit ]
[ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
@ -172,6 +227,7 @@ viewForm model =
h3 [ class "ui dividing header" ]
[ text "Create new person"
]
else
h3 [ class "ui dividing header" ]
[ text ("Edit org: " ++ model.formModel.org.name)
@ -181,7 +237,9 @@ viewForm model =
]
]
, Html.map FormMsg (Comp.PersonForm.view model.formModel)
,div [classList [("ui error message", True)
, div
[ classList
[ ( "ui error message", True )
, ( "invisible", Util.Maybe.isEmpty model.formError )
]
]
@ -197,11 +255,15 @@ viewForm model =
, if not newPerson then
a [ class "ui right floated red button", href "", onClick RequestDelete ]
[ text "Delete" ]
else
span [] []
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]

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

@ -1,35 +1,39 @@
module Comp.PersonTable exposing ( Model
, emptyModel
module Comp.PersonTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Api.Model.Person exposing (Person)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Api.Model.Person exposing (Person)
import Api.Model.Address exposing (Address)
import Api.Model.Contact exposing (Contact)
import Util.Address
import Util.Contact
type alias Model =
{ equips : List Person
, selected : Maybe Person
}
emptyModel : Model
emptyModel =
{ equips = []
, selected = Nothing
}
type Msg
= SetPersons (List Person)
| Select Person
| Deselect
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -58,9 +62,11 @@ view model =
(List.map (renderPersonLine model) model.equips)
]
renderPersonLine : Model -> Person -> Html Msg
renderPersonLine model person =
tr [classList [("active", model.selected == Just person)]
tr
[ classList [ ( "active", model.selected == Just person ) ]
, onClick (Select person)
]
[ td [ class "collapsing" ]
@ -69,6 +75,7 @@ renderPersonLine model person =
, td [ class "collapsing" ]
[ if person.concerning then
i [ class "check square outline icon" ] []
else
i [ class "minus square outline icon" ] []
]

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

@ -1,34 +1,38 @@
module Comp.SearchMenu exposing ( Model
, emptyModel
module Comp.SearchMenu exposing
( Model
, Msg(..)
, update
, NextState
, view
, emptyModel
, getItemSearch
, update
, view
)
import Http
import Api
import Api.Model.Equipment exposing (Equipment)
import Api.Model.EquipmentList exposing (EquipmentList)
import Api.Model.IdName exposing (IdName)
import Api.Model.ItemSearch exposing (ItemSearch)
import Api.Model.ReferenceList exposing (ReferenceList)
import Api.Model.Tag exposing (Tag)
import Api.Model.TagList exposing (TagList)
import Comp.DatePicker
import Comp.Dropdown exposing (isDropdownChangeMsg)
import Data.Direction exposing (Direction)
import Data.Flags exposing (Flags)
import DatePicker exposing (DatePicker)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onInput)
import Data.Direction exposing (Direction)
import Data.Flags exposing (Flags)
import Comp.Dropdown exposing (isDropdownChangeMsg)
import Comp.DatePicker
import DatePicker exposing (DatePicker)
import Api
import Api.Model.IdName exposing (IdName)
import Api.Model.ItemSearch exposing (ItemSearch)
import Api.Model.TagList exposing (TagList)
import Api.Model.Tag exposing (Tag)
import Api.Model.Equipment exposing (Equipment)
import Api.Model.ReferenceList exposing (ReferenceList)
import Api.Model.EquipmentList exposing (EquipmentList)
import Http
import Util.Maybe
import Util.Update
-- Data Model
type alias Model =
{ tagInclModel : Comp.Dropdown.Model Tag
, tagExclModel : Comp.Dropdown.Model Tag
@ -54,28 +58,33 @@ emptyModel: Model
emptyModel =
{ tagInclModel = makeTagModel
, tagExclModel = makeTagModel
, directionModel = Comp.Dropdown.makeSingleList
, directionModel =
Comp.Dropdown.makeSingleList
{ makeOption = \entry -> { value = Data.Direction.toString entry, text = Data.Direction.toString entry }
, options = Data.Direction.all
, placeholder = "Choose a direction…"
, selected = Nothing
}
, orgModel = Comp.Dropdown.makeModel
, orgModel =
Comp.Dropdown.makeModel
{ multiple = False
, searchable = \n -> n > 5
, makeOption = \e -> { value = e.id, text = e.name }
, labelColor = \_ -> ""
, placeholder = "Choose an organization"
}
, corrPersonModel = Comp.Dropdown.makeSingle
, corrPersonModel =
Comp.Dropdown.makeSingle
{ makeOption = \e -> { value = e.id, text = e.name }
, placeholder = "Choose a person"
}
, concPersonModel = Comp.Dropdown.makeSingle
, concPersonModel =
Comp.Dropdown.makeSingle
{ makeOption = \e -> { value = e.id, text = e.name }
, placeholder = "Choose a person"
}
, concEquipmentModel = Comp.Dropdown.makeModel
, concEquipmentModel =
Comp.Dropdown.makeModel
{ multiple = False
, searchable = \n -> n > 5
, makeOption = \e -> { value = e.id, text = e.name }
@ -94,6 +103,7 @@ emptyModel =
, nameModel = Nothing
}
type Msg
= Init
| TagIncMsg (Comp.Dropdown.Msg Tag)
@ -121,23 +131,39 @@ makeTagModel =
{ multiple = True
, searchable = \n -> n > 4
, makeOption = \tag -> { value = tag.id, text = tag.name }
, labelColor = \tag -> if Util.Maybe.nonEmpty tag.category then "basic blue" else ""
, labelColor =
\tag ->
if Util.Maybe.nonEmpty tag.category then
"basic blue"
else
""
, placeholder = "Choose a tag…"
}
getDirection : Model -> Maybe Direction
getDirection model =
let
selection = Comp.Dropdown.getSelected model.directionModel
selection =
Comp.Dropdown.getSelected model.directionModel
in
case selection of
[d] -> Just d
_ -> Nothing
[ d ] ->
Just d
_ ->
Nothing
getItemSearch : Model -> ItemSearch
getItemSearch model =
let e = Api.Model.ItemSearch.empty in
{ e | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id
let
e =
Api.Model.ItemSearch.empty
in
{ e
| tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id
, tagsExclude = Comp.Dropdown.getSelected model.tagExclModel |> List.map .id
, corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head
, corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head
@ -152,25 +178,32 @@ getItemSearch model =
, name = model.nameModel
}
-- Update
type alias NextState
= { modelCmd: (Model, Cmd Msg)
type alias NextState =
{ modelCmd : ( Model, Cmd Msg )
, stateChange : Bool
}
noChange : ( Model, Cmd Msg ) -> NextState
noChange p =
NextState p False
update : Flags -> Msg -> Model -> NextState
update flags msg model =
case msg of
Init ->
let
(dp, dpc) = Comp.DatePicker.init
( dp, dpc ) =
Comp.DatePicker.init
in
noChange ({model|untilDateModel = dp, fromDateModel = dp, untilDueDateModel = dp, fromDueDateModel = dp}
noChange
( { model | untilDateModel = dp, fromDateModel = dp, untilDueDateModel = dp, fromDueDateModel = dp }
, Cmd.batch
[ Api.getTags flags GetTagsResp
, Api.getOrgLight flags GetOrgResp
@ -185,7 +218,8 @@ update flags msg model =
GetTagsResp (Ok tags) ->
let
tagList = Comp.Dropdown.SetOptions tags.items
tagList =
Comp.Dropdown.SetOptions tags.items
in
noChange <|
Util.Update.andThen1
@ -194,30 +228,33 @@ update flags msg model =
]
model
GetTagsResp (Err err) ->
GetTagsResp (Err _) ->
noChange ( model, Cmd.none )
GetEquipResp (Ok equips) ->
let
opts = Comp.Dropdown.SetOptions equips.items
opts =
Comp.Dropdown.SetOptions equips.items
in
update flags (ConcEquipmentMsg opts) model
GetEquipResp (Err err) ->
GetEquipResp (Err _) ->
noChange ( model, Cmd.none )
GetOrgResp (Ok orgs) ->
let
opts = Comp.Dropdown.SetOptions orgs.items
opts =
Comp.Dropdown.SetOptions orgs.items
in
update flags (OrgMsg opts) model
GetOrgResp (Err err) ->
GetOrgResp (Err _) ->
noChange ( model, Cmd.none )
GetPersonResp (Ok ps) ->
let
opts = Comp.Dropdown.SetOptions ps.items
opts =
Comp.Dropdown.SetOptions ps.items
in
noChange <|
Util.Update.andThen1
@ -226,63 +263,75 @@ update flags msg model =
]
model
GetPersonResp (Err err) ->
GetPersonResp (Err _) ->
noChange ( model, Cmd.none )
TagIncMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.tagInclModel
( m2, c2 ) =
Comp.Dropdown.update m model.tagInclModel
in
NextState ( { model | tagInclModel = m2 }, Cmd.map TagIncMsg c2 ) (isDropdownChangeMsg m)
TagExcMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.tagExclModel
( m2, c2 ) =
Comp.Dropdown.update m model.tagExclModel
in
NextState ( { model | tagExclModel = m2 }, Cmd.map TagExcMsg c2 ) (isDropdownChangeMsg m)
DirectionMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.directionModel
( m2, c2 ) =
Comp.Dropdown.update m model.directionModel
in
NextState ( { model | directionModel = m2 }, Cmd.map DirectionMsg c2 ) (isDropdownChangeMsg m)
OrgMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.orgModel
( m2, c2 ) =
Comp.Dropdown.update m model.orgModel
in
NextState ( { model | orgModel = m2 }, Cmd.map OrgMsg c2 ) (isDropdownChangeMsg m)
CorrPersonMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.corrPersonModel
( m2, c2 ) =
Comp.Dropdown.update m model.corrPersonModel
in
NextState ( { model | corrPersonModel = m2 }, Cmd.map CorrPersonMsg c2 ) (isDropdownChangeMsg m)
ConcPersonMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.concPersonModel
( m2, c2 ) =
Comp.Dropdown.update m model.concPersonModel
in
NextState ( { model | concPersonModel = m2 }, Cmd.map ConcPersonMsg c2 ) (isDropdownChangeMsg m)
ConcEquipmentMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.concEquipmentModel
( m2, c2 ) =
Comp.Dropdown.update m model.concEquipmentModel
in
NextState ( { model | concEquipmentModel = m2 }, Cmd.map ConcEquipmentMsg c2 ) (isDropdownChangeMsg m)
ToggleInbox ->
let
current = model.inboxCheckbox
current =
model.inboxCheckbox
in
NextState ( { model | inboxCheckbox = not current }, Cmd.none ) True
FromDateMsg m ->
let
(dp, event) = Comp.DatePicker.updateDefault m model.fromDateModel
nextDate = case event of
( dp, event ) =
Comp.DatePicker.updateDefault m model.fromDateModel
nextDate =
case event of
DatePicker.Picked date ->
Just (Comp.DatePicker.startOfDay date)
_ ->
Nothing
in
@ -290,10 +339,14 @@ update flags msg model =
UntilDateMsg m ->
let
(dp, event) = Comp.DatePicker.updateDefault m model.untilDateModel
nextDate = case event of
( dp, event ) =
Comp.DatePicker.updateDefault m model.untilDateModel
nextDate =
case event of
DatePicker.Picked date ->
Just (Comp.DatePicker.endOfDay date)
_ ->
Nothing
in
@ -301,10 +354,14 @@ update flags msg model =
FromDueDateMsg m ->
let
(dp, event) = Comp.DatePicker.updateDefault m model.fromDueDateModel
nextDate = case event of
( dp, event ) =
Comp.DatePicker.updateDefault m model.fromDueDateModel
nextDate =
case event of
DatePicker.Picked date ->
Just (Comp.DatePicker.startOfDay date)
_ ->
Nothing
in
@ -312,10 +369,14 @@ update flags msg model =
UntilDueDateMsg m ->
let
(dp, event) = Comp.DatePicker.updateDefault m model.untilDueDateModel
nextDate = case event of
( dp, event ) =
Comp.DatePicker.updateDefault m model.untilDueDateModel
nextDate =
case event of
DatePicker.Picked date ->
Just (Comp.DatePicker.endOfDay date)
_ ->
Nothing
in
@ -323,13 +384,18 @@ update flags msg model =
SetName str ->
let
next = if str == "" then Nothing else Just str
next =
if str == "" then
Nothing
else
Just str
in
NextState ( { model | nameModel = next }, Cmd.none ) (model.nameModel /= next)
-- View
-- View
view : Model -> Html Msg
@ -337,19 +403,25 @@ view model =
div [ class "ui form" ]
[ div [ class "inline field" ]
[ div [ class "ui checkbox" ]
[input [type_ "checkbox"
[ input
[ type_ "checkbox"
, onCheck (\_ -> ToggleInbox)
, checked model.inboxCheckbox][]
,label [][text "Only New"
, checked model.inboxCheckbox
]
[]
, label []
[ text "Only New"
]
]
]
, div [ class "field" ]
[ label [] [ text "Name" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetName
, model.nameModel |> Maybe.withDefault "" |> value
][]
]
[]
, span [ class "small-info" ]
[ text "May contain wildcard "
, code [] [ text "*" ]
@ -373,9 +445,14 @@ view model =
]
, h3 [ class "ui header" ]
[ case getDirection model of
Just Data.Direction.Incoming -> text "Sender"
Just Data.Direction.Outgoing -> text "Recipient"
Nothing -> text "Correspondent"
Just Data.Direction.Incoming ->
text "Sender"
Just Data.Direction.Outgoing ->
text "Recipient"
Nothing ->
text "Correspondent"
]
, div [ class "field" ]
[ label [] [ text "Organization" ]
@ -401,12 +478,14 @@ view model =
]
, div [ class "fields" ]
[ div [ class "field" ]
[label [][text "From"
[ label []
[ text "From"
]
, Html.map FromDateMsg (Comp.DatePicker.viewTimeDefault model.fromDate model.fromDateModel)
]
, div [ class "field" ]
[label [][text "To"
[ label []
[ text "To"
]
, Html.map UntilDateMsg (Comp.DatePicker.viewTimeDefault model.untilDate model.untilDateModel)
]
@ -416,12 +495,14 @@ view model =
]
, div [ class "fields" ]
[ div [ class "field" ]
[label [][text "Due From"
[ label []
[ text "Due From"
]
, Html.map FromDueDateMsg (Comp.DatePicker.viewTimeDefault model.fromDueDate model.fromDueDateModel)
]
, div [ class "field" ]
[label [][text "Due To"
[ label []
[ text "Due To"
]
, Html.map UntilDueDateMsg (Comp.DatePicker.viewTimeDefault model.untilDueDate model.untilDueDateModel)
]

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

@ -1,24 +1,40 @@
module Comp.Settings exposing (..)
module Comp.Settings exposing
( Model
, Msg
, getSettings
, init
, update
, view
)
import Api.Model.CollectiveSettings exposing (CollectiveSettings)
import Comp.Dropdown
import Data.Flags exposing (Flags)
import Data.Language exposing (Language)
import Html exposing (..)
import Html.Attributes exposing (..)
import Data.Language exposing (Language)
import Data.Flags exposing (Flags)
import Comp.Dropdown
import Api.Model.CollectiveSettings exposing (CollectiveSettings)
type alias Model =
{ langModel : Comp.Dropdown.Model Language
, initSettings : CollectiveSettings
}
init : CollectiveSettings -> Model
init settings =
let
lang = Data.Language.fromString settings.language |> Maybe.withDefault Data.Language.German
lang =
Data.Language.fromString settings.language
|> Maybe.withDefault Data.Language.German
in
{ langModel = Comp.Dropdown.makeSingleList
{ makeOption = \l -> { value = Data.Language.toIso3 l, text = Data.Language.toName l }
{ langModel =
Comp.Dropdown.makeSingleList
{ makeOption =
\l ->
{ value = Data.Language.toIso3 l
, text = Data.Language.toName l
}
, placeholder = ""
, options = Data.Language.all
, selected = Just lang
@ -26,6 +42,7 @@ init settings =
, initSettings = settings
}
getSettings : Model -> CollectiveSettings
getSettings model =
CollectiveSettings
@ -35,6 +52,7 @@ getSettings model =
|> Maybe.withDefault model.initSettings.language
)
type Msg
= LangDropdownMsg (Comp.Dropdown.Msg Language)
@ -44,10 +62,18 @@ update flags msg model =
case msg of
LangDropdownMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.langModel
nextModel = {model|langModel = m2}
nextSettings = if Comp.Dropdown.isDropdownChangeMsg m then Just (getSettings nextModel)
else Nothing
( m2, c2 ) =
Comp.Dropdown.update m model.langModel
nextModel =
{ model | langModel = m2 }
nextSettings =
if Comp.Dropdown.isDropdownChangeMsg m then
Just (getSettings nextModel)
else
Nothing
in
( nextModel, Cmd.map LangDropdownMsg c2, nextSettings )

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

@ -1,20 +1,21 @@
module Comp.SourceForm exposing ( Model
, emptyModel
module Comp.SourceForm exposing
( Model
, Msg(..)
, view
, update
, emptyModel
, getSource
, 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.Attributes exposing (..)
import Html.Events exposing (onInput, onCheck)
import Data.Flags exposing (Flags)
import Data.SourceState exposing (SourceState)
import Data.Priority exposing (Priority)
import Comp.Dropdown
import Api.Model.Source exposing (Source)
import Util.Maybe
import Html.Events exposing (onCheck, onInput)
type alias Model =
{ source : Source
@ -24,12 +25,14 @@ type alias Model =
, enabled : Bool
}
emptyModel : Model
emptyModel =
{ source = Api.Model.Source.empty
, abbrev = ""
, description = Nothing
, priority = Comp.Dropdown.makeSingleList
, priority =
Comp.Dropdown.makeSingleList
{ makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p }
, placeholder = ""
, options = Data.Priority.all
@ -38,19 +41,24 @@ emptyModel =
, enabled = False
}
isValid : Model -> Bool
isValid model =
model.abbrev /= ""
getSource : Model -> Source
getSource model =
let
s = model.source
s =
model.source
in
{s | abbrev = model.abbrev
{ s
| abbrev = model.abbrev
, description = model.description
, enabled = model.enabled
, priority = Comp.Dropdown.getSelected model.priority
, priority =
Comp.Dropdown.getSelected model.priority
|> List.head
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault s.priority
@ -64,61 +72,83 @@ type Msg
| ToggleEnabled
| PrioDropdownMsg (Comp.Dropdown.Msg Priority)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetSource t ->
let
post = model.source
np = {post | id = t.id
post =
model.source
np =
{ post
| id = t.id
, abbrev = t.abbrev
, description = t.description
, priority = t.priority
, enabled = t.enabled
}
in
({model | source = np
( { model
| source = np
, abbrev = t.abbrev
, description = t.description
, priority = Comp.Dropdown.makeSingleList
, priority =
Comp.Dropdown.makeSingleList
{ makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p }
, placeholder = ""
, options = Data.Priority.all
, selected = Data.Priority.fromString t.priority
}
, enabled = t.enabled }, Cmd.none)
, enabled = t.enabled
}
, Cmd.none
)
ToggleEnabled ->
let
_ = Debug.log "got" model.enabled
in
( { model | enabled = not model.enabled }, Cmd.none )
SetAbbrev n ->
( { model | abbrev = n }, Cmd.none )
SetDescr d ->
({model | description = if d /= "" then Just d else Nothing }, Cmd.none)
( { model
| description =
if d /= "" then
Just d
else
Nothing
}
, Cmd.none
)
PrioDropdownMsg m ->
let
(m2, c2) = Comp.Dropdown.update m model.priority
( m2, c2 ) =
Comp.Dropdown.update m model.priority
in
( { model | priority = m2 }, Cmd.map PrioDropdownMsg c2 )
view : Flags -> Model -> Html Msg
view flags model =
div [ class "ui form" ]
[div [classList [("field", True)
[ div
[ classList
[ ( "field", True )
, ( "error", not (isValid model) )
]
]
[ label [] [ text "Abbrev*" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetAbbrev
, placeholder "Abbrev"
, value model.abbrev
][]
]
[]
]
, div [ class "field" ]
[ label [] [ text "Description" ]
@ -126,9 +156,12 @@ view flags model =
]
, div [ class "inline field" ]
[ div [ class "ui checkbox" ]
[input [type_ "checkbox"
[ input
[ type_ "checkbox"
, onCheck (\_ -> ToggleEnabled)
, checked model.enabled][]
, checked model.enabled
]
[]
, label [] [ text "Enabled" ]
]
]
@ -139,29 +172,37 @@ view flags model =
, urlInfoMessage flags model
]
urlInfoMessage : Flags -> Model -> Html Msg
urlInfoMessage flags model =
div [classList [("ui info icon message", True)
div
[ classList
[ ( "ui info icon message", True )
, ( "hidden", not model.enabled || model.source.id == "" )
]]
]
]
[ i [ class "info icon" ] []
, div [ class "content" ]
[ div [ class "header" ]
[ text "Public Uploads"
]
,p [][text "This source defines URLs that can be used by anyone to send files to "
, p []
[ text "This source defines URLs that can be used by anyone to send files to "
, text "you. There is a web page that you can share or tha API url can be used "
, text "with other clients."
]
, dl [ class "ui list" ]
[ dt [] [ text "Public Upload Page" ]
,dd [][let
url = flags.config.baseUrl ++ "/app/index.html#/upload/" ++ model.source.id
, dd []
[ let
url =
flags.config.baseUrl ++ "/app/index.html#/upload/" ++ model.source.id
in
a [ href url, target "_blank" ] [ code [] [ text url ] ]
]
, dt [] [ text "Public API Upload URL" ]
,dd [][code [][text (flags.config.baseUrl ++ "/api/v1/open/upload/item/" ++ model.source.id)]
, dd []
[ code [] [ text (flags.config.baseUrl ++ "/api/v1/open/upload/item/" ++ model.source.id) ]
]
]
]

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

@ -1,23 +1,26 @@
module Comp.SourceManage exposing ( Model
, emptyModel
module Comp.SourceManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Source
import Api.Model.SourceList exposing (SourceList)
import Comp.SourceForm
import Comp.SourceTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags)
import Comp.SourceTable
import Comp.SourceForm
import Comp.YesNoDimmer
import Api.Model.Source
import Api.Model.SourceList exposing (SourceList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel : Comp.SourceTable.Model
@ -28,7 +31,11 @@ type alias Model =
, deleteConfirm : Comp.YesNoDimmer.Model
}
type ViewMode = Table | Form
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.SourceTable.Msg
| FormMsg Comp.SourceForm.Msg
@ -52,21 +60,34 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
TableMsg m ->
let
(tm, tc) = Comp.SourceTable.update flags m model.tableModel
(m2, c2) = ({model | tableModel = tm
( tm, tc ) =
Comp.SourceTable.update flags m model.tableModel
( m2, c2 ) =
( { model
| tableModel = tm
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
(m3, c3) = case tm.selected of
( m3, c3 ) =
case tm.selected of
Just source ->
update flags (FormMsg (Comp.SourceForm.SetSource source)) m2
Nothing ->
( m2, Cmd.none )
in
@ -74,7 +95,8 @@ update flags msg model =
FormMsg m ->
let
(m2, c2) = Comp.SourceForm.update flags m model.formModel
( m2, c2 ) =
Comp.SourceForm.update flags m model.formModel
in
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
@ -83,46 +105,61 @@ update flags msg model =
SourceResp (Ok sources) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.SourceTable.SetSources sources.items)) m2
SourceResp (Err err) ->
SourceResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.SourceTable.Deselect) m2
Form ->
( m2, Cmd.none )
InitNewSource ->
let
nm = {model | viewMode = Form, formError = Nothing }
source = Api.Model.Source.empty
nm =
{ model | viewMode = Form, formError = Nothing }
source =
Api.Model.Source.empty
in
update flags (FormMsg (Comp.SourceForm.SetSource source)) nm
Submit ->
let
source = Comp.SourceForm.getSource model.formModel
valid = Comp.SourceForm.isValid model.formModel
in if valid then
source =
Comp.SourceForm.getSource model.formModel
valid =
Comp.SourceForm.isValid model.formModel
in
if valid then
( { model | loading = True }, Api.postSource flags source SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
let
(m2, c2) = update flags (SetViewMode Table) model
(m3, c3) = update flags LoadSources m2
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadSources m2
in
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
@ -134,16 +171,30 @@ update flags msg model =
YesNoMsg m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
src = Comp.SourceForm.getSource model.formModel
cmd = if confirmed then Api.deleteSource flags src.id SubmitResp else Cmd.none
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
src =
Comp.SourceForm.getSource model.formModel
cmd =
if confirmed then
Api.deleteSource flags src.id SubmitResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
view : Flags -> Model -> Html Msg
view flags model =
if model.viewMode == Table then viewTable model
else div [](viewForm flags model)
if model.viewMode == Table then
viewTable model
else
div [] (viewForm flags model)
viewTable : Model -> Html Msg
viewTable model =
@ -153,22 +204,28 @@ viewTable model =
, text "Create new"
]
, Html.map TableMsg (Comp.SourceTable.view model.tableModel)
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]
viewForm : Flags -> Model -> List (Html Msg)
viewForm flags model =
let
newSource = model.formModel.source.id == ""
newSource =
model.formModel.source.id == ""
in
[ if newSource then
h3 [ class "ui top attached header" ]
[ text "Create new source"
]
else
h3 [ class "ui top attached header" ]
[ text ("Edit: " ++ model.formModel.source.abbrev)
@ -180,7 +237,9 @@ viewForm flags model =
, 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)
, div
[ classList
[ ( "ui error message", True )
, ( "invisible", Util.Maybe.isEmpty model.formError )
]
]
@ -196,11 +255,15 @@ viewForm flags model =
, if not newSource then
a [ class "ui right floated red button", href "", onClick RequestDelete ]
[ text "Delete" ]
else
span [] []
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]

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

@ -1,32 +1,38 @@
module Comp.SourceTable exposing ( Model
, emptyModel
module Comp.SourceTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Api.Model.Source exposing (Source)
import Data.Flags exposing (Flags)
import Data.Priority
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Data.Priority exposing (Priority)
import Api.Model.Source exposing (Source)
type alias Model =
{ sources : List Source
, selected : Maybe Source
}
emptyModel : Model
emptyModel =
{ sources = []
, selected = Nothing
}
type Msg
= SetSources (List Source)
| Select Source
| Deselect
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -56,9 +62,11 @@ view model =
(List.map (renderSourceLine model) model.sources)
]
renderSourceLine : Model -> Source -> Html Msg
renderSourceLine model source =
tr [classList [("active", model.selected == Just source)]
tr
[ classList [ ( "active", model.selected == Just source ) ]
, onClick (Select source)
]
[ td [ class "collapsing" ]
@ -67,6 +75,7 @@ renderSourceLine model source =
, td [ class "collapsing" ]
[ if source.enabled then
i [ class "check square outline icon" ] []
else
i [ class "minus square outline icon" ] []
]

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

@ -1,16 +1,19 @@
module Comp.TagForm exposing ( Model
, emptyModel
module Comp.TagForm exposing
( Model
, Msg(..)
, view
, update
, emptyModel
, getTag
, isValid
, getTag)
, update
, view
)
import Api.Model.Tag exposing (Tag)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
import Data.Flags exposing (Flags)
import Api.Model.Tag exposing (Tag)
type alias Model =
{ tag : Tag
@ -18,6 +21,7 @@ type alias Model =
, category : Maybe String
}
emptyModel : Model
emptyModel =
{ tag = Api.Model.Tag.empty
@ -25,19 +29,23 @@ emptyModel =
, category = Nothing
}
isValid : Model -> Bool
isValid model =
model.name /= ""
getTag : Model -> Tag
getTag model =
Tag model.tag.id model.name model.category 0
type Msg
= SetName String
| SetCategory String
| SetTag Tag
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -54,23 +62,29 @@ update flags msg model =
view : Model -> Html Msg
view model =
div [ class "ui form" ]
[div [classList [("field", True)
[ div
[ classList
[ ( "field", True )
, ( "error", not (isValid model) )
]
]
[ label [] [ text "Name*" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetName
, placeholder "Name"
, value model.name
][]
]
[]
]
, div [ class "field" ]
[ label [] [ text "Category" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetCategory
, placeholder "Category (optional)"
, value (Maybe.withDefault "" model.category)
][]
]
[]
]
]

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

@ -1,23 +1,26 @@
module Comp.TagManage exposing ( Model
, emptyModel
module Comp.TagManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.Tag
import Api.Model.TagList exposing (TagList)
import Comp.TagForm
import Comp.TagTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags)
import Comp.TagTable
import Comp.TagForm
import Comp.YesNoDimmer
import Api.Model.Tag
import Api.Model.TagList exposing (TagList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Http
import Util.Http
import Util.Maybe
type alias Model =
{ tagTableModel : Comp.TagTable.Model
@ -28,7 +31,11 @@ type alias Model =
, deleteConfirm : Comp.YesNoDimmer.Model
}
type ViewMode = Table | Form
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.TagTable.Msg
| FormMsg Comp.TagForm.Msg
@ -52,21 +60,34 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
TableMsg m ->
let
(tm, tc) = Comp.TagTable.update flags m model.tagTableModel
(m2, c2) = ({model | tagTableModel = tm
( tm, tc ) =
Comp.TagTable.update flags m model.tagTableModel
( m2, c2 ) =
( { model
| tagTableModel = tm
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
(m3, c3) = case tm.selected of
( m3, c3 ) =
case tm.selected of
Just tag ->
update flags (FormMsg (Comp.TagForm.SetTag tag)) m2
Nothing ->
( m2, Cmd.none )
in
@ -74,7 +95,8 @@ update flags msg model =
FormMsg m ->
let
(m2, c2) = Comp.TagForm.update flags m model.tagFormModel
( m2, c2 ) =
Comp.TagForm.update flags m model.tagFormModel
in
( { model | tagFormModel = m2 }, Cmd.map FormMsg c2 )
@ -83,46 +105,61 @@ update flags msg model =
TagResp (Ok tags) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2
TagResp (Err err) ->
TagResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.TagTable.Deselect) m2
Form ->
( m2, Cmd.none )
InitNewTag ->
let
nm = {model | viewMode = Form, formError = Nothing }
tag = Api.Model.Tag.empty
nm =
{ model | viewMode = Form, formError = Nothing }
tag =
Api.Model.Tag.empty
in
update flags (FormMsg (Comp.TagForm.SetTag tag)) nm
Submit ->
let
tag = Comp.TagForm.getTag model.tagFormModel
valid = Comp.TagForm.isValid model.tagFormModel
in if valid then
tag =
Comp.TagForm.getTag model.tagFormModel
valid =
Comp.TagForm.isValid model.tagFormModel
in
if valid then
( { model | loading = True }, Api.postTag flags tag SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
let
(m2, c2) = update flags (SetViewMode Table) model
(m3, c3) = update flags LoadTags m2
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadTags m2
in
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
@ -134,16 +171,30 @@ update flags msg model =
YesNoMsg m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
tag = Comp.TagForm.getTag model.tagFormModel
cmd = if confirmed then Api.deleteTag flags tag.id SubmitResp else Cmd.none
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
tag =
Comp.TagForm.getTag model.tagFormModel
cmd =
if confirmed then
Api.deleteTag flags tag.id SubmitResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
else
viewForm model
viewTable : Model -> Html Msg
viewTable model =
@ -153,17 +204,22 @@ viewTable model =
, text "Create new"
]
, Html.map TableMsg (Comp.TagTable.view model.tagTableModel)
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]
viewForm : Model -> Html Msg
viewForm model =
let
newTag = model.tagFormModel.tag.id == ""
newTag =
model.tagFormModel.tag.id == ""
in
Html.form [ class "ui segment", onSubmit Submit ]
[ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
@ -171,6 +227,7 @@ viewForm model =
h3 [ class "ui dividing header" ]
[ text "Create new tag"
]
else
h3 [ class "ui dividing header" ]
[ text ("Edit tag: " ++ model.tagFormModel.tag.name)
@ -180,7 +237,9 @@ viewForm model =
]
]
, Html.map FormMsg (Comp.TagForm.view model.tagFormModel)
,div [classList [("ui error message", True)
, div
[ classList
[ ( "ui error message", True )
, ( "invisible", Util.Maybe.isEmpty model.formError )
]
]
@ -196,11 +255,15 @@ viewForm model =
, if not newTag then
a [ class "ui right floated red button", href "", onClick RequestDelete ]
[ text "Delete" ]
else
span [] []
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]

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

@ -1,31 +1,37 @@
module Comp.TagTable exposing ( Model
, emptyModel
module Comp.TagTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Api.Model.Tag exposing (Tag)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Api.Model.Tag exposing (Tag)
type alias Model =
{ tags : List Tag
, selected : Maybe Tag
}
emptyModel : Model
emptyModel =
{ tags = []
, selected = Nothing
}
type Msg
= SetTags (List Tag)
| Select Tag
| Deselect
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -52,9 +58,11 @@ view model =
(List.map (renderTagLine model) model.tags)
]
renderTagLine : Model -> Tag -> Html Msg
renderTagLine model tag =
tr [classList [("active", model.selected == Just tag)]
tr
[ classList [ ( "active", model.selected == Just tag ) ]
, onClick (Select tag)
]
[ td []

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

@ -1,20 +1,23 @@
module Comp.UserForm exposing ( Model
, emptyModel
module Comp.UserForm exposing
( Model
, Msg(..)
, view
, update
, isValid
, emptyModel
, getUser
, isNewUser
, getUser)
, isValid
, update
, view
)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onCheck)
import Api.Model.User exposing (User)
import Comp.Dropdown
import Data.Flags exposing (Flags)
import Data.UserState exposing (UserState)
import Api.Model.User exposing (User)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
import Util.Maybe
import Comp.Dropdown
type alias Model =
{ user : User
@ -24,41 +27,55 @@ type alias Model =
, password : Maybe String
}
emptyModel : Model
emptyModel =
{ user = Api.Model.User.empty
, login = ""
, email = Nothing
, password = Nothing
, state = Comp.Dropdown.makeSingleList
{ makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s }
, state =
Comp.Dropdown.makeSingleList
{ makeOption =
\s ->
{ value = Data.UserState.toString s
, text = Data.UserState.toString s
}
, placeholder = ""
, options = Data.UserState.all
, selected = List.head Data.UserState.all
}
}
isValid : Model -> Bool
isValid model =
if model.user.login == "" then
model.login /= "" && Util.Maybe.nonEmpty model.password
else
True
isNewUser : Model -> Bool
isNewUser model =
model.user.login == ""
getUser : Model -> User
getUser model =
let
s = model.user
state = Comp.Dropdown.getSelected model.state
s =
model.user
state =
Comp.Dropdown.getSelected model.state
|> List.head
|> Maybe.withDefault Data.UserState.Active
|> Data.UserState.toString
in
{s | login = model.login
{ s
| login = model.login
, email = model.email
, state = state
, password = model.password
@ -72,30 +89,38 @@ type Msg
| StateMsg (Comp.Dropdown.Msg UserState)
| SetPassword String
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetUser t ->
let
state = Comp.Dropdown.makeSingleList
state =
Comp.Dropdown.makeSingleList
{ makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s }
, placeholder = ""
, options = Data.UserState.all
, selected = Data.UserState.fromString t.state
, selected =
Data.UserState.fromString t.state
|> Maybe.map (\u -> List.filter ((==) u) Data.UserState.all)
|> Maybe.andThen List.head
|> Util.Maybe.withDefault (List.head Data.UserState.all)
}
in
({model | user = t
( { model
| user = t
, login = t.login
, email = t.email
, password = t.password
, state = state }, Cmd.none)
, state = state
}
, Cmd.none
)
StateMsg m ->
let
(m1, c1) = Comp.Dropdown.update m model.state
( m1, c1 ) =
Comp.Dropdown.update m model.state
in
( { model | state = m1 }, Cmd.map StateMsg c1 )
@ -103,48 +128,76 @@ update flags msg model =
( { model | login = n }, Cmd.none )
SetEmail e ->
({model | email = if e == "" then Nothing else Just e }, Cmd.none)
( { model
| email =
if e == "" then
Nothing
else
Just e
}
, Cmd.none
)
SetPassword p ->
({model | password = if p == "" then Nothing else Just p}, Cmd.none)
( { model
| password =
if p == "" then
Nothing
else
Just p
}
, Cmd.none
)
view : Model -> Html Msg
view model =
div [ class "ui form" ]
[div [classList [("field", True)
[ div
[ classList
[ ( "field", True )
, ( "error", model.login == "" )
, ( "invisible", model.user.login /= "" )
]
]
[ label [] [ text "Login*" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetLogin
, placeholder "Login"
, value model.login
][]
]
[]
]
, div [ class "field" ]
[ label [] [ text "E-Mail" ]
,input [ onInput SetEmail
, input
[ onInput SetEmail
, model.email |> Maybe.withDefault "" |> value
, placeholder "E-Mail"
][]
]
[]
]
, div [ class "field" ]
[ label [] [ text "State" ]
, Html.map StateMsg (Comp.Dropdown.view model.state)
]
,div [classList [("field", True)
, div
[ classList
[ ( "field", True )
, ( "invisible", model.user.login /= "" )
, ( "error", Util.Maybe.isEmpty model.password )
]
]
[ label [] [ text "Password*" ]
,input [type_ "text"
, input
[ type_ "text"
, onInput SetPassword
, placeholder "Password"
, Maybe.withDefault "" model.password |> value
][]
]
[]
]
]

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

@ -1,23 +1,26 @@
module Comp.UserManage exposing ( Model
, emptyModel
module Comp.UserManage exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Http
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.User
import Api.Model.UserList exposing (UserList)
import Comp.UserForm
import Comp.UserTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit)
import Data.Flags exposing (Flags)
import Comp.UserTable
import Comp.UserForm
import Comp.YesNoDimmer
import Api.Model.User
import Api.Model.UserList exposing (UserList)
import Api.Model.BasicResult exposing (BasicResult)
import Util.Maybe
import Http
import Util.Http
import Util.Maybe
type alias Model =
{ tableModel : Comp.UserTable.Model
@ -28,7 +31,11 @@ type alias Model =
, deleteConfirm : Comp.YesNoDimmer.Model
}
type ViewMode = Table | Form
type ViewMode
= Table
| Form
emptyModel : Model
emptyModel =
@ -40,6 +47,7 @@ emptyModel =
, deleteConfirm = Comp.YesNoDimmer.emptyModel
}
type Msg
= TableMsg Comp.UserTable.Msg
| FormMsg Comp.UserForm.Msg
@ -52,21 +60,34 @@ type Msg
| YesNoMsg Comp.YesNoDimmer.Msg
| RequestDelete
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
TableMsg m ->
let
(tm, tc) = Comp.UserTable.update flags m model.tableModel
(m2, c2) = ({model | tableModel = tm
( tm, tc ) =
Comp.UserTable.update flags m model.tableModel
( m2, c2 ) =
( { model
| tableModel = tm
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
else
model.formError
}
, Cmd.map TableMsg tc
)
(m3, c3) = case tm.selected of
( m3, c3 ) =
case tm.selected of
Just user ->
update flags (FormMsg (Comp.UserForm.SetUser user)) m2
Nothing ->
( m2, Cmd.none )
in
@ -74,7 +95,8 @@ update flags msg model =
FormMsg m ->
let
(m2, c2) = Comp.UserForm.update flags m model.formModel
( m2, c2 ) =
Comp.UserForm.update flags m model.formModel
in
( { model | formModel = m2 }, Cmd.map FormMsg c2 )
@ -83,49 +105,68 @@ update flags msg model =
UserResp (Ok users) ->
let
m2 = {model|viewMode = Table, loading = False}
m2 =
{ model | viewMode = Table, loading = False }
in
update flags (TableMsg (Comp.UserTable.SetUsers users.items)) m2
UserResp (Err err) ->
UserResp (Err _) ->
( { model | loading = False }, Cmd.none )
SetViewMode m ->
let
m2 = {model | viewMode = m }
m2 =
{ model | viewMode = m }
in
case m of
Table ->
update flags (TableMsg Comp.UserTable.Deselect) m2
Form ->
( m2, Cmd.none )
InitNewUser ->
let
nm = {model | viewMode = Form, formError = Nothing }
user = Api.Model.User.empty
nm =
{ model | viewMode = Form, formError = Nothing }
user =
Api.Model.User.empty
in
update flags (FormMsg (Comp.UserForm.SetUser user)) nm
Submit ->
let
user = Comp.UserForm.getUser model.formModel
valid = Comp.UserForm.isValid model.formModel
cmd = if Comp.UserForm.isNewUser model.formModel
then Api.postNewUser flags user SubmitResp
else Api.putUser flags user SubmitResp
in if valid then
user =
Comp.UserForm.getUser model.formModel
valid =
Comp.UserForm.isValid model.formModel
cmd =
if Comp.UserForm.isNewUser model.formModel then
Api.postNewUser flags user SubmitResp
else
Api.putUser flags user SubmitResp
in
if valid then
( { model | loading = True }, cmd )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
let
(m2, c2) = update flags (SetViewMode Table) model
(m3, c3) = update flags LoadUsers m2
( m2, c2 ) =
update flags (SetViewMode Table) model
( m3, c3 ) =
update flags LoadUsers m2
in
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
@ -137,16 +178,30 @@ update flags msg model =
YesNoMsg m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
user = Comp.UserForm.getUser model.formModel
cmd = if confirmed then Api.deleteUser flags user.login SubmitResp else Cmd.none
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
user =
Comp.UserForm.getUser model.formModel
cmd =
if confirmed then
Api.deleteUser flags user.login SubmitResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
view : Model -> Html Msg
view model =
if model.viewMode == Table then viewTable model
else viewForm model
if model.viewMode == Table then
viewTable model
else
viewForm model
viewTable : Model -> Html Msg
viewTable model =
@ -156,17 +211,22 @@ viewTable model =
, text "Create new"
]
, Html.map TableMsg (Comp.UserTable.view model.tableModel)
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]
viewForm : Model -> Html Msg
viewForm model =
let
newUser = Comp.UserForm.isNewUser model.formModel
newUser =
Comp.UserForm.isNewUser model.formModel
in
Html.form [ class "ui segment", onSubmit Submit ]
[ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
@ -174,12 +234,15 @@ viewForm model =
h3 [ class "ui dividing header" ]
[ text "Create new user"
]
else
h3 [ class "ui dividing header" ]
[ text ("Edit user: " ++ model.formModel.user.login)
]
, Html.map FormMsg (Comp.UserForm.view model.formModel)
,div [classList [("ui error message", True)
, div
[ classList
[ ( "ui error message", True )
, ( "invisible", Util.Maybe.isEmpty model.formError )
]
]
@ -195,11 +258,15 @@ viewForm model =
, if not newUser then
a [ class "ui right floated red button", href "", onClick RequestDelete ]
[ text "Delete" ]
else
span [] []
,div [classList [("ui dimmer", True)
, div
[ classList
[ ( "ui dimmer", True )
, ( "active", model.loading )
]]
]
]
[ div [ class "ui loader" ] []
]
]

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

@ -1,32 +1,38 @@
module Comp.UserTable exposing ( Model
, emptyModel
module Comp.UserTable exposing
( Model
, Msg(..)
, emptyModel
, update
, view
, update)
)
import Api.Model.User exposing (User)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Data.Flags exposing (Flags)
import Api.Model.User exposing (User)
import Util.Time exposing (formatDateTime)
type alias Model =
{ users : List User
, selected : Maybe User
}
emptyModel : Model
emptyModel =
{ users = []
, selected = Nothing
}
type Msg
= SetUsers (List User)
| Select User
| Deselect
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
@ -57,9 +63,11 @@ view model =
(List.map (renderUserLine model) model.users)
]
renderUserLine : Model -> User -> Html Msg
renderUserLine model user =
tr [classList [("active", model.selected == Just user)]
tr
[ classList [ ( "active", model.selected == Just user ) ]
, onClick (Select user)
]
[ td [ class "collapsing" ]

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

@ -1,33 +1,38 @@
module Comp.YesNoDimmer exposing ( Model
module Comp.YesNoDimmer exposing
( Model
, Msg(..)
, Settings
, activate
, defaultSettings
, disable
, emptyModel
, update
, view
, view2
, activate
, disable
, Settings
, defaultSettings
)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
type alias Model =
{ active : Bool
}
emptyModel : Model
emptyModel =
{ active = False
}
type Msg
= Activate
| Disable
| ConfirmDelete
type alias Settings =
{ message : String
, headerIcon : String
@ -37,6 +42,7 @@ type alias Settings =
, invertedDimmer : Bool
}
defaultSettings : Settings
defaultSettings =
{ message = "Delete this item permanently?"
@ -49,35 +55,49 @@ defaultSettings =
activate : Msg
activate = Activate
activate =
Activate
disable : Msg
disable = Disable
disable =
Disable
update : Msg -> Model -> ( Model, Bool )
update msg model =
case msg of
Activate ->
( { model | active = True }, False )
Disable ->
( { model | active = False }, False )
ConfirmDelete ->
( { model | active = False }, True )
view : Model -> Html Msg
view model =
view2 True defaultSettings model
view2 : Bool -> Settings -> Model -> Html Msg
view2 active settings model =
div [classList [("ui dimmer", True)
div
[ classList
[ ( "ui dimmer", True )
, ( "inverted", settings.invertedDimmer )
,("active", (active && model.active))
, ( "active", active && model.active )
]
]
[ div [ class "content" ]
[ h3 [ class settings.headerClass ]
[if settings.headerIcon == "" then span[][] else i [class settings.headerIcon][]
[ if settings.headerIcon == "" then
span [] []
else
i [ class settings.headerIcon ] []
, text settings.message
]
]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -2,19 +2,21 @@ module Page.CollectiveSettings.Update exposing (update)
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Page.CollectiveSettings.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Comp.Settings
import Data.Flags exposing (Flags)
import Page.CollectiveSettings.Data exposing (..)
import Util.Http
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTab t ->
let
m = { model | currentTab = Just t }
m =
{ model | currentTab = Just t }
in
case t of
SourceTab ->
@ -31,21 +33,28 @@ update flags msg model =
SourceMsg m ->
let
(m2, c2) = Comp.SourceManage.update flags m model.sourceModel
( m2, c2 ) =
Comp.SourceManage.update flags m model.sourceModel
in
( { model | sourceModel = m2 }, Cmd.map SourceMsg c2 )
UserMsg m ->
let
(m2, c2) = Comp.UserManage.update flags m model.userModel
( m2, c2 ) =
Comp.UserManage.update flags m model.userModel
in
( { model | userModel = m2 }, Cmd.map UserMsg c2 )
SettingsMsg m ->
let
(m2, c2, msett) = Comp.Settings.update flags m model.settingsModel
cmd = case msett of
Nothing -> Cmd.none
( m2, c2, msett ) =
Comp.Settings.update flags m model.settingsModel
cmd =
case msett of
Nothing ->
Cmd.none
Just sett ->
Api.setCollectiveSettings flags sett SubmitResp
in
@ -62,13 +71,13 @@ update flags msg model =
GetInsightsResp (Ok data) ->
( { model | insights = data }, Cmd.none )
GetInsightsResp (Err err) ->
GetInsightsResp (Err _) ->
( model, Cmd.none )
CollectiveSettingsResp (Ok data) ->
( { model | settingsModel = Comp.Settings.init data }, Cmd.none )
CollectiveSettingsResp (Err err) ->
CollectiveSettingsResp (Err _) ->
( model, Cmd.none )
SubmitResp (Ok res) ->
@ -76,6 +85,7 @@ update flags msg model =
SubmitResp (Err err) ->
let
res = BasicResult False (Util.Http.errorToString err)
res =
BasicResult False (Util.Http.errorToString err)
in
( { model | submitResult = Just res }, Cmd.none )

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

@ -1,17 +1,18 @@
module Page.CollectiveSettings.View exposing (view)
import Api.Model.NameCount exposing (NameCount)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Api.Model.NameCount exposing (NameCount)
import Util.Html exposing (classActive)
import Data.Flags exposing (Flags)
import Page.CollectiveSettings.Data exposing (..)
import Comp.SourceManage
import Comp.UserManage
import Comp.Settings
import Util.Size
import Util.Html exposing (classActive)
import Util.Maybe
import Util.Size
view : Flags -> Model -> Html Msg
view flags model =
@ -22,25 +23,29 @@ view flags model =
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[div [classActive (model.currentTab == Just InsightsTab) "link icon item"
[ div
[ classActive (model.currentTab == Just InsightsTab) "link icon item"
, onClick (SetTab InsightsTab)
]
[ i [ class "chart bar outline icon" ] []
, text "Insights"
]
,div [classActive (model.currentTab == Just SourceTab) "link icon item"
, 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"
, div
[ classActive (model.currentTab == Just SettingsTab) "link icon item"
, onClick (SetTab SettingsTab)
]
[ i [ class "language icon" ] []
, text "Document Language"
]
,div [classActive (model.currentTab == Just UserTab) "link icon item"
, div
[ classActive (model.currentTab == Just UserTab) "link icon item"
, onClick (SetTab UserTab)
]
[ i [ class "user icon" ] []
@ -52,15 +57,25 @@ view flags model =
, 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 -> []
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 =
[ h1 [ class "ui header" ]
@ -124,6 +139,7 @@ viewInsights model =
]
]
makeTagStats : NameCount -> Html Msg
makeTagStats nc =
div [ class "ui statistic" ]
@ -159,6 +175,7 @@ viewUsers model =
, Html.map UserMsg (Comp.UserManage.view model.userModel)
]
viewSettings : Model -> List (Html Msg)
viewSettings model =
[ div [ class "ui grid" ]
@ -182,11 +199,14 @@ viewSettings model =
, div [ class "row" ]
[ div [ class "six wide column" ]
[ Html.map SettingsMsg (Comp.Settings.view model.settingsModel)
,div [classList [("ui message", True)
, 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

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

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

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

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

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

@ -1,16 +1,14 @@
module Page.Home.View exposing (view)
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page exposing (Page(..))
import Page.Home.Data exposing (..)
import Comp.SearchMenu
import Comp.ItemList
import Comp.ItemDetail
import Data.Flags
import Util.Html exposing (onClickk)
view : Model -> Html Msg
view model =
@ -21,7 +19,8 @@ view model =
[ text "Search"
]
, div [ class "right floated menu" ]
[a [class "item"
[ a
[ class "item"
, onClick DoSearch
, href ""
]
@ -30,19 +29,24 @@ view model =
]
]
, div [ class "ui attached fluid segment" ]
[(Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel))
[ Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel)
]
]
, div [ class "twelve wide column" ]
[ case model.viewMode of
Listing ->
if model.searchInProgress then resultPlaceholder
else (Html.map ItemListMsg (Comp.ItemList.view model.itemListModel))
if model.searchInProgress then
resultPlaceholder
else
Html.map ItemListMsg (Comp.ItemList.view model.itemListModel)
Detail ->
Html.map ItemDetailMsg (Comp.ItemDetail.view model.itemDetailModel)
]
]
resultPlaceholder : Html Msg
resultPlaceholder =
div [ class "ui basic segment" ]

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

@ -1,8 +1,13 @@
module Page.Login.Data exposing (..)
module Page.Login.Data exposing
( Model
, Msg(..)
, emptyModel
)
import Api.Model.AuthResult exposing (AuthResult)
import Http
import Page exposing (Page(..))
import Api.Model.AuthResult exposing (AuthResult)
type alias Model =
{ username : String
@ -10,6 +15,7 @@ type alias Model =
, result : Maybe AuthResult
}
emptyModel : Model
emptyModel =
{ username = ""
@ -17,6 +23,7 @@ emptyModel =
, result = Nothing
}
type Msg
= SetUsername String
| SetPassword String

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

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

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

@ -1,11 +1,12 @@
module Page.Login.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
import Html.Events exposing (onInput, onSubmit)
import Page exposing (Page(..))
import Page.Login.Data exposing (..)
import Data.Flags exposing (Flags)
view : Flags -> Model -> Html Msg
view flags model =
@ -14,49 +15,57 @@ view flags model =
[ div [ class "row" ]
[ div [ class "six wide column ui segment login-view" ]
[ h1 [ class "ui center aligned icon header" ]
[img [class "ui image"
[ img
[ 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"
, Html.form
[ class "ui large error raised form segment"
, onSubmit Authenticate
, autocomplete False
]
[ div [ class "field" ]
[ label [] [ text "Username" ]
, div [ class "ui left icon input" ]
[input [type_ "text"
[ input
[ type_ "text"
, autocomplete False
, onInput SetUsername
, value model.username
, placeholder "Collective / Login"
, autofocus True
][]
]
[]
, i [ class "user icon" ] []
]
]
, div [ class "field" ]
[ label [] [ text "Password" ]
, div [ class "ui left icon input" ]
[input [type_ "password"
[ input
[ type_ "password"
, autocomplete False
, onInput SetPassword
, value model.password
, placeholder "Password"
][]
]
[]
, i [ class "lock icon" ] []
]
]
,button [class "ui primary fluid button"
, button
[ class "ui primary fluid button"
, type_ "submit"
]
[ text "Login"
]
]
,(resultMessage model)
, resultMessage model
, div [ class "ui very basic right aligned segment" ]
[ text "No account? "
, a [ class "ui icon link", Page.href RegisterPage ]
@ -69,15 +78,16 @@ view flags model =
]
]
resultMessage : Model -> Html Msg
resultMessage model =
case model.result of
Just r ->
if r.success
then
if r.success then
div [ class "ui success message" ]
[ text "Login successful."
]
else
div [ class "ui error message" ]
[ text r.message

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

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

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

@ -1,18 +1,20 @@
module Page.ManageData.Update exposing (update)
import Page.ManageData.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.TagManage
import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
import Data.Flags exposing (Flags)
import Page.ManageData.Data exposing (..)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTab t ->
let
m = { model | currentTab = Just t }
m =
{ model | currentTab = Just t }
in
case t of
TagTab ->
@ -29,24 +31,28 @@ update flags msg model =
TagManageMsg m ->
let
(m2, c2) = Comp.TagManage.update flags m model.tagManageModel
( m2, c2 ) =
Comp.TagManage.update flags m model.tagManageModel
in
( { model | tagManageModel = m2 }, Cmd.map TagManageMsg c2 )
EquipManageMsg m ->
let
(m2, c2) = Comp.EquipmentManage.update flags m model.equipManageModel
( m2, c2 ) =
Comp.EquipmentManage.update flags m model.equipManageModel
in
( { model | equipManageModel = m2 }, Cmd.map EquipManageMsg c2 )
OrgManageMsg m ->
let
(m2, c2) = Comp.OrgManage.update flags m model.orgManageModel
( m2, c2 ) =
Comp.OrgManage.update flags m model.orgManageModel
in
( { model | orgManageModel = m2 }, Cmd.map OrgManageMsg c2 )
PersonManageMsg m ->
let
(m2, c2) = Comp.PersonManage.update flags m model.personManageModel
( m2, c2 ) =
Comp.PersonManage.update flags m model.personManageModel
in
( { model | personManageModel = m2 }, Cmd.map PersonManageMsg c2 )

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

@ -1,15 +1,15 @@
module Page.ManageData.View exposing (view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Util.Html exposing (classActive)
import Page.ManageData.Data exposing (..)
import Comp.TagManage
import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.ManageData.Data exposing (..)
import Util.Html exposing (classActive)
view : Model -> Html Msg
view model =
@ -20,25 +20,29 @@ view model =
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[div [classActive (model.currentTab == Just TagTab) "link icon item"
[ div
[ classActive (model.currentTab == Just TagTab) "link icon item"
, onClick (SetTab TagTab)
]
[ i [ class "tag icon" ] []
, text "Tag"
]
,div [classActive (model.currentTab == Just EquipTab) "link icon item"
, div
[ classActive (model.currentTab == Just EquipTab) "link icon item"
, onClick (SetTab EquipTab)
]
[ i [ class "box icon" ] []
, text "Equipment"
]
,div [classActive (model.currentTab == Just OrgTab) "link icon item"
, div
[ classActive (model.currentTab == Just OrgTab) "link icon item"
, onClick (SetTab OrgTab)
]
[ i [ class "factory icon" ] []
, text "Organization"
]
,div [classActive (model.currentTab == Just PersonTab) "link icon item"
, div
[ classActive (model.currentTab == Just PersonTab) "link icon item"
, onClick (SetTab PersonTab)
]
[ i [ class "user icon" ] []
@ -50,15 +54,25 @@ view model =
, div [ class "twelve wide column" ]
[ div [ class "" ]
(case model.currentTab of
Just TagTab -> viewTags model
Just EquipTab -> viewEquip model
Just OrgTab -> viewOrg model
Just PersonTab -> viewPerson model
Nothing -> []
Just TagTab ->
viewTags model
Just EquipTab ->
viewEquip model
Just OrgTab ->
viewOrg model
Just PersonTab ->
viewPerson model
Nothing ->
[]
)
]
]
viewTags : Model -> List (Html Msg)
viewTags model =
[ h2 [ class "ui header" ]
@ -70,6 +84,7 @@ viewTags model =
, Html.map TagManageMsg (Comp.TagManage.view model.tagManageModel)
]
viewEquip : Model -> List (Html Msg)
viewEquip model =
[ h2 [ class "ui header" ]
@ -81,6 +96,7 @@ viewEquip model =
, Html.map EquipManageMsg (Comp.EquipmentManage.view model.equipManageModel)
]
viewOrg : Model -> List (Html Msg)
viewOrg model =
[ h2 [ class "ui header" ]
@ -92,6 +108,7 @@ viewOrg model =
, Html.map OrgManageMsg (Comp.OrgManage.view model.orgManageModel)
]
viewPerson : Model -> List (Html Msg)
viewPerson model =
[ h2 [ class "ui header" ]

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

@ -1,13 +1,22 @@
module Page.NewInvite.Data exposing (..)
module Page.NewInvite.Data exposing
( Model
, Msg(..)
, State(..)
, emptyModel
, isFailed
, isSuccess
)
import Http
import Api.Model.InviteResult exposing (InviteResult)
import Http
type alias Model =
{ password : String
, result : State
}
type State
= Empty
| Failed String
@ -17,14 +26,22 @@ type State
isFailed : State -> Bool
isFailed state =
case state of
Failed _ -> True
_ -> False
Failed _ ->
True
_ ->
False
isSuccess : State -> Bool
isSuccess state =
case state of
Success _ -> True
_ -> False
Success _ ->
True
_ ->
False
emptyModel : Model
emptyModel =
@ -32,6 +49,7 @@ emptyModel =
, result = Empty
}
type Msg
= SetPassword String
| GenerateInvite

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

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

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

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

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

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

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

@ -1,22 +1,26 @@
module Page.Queue.Update exposing (update)
import Api
import Ports
import Page.Queue.Data exposing (..)
import Data.Flags exposing (Flags)
import Util.Http
import Time
import Task
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Page.Queue.Data exposing (..)
import Ports
import Task
import Time
import Util.Http
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
Init ->
let
start = if model.init
then Cmd.none
else Cmd.batch
start =
if model.init then
Cmd.none
else
Cmd.batch
[ Api.getJobQueueState flags StateResp
, getNewTime
]
@ -27,10 +31,13 @@ update flags msg model =
let
progressCmd =
List.map (\job -> Ports.setProgress ( job.id, job.progress )) s.progress
_ = Debug.log "stopRefresh" model.stopRefresh
refresh =
if model.pollingInterval <= 0 || model.stopRefresh then Cmd.none
else Cmd.batch
if model.pollingInterval <= 0 || model.stopRefresh then
Cmd.none
else
Cmd.batch
[ Api.getJobQueueStateIn flags model.pollingInterval StateResp
, getNewTime
]
@ -54,20 +61,29 @@ update flags msg model =
RequestCancelJob job ->
let
newModel = {model|cancelJobRequest = Just job.id}
newModel =
{ model | cancelJobRequest = Just job.id }
in
update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel
DimmerMsg job m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.cancelJob flags job.id CancelResp else Cmd.none
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
cmd =
if confirmed then
Api.cancelJob flags job.id CancelResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
CancelResp (Ok r) ->
CancelResp (Ok _) ->
( model, Cmd.none )
CancelResp (Err err) ->
CancelResp (Err _) ->
( model, Cmd.none )

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

@ -1,17 +1,15 @@
module Page.Queue.View exposing (view)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobLogEvent exposing (JobLogEvent)
import Comp.YesNoDimmer
import Data.Priority
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.Queue.Data exposing (..)
import Api.Model.JobQueueState exposing (JobQueueState)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobLogEvent exposing (JobLogEvent)
import Data.Priority
import Comp.YesNoDimmer
import Util.Time exposing (formatDateTime, formatIsoDateTime)
import Util.Duration
view : Model -> Html Msg
view model =
@ -20,6 +18,7 @@ view model =
[ case model.showLog of
Just job ->
[ renderJobLog job ]
Nothing ->
List.map (renderProgressCard model) model.state.progress
|> List.map (\el -> div [ class "row" ] [ div [ class "column" ] [ el ] ])
@ -30,6 +29,7 @@ view model =
]
]
renderJobLog : JobDetail -> Html Msg
renderJobLog job =
div [ class "ui fluid card" ]
@ -54,6 +54,7 @@ renderWaiting model =
(List.map (renderInfoCard model) model.state.queued)
]
renderCompleted : Model -> Html Msg
renderCompleted model =
div [ class "column" ]
@ -64,6 +65,7 @@ renderCompleted model =
(List.map (renderInfoCard model) model.state.completed)
]
renderProgressCard : Model -> JobDetail -> Html Msg
renderProgressCard model job =
div [ class "ui fluid card" ]
@ -103,6 +105,7 @@ renderProgressCard model job =
]
]
renderLogLine : JobLogEvent -> Html Msg
renderLogLine log =
span [ class (String.toLower log.level) ]
@ -112,24 +115,37 @@ renderLogLine log =
, br [] []
]
isFinal : JobDetail -> Bool
isFinal job =
case job.state of
"failed" -> True
"success" -> True
"cancelled" -> True
_ -> False
"failed" ->
True
"success" ->
True
"cancelled" ->
True
_ ->
False
dimmerSettings : Comp.YesNoDimmer.Settings
dimmerSettings =
let
defaults = Comp.YesNoDimmer.defaultSettings
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)
div
[ classList
[ ( "ui fluid card", True )
, ( jobStateColor job, True )
]
]
@ -140,25 +156,30 @@ renderInfoCard model job =
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")
, 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" ]
@ -170,12 +191,14 @@ renderInfoCard model job =
[ 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
[ code []
[ Data.Priority.fromString job.priority
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault job.priority
|> text
@ -196,21 +219,37 @@ renderInfoCard model job =
]
]
jobStateColor : JobDetail -> String
jobStateColor job =
case job.state of
"success" -> "green"
"failed" -> "red"
"canceled" -> "orange"
"stuck" -> "purple"
"scheduled" -> "blue"
"waiting" -> "grey"
_ -> ""
"success" ->
"green"
"failed" ->
"red"
"canceled" ->
"orange"
"stuck" ->
"purple"
"scheduled" ->
"blue"
"waiting" ->
"grey"
_ ->
""
jobStateLabel : JobDetail -> Html Msg
jobStateLabel job =
let
col = jobStateColor job
col =
jobStateColor job
in
div [ class ("ui label " ++ col) ]
[ text job.state

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

@ -1,7 +1,12 @@
module Page.Register.Data exposing (..)
module Page.Register.Data exposing
( Model
, Msg(..)
, emptyModel
)
import Http
import Api.Model.BasicResult exposing (BasicResult)
import Http
type alias Model =
{ result : Maybe BasicResult
@ -17,6 +22,7 @@ type alias Model =
, invite : Maybe String
}
emptyModel : Model
emptyModel =
{ result = Nothing
@ -32,6 +38,7 @@ emptyModel =
, invite = Nothing
}
type Msg
= SetCollId String
| SetLogin String

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

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

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

@ -1,11 +1,12 @@
module Page.Register.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
import Data.Flags exposing (Flags)
import Page.Register.Data exposing (..)
import Page exposing (Page(..))
import Page.Register.Data exposing (..)
view : Flags -> Model -> Html Msg
view flags model =
@ -14,89 +15,119 @@ view flags model =
[ div [ class "row" ]
[ div [ class "six wide column ui segment register-view" ]
[ h1 [ class "ui cener aligned icon header" ]
[img [class "ui image"
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")][]
[ img
[ class "ui image"
, src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
]
[]
, div [ class "content" ]
[ text "Sign up @ Docspell"
]
]
,Html.form [ class "ui large error form raised segment"
, 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"
[ 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"
[ input
[ type_ "text"
, autocomplete False
, onInput SetLogin
, value model.login
][]
]
[]
, i [ class "user icon" ] []
]
]
,div [class "required field"
, div
[ class "required field"
]
[ label [] [ text "Password" ]
, div [ class "ui left icon action input" ]
[input [type_ <| if model.showPass1 then "text" else "password"
[ 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"
, div
[ class "required field"
]
[ label [] [ text "Password (repeat)" ]
, div [ class "ui left icon action input" ]
[input [type_ <| if model.showPass2 then "text" else "password"
[ 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)
, div
[ classList
[ ( "field", True )
, ( "invisible", flags.config.signupMode /= "invite" )
]]
]
]
[ label [] [ text "Invitation Key" ]
, div [ class "ui left icon input" ]
[input [type_ "text"
[ input
[ type_ "text"
, autocomplete False
, onInput SetInvite
, model.invite |> Maybe.withDefault "" |> value
][]
]
[]
, i [ class "key icon" ] []
]
]
,button [class "ui primary button"
, button
[ class "ui primary button"
, type_ "submit"
]
[ text "Submit"
]
]
,(resultMessage model)
, resultMessage model
, div [ class "ui very basic right aligned segment" ]
[ text "Already signed up? "
, a [ class "ui link", Page.href (LoginPage Nothing) ]
@ -109,15 +140,16 @@ view flags model =
]
]
resultMessage : Model -> Html Msg
resultMessage model =
case model.result of
Just r ->
if r.success
then
if r.success then
div [ class "ui success message" ]
[ text "Registration successful."
]
else
div [ class "ui error message" ]
[ text r.message
@ -126,6 +158,7 @@ resultMessage model =
Nothing ->
if List.isEmpty model.errorMsg then
span [ class "invisible" ] []
else
div [ class "ui error message" ]
(List.map (\s -> div [] [ text s ]) model.errorMsg)

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

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

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

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

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

@ -1,17 +1,18 @@
module Page.Upload.View exposing (view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onCheck)
import Comp.Dropzone
import File exposing (File)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick)
import Page exposing (Page(..))
import Page.Upload.Data exposing (..)
import Util.File exposing (makeFileId)
import Util.Maybe
import Util.Size
view: (Maybe String) -> Model -> Html Msg
view : Maybe String -> Model -> Html Msg
view mid model =
div [ class "upload-page ui grid container" ]
[ div [ class "row" ]
@ -30,11 +31,19 @@ view mid model =
]
]
]
,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
, 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
]
@ -52,6 +61,7 @@ renderErrorMsg model =
]
]
renderSuccessMsg : Bool -> Model -> Html Msg
renderSuccessMsg public model =
div [ class "row" ]
@ -61,7 +71,11 @@ renderSuccessMsg public model =
[ i [ class "smile outline icon" ] []
, text "All files uploaded"
]
,if public then p [][] else p []
, 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"
@ -94,9 +108,10 @@ renderUploads model =
]
, div [ class "ui items" ] <|
if model.singleItem then
(List.map (renderFileItem model (Just uploadAllTracker)) model.files)
List.map (renderFileItem model (Just uploadAllTracker)) model.files
else
(List.map (renderFileItem model Nothing) model.files)
List.map (renderFileItem model Nothing) model.files
]
]
]
@ -105,18 +120,25 @@ renderUploads model =
renderFileItem : Model -> Maybe String -> File -> Html Msg
renderFileItem model mtracker file =
let
name = File.name file
size = File.size file
name =
File.name file
size =
File.size file
|> toFloat
|> Util.Size.bytesReadable Util.Size.B
in
div [ class "item" ]
[i [classList [("large", True)
[ 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
@ -125,7 +147,9 @@ renderFileItem model mtracker file =
[ text size
]
, div [ class "description" ]
[div [classList [("ui small indicating progress", True)
[ div
[ classList
[ ( "ui small indicating progress", True )
, ( uploadAllTracker, Util.Maybe.nonEmpty mtracker )
]
, id (makeFileId file)

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

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

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

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

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

@ -1,12 +1,12 @@
module Page.UserSettings.View exposing (view)
import Comp.ChangePasswordForm
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.UserSettings.Data exposing (..)
import Util.Html exposing (classActive)
import Page.UserSettings.Data exposing (..)
import Comp.ChangePasswordForm
view : Model -> Html Msg
view model =
@ -17,7 +17,8 @@ view model =
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[div [classActive (model.currentTab == Just ChangePassTab) "link icon item"
[ div
[ classActive (model.currentTab == Just ChangePassTab) "link icon item"
, onClick (SetTab ChangePassTab)
]
[ i [ class "user secret icon" ] []
@ -29,12 +30,16 @@ view model =
, div [ class "twelve wide column" ]
[ div [ class "" ]
(case model.currentTab of
Just ChangePassTab -> viewChangePassword model
Nothing -> []
Just ChangePassTab ->
viewChangePassword model
Nothing ->
[]
)
]
]
viewChangePassword : Model -> List (Html Msg)
viewChangePassword model =
[ h2 [ class "ui header" ]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

33
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 ma =
Maybe.map (\_ -> True) ma
|> Maybe.withDefault False
not (isEmpty ma)
isEmpty : Maybe a -> Bool
isEmpty ma =
not (nonEmpty ma)
ma == Nothing
withDefault : Maybe a -> Maybe a -> Maybe a
withDefault ma1 ma2 =
if isEmpty ma2 then ma1 else ma2
if isEmpty ma2 then
ma1
else
ma2
or : List (Maybe a) -> Maybe a
or listma =
case listma of
[] -> Nothing
[] ->
Nothing
el :: els ->
case el of
Just _ -> el
Nothing -> or els
Just _ ->
el
Nothing ->
or els

58
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
type SizeUnit = G|M|K|B
prettyNumber : Float -> String
prettyNumber n =
let
parts = String.split "." (String.fromFloat n)
parts =
String.split "." (String.fromFloat n)
in
case parts of
n0 :: d :: [] -> n0 ++ "." ++ (String.left 2 d)
_ -> String.join "." parts
n0 :: d :: [] ->
n0 ++ "." ++ String.left 2 d
_ ->
String.join "." parts
bytesReadable : SizeUnit -> Float -> String
bytesReadable unit n =
let
k = n / 1024
num = prettyNumber n
k =
n / 1024
num =
prettyNumber n
in
case unit of
G -> num ++ "G"
M -> if k > 1 then (bytesReadable G k) else num ++ "M"
K -> if k > 1 then (bytesReadable M k) else num ++ "K"
B -> if k > 1 then (bytesReadable K k) else num ++ "B"
G ->
num ++ "G"
M ->
if k > 1 then
bytesReadable G k
else
num ++ "M"
K ->
if k > 1 then
bytesReadable M k
else
num ++ "K"
B ->
if k > 1 then
bytesReadable K k
else
num ++ "B"

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

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

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

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

11
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 fs a =
let
init = (a, [])
init =
( a, [] )
update el tuple =
let
(a2, c2) = el (Tuple.first tuple)
( a2, c2 ) =
el (Tuple.first tuple)
in
(a2, c2 :: (Tuple.second tuple))
( a2, c2 :: Tuple.second tuple )
in
List.foldl update init fs
|> Tuple.mapSecond Cmd.batch

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

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