diff --git a/elm.json b/elm.json index 2fc179fd..3d52f6ca 100644 --- a/elm.json +++ b/elm.json @@ -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": { diff --git a/modules/webapp/src/main/elm/Api.elm b/modules/webapp/src/main/elm/Api.elm index caa3e60e..73cac0e0 100644 --- a/modules/webapp/src/main/elm/Api.elm +++ b/modules/webapp/src/main/elm/Api.elm @@ -1,12 +1,60 @@ -module Api exposing (..) +module Api exposing + ( cancelJob + , changePassword + , deleteEquip + , deleteItem + , deleteOrg + , deletePerson + , deleteSource + , deleteTag + , deleteUser + , getCollective + , getCollectiveSettings + , getEquipments + , getInsights + , getItemProposals + , getJobQueueState + , getJobQueueStateIn + , getOrgLight + , getOrganizations + , getPersons + , getPersonsLight + , getSources + , getTags + , getUsers + , itemDetail + , itemSearch + , login + , loginSession + , logout + , newInvite + , postEquipment + , postNewUser + , postOrg + , postPerson + , postSource + , postTag + , putUser + , refreshSession + , register + , setCollectiveSettings + , setConcEquip + , setConcPerson + , setConfirmed + , setCorrOrg + , setCorrPerson + , setDirection + , setItemDate + , setItemDueDate + , setItemName + , setItemNotes + , setTags + , setUnconfirmed + , upload + , uploadSingle + , versionInfo + ) -import Http -import Task -import Util.Http as Http2 -import Util.File -import Json.Encode as JsonEncode -import File exposing (File) -import Data.Flags exposing (Flags) import Api.Model.AuthResult exposing (AuthResult) import Api.Model.BasicResult exposing (BasicResult) import Api.Model.Collective exposing (Collective) @@ -41,46 +89,69 @@ import Api.Model.User exposing (User) import Api.Model.UserList exposing (UserList) import Api.Model.UserPass exposing (UserPass) import Api.Model.VersionInfo exposing (VersionInfo) +import Data.Flags exposing (Flags) +import File exposing (File) +import Http +import Json.Encode as JsonEncode +import Task +import Util.File +import Util.Http as Http2 -upload: Flags -> Maybe String -> ItemUploadMeta -> List File -> (String -> (Result Http.Error BasicResult) -> msg) -> List (Cmd msg) + +upload : Flags -> Maybe String -> ItemUploadMeta -> List File -> (String -> Result Http.Error BasicResult -> msg) -> List (Cmd msg) upload flags sourceId meta files receive = let - metaStr = JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta) + metaStr = + JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta) + mkReq file = let - fid = Util.File.makeFileId file - path = Maybe.map ((++) "/api/v1/open/upload/item/") sourceId - |> Maybe.withDefault "/api/v1/sec/upload/item" - in - Http2.authPostTrack - { url = flags.config.baseUrl ++ path - , account = getAccount flags - , body = Http.multipartBody <| - [Http.stringPart "meta" metaStr, Http.filePart "file[]" file] - , expect = Http.expectJson (receive fid) Api.Model.BasicResult.decoder - , tracker = fid - } - in - List.map mkReq files + fid = + Util.File.makeFileId file -uploadSingle: Flags -> Maybe String -> ItemUploadMeta -> String -> List File -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + path = + Maybe.map ((++) "/api/v1/open/upload/item/") sourceId + |> Maybe.withDefault "/api/v1/sec/upload/item" + in + Http2.authPostTrack + { url = flags.config.baseUrl ++ path + , account = getAccount flags + , body = + Http.multipartBody <| + [ Http.stringPart "meta" metaStr, Http.filePart "file[]" file ] + , expect = Http.expectJson (receive fid) Api.Model.BasicResult.decoder + , tracker = fid + } + in + List.map mkReq files + + +uploadSingle : Flags -> Maybe String -> ItemUploadMeta -> String -> List File -> (Result Http.Error BasicResult -> msg) -> Cmd msg uploadSingle flags sourceId meta track files receive = let - metaStr = JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta) - fileParts = List.map (\f -> Http.filePart "file[]" f) files - allParts = (Http.stringPart "meta" metaStr) :: fileParts - path = Maybe.map ((++) "/api/v1/open/upload/item/") sourceId - |> Maybe.withDefault "/api/v1/sec/upload/item" - in - Http2.authPostTrack - { url = flags.config.baseUrl ++ path - , account = getAccount flags - , body = Http.multipartBody allParts - , expect = Http.expectJson receive Api.Model.BasicResult.decoder - , tracker = track - } + metaStr = + JsonEncode.encode 0 (Api.Model.ItemUploadMeta.encode meta) -register: Flags -> Registration -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + fileParts = + List.map (\f -> Http.filePart "file[]" f) files + + allParts = + Http.stringPart "meta" metaStr :: fileParts + + path = + Maybe.map ((++) "/api/v1/open/upload/item/") sourceId + |> Maybe.withDefault "/api/v1/sec/upload/item" + in + Http2.authPostTrack + { url = flags.config.baseUrl ++ path + , account = getAccount flags + , body = Http.multipartBody allParts + , expect = Http.expectJson receive Api.Model.BasicResult.decoder + , tracker = track + } + + +register : Flags -> Registration -> (Result Http.Error BasicResult -> msg) -> Cmd msg register flags reg receive = Http.post { url = flags.config.baseUrl ++ "/api/v1/open/signup/register" @@ -88,7 +159,8 @@ register flags reg receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -newInvite: Flags -> GenInvite -> ((Result Http.Error InviteResult) -> msg) -> Cmd msg + +newInvite : Flags -> GenInvite -> (Result Http.Error InviteResult -> msg) -> Cmd msg newInvite flags req receive = Http.post { url = flags.config.baseUrl ++ "/api/v1/open/signup/newinvite" @@ -96,7 +168,8 @@ newInvite flags req receive = , expect = Http.expectJson receive Api.Model.InviteResult.decoder } -login: Flags -> UserPass -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg + +login : Flags -> UserPass -> (Result Http.Error AuthResult -> msg) -> Cmd msg login flags up receive = Http.post { url = flags.config.baseUrl ++ "/api/v1/open/auth/login" @@ -104,7 +177,8 @@ login flags up receive = , expect = Http.expectJson receive Api.Model.AuthResult.decoder } -logout: Flags -> ((Result Http.Error ()) -> msg) -> Cmd msg + +logout : Flags -> (Result Http.Error () -> msg) -> Cmd msg logout flags receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/auth/logout" @@ -113,7 +187,8 @@ logout flags receive = , expect = Http.expectWhatever receive } -loginSession: Flags -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg + +loginSession : Flags -> (Result Http.Error AuthResult -> msg) -> Cmd msg loginSession flags receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/auth/session" @@ -122,28 +197,34 @@ loginSession flags receive = , expect = Http.expectJson receive Api.Model.AuthResult.decoder } -versionInfo: Flags -> ((Result Http.Error VersionInfo) -> msg) -> Cmd msg + +versionInfo : Flags -> (Result Http.Error VersionInfo -> msg) -> Cmd msg versionInfo flags receive = Http.get { url = flags.config.baseUrl ++ "/api/info/version" , expect = Http.expectJson receive Api.Model.VersionInfo.decoder } -refreshSession: Flags -> ((Result Http.Error AuthResult) -> msg) -> Cmd msg + +refreshSession : Flags -> (Result Http.Error AuthResult -> msg) -> Cmd msg refreshSession flags receive = case flags.account of Just acc -> - if acc.success && acc.validMs > 30000 - then + if acc.success && acc.validMs > 30000 then let - delay = Debug.log "Refresh session in " (acc.validMs - 30000) |> toFloat + delay = + acc.validMs - 30000 |> toFloat in - Http2.executeIn delay receive (refreshSessionTask flags) - else Cmd.none + Http2.executeIn delay receive (refreshSessionTask flags) + + else + Cmd.none + Nothing -> Cmd.none -refreshSessionTask: Flags -> Task.Task Http.Error AuthResult + +refreshSessionTask : Flags -> Task.Task Http.Error AuthResult refreshSessionTask flags = Http2.authTask { url = flags.config.baseUrl ++ "/api/v1/sec/auth/session" @@ -156,7 +237,7 @@ refreshSessionTask flags = } -getInsights: Flags -> ((Result Http.Error ItemInsights) -> msg) -> Cmd msg +getInsights : Flags -> (Result Http.Error ItemInsights -> msg) -> Cmd msg getInsights flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/collective/insights" @@ -164,7 +245,8 @@ getInsights flags receive = , expect = Http.expectJson receive Api.Model.ItemInsights.decoder } -getCollective: Flags -> ((Result Http.Error Collective) -> msg) -> Cmd msg + +getCollective : Flags -> (Result Http.Error Collective -> msg) -> Cmd msg getCollective flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/collective" @@ -172,7 +254,8 @@ getCollective flags receive = , expect = Http.expectJson receive Api.Model.Collective.decoder } -getCollectiveSettings: Flags -> ((Result Http.Error CollectiveSettings) -> msg) -> Cmd msg + +getCollectiveSettings : Flags -> (Result Http.Error CollectiveSettings -> msg) -> Cmd msg getCollectiveSettings flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/collective/settings" @@ -180,7 +263,8 @@ getCollectiveSettings flags receive = , expect = Http.expectJson receive Api.Model.CollectiveSettings.decoder } -setCollectiveSettings: Flags -> CollectiveSettings -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setCollectiveSettings : Flags -> CollectiveSettings -> (Result Http.Error BasicResult -> msg) -> Cmd msg setCollectiveSettings flags settings receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/collective/settings" @@ -189,9 +273,12 @@ setCollectiveSettings flags settings receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } + + -- Tags -getTags: Flags -> ((Result Http.Error TagList) -> msg) -> Cmd msg + +getTags : Flags -> (Result Http.Error TagList -> msg) -> Cmd msg getTags flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/tag" @@ -199,7 +286,8 @@ getTags flags receive = , expect = Http.expectJson receive Api.Model.TagList.decoder } -postTag: Flags -> Tag -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +postTag : Flags -> Tag -> (Result Http.Error BasicResult -> msg) -> Cmd msg postTag flags tag receive = let params = @@ -209,10 +297,14 @@ postTag flags tag receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } in - if tag.id == "" then Http2.authPost params - else Http2.authPut params + if tag.id == "" then + Http2.authPost params -deleteTag: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + else + Http2.authPut params + + +deleteTag : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg deleteTag flags tag receive = Http2.authDelete { url = flags.config.baseUrl ++ "/api/v1/sec/tag/" ++ tag @@ -220,9 +312,12 @@ deleteTag flags tag receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } + + -- Equipments -getEquipments: Flags -> ((Result Http.Error EquipmentList) -> msg) -> Cmd msg + +getEquipments : Flags -> (Result Http.Error EquipmentList -> msg) -> Cmd msg getEquipments flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/equipment" @@ -230,7 +325,8 @@ getEquipments flags receive = , expect = Http.expectJson receive Api.Model.EquipmentList.decoder } -postEquipment: Flags -> Equipment -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +postEquipment : Flags -> Equipment -> (Result Http.Error BasicResult -> msg) -> Cmd msg postEquipment flags equip receive = let params = @@ -240,10 +336,14 @@ postEquipment flags equip receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } in - if equip.id == "" then Http2.authPost params - else Http2.authPut params + if equip.id == "" then + Http2.authPost params -deleteEquip: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + else + Http2.authPut params + + +deleteEquip : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg deleteEquip flags equip receive = Http2.authDelete { url = flags.config.baseUrl ++ "/api/v1/sec/equipment/" ++ equip @@ -252,9 +352,11 @@ deleteEquip flags equip receive = } + -- Organization -getOrgLight: Flags -> ((Result Http.Error ReferenceList) -> msg) -> Cmd msg + +getOrgLight : Flags -> (Result Http.Error ReferenceList -> msg) -> Cmd msg getOrgLight flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/organization" @@ -262,7 +364,8 @@ getOrgLight flags receive = , expect = Http.expectJson receive Api.Model.ReferenceList.decoder } -getOrganizations: Flags -> ((Result Http.Error OrganizationList) -> msg) -> Cmd msg + +getOrganizations : Flags -> (Result Http.Error OrganizationList -> msg) -> Cmd msg getOrganizations flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/organization?full=true" @@ -270,7 +373,8 @@ getOrganizations flags receive = , expect = Http.expectJson receive Api.Model.OrganizationList.decoder } -postOrg: Flags -> Organization -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +postOrg : Flags -> Organization -> (Result Http.Error BasicResult -> msg) -> Cmd msg postOrg flags org receive = let params = @@ -280,10 +384,14 @@ postOrg flags org receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } in - if org.id == "" then Http2.authPost params - else Http2.authPut params + if org.id == "" then + Http2.authPost params -deleteOrg: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + else + Http2.authPut params + + +deleteOrg : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg deleteOrg flags org receive = Http2.authDelete { url = flags.config.baseUrl ++ "/api/v1/sec/organization/" ++ org @@ -292,10 +400,11 @@ deleteOrg flags org receive = } + -- Person -getPersonsLight: Flags -> ((Result Http.Error ReferenceList) -> msg) -> Cmd msg +getPersonsLight : Flags -> (Result Http.Error ReferenceList -> msg) -> Cmd msg getPersonsLight flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/person?full=false" @@ -303,7 +412,8 @@ getPersonsLight flags receive = , expect = Http.expectJson receive Api.Model.ReferenceList.decoder } -getPersons: Flags -> ((Result Http.Error PersonList) -> msg) -> Cmd msg + +getPersons : Flags -> (Result Http.Error PersonList -> msg) -> Cmd msg getPersons flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/person?full=true" @@ -311,7 +421,8 @@ getPersons flags receive = , expect = Http.expectJson receive Api.Model.PersonList.decoder } -postPerson: Flags -> Person -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +postPerson : Flags -> Person -> (Result Http.Error BasicResult -> msg) -> Cmd msg postPerson flags person receive = let params = @@ -321,10 +432,14 @@ postPerson flags person receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } in - if person.id == "" then Http2.authPost params - else Http2.authPut params + if person.id == "" then + Http2.authPost params -deletePerson: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + else + Http2.authPut params + + +deletePerson : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg deletePerson flags person receive = Http2.authDelete { url = flags.config.baseUrl ++ "/api/v1/sec/person/" ++ person @@ -332,9 +447,12 @@ deletePerson flags person receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } + + --- Sources -getSources: Flags -> ((Result Http.Error SourceList) -> msg) -> Cmd msg + +getSources : Flags -> (Result Http.Error SourceList -> msg) -> Cmd msg getSources flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/source" @@ -342,7 +460,8 @@ getSources flags receive = , expect = Http.expectJson receive Api.Model.SourceList.decoder } -postSource: Flags -> Source -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +postSource : Flags -> Source -> (Result Http.Error BasicResult -> msg) -> Cmd msg postSource flags source receive = let params = @@ -352,10 +471,14 @@ postSource flags source receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } in - if source.id == "" then Http2.authPost params - else Http2.authPut params + if source.id == "" then + Http2.authPost params -deleteSource: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + else + Http2.authPut params + + +deleteSource : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg deleteSource flags src receive = Http2.authDelete { url = flags.config.baseUrl ++ "/api/v1/sec/source/" ++ src @@ -363,9 +486,12 @@ deleteSource flags src receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } + + -- Users -getUsers: Flags -> ((Result Http.Error UserList) -> msg) -> Cmd msg + +getUsers : Flags -> (Result Http.Error UserList -> msg) -> Cmd msg getUsers flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/user" @@ -373,16 +499,18 @@ getUsers flags receive = , expect = Http.expectJson receive Api.Model.UserList.decoder } -postNewUser: Flags -> User -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +postNewUser : Flags -> User -> (Result Http.Error BasicResult -> msg) -> Cmd msg postNewUser flags user receive = Http2.authPost - { url = flags.config.baseUrl ++ "/api/v1/sec/user" - , account = getAccount flags - , body = Http.jsonBody (Api.Model.User.encode user) - , expect = Http.expectJson receive Api.Model.BasicResult.decoder - } + { url = flags.config.baseUrl ++ "/api/v1/sec/user" + , account = getAccount flags + , body = Http.jsonBody (Api.Model.User.encode user) + , expect = Http.expectJson receive Api.Model.BasicResult.decoder + } -putUser: Flags -> User -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +putUser : Flags -> User -> (Result Http.Error BasicResult -> msg) -> Cmd msg putUser flags user receive = Http2.authPut { url = flags.config.baseUrl ++ "/api/v1/sec/user" @@ -391,7 +519,8 @@ putUser flags user receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -changePassword: Flags -> PasswordChange -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +changePassword : Flags -> PasswordChange -> (Result Http.Error BasicResult -> msg) -> Cmd msg changePassword flags cp receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/user/changePassword" @@ -400,7 +529,8 @@ changePassword flags cp receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -deleteUser: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +deleteUser : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg deleteUser flags user receive = Http2.authDelete { url = flags.config.baseUrl ++ "/api/v1/sec/user/" ++ user @@ -409,9 +539,11 @@ deleteUser flags user receive = } + -- Job Queue -cancelJob: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +cancelJob : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg cancelJob flags jobid receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/queue/" ++ jobid ++ "/cancel" @@ -420,7 +552,8 @@ cancelJob flags jobid receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -getJobQueueState: Flags -> ((Result Http.Error JobQueueState) -> msg) -> Cmd msg + +getJobQueueState : Flags -> (Result Http.Error JobQueueState -> msg) -> Cmd msg getJobQueueState flags receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/queue/state" @@ -429,21 +562,21 @@ getJobQueueState flags receive = } -getJobQueueStateIn: Flags -> Float -> ((Result Http.Error JobQueueState) -> msg) -> Cmd msg +getJobQueueStateIn : Flags -> Float -> (Result Http.Error JobQueueState -> msg) -> Cmd msg getJobQueueStateIn flags delay receive = case flags.account of Just acc -> - if acc.success && delay > 100 - then - let - _ = Debug.log "Refresh job qeue state in " delay - in - Http2.executeIn delay receive (getJobQueueStateTask flags) - else Cmd.none + if acc.success && delay > 100 then + Http2.executeIn delay receive (getJobQueueStateTask flags) + + else + Cmd.none + Nothing -> Cmd.none -getJobQueueStateTask: Flags -> Task.Task Http.Error JobQueueState + +getJobQueueStateTask : Flags -> Task.Task Http.Error JobQueueState getJobQueueStateTask flags = Http2.authTask { url = flags.config.baseUrl ++ "/api/v1/sec/queue/state" @@ -455,9 +588,12 @@ getJobQueueStateTask flags = , timeout = Nothing } + + -- Item -itemSearch: Flags -> ItemSearch -> ((Result Http.Error ItemLightList) -> msg) -> Cmd msg + +itemSearch : Flags -> ItemSearch -> (Result Http.Error ItemLightList -> msg) -> Cmd msg itemSearch flags search receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/search" @@ -466,7 +602,8 @@ itemSearch flags search receive = , expect = Http.expectJson receive Api.Model.ItemLightList.decoder } -itemDetail: Flags -> String -> ((Result Http.Error ItemDetail) -> msg) -> Cmd msg + +itemDetail : Flags -> String -> (Result Http.Error ItemDetail -> msg) -> Cmd msg itemDetail flags id receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ id @@ -474,7 +611,8 @@ itemDetail flags id receive = , expect = Http.expectJson receive Api.Model.ItemDetail.decoder } -setTags: Flags -> String -> ReferenceList -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setTags : Flags -> String -> ReferenceList -> (Result Http.Error BasicResult -> msg) -> Cmd msg setTags flags item tags receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/tags" @@ -483,7 +621,8 @@ setTags flags item tags receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setDirection: Flags -> String -> DirectionValue -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setDirection : Flags -> String -> DirectionValue -> (Result Http.Error BasicResult -> msg) -> Cmd msg setDirection flags item dir receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/direction" @@ -492,7 +631,8 @@ setDirection flags item dir receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setCorrOrg: Flags -> String -> OptionalId -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setCorrOrg : Flags -> String -> OptionalId -> (Result Http.Error BasicResult -> msg) -> Cmd msg setCorrOrg flags item id receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/corrOrg" @@ -501,7 +641,8 @@ setCorrOrg flags item id receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setCorrPerson: Flags -> String -> OptionalId -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setCorrPerson : Flags -> String -> OptionalId -> (Result Http.Error BasicResult -> msg) -> Cmd msg setCorrPerson flags item id receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/corrPerson" @@ -510,7 +651,8 @@ setCorrPerson flags item id receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setConcPerson: Flags -> String -> OptionalId -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setConcPerson : Flags -> String -> OptionalId -> (Result Http.Error BasicResult -> msg) -> Cmd msg setConcPerson flags item id receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/concPerson" @@ -519,7 +661,8 @@ setConcPerson flags item id receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setConcEquip: Flags -> String -> OptionalId -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setConcEquip : Flags -> String -> OptionalId -> (Result Http.Error BasicResult -> msg) -> Cmd msg setConcEquip flags item id receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/concEquipment" @@ -528,7 +671,8 @@ setConcEquip flags item id receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setItemName: Flags -> String -> OptionalText -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setItemName : Flags -> String -> OptionalText -> (Result Http.Error BasicResult -> msg) -> Cmd msg setItemName flags item text receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/name" @@ -537,7 +681,8 @@ setItemName flags item text receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setItemNotes: Flags -> String -> OptionalText -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setItemNotes : Flags -> String -> OptionalText -> (Result Http.Error BasicResult -> msg) -> Cmd msg setItemNotes flags item text receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/notes" @@ -546,7 +691,8 @@ setItemNotes flags item text receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setItemDate: Flags -> String -> OptionalDate -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setItemDate : Flags -> String -> OptionalDate -> (Result Http.Error BasicResult -> msg) -> Cmd msg setItemDate flags item date receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/date" @@ -555,7 +701,8 @@ setItemDate flags item date receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setItemDueDate: Flags -> String -> OptionalDate -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setItemDueDate : Flags -> String -> OptionalDate -> (Result Http.Error BasicResult -> msg) -> Cmd msg setItemDueDate flags item date receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/duedate" @@ -564,7 +711,8 @@ setItemDueDate flags item date receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setConfirmed: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setConfirmed : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg setConfirmed flags item receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/confirm" @@ -573,7 +721,8 @@ setConfirmed flags item receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -setUnconfirmed: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +setUnconfirmed : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg setUnconfirmed flags item receive = Http2.authPost { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/unconfirm" @@ -582,7 +731,8 @@ setUnconfirmed flags item receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -deleteItem: Flags -> String -> ((Result Http.Error BasicResult) -> msg) -> Cmd msg + +deleteItem : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg deleteItem flags item receive = Http2.authDelete { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item @@ -590,7 +740,8 @@ deleteItem flags item receive = , expect = Http.expectJson receive Api.Model.BasicResult.decoder } -getItemProposals: Flags -> String -> ((Result Http.Error ItemProposals) -> msg) -> Cmd msg + +getItemProposals : Flags -> String -> (Result Http.Error ItemProposals -> msg) -> Cmd msg getItemProposals flags item receive = Http2.authGet { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/proposals" @@ -599,8 +750,10 @@ getItemProposals flags item receive = } + -- Helper -getAccount: Flags -> AuthResult + +getAccount : Flags -> AuthResult getAccount flags = Maybe.withDefault Api.Model.AuthResult.empty flags.account diff --git a/modules/webapp/src/main/elm/App/Data.elm b/modules/webapp/src/main/elm/App/Data.elm index 24bffa02..9abc609b 100644 --- a/modules/webapp/src/main/elm/App/Data.elm +++ b/modules/webapp/src/main/elm/App/Data.elm @@ -1,63 +1,73 @@ -module App.Data exposing (..) +module App.Data exposing + ( Model + , Msg(..) + , checkPage + , defaultPage + , init + ) +import Api.Model.AuthResult exposing (AuthResult) +import Api.Model.VersionInfo exposing (VersionInfo) import Browser exposing (UrlRequest) import Browser.Navigation exposing (Key) -import Url exposing (Url) -import Http import Data.Flags exposing (Flags) -import Api.Model.VersionInfo exposing (VersionInfo) -import Api.Model.AuthResult exposing (AuthResult) +import Http import Page exposing (Page(..)) +import Page.CollectiveSettings.Data import Page.Home.Data import Page.Login.Data import Page.ManageData.Data -import Page.CollectiveSettings.Data -import Page.UserSettings.Data +import Page.NewInvite.Data import Page.Queue.Data import Page.Register.Data import Page.Upload.Data -import Page.NewInvite.Data +import Page.UserSettings.Data +import Url exposing (Url) + type alias Model = - { flags: Flags - , key: Key - , page: Page - , version: VersionInfo - , homeModel: Page.Home.Data.Model - , loginModel: Page.Login.Data.Model - , manageDataModel: Page.ManageData.Data.Model - , collSettingsModel: Page.CollectiveSettings.Data.Model - , userSettingsModel: Page.UserSettings.Data.Model - , queueModel: Page.Queue.Data.Model - , registerModel: Page.Register.Data.Model - , uploadModel: Page.Upload.Data.Model - , newInviteModel: Page.NewInvite.Data.Model - , navMenuOpen: Bool - , subs: Sub Msg + { flags : Flags + , key : Key + , page : Page + , version : VersionInfo + , homeModel : Page.Home.Data.Model + , loginModel : Page.Login.Data.Model + , manageDataModel : Page.ManageData.Data.Model + , collSettingsModel : Page.CollectiveSettings.Data.Model + , userSettingsModel : Page.UserSettings.Data.Model + , queueModel : Page.Queue.Data.Model + , registerModel : Page.Register.Data.Model + , uploadModel : Page.Upload.Data.Model + , newInviteModel : Page.NewInvite.Data.Model + , navMenuOpen : Bool + , subs : Sub Msg } -init: Key -> Url -> Flags -> Model + +init : Key -> Url -> Flags -> Model init key url flags = let - page = Page.fromUrl url - |> Maybe.withDefault (defaultPage flags) + page = + Page.fromUrl url + |> Maybe.withDefault (defaultPage flags) in - { flags = flags - , key = key - , page = page - , version = Api.Model.VersionInfo.empty - , homeModel = Page.Home.Data.emptyModel - , loginModel = Page.Login.Data.emptyModel - , manageDataModel = Page.ManageData.Data.emptyModel - , collSettingsModel = Page.CollectiveSettings.Data.emptyModel - , userSettingsModel = Page.UserSettings.Data.emptyModel - , queueModel = Page.Queue.Data.emptyModel - , registerModel = Page.Register.Data.emptyModel - , uploadModel = Page.Upload.Data.emptyModel - , newInviteModel = Page.NewInvite.Data.emptyModel - , navMenuOpen = False - , subs = Sub.none - } + { flags = flags + , key = key + , page = page + , version = Api.Model.VersionInfo.empty + , homeModel = Page.Home.Data.emptyModel + , loginModel = Page.Login.Data.emptyModel + , manageDataModel = Page.ManageData.Data.emptyModel + , collSettingsModel = Page.CollectiveSettings.Data.emptyModel + , userSettingsModel = Page.UserSettings.Data.emptyModel + , queueModel = Page.Queue.Data.emptyModel + , registerModel = Page.Register.Data.emptyModel + , uploadModel = Page.Upload.Data.emptyModel + , newInviteModel = Page.NewInvite.Data.emptyModel + , navMenuOpen = False + , subs = Sub.none + } + type Msg = NavRequest UrlRequest @@ -77,18 +87,30 @@ type Msg | SessionCheckResp (Result Http.Error AuthResult) | ToggleNavMenu -isSignedIn: Flags -> Bool + +isSignedIn : Flags -> Bool isSignedIn flags = flags.account |> Maybe.map .success |> Maybe.withDefault False -checkPage: Flags -> Page -> Page -checkPage flags page = - if Page.isSecured page && isSignedIn flags then page - else if Page.isOpen page then page - else Page.loginPage page -defaultPage: Flags -> Page +checkPage : Flags -> Page -> Page +checkPage flags page = + if Page.isSecured page && isSignedIn flags then + page + + else if Page.isOpen page then + page + + else + Page.loginPage page + + +defaultPage : Flags -> Page defaultPage flags = - if isSignedIn flags then HomePage else (LoginPage Nothing) + if isSignedIn flags then + HomePage + + else + LoginPage Nothing diff --git a/modules/webapp/src/main/elm/App/Update.elm b/modules/webapp/src/main/elm/App/Update.elm index b7a3249f..86547b49 100644 --- a/modules/webapp/src/main/elm/App/Update.elm +++ b/modules/webapp/src/main/elm/App/Update.elm @@ -1,42 +1,48 @@ -module App.Update exposing (update, initPage) +module App.Update exposing + ( initPage + , update + ) import Api -import Ports +import App.Data exposing (..) import Browser exposing (UrlRequest(..)) import Browser.Navigation as Nav -import Url import Data.Flags -import App.Data exposing (..) import Page exposing (Page(..)) +import Page.CollectiveSettings.Data +import Page.CollectiveSettings.Update import Page.Home.Data import Page.Home.Update import Page.Login.Data import Page.Login.Update import Page.ManageData.Data import Page.ManageData.Update -import Page.CollectiveSettings.Data -import Page.CollectiveSettings.Update -import Page.UserSettings.Data -import Page.UserSettings.Update +import Page.NewInvite.Data +import Page.NewInvite.Update import Page.Queue.Data import Page.Queue.Update import Page.Register.Data import Page.Register.Update import Page.Upload.Data import Page.Upload.Update -import Page.NewInvite.Data -import Page.NewInvite.Update +import Page.UserSettings.Data +import Page.UserSettings.Update +import Ports +import Url import Util.Update -update: Msg -> Model -> (Model, Cmd Msg) + +update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = let - (m, c, s) = updateWithSub msg model + ( m, c, s ) = + updateWithSub msg model in - ({m|subs = s}, c) + ( { m | subs = s }, c ) -updateWithSub: Msg -> Model -> (Model, Cmd Msg, Sub Msg) -updateWithSub msg model = + +updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) +updateWithSub msg model = case msg of HomeMsg lm -> updateHome lm model |> noSub @@ -66,49 +72,75 @@ updateWithSub msg model = updateNewInvite m model |> noSub VersionResp (Ok info) -> - ({model|version = info}, Cmd.none) |> noSub + ( { model | version = info }, Cmd.none ) |> noSub - VersionResp (Err err) -> - (model, Cmd.none, Sub.none) + VersionResp (Err _) -> + ( model, Cmd.none, Sub.none ) Logout -> - (model + ( model , Cmd.batch [ Api.logout model.flags LogoutResp , Ports.removeAccount () ] - , Sub.none) + , Sub.none + ) LogoutResp _ -> - ({model|loginModel = Page.Login.Data.emptyModel}, Page.goto (LoginPage Nothing), Sub.none) + ( { model | loginModel = Page.Login.Data.emptyModel }, Page.goto (LoginPage Nothing), Sub.none ) SessionCheckResp res -> case res of Ok lr -> let - newFlags = if lr.success then Data.Flags.withAccount model.flags lr - else Data.Flags.withoutAccount model.flags - command = if lr.success then Api.refreshSession newFlags SessionCheckResp - else Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)] + newFlags = + if lr.success then + Data.Flags.withAccount model.flags lr + + else + Data.Flags.withoutAccount model.flags + + command = + if lr.success then + Api.refreshSession newFlags SessionCheckResp + + else + Cmd.batch + [ Ports.removeAccount () + , Page.goto (Page.loginPage model.page) + ] in - ({model | flags = newFlags}, command, Sub.none) + ( { model | flags = newFlags }, command, Sub.none ) + Err _ -> - (model, Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)], Sub.none) + ( model + , Cmd.batch + [ Ports.removeAccount () + , Page.goto (Page.loginPage model.page) + ] + , Sub.none + ) NavRequest req -> case req of Internal url -> let - newPage = Page.fromUrl url + newPage = + Page.fromUrl url + isCurrent = - Page.fromUrl url |> - Maybe.map (\p -> p == model.page) |> - Maybe.withDefault True + Page.fromUrl url + |> Maybe.map (\p -> p == model.page) + |> Maybe.withDefault True in - ( model - , if isCurrent then Cmd.none else Nav.pushUrl model.key (Url.toString url) - , Sub.none - ) + ( model + , if isCurrent then + Cmd.none + + else + Nav.pushUrl model.key (Url.toString url) + , Sub.none + ) External url -> ( model @@ -118,111 +150,148 @@ updateWithSub msg model = NavChange url -> let - page = Page.fromUrl url - |> Maybe.withDefault (defaultPage model.flags) - check = checkPage model.flags page - (m, c) = initPage model page + page = + Page.fromUrl url + |> Maybe.withDefault (defaultPage model.flags) + + check = + checkPage model.flags page + + ( m, c ) = + initPage model page in - if check == page then ( { m | page = page }, c, Sub.none ) - else (model, Page.goto check, Sub.none) + if check == page then + ( { m | page = page }, c, Sub.none ) + + else + ( model, Page.goto check, Sub.none ) ToggleNavMenu -> - ({model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none) + ( { model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none ) -updateNewInvite: Page.NewInvite.Data.Msg -> Model -> (Model, Cmd Msg) +updateNewInvite : Page.NewInvite.Data.Msg -> Model -> ( Model, Cmd Msg ) updateNewInvite lmsg model = let - (lm, lc) = Page.NewInvite.Update.update model.flags lmsg model.newInviteModel + ( lm, lc ) = + Page.NewInvite.Update.update model.flags lmsg model.newInviteModel in - ( {model | newInviteModel = lm } - , Cmd.map NewInviteMsg lc - ) + ( { model | newInviteModel = lm } + , Cmd.map NewInviteMsg lc + ) -updateUpload: Page.Upload.Data.Msg -> Model -> (Model, Cmd Msg, Sub Msg) + +updateUpload : Page.Upload.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateUpload lmsg model = let - (lm, lc, ls) = Page.Upload.Update.update (Page.uploadId model.page) model.flags lmsg model.uploadModel + ( lm, lc, ls ) = + Page.Upload.Update.update + (Page.uploadId model.page) + model.flags + lmsg + model.uploadModel in - ( { model | uploadModel = lm } - , Cmd.map UploadMsg lc - , Sub.map UploadMsg ls - ) + ( { model | uploadModel = lm } + , Cmd.map UploadMsg lc + , Sub.map UploadMsg ls + ) -updateRegister: Page.Register.Data.Msg -> Model -> (Model, Cmd Msg) + +updateRegister : Page.Register.Data.Msg -> Model -> ( Model, Cmd Msg ) updateRegister lmsg model = let - (lm, lc) = Page.Register.Update.update model.flags lmsg model.registerModel + ( lm, lc ) = + Page.Register.Update.update model.flags lmsg model.registerModel in - ( { model | registerModel = lm } - , Cmd.map RegisterMsg lc - ) + ( { model | registerModel = lm } + , Cmd.map RegisterMsg lc + ) -updateQueue: Page.Queue.Data.Msg -> Model -> (Model, Cmd Msg) + +updateQueue : Page.Queue.Data.Msg -> Model -> ( Model, Cmd Msg ) updateQueue lmsg model = let - (lm, lc) = Page.Queue.Update.update model.flags lmsg model.queueModel + ( lm, lc ) = + Page.Queue.Update.update model.flags lmsg model.queueModel in - ( { model | queueModel = lm } - , Cmd.map QueueMsg lc - ) + ( { model | queueModel = lm } + , Cmd.map QueueMsg lc + ) -updateUserSettings: Page.UserSettings.Data.Msg -> Model -> (Model, Cmd Msg) +updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg ) updateUserSettings lmsg model = let - (lm, lc) = Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel + ( lm, lc ) = + Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel in - ( { model | userSettingsModel = lm } - , Cmd.map UserSettingsMsg lc - ) + ( { model | userSettingsModel = lm } + , Cmd.map UserSettingsMsg lc + ) -updateCollSettings: Page.CollectiveSettings.Data.Msg -> Model -> (Model, Cmd Msg) + +updateCollSettings : Page.CollectiveSettings.Data.Msg -> Model -> ( Model, Cmd Msg ) updateCollSettings lmsg model = let - (lm, lc) = Page.CollectiveSettings.Update.update model.flags lmsg model.collSettingsModel + ( lm, lc ) = + Page.CollectiveSettings.Update.update model.flags + lmsg + model.collSettingsModel in - ( { model | collSettingsModel = lm } - , Cmd.map CollSettingsMsg lc - ) + ( { model | collSettingsModel = lm } + , Cmd.map CollSettingsMsg lc + ) -updateLogin: Page.Login.Data.Msg -> Model -> (Model, Cmd Msg) + +updateLogin : Page.Login.Data.Msg -> Model -> ( Model, Cmd Msg ) updateLogin lmsg model = let - (lm, lc, ar) = Page.Login.Update.update (Page.loginPageReferrer model.page) model.flags lmsg model.loginModel - newFlags = Maybe.map (Data.Flags.withAccount model.flags) ar - |> Maybe.withDefault model.flags - in - ({model | loginModel = lm, flags = newFlags} - ,Cmd.map LoginMsg lc - ) + ( lm, lc, ar ) = + Page.Login.Update.update (Page.loginPageReferrer model.page) + model.flags + lmsg + model.loginModel -updateHome: Page.Home.Data.Msg -> Model -> (Model, Cmd Msg) + newFlags = + Maybe.map (Data.Flags.withAccount model.flags) ar + |> Maybe.withDefault model.flags + in + ( { model | loginModel = lm, flags = newFlags } + , Cmd.map LoginMsg lc + ) + + +updateHome : Page.Home.Data.Msg -> Model -> ( Model, Cmd Msg ) updateHome lmsg model = let - (lm, lc) = Page.Home.Update.update model.flags lmsg model.homeModel + ( lm, lc ) = + Page.Home.Update.update model.flags lmsg model.homeModel in - ( {model | homeModel = lm } - , Cmd.map HomeMsg lc - ) + ( { model | homeModel = lm } + , Cmd.map HomeMsg lc + ) -updateManageData: Page.ManageData.Data.Msg -> Model -> (Model, Cmd Msg) + +updateManageData : Page.ManageData.Data.Msg -> Model -> ( Model, Cmd Msg ) updateManageData lmsg model = let - (lm, lc) = Page.ManageData.Update.update model.flags lmsg model.manageDataModel + ( lm, lc ) = + Page.ManageData.Update.update model.flags lmsg model.manageDataModel in - ({ model | manageDataModel = lm } - ,Cmd.map ManageDataMsg lc - ) + ( { model | manageDataModel = lm } + , Cmd.map ManageDataMsg lc + ) -initPage: Model -> Page -> (Model, Cmd Msg) + +initPage : Model -> Page -> ( Model, Cmd Msg ) initPage model page = case page of HomePage -> Util.Update.andThen1 - [updateHome Page.Home.Data.Init - ,updateQueue Page.Queue.Data.StopRefresh - ] model + [ updateHome Page.Home.Data.Init + , updateQueue Page.Queue.Data.StopRefresh + ] + model LoginPage _ -> updateQueue Page.Queue.Data.StopRefresh model @@ -232,9 +301,10 @@ initPage model page = CollectiveSettingPage -> Util.Update.andThen1 - [updateQueue Page.Queue.Data.StopRefresh - ,updateCollSettings Page.CollectiveSettings.Data.Init - ] model + [ updateQueue Page.Queue.Data.StopRefresh + , updateCollSettings Page.CollectiveSettings.Data.Init + ] + model UserSettingPage -> updateQueue Page.Queue.Data.StopRefresh model @@ -252,6 +322,6 @@ initPage model page = updateQueue Page.Queue.Data.StopRefresh model -noSub: (Model, Cmd Msg) -> (Model, Cmd Msg, Sub Msg) -noSub (m, c) = - (m, c, Sub.none) +noSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg ) +noSub ( m, c ) = + ( m, c, Sub.none ) diff --git a/modules/webapp/src/main/elm/App/View.elm b/modules/webapp/src/main/elm/App/View.elm index 71d4173a..c2a5c05d 100644 --- a/modules/webapp/src/main/elm/App/View.elm +++ b/modules/webapp/src/main/elm/App/View.elm @@ -1,227 +1,278 @@ module App.View exposing (view) +import App.Data exposing (..) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) - -import Page -import App.Data exposing (..) -import Data.Flags exposing (Flags) import Page exposing (Page(..)) +import Page.CollectiveSettings.View import Page.Home.View import Page.Login.View import Page.ManageData.View -import Page.CollectiveSettings.View -import Page.UserSettings.View +import Page.NewInvite.View import Page.Queue.View import Page.Register.View import Page.Upload.View -import Page.NewInvite.View +import Page.UserSettings.View -view: Model -> Html Msg + +view : Model -> Html Msg view model = case model.page of LoginPage _ -> loginLayout model + RegisterPage -> registerLayout model + NewInvitePage -> newInviteLayout model + _ -> defaultLayout model -registerLayout: Model -> Html Msg + +registerLayout : Model -> Html Msg registerLayout model = - div [class "register-layout"] - [ (viewRegister model) - , (footer model) + div [ class "register-layout" ] + [ viewRegister model + , footer model ] -loginLayout: Model -> Html Msg + +loginLayout : Model -> Html Msg loginLayout model = - div [class "login-layout"] - [ (viewLogin model) - , (footer model) + div [ class "login-layout" ] + [ viewLogin model + , footer model ] -newInviteLayout: Model -> Html Msg + +newInviteLayout : Model -> Html Msg newInviteLayout model = - div [class "newinvite-layout"] - [ (viewNewInvite model) - , (footer model) + div [ class "newinvite-layout" ] + [ viewNewInvite model + , footer model ] -defaultLayout: Model -> Html Msg + +defaultLayout : Model -> Html Msg defaultLayout model = - div [class "default-layout"] - [ div [class "ui fixed top sticky attached large menu top-menu"] - [div [class "ui fluid container"] - [ a [class "header item narrow-item" - ,Page.href HomePage - ] - [img [class "image" - ,src (model.flags.config.docspellAssetPath ++ "/img/logo-96.png")][] - ,div [class "content"] - [text model.flags.config.appName - ] - ] - , (loginInfo model) - ] - ] - , div [ class "main-content" ] - [ (case model.page of - HomePage -> - viewHome model - LoginPage _ -> - viewLogin model - ManageDataPage -> - viewManageData model - CollectiveSettingPage -> - viewCollectiveSettings model - UserSettingPage -> - viewUserSettings model - QueuePage -> - viewQueue model - RegisterPage -> - viewRegister model - UploadPage mid -> - viewUpload mid model - NewInvitePage -> - viewNewInvite model - ) + div [ class "default-layout" ] + [ div [ class "ui fixed top sticky attached large menu top-menu" ] + [ div [ class "ui fluid container" ] + [ a + [ class "header item narrow-item" + , Page.href HomePage + ] + [ img + [ class "image" + , src (model.flags.config.docspellAssetPath ++ "/img/logo-96.png") + ] + [] + , div [ class "content" ] + [ text model.flags.config.appName + ] + ] + , loginInfo model + ] ] - , (footer model) + , div [ class "main-content" ] + [ case model.page of + HomePage -> + viewHome model + + LoginPage _ -> + viewLogin model + + ManageDataPage -> + viewManageData model + + CollectiveSettingPage -> + viewCollectiveSettings model + + UserSettingPage -> + viewUserSettings model + + QueuePage -> + viewQueue model + + RegisterPage -> + viewRegister model + + UploadPage mid -> + viewUpload mid model + + NewInvitePage -> + viewNewInvite model + ] + , footer model ] -viewNewInvite: Model -> Html Msg + +viewNewInvite : Model -> Html Msg viewNewInvite model = Html.map NewInviteMsg (Page.NewInvite.View.view model.flags model.newInviteModel) -viewUpload: (Maybe String) ->Model -> Html Msg + +viewUpload : Maybe String -> Model -> Html Msg viewUpload mid model = Html.map UploadMsg (Page.Upload.View.view mid model.uploadModel) -viewRegister: Model -> Html Msg + +viewRegister : Model -> Html Msg viewRegister model = Html.map RegisterMsg (Page.Register.View.view model.flags model.registerModel) -viewQueue: Model -> Html Msg + +viewQueue : Model -> Html Msg viewQueue model = Html.map QueueMsg (Page.Queue.View.view model.queueModel) -viewUserSettings: Model -> Html Msg + +viewUserSettings : Model -> Html Msg viewUserSettings model = Html.map UserSettingsMsg (Page.UserSettings.View.view model.userSettingsModel) -viewCollectiveSettings: Model -> Html Msg + +viewCollectiveSettings : Model -> Html Msg viewCollectiveSettings model = Html.map CollSettingsMsg (Page.CollectiveSettings.View.view model.flags model.collSettingsModel) -viewManageData: Model -> Html Msg + +viewManageData : Model -> Html Msg viewManageData model = Html.map ManageDataMsg (Page.ManageData.View.view model.manageDataModel) -viewLogin: Model -> Html Msg + +viewLogin : Model -> Html Msg viewLogin model = Html.map LoginMsg (Page.Login.View.view model.flags model.loginModel) -viewHome: Model -> Html Msg + +viewHome : Model -> Html Msg viewHome model = Html.map HomeMsg (Page.Home.View.view model.homeModel) -menuEntry: Model -> Page -> List (Html Msg) -> Html Msg +menuEntry : Model -> Page -> List (Html Msg) -> Html Msg menuEntry model page children = - a [classList [("icon item", True) - ,("active", model.page == page) - ] - , Page.href page] - children + a + [ classList + [ ( "icon item", True ) + , ( "active", model.page == page ) + ] + , Page.href page + ] + children -loginInfo: Model -> Html Msg + +loginInfo : Model -> Html Msg loginInfo model = - div [class "right menu"] + div [ class "right menu" ] (case model.flags.account of - Just acc -> - [div [class "ui dropdown icon link item" - , onClick ToggleNavMenu - ] - [i [class "ui bars icon"][] - ,div [classList [("left menu", True) - ,("transition visible", model.navMenuOpen) - ] - ] - [menuEntry model HomePage - [img [class "image icon" - ,src (model.flags.config.docspellAssetPath ++ "/img/logo-mc-96.png") - ][] - ,text "Items" + Just _ -> + [ div + [ class "ui dropdown icon link item" + , onClick ToggleNavMenu + ] + [ i [ class "ui bars icon" ] [] + , div + [ classList + [ ( "left menu", True ) + , ( "transition visible", model.navMenuOpen ) ] - ,div [class "divider"][] - ,menuEntry model CollectiveSettingPage - [i [class "users circle icon"][] - ,text "Collective Settings" - ] - ,menuEntry model UserSettingPage - [i [class "user circle icon"][] - ,text "User Settings" - ] - ,div [class "divider"][] - ,menuEntry model ManageDataPage - [i [class "cubes icon"][] - ,text "Manage Data" - ] - ,div [class "divider"][] - ,menuEntry model (UploadPage Nothing) - [i [class "upload icon"][] - ,text "Upload files" + ] + [ menuEntry model + HomePage + [ img + [ class "image icon" + , src (model.flags.config.docspellAssetPath ++ "/img/logo-mc-96.png") + ] + [] + , text "Items" ] - ,menuEntry model QueuePage - [i [class "tachometer alternate icon"][] - ,text "Procesing Queue" - ] - ,div [classList [("divider", True) - ,("invisible", model.flags.config.signupMode /= "invite") - ]] - [] - ,a [classList [("icon item", True) - ,("invisible", model.flags.config.signupMode /= "invite") - ] + , div [ class "divider" ] [] + , menuEntry model + CollectiveSettingPage + [ i [ class "users circle icon" ] [] + , text "Collective Settings" + ] + , menuEntry model + UserSettingPage + [ i [ class "user circle icon" ] [] + , text "User Settings" + ] + , div [ class "divider" ] [] + , menuEntry model + ManageDataPage + [ i [ class "cubes icon" ] [] + , text "Manage Data" + ] + , div [ class "divider" ] [] + , menuEntry model + (UploadPage Nothing) + [ i [ class "upload icon" ] [] + , text "Upload files" + ] + , menuEntry model + QueuePage + [ i [ class "tachometer alternate icon" ] [] + , text "Procesing Queue" + ] + , div + [ classList + [ ( "divider", True ) + , ( "invisible", model.flags.config.signupMode /= "invite" ) + ] + ] + [] + , a + [ classList + [ ( "icon item", True ) + , ( "invisible", model.flags.config.signupMode /= "invite" ) + ] , Page.href NewInvitePage ] - [i [class "key icon"][] - ,text "New Invites" + [ i [ class "key icon" ] [] + , text "New Invites" ] - ,div [class "divider"][] - ,a [class "icon item" - ,href "" - ,onClick Logout] - [i [class "sign-out icon"][] - ,text "Logout" - ] - ] - ] + , div [ class "divider" ] [] + , a + [ class "icon item" + , href "" + , onClick Logout + ] + [ i [ class "sign-out icon" ] [] + , text "Logout" + ] + ] + ] ] + Nothing -> - [a [class "item" - ,Page.href (Page.loginPage model.page) - ] - [text "Login" - ] - ,a [class "item" - ,Page.href RegisterPage - ] - [text "Register" + [ a + [ class "item" + , Page.href (Page.loginPage model.page) + ] + [ text "Login" + ] + , a + [ class "item" + , Page.href RegisterPage + ] + [ text "Register" ] ] ) -footer: Model -> Html Msg + +footer : Model -> Html Msg footer model = div [ class "ui footer" ] - [ a [href "https://github.com/eikek/docspell"] - [ i [class "ui github icon"][] - ] + [ a [ href "https://github.com/eikek/docspell" ] + [ i [ class "ui github icon" ] [] + ] , span [] [ text "Docspell " , text model.version.version diff --git a/modules/webapp/src/main/elm/Comp/AddressForm.elm b/modules/webapp/src/main/elm/Comp/AddressForm.elm index 26784231..3e4fb7b6 100644 --- a/modules/webapp/src/main/elm/Comp/AddressForm.elm +++ b/modules/webapp/src/main/elm/Comp/AddressForm.elm @@ -1,32 +1,36 @@ -module Comp.AddressForm exposing ( Model - , emptyModel - , Msg(..) - , view - , update - , getAddress) +module Comp.AddressForm exposing + ( Model + , Msg(..) + , emptyModel + , getAddress + , update + , view + ) +import Api.Model.Address exposing (Address) +import Comp.Dropdown import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onInput) -import Data.Flags exposing (Flags) -import Api.Model.Address exposing (Address) -import Comp.Dropdown import Util.List + type alias Model = - { address: Address - , street: String - , zip: String - , city: String - , country: Comp.Dropdown.Model Country + { address : Address + , street : String + , zip : String + , city : String + , country : Comp.Dropdown.Model Country } + type alias Country = - { code: String - , label: String + { code : String + , label : String } -countries: List Country + +countries : List Country countries = [ Country "DE" "Germany" , Country "CH" "Switzerland" @@ -35,22 +39,24 @@ countries = , Country "AU" "Austria" ] -emptyModel: Model + +emptyModel : Model emptyModel = { address = Api.Model.Address.empty , street = "" , zip = "" , city = "" - , country = Comp.Dropdown.makeSingleList - { makeOption = \c -> { value = c.code, text = c.label } - , placeholder = "Select Country" - , options = countries - , selected = Nothing - } + , country = + Comp.Dropdown.makeSingleList + { makeOption = \c -> { value = c.code, text = c.label } + , placeholder = "Select Country" + , options = countries + , selected = Nothing + } } -getAddress: Model -> Address +getAddress : Model -> Address getAddress model = { street = model.street , zip = model.zip @@ -58,6 +64,7 @@ getAddress model = , country = Comp.Dropdown.getSelected model.country |> List.head |> Maybe.map .code |> Maybe.withDefault "" } + type Msg = SetStreet String | SetCity String @@ -65,65 +72,80 @@ type Msg | SetAddress Address | CountryMsg (Comp.Dropdown.Msg Country) -update: Msg -> Model -> (Model, Cmd Msg) + +update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of SetAddress a -> let - selection = Util.List.find (\c -> c.code == a.country) countries - |> Maybe.map List.singleton - |> Maybe.withDefault [] - (m2, c2) = Comp.Dropdown.update (Comp.Dropdown.SetSelection selection) model.country + selection = + Util.List.find (\c -> c.code == a.country) countries + |> Maybe.map List.singleton + |> Maybe.withDefault [] + + ( m2, c2 ) = + Comp.Dropdown.update (Comp.Dropdown.SetSelection selection) model.country in - ({model | address = a, street = a.street, city = a.city, zip = a.zip, country = m2 }, Cmd.map CountryMsg c2) + ( { model | address = a, street = a.street, city = a.city, zip = a.zip, country = m2 }, Cmd.map CountryMsg c2 ) SetStreet n -> - ({model | street = n}, Cmd.none) + ( { model | street = n }, Cmd.none ) SetCity c -> - ({model | city = c }, Cmd.none) + ( { model | city = c }, Cmd.none ) SetZip z -> - ({model | zip = z }, Cmd.none) + ( { model | zip = z }, Cmd.none ) CountryMsg m -> let - (m1, c1) = Comp.Dropdown.update m model.country + ( m1, c1 ) = + Comp.Dropdown.update m model.country in - ({model | country = m1}, Cmd.map CountryMsg c1) + ( { model | country = m1 }, Cmd.map CountryMsg c1 ) -view: Model -> Html Msg + +view : Model -> Html Msg view model = - div [class "ui form"] - [div [class "field" - ] - [label [][text "Street"] - ,input [type_ "text" - ,onInput SetStreet - ,placeholder "Street" - ,value model.street - ][] - ] - ,div [class "field" - ] - [label [][text "Zip Code"] - ,input [type_ "text" - ,onInput SetZip - ,placeholder "Zip" - ,value model.zip - ][] - ] - ,div [class "field" - ] - [label [][text "City"] - ,input [type_ "text" - ,onInput SetCity - ,placeholder "City" - ,value model.city - ][] - ] - ,div [class "field"] - [label [][text "Country"] - ,Html.map CountryMsg (Comp.Dropdown.view model.country) - ] + div [ class "ui form" ] + [ div + [ class "field" + ] + [ label [] [ text "Street" ] + , input + [ type_ "text" + , onInput SetStreet + , placeholder "Street" + , value model.street + ] + [] + ] + , div + [ class "field" + ] + [ label [] [ text "Zip Code" ] + , input + [ type_ "text" + , onInput SetZip + , placeholder "Zip" + , value model.zip + ] + [] + ] + , div + [ class "field" + ] + [ label [] [ text "City" ] + , input + [ type_ "text" + , onInput SetCity + , placeholder "City" + , value model.city + ] + [] + ] + , div [ class "field" ] + [ label [] [ text "Country" ] + , Html.map CountryMsg (Comp.Dropdown.view model.country) + ] ] diff --git a/modules/webapp/src/main/elm/Comp/ChangePasswordForm.elm b/modules/webapp/src/main/elm/Comp/ChangePasswordForm.elm index 4c0958bc..4617e718 100644 --- a/modules/webapp/src/main/elm/Comp/ChangePasswordForm.elm +++ b/modules/webapp/src/main/elm/Comp/ChangePasswordForm.elm @@ -1,45 +1,49 @@ -module Comp.ChangePasswordForm exposing (Model - ,emptyModel - ,Msg(..) - ,update - ,view - ) -import Http -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onInput, onClick) +module Comp.ChangePasswordForm exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) import Api -import Api.Model.PasswordChange exposing (PasswordChange) -import Util.Http import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.PasswordChange exposing (PasswordChange) import Data.Flags exposing (Flags) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onClick, onInput) +import Http +import Util.Http + type alias Model = - { current: String - , newPass1: String - , newPass2: String - , showCurrent: Bool - , showPass1: Bool - , showPass2: Bool - , errors: List String - , loading: Bool - , successMsg: String + { current : String + , newPass1 : String + , newPass2 : String + , showCurrent : Bool + , showPass1 : Bool + , showPass2 : Bool + , errors : List String + , loading : Bool + , successMsg : String } -emptyModel: Model + +emptyModel : Model emptyModel = validateModel - { current = "" - , newPass1 = "" - , newPass2 = "" - , showCurrent = False - , showPass1 = False - , showPass2 = False - , errors = [] - , loading = False - , successMsg = "" - } + { current = "" + , newPass1 = "" + , newPass2 = "" + , showCurrent = False + , showPass1 = False + , showPass2 = False + , errors = [] + , loading = False + , successMsg = "" + } + type Msg = SetCurrent String @@ -52,147 +56,205 @@ type Msg | SubmitResp (Result Http.Error BasicResult) -validate: Model -> List String +validate : Model -> List String validate model = List.concat - [ if model.newPass1 /= "" && model.newPass2 /= "" && model.newPass1 /= model.newPass2 - then ["New passwords do not match."] - else [] - , if model.newPass1 == "" || model.newPass2 == "" || model.current == "" - then ["Please fill in required fields."] - else [] + [ if model.newPass1 /= "" && model.newPass2 /= "" && model.newPass1 /= model.newPass2 then + [ "New passwords do not match." ] + + else + [] + , if model.newPass1 == "" || model.newPass2 == "" || model.current == "" then + [ "Please fill in required fields." ] + + else + [] ] -validateModel: Model -> Model + +validateModel : Model -> Model validateModel model = let - err = validate model + err = + validate model in - {model | errors = err, successMsg = if err == [] then model.successMsg else "" } + { model + | errors = err + , successMsg = + if err == [] then + model.successMsg + + else + "" + } + + -- Update -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetCurrent s -> - (validateModel {model | current = s}, Cmd.none) + ( validateModel { model | current = s }, Cmd.none ) SetNew1 s -> - (validateModel {model | newPass1 = s}, Cmd.none) + ( validateModel { model | newPass1 = s }, Cmd.none ) SetNew2 s -> - (validateModel {model | newPass2 = s}, Cmd.none) + ( validateModel { model | newPass2 = s }, Cmd.none ) ToggleShowCurrent -> - ({model | showCurrent = not model.showCurrent}, Cmd.none) + ( { model | showCurrent = not model.showCurrent }, Cmd.none ) ToggleShowPass1 -> - ({model | showPass1 = not model.showPass1}, Cmd.none) + ( { model | showPass1 = not model.showPass1 }, Cmd.none ) ToggleShowPass2 -> - ({model | showPass2 = not model.showPass2}, Cmd.none) - + ( { model | showPass2 = not model.showPass2 }, Cmd.none ) Submit -> let - valid = validate model - cp = PasswordChange model.current model.newPass1 + valid = + validate model + + cp = + PasswordChange model.current model.newPass1 in - if List.isEmpty valid then - ({model | loading = True, errors = [], successMsg = ""}, Api.changePassword flags cp SubmitResp) - else - (model, Cmd.none) + if List.isEmpty valid then + ( { model | loading = True, errors = [], successMsg = "" }, Api.changePassword flags cp SubmitResp ) + + else + ( model, Cmd.none ) SubmitResp (Ok res) -> let - em = { emptyModel | errors = [], successMsg = "Password has been changed."} + em = + { emptyModel | errors = [], successMsg = "Password has been changed." } in - if res.success then - (em, Cmd.none) - else - ({model | errors = [res.message], loading = False, successMsg = ""}, Cmd.none) + if res.success then + ( em, Cmd.none ) + + else + ( { model | errors = [ res.message ], loading = False, successMsg = "" }, Cmd.none ) SubmitResp (Err err) -> let - str = Util.Http.errorToString err + str = + Util.Http.errorToString err in - ({model | errors = [str], loading = False, successMsg = ""}, Cmd.none) + ( { model | errors = [ str ], loading = False, successMsg = "" }, Cmd.none ) + -- View -view: Model -> Html Msg + +view : Model -> Html Msg view model = - div [classList [("ui form", True) - ,("error", List.isEmpty model.errors |> not) - ,("success", model.successMsg /= "") - ] - ] - [div [classList [("field", True) - ,("error", model.current == "") - ] - ] - [label [][text "Current Password*"] - ,div [class "ui action input"] - [input [type_ <| if model.showCurrent then "text" else "password" - ,onInput SetCurrent - ,value model.current - ][] - ,button [class "ui icon button", onClick ToggleShowCurrent] - [i [class "eye icon"][] - ] - ] - ] - ,div [classList [("field", True) - ,("error", model.newPass1 == "") - ] - ] - [label [][text "New Password*"] - ,div [class "ui action input"] - [input [type_ <| if model.showPass1 then "text" else "password" - ,onInput SetNew1 - ,value model.newPass1 - ][] - ,button [class "ui icon button", onClick ToggleShowPass1] - [i [class "eye icon"][] - ] - ] - ] - ,div [classList [("field", True) - ,("error", model.newPass2 == "") - ] - ] - [label [][text "New Password (repeat)*"] - ,div [class "ui action input"] - [input [type_ <| if model.showPass2 then "text" else "password" - ,onInput SetNew2 - ,value model.newPass2 - ][] - ,button [class "ui icon button", onClick ToggleShowPass2] - [i [class "eye icon"][] - ] - ] - ] - ,div [class "ui horizontal divider"][] - ,div [class "ui success message"] - [text model.successMsg - ] - ,div [class "ui error message"] - [case model.errors of - a :: [] -> - text a - _ -> - ul [class "ui list"] - (List.map (\em -> li[][text em]) model.errors) - ] - ,div [class "ui horizontal divider"][] - ,button [class "ui primary button", onClick Submit] - [text "Submit" - ] - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] + div + [ classList + [ ( "ui form", True ) + , ( "error", List.isEmpty model.errors |> not ) + , ( "success", model.successMsg /= "" ) + ] + ] + [ div + [ classList + [ ( "field", True ) + , ( "error", model.current == "" ) + ] + ] + [ label [] [ text "Current Password*" ] + , div [ class "ui action input" ] + [ input + [ type_ <| + if model.showCurrent then + "text" + + else + "password" + , onInput SetCurrent + , value model.current + ] + [] + , button [ class "ui icon button", onClick ToggleShowCurrent ] + [ i [ class "eye icon" ] [] + ] + ] + ] + , div + [ classList + [ ( "field", True ) + , ( "error", model.newPass1 == "" ) + ] + ] + [ label [] [ text "New Password*" ] + , div [ class "ui action input" ] + [ input + [ type_ <| + if model.showPass1 then + "text" + + else + "password" + , onInput SetNew1 + , value model.newPass1 + ] + [] + , button [ class "ui icon button", onClick ToggleShowPass1 ] + [ i [ class "eye icon" ] [] + ] + ] + ] + , div + [ classList + [ ( "field", True ) + , ( "error", model.newPass2 == "" ) + ] + ] + [ label [] [ text "New Password (repeat)*" ] + , div [ class "ui action input" ] + [ input + [ type_ <| + if model.showPass2 then + "text" + + else + "password" + , onInput SetNew2 + , value model.newPass2 + ] + [] + , button [ class "ui icon button", onClick ToggleShowPass2 ] + [ i [ class "eye icon" ] [] + ] + ] + ] + , div [ class "ui horizontal divider" ] [] + , div [ class "ui success message" ] + [ text model.successMsg + ] + , div [ class "ui error message" ] + [ case model.errors of + a :: [] -> + text a + + _ -> + ul [ class "ui list" ] + (List.map (\em -> li [] [ text em ]) model.errors) + ] + , div [ class "ui horizontal divider" ] [] + , button [ class "ui primary button", onClick Submit ] + [ text "Submit" + ] + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] ] ] diff --git a/modules/webapp/src/main/elm/Comp/ContactField.elm b/modules/webapp/src/main/elm/Comp/ContactField.elm index d5b5e3d1..3f97202e 100644 --- a/modules/webapp/src/main/elm/Comp/ContactField.elm +++ b/modules/webapp/src/main/elm/Comp/ContactField.elm @@ -1,40 +1,50 @@ -module Comp.ContactField exposing (Model - ,emptyModel - ,getContacts - ,Msg(..) - ,update - ,view - ) +module Comp.ContactField exposing + ( Model + , Msg(..) + , emptyModel + , getContacts + , update + , view + ) +import Api.Model.Contact exposing (Contact) +import Comp.Dropdown +import Data.ContactType exposing (ContactType) import Html exposing (..) import Html.Attributes exposing (..) -import Html.Events exposing (onInput, onClick) -import Api.Model.Contact exposing (Contact) -import Data.ContactType exposing (ContactType) -import Comp.Dropdown +import Html.Events exposing (onClick, onInput) + type alias Model = - { items: List Contact - , kind: Comp.Dropdown.Model ContactType - , value: String + { items : List Contact + , kind : Comp.Dropdown.Model ContactType + , value : String } -emptyModel: Model + +emptyModel : Model emptyModel = { items = [] - , kind = Comp.Dropdown.makeSingleList - { makeOption = \ct -> { value = Data.ContactType.toString ct, text = Data.ContactType.toString ct } - , placeholder = "" - , options = Data.ContactType.all - , selected = List.head Data.ContactType.all - } + , kind = + Comp.Dropdown.makeSingleList + { makeOption = + \ct -> + { value = Data.ContactType.toString ct + , text = Data.ContactType.toString ct + } + , placeholder = "" + , options = Data.ContactType.all + , selected = List.head Data.ContactType.all + } , value = "" } -getContacts: Model -> List Contact + +getContacts : Model -> List Contact getContacts model = List.filter (\c -> c.value /= "") model.items + type Msg = SetValue String | TypeMsg (Comp.Dropdown.Msg ContactType) @@ -42,76 +52,89 @@ type Msg | Select Contact | SetItems (List Contact) -update: Msg -> Model -> (Model, Cmd Msg) + +update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of SetItems contacts -> - ({model | items = contacts, value = "" }, Cmd.none) + ( { model | items = contacts, value = "" }, Cmd.none ) SetValue v -> - ({model | value = v}, Cmd.none) + ( { model | value = v }, Cmd.none ) TypeMsg m -> let - (m1, c1) = Comp.Dropdown.update m model.kind + ( m1, c1 ) = + Comp.Dropdown.update m model.kind in - ({model|kind = m1}, Cmd.map TypeMsg c1) + ( { model | kind = m1 }, Cmd.map TypeMsg c1 ) AddContact -> - if model.value == "" then (model, Cmd.none) + if model.value == "" then + ( model, Cmd.none ) + else let - kind = Comp.Dropdown.getSelected model.kind - |> List.head - |> Maybe.map Data.ContactType.toString - |> Maybe.withDefault "" + kind = + Comp.Dropdown.getSelected model.kind + |> List.head + |> Maybe.map Data.ContactType.toString + |> Maybe.withDefault "" in - ({model| items = (Contact "" model.value kind) :: model.items, value = ""}, Cmd.none) + ( { model | items = Contact "" model.value kind :: model.items, value = "" }, Cmd.none ) Select contact -> let - newItems = List.filter (\c -> c /= contact) model.items - (m1, c1) = Data.ContactType.fromString contact.kind - |> Maybe.map (\ct -> update (TypeMsg (Comp.Dropdown.SetSelection [ct])) model) - |> Maybe.withDefault (model, Cmd.none) - in - ({m1 | value = contact.value, items = newItems}, c1) + newItems = + List.filter (\c -> c /= contact) model.items -view: Model -> Html Msg + ( m1, c1 ) = + Data.ContactType.fromString contact.kind + |> Maybe.map (\ct -> update (TypeMsg (Comp.Dropdown.SetSelection [ ct ])) model) + |> Maybe.withDefault ( model, Cmd.none ) + in + ( { m1 | value = contact.value, items = newItems }, c1 ) + + +view : Model -> Html Msg view model = div [] - [div [class "fields"] - [div [class "four wide field"] - [Html.map TypeMsg (Comp.Dropdown.view model.kind) - ] - ,div [class "twelve wide field"] - [div [class "ui action input"] - [input [type_ "text" - ,onInput SetValue - ,value model.value - ][] - ,a [class "ui button", onClick AddContact, href ""] - [text "Add" - ] - ] - ] - ] - ,div [classList [("field", True) - ,("invisible", List.isEmpty model.items) + [ div [ class "fields" ] + [ div [ class "four wide field" ] + [ Html.map TypeMsg (Comp.Dropdown.view model.kind) + ] + , div [ class "twelve wide field" ] + [ div [ class "ui action input" ] + [ input + [ type_ "text" + , onInput SetValue + , value model.value ] - ] - [div [class "ui vertical secondary fluid menu"] - (List.map renderItem model.items) - ] - ] - - -renderItem: Contact -> Html Msg -renderItem contact = - div [class "link item", onClick (Select contact) ] - [i [class "delete icon"][] - ,div [class "ui blue label"] - [text contact.kind + [] + , a [ class "ui button", onClick AddContact, href "" ] + [ text "Add" + ] + ] + ] + ] + , div + [ classList + [ ( "field", True ) + , ( "invisible", List.isEmpty model.items ) + ] + ] + [ div [ class "ui vertical secondary fluid menu" ] + (List.map renderItem model.items) ] - ,text contact.value + ] + + +renderItem : Contact -> Html Msg +renderItem contact = + div [ class "link item", onClick (Select contact) ] + [ i [ class "delete icon" ] [] + , div [ class "ui blue label" ] + [ text contact.kind + ] + , text contact.value ] diff --git a/modules/webapp/src/main/elm/Comp/DatePicker.elm b/modules/webapp/src/main/elm/Comp/DatePicker.elm index a341d14f..fa459057 100644 --- a/modules/webapp/src/main/elm/Comp/DatePicker.elm +++ b/modules/webapp/src/main/elm/Comp/DatePicker.elm @@ -1,65 +1,94 @@ -module Comp.DatePicker exposing (..) +module Comp.DatePicker exposing + ( Msg + , defaultSettings + , emptyModel + , endOfDay + , init + , midOfDay + , startOfDay + , update + , updateDefault + , view + , viewTime + , viewTimeDefault + ) -import Html exposing (Html) -import DatePicker exposing (DatePicker, DateEvent, Settings) import Date exposing (Date) -import Time exposing (Posix, Zone, utc, Month(..)) +import DatePicker exposing (DateEvent, DatePicker, Settings) +import Html exposing (Html) +import Time exposing (Month(..), Posix, Zone, utc) -type alias Msg = DatePicker.Msg -init: (DatePicker, Cmd Msg) +type alias Msg = + DatePicker.Msg + + +init : ( DatePicker, Cmd Msg ) init = DatePicker.init -emptyModel: DatePicker + +emptyModel : DatePicker emptyModel = DatePicker.initFromDate (Date.fromCalendarDate 2019 Aug 21) -defaultSettings: Settings + +defaultSettings : Settings defaultSettings = let - ds = DatePicker.defaultSettings + ds = + DatePicker.defaultSettings in - {ds | changeYear = DatePicker.from 2010} + { ds | changeYear = DatePicker.from 2010 } -update: Settings -> Msg -> DatePicker -> (DatePicker, DateEvent) + +update : Settings -> Msg -> DatePicker -> ( DatePicker, DateEvent ) update settings msg model = DatePicker.update settings msg model -updateDefault: Msg -> DatePicker -> (DatePicker, DateEvent) + +updateDefault : Msg -> DatePicker -> ( DatePicker, DateEvent ) updateDefault msg model = DatePicker.update defaultSettings msg model view : Maybe Date -> Settings -> DatePicker -> Html Msg -view md settings model = +view md settings model = DatePicker.view md settings model + viewTime : Maybe Int -> Settings -> DatePicker -> Html Msg -viewTime md settings model = +viewTime md settings model = let - date = Maybe.map Time.millisToPosix md + date = + Maybe.map Time.millisToPosix md |> Maybe.map (Date.fromPosix Time.utc) in - view date settings model + view date settings model -viewTimeDefault: Maybe Int -> DatePicker -> Html Msg + +viewTimeDefault : Maybe Int -> DatePicker -> Html Msg viewTimeDefault md model = viewTime md defaultSettings model -startOfDay: Date -> Int +startOfDay : Date -> Int startOfDay date = let - unix0 = Date.fromPosix Time.utc (Time.millisToPosix 0) - days = Date.diff Date.Days unix0 date + unix0 = + Date.fromPosix Time.utc (Time.millisToPosix 0) + + days = + Date.diff Date.Days unix0 date in - days * 24 * 60 * 60 * 1000 + days * 24 * 60 * 60 * 1000 -endOfDay: Date -> Int + +endOfDay : Date -> Int endOfDay date = - (startOfDay date) + ((24 * 60) - 1) * 60 * 1000 + startOfDay date + ((24 * 60) - 1) * 60 * 1000 -midOfDay: Date -> Int + +midOfDay : Date -> Int midOfDay date = - (startOfDay date) + (12 * 60 * 60 * 1000) + startOfDay date + (12 * 60 * 60 * 1000) diff --git a/modules/webapp/src/main/elm/Comp/Dropdown.elm b/modules/webapp/src/main/elm/Comp/Dropdown.elm index dad3357d..99f44933 100644 --- a/modules/webapp/src/main/elm/Comp/Dropdown.elm +++ b/modules/webapp/src/main/elm/Comp/Dropdown.elm @@ -1,39 +1,41 @@ -module Comp.Dropdown exposing ( Model - , Option - , makeModel - , makeSingle - , makeSingleList - , makeMultiple - , update - , isDropdownChangeMsg - , view - , getSelected - , Msg(..)) +module Comp.Dropdown exposing + ( Model + , Msg(..) + , Option + , getSelected + , isDropdownChangeMsg + , makeModel + , makeMultiple + , makeSingle + , makeSingleList + , update + , view + ) -import Http -import Task import Html exposing (..) import Html.Attributes exposing (..) -import Html.Events exposing (onInput, onClick, onFocus, onBlur) -import Json.Decode as Decode +import Html.Events exposing (onClick, onInput) import Simple.Fuzzy import Util.Html exposing (onKeyUp) import Util.List + type alias Option = - { value: String - , text: String + { value : String + , text : String } + type alias Item a = - { value: a - , option: Option - , visible: Bool - , selected: Bool - , active: Bool + { value : a + , option : Option + , visible : Bool + , selected : Bool + , active : Bool } -makeItem: Model a -> a -> Item a + +makeItem : Model a -> a -> Item a makeItem model val = { value = val , option = model.makeOption val @@ -42,25 +44,28 @@ makeItem model val = , active = False } + type alias Model a = - { multiple: Bool - , selected: List (Item a) - , available: List (Item a) - , makeOption: a -> Option - , menuOpen: Bool - , filterString: String - , labelColor: a -> String - , searchable: Int -> Bool - , placeholder: String + { multiple : Bool + , selected : List (Item a) + , available : List (Item a) + , makeOption : a -> Option + , menuOpen : Bool + , filterString : String + , labelColor : a -> String + , searchable : Int -> Bool + , placeholder : String } -makeModel: - { multiple: Bool - , searchable: Int -> Bool - , makeOption: a -> Option - , labelColor: a -> String - , placeholder: String - } -> Model a + +makeModel : + { multiple : Bool + , searchable : Int -> Bool + , makeOption : a -> Option + , labelColor : a -> String + , placeholder : String + } + -> Model a makeModel input = { multiple = input.multiple , searchable = input.searchable @@ -73,10 +78,12 @@ makeModel input = , placeholder = input.placeholder } -makeSingle: - { makeOption: a -> Option - , placeholder: String - } -> Model a + +makeSingle : + { makeOption : a -> Option + , placeholder : String + } + -> Model a makeSingle opts = makeModel { multiple = False @@ -86,26 +93,35 @@ makeSingle opts = , placeholder = opts.placeholder } -makeSingleList: - { makeOption: a -> Option - , placeholder: String - , options: List a - , selected: Maybe a - } -> Model a + +makeSingleList : + { makeOption : a -> Option + , placeholder : String + , options : List a + , selected : Maybe a + } + -> Model a makeSingleList opts = let - m = makeSingle {makeOption = opts.makeOption, placeholder = opts.placeholder} - m2 = {m | available = List.map (makeItem m) opts.options} - m3 = Maybe.map (makeItem m2) opts.selected - |> Maybe.map (selectItem m2) - |> Maybe.withDefault m2 - in - m3 + m = + makeSingle { makeOption = opts.makeOption, placeholder = opts.placeholder } -makeMultiple: - { makeOption: a -> Option - , labelColor: a -> String - } -> Model a + m2 = + { m | available = List.map (makeItem m) opts.options } + + m3 = + Maybe.map (makeItem m2) opts.selected + |> Maybe.map (selectItem m2) + |> Maybe.withDefault m2 + in + m3 + + +makeMultiple : + { makeOption : a -> Option + , labelColor : a -> String + } + -> Model a makeMultiple opts = makeModel { multiple = True @@ -115,10 +131,12 @@ makeMultiple opts = , placeholder = "" } -getSelected: Model a -> List a + +getSelected : Model a -> List a getSelected model = List.map .value model.selected + type Msg a = SetOptions (List a) | SetSelection (List a) @@ -129,265 +147,367 @@ type Msg a | ShowMenu Bool | KeyPress Int -getOptions: Model a -> List (Item a) -getOptions model = - if not model.multiple && isSearchable model && model.menuOpen - then List.filter .visible model.available - else List.filter (\e -> e.visible && (not e.selected)) model.available -isSearchable: Model a -> Bool +getOptions : Model a -> List (Item a) +getOptions model = + if not model.multiple && isSearchable model && model.menuOpen then + List.filter .visible model.available + + else + List.filter (\e -> e.visible && not e.selected) model.available + + +isSearchable : Model a -> Bool isSearchable model = List.length model.available |> model.searchable + + -- Update -deselectItem: Model a -> Item a -> Model a + +deselectItem : Model a -> Item a -> Model a deselectItem model item = let - value = item.option.value - sel = if model.multiple then List.filter (\e -> e.option.value /= value) model.selected - else [] + value = + item.option.value - show e = if e.option.value == value then {e | selected = False } else e - avail = List.map show model.available + sel = + if model.multiple then + List.filter (\e -> e.option.value /= value) model.selected + + else + [] + + show e = + if e.option.value == value then + { e | selected = False } + + else + e + + avail = + List.map show model.available in - { model | selected = sel, available = avail } + { model | selected = sel, available = avail } -selectItem: Model a -> Item a -> Model a + +selectItem : Model a -> Item a -> Model a selectItem model item = let - value = item.option.value - sel = if model.multiple - then List.concat [ model.selected, [ item ] ] - else [ item ] + value = + item.option.value - hide e = if e.option.value == value - then {e | selected = True } - else if model.multiple then e else {e | selected = False} - avail = List.map hide model.available + sel = + if model.multiple then + List.concat [ model.selected, [ item ] ] + + else + [ item ] + + hide e = + if e.option.value == value then + { e | selected = True } + + else if model.multiple then + e + + else + { e | selected = False } + + avail = + List.map hide model.available in - { model | selected = sel, available = avail } + { model | selected = sel, available = avail } -filterOptions: String -> List (Item a) -> List (Item a) +filterOptions : String -> List (Item a) -> List (Item a) filterOptions str list = - List.map (\e -> {e | visible = Simple.Fuzzy.match str e.option.text, active = False}) list + List.map (\e -> { e | visible = Simple.Fuzzy.match str e.option.text, active = False }) list -applyFilter: String -> Model a -> Model a + +applyFilter : String -> Model a -> Model a applyFilter str model = { model | filterString = str, available = filterOptions str model.available } -makeNextActive: (Int -> Int) -> Model a -> Model a +makeNextActive : (Int -> Int) -> Model a -> Model a makeNextActive nextEl model = let - opts = getOptions model - current = Util.List.findIndexed .active opts - next = Maybe.map Tuple.second current - |> Maybe.map nextEl - |> Maybe.andThen (Util.List.get opts) - merge item1 item2 = { item2 | active = item1.option.value == item2.option.value } - updateModel item = { model | available = List.map (merge item) model.available, menuOpen = True } - in - case next of - Just item -> updateModel item - Nothing -> - case List.head opts of - Just item -> updateModel item - Nothing -> model + opts = + getOptions model -selectActive: Model a -> Model a + current = + Util.List.findIndexed .active opts + + next = + Maybe.map Tuple.second current + |> Maybe.map nextEl + |> Maybe.andThen (Util.List.get opts) + + merge item1 item2 = + { item2 | active = item1.option.value == item2.option.value } + + updateModel item = + { model | available = List.map (merge item) model.available, menuOpen = True } + in + case next of + Just item -> + updateModel item + + Nothing -> + case List.head opts of + Just item -> + updateModel item + + Nothing -> + model + + +selectActive : Model a -> Model a selectActive model = let - current = getOptions model |> Util.List.find .active + current = + getOptions model |> Util.List.find .active in - case current of - Just item -> - selectItem model item |> applyFilter "" - Nothing -> - model + case current of + Just item -> + selectItem model item |> applyFilter "" -clearActive: Model a -> Model a + Nothing -> + model + + +clearActive : Model a -> Model a clearActive model = - { model | available = List.map (\e -> {e | active = False}) model.available } + { model | available = List.map (\e -> { e | active = False }) model.available } + -- TODO enhance update function to return this info -isDropdownChangeMsg: Msg a -> Bool + + +isDropdownChangeMsg : Msg a -> Bool isDropdownChangeMsg cm = case cm of - AddItem _ -> True - RemoveItem _ -> True + AddItem _ -> + True + + RemoveItem _ -> + True + KeyPress code -> - Util.Html.intToKeyCode code - |> Maybe.map (\c -> c == Util.Html.Enter) - |> Maybe.withDefault False - _ -> False + Util.Html.intToKeyCode code + |> Maybe.map (\c -> c == Util.Html.Enter) + |> Maybe.withDefault False + + _ -> + False -update: Msg a -> Model a -> (Model a, Cmd (Msg a)) +update : Msg a -> Model a -> ( Model a, Cmd (Msg a) ) update msg model = case msg of SetOptions list -> - ({model | available = List.map (makeItem model) list}, Cmd.none) + ( { model | available = List.map (makeItem model) list }, Cmd.none ) SetSelection list -> let - m0 = List.foldl (\item -> \m -> deselectItem m item) model model.selected - m1 = List.map (makeItem model) list - |> List.foldl (\item -> \m -> selectItem m item) m0 + m0 = + List.foldl (\item -> \m -> deselectItem m item) model model.selected + + m1 = + List.map (makeItem model) list + |> List.foldl (\item -> \m -> selectItem m item) m0 in - (m1, Cmd.none) + ( m1, Cmd.none ) ToggleMenu -> - ({model | menuOpen = not model.menuOpen}, Cmd.none) + ( { model | menuOpen = not model.menuOpen }, Cmd.none ) AddItem e -> let - m = selectItem model e |> applyFilter "" + m = + selectItem model e |> applyFilter "" in - ({ m | menuOpen = False }, Cmd.none) + ( { m | menuOpen = False }, Cmd.none ) RemoveItem e -> let - m = deselectItem model e |> applyFilter "" + m = + deselectItem model e |> applyFilter "" in - ({ m | menuOpen = False }, Cmd.none) + ( { m | menuOpen = False }, Cmd.none ) Filter str -> let - m = applyFilter str model + m = + applyFilter str model in - ({ m | menuOpen = True}, Cmd.none) + ( { m | menuOpen = True }, Cmd.none ) ShowMenu flag -> - ({ model | menuOpen = flag }, Cmd.none) + ( { model | menuOpen = flag }, Cmd.none ) KeyPress code -> case Util.Html.intToKeyCode code of Just Util.Html.Up -> - (makeNextActive (\n -> n - 1) model, Cmd.none) + ( makeNextActive (\n -> n - 1) model, Cmd.none ) + Just Util.Html.Down -> - (makeNextActive ((+) 1) model, Cmd.none) + ( makeNextActive ((+) 1) model, Cmd.none ) + Just Util.Html.Enter -> let - m = selectActive model + m = + selectActive model in - ({m | menuOpen = False }, Cmd.none) + ( { m | menuOpen = False }, Cmd.none ) + _ -> - (model, Cmd.none) + ( model, Cmd.none ) + -- View -view: Model a -> Html (Msg a) + +view : Model a -> Html (Msg a) view model = - if model.multiple then viewMultiple model else viewSingle model + if model.multiple then + viewMultiple model + + else + viewSingle model -viewSingle: Model a -> Html (Msg a) +viewSingle : Model a -> Html (Msg a) viewSingle model = let renderClosed item = - div [class "message" - ,style "display" "inline-block !important" - ,onClick ToggleMenu + div + [ class "message" + , style "display" "inline-block !important" + , onClick ToggleMenu ] - [i [class "delete icon", onClick (RemoveItem item)][] - ,text item.option.text + [ i [ class "delete icon", onClick (RemoveItem item) ] [] + , text item.option.text ] + renderDefault = [ List.head model.selected |> Maybe.map renderClosed |> Maybe.withDefault (renderPlaceholder model) , renderMenu model ] - openSearch = - [ input [ class "search" + [ input + [ class "search" + , placeholder "Search…" + , onInput Filter + , onKeyUp KeyPress + , value model.filterString + ] + [] + , renderMenu model + ] + in + div + [ classList + [ ( "ui search dropdown selection", True ) + , ( "open", model.menuOpen ) + ] + ] + (List.append + [ i [ class "dropdown icon", onClick ToggleMenu ] [] + ] + <| + if model.menuOpen && isSearchable model then + openSearch + + else + renderDefault + ) + + +viewMultiple : Model a -> Html (Msg a) +viewMultiple model = + let + renderSelectMultiple : Item a -> Html (Msg a) + renderSelectMultiple item = + div + [ classList + [ ( "ui label", True ) + , ( model.labelColor item.value, True ) + ] + , style "display" "inline-block !important" + , onClick (RemoveItem item) + ] + [ text item.option.text + , i [ class "delete icon" ] [] + ] + in + div + [ classList + [ ( "ui search dropdown multiple selection", True ) + , ( "open", model.menuOpen ) + ] + ] + (List.concat + [ [ i [ class "dropdown icon", onClick ToggleMenu ] [] + ] + , List.map renderSelectMultiple model.selected + , if isSearchable model then + [ input + [ class "search" , placeholder "Search…" , onInput Filter , onKeyUp KeyPress , value model.filterString - ][] - , renderMenu model - ] - in - div [classList [ ("ui search dropdown selection", True) - , ("open", model.menuOpen) - ] - ] - (List.append [ i [class "dropdown icon", onClick ToggleMenu][] - ] <| - if model.menuOpen && isSearchable model - then openSearch - else renderDefault - ) - - -viewMultiple: Model a -> Html (Msg a) -viewMultiple model = - let - renderSelectMultiple: Item a -> Html (Msg a) - renderSelectMultiple item = - div [classList [ ("ui label", True) - , (model.labelColor item.value, True) - ] - ,style "display" "inline-block !important" - ,onClick (RemoveItem item) + ] + [] ] - [text item.option.text - ,i [class "delete icon"][] - ] - in - div [classList [ ("ui search dropdown multiple selection", True) - , ("open", model.menuOpen) - ] - ] - (List.concat - [ [i [class "dropdown icon", onClick ToggleMenu][] - ] - , List.map renderSelectMultiple model.selected - , if isSearchable model then - [ input [ class "search" - , placeholder "Search…" - , onInput Filter - , onKeyUp KeyPress - , value model.filterString - ][] - ] - else [] - , [ renderMenu model - ] - ]) -renderMenu: Model a -> Html (Msg a) + else + [] + , [ renderMenu model + ] + ] + ) + + +renderMenu : Model a -> Html (Msg a) renderMenu model = - div [classList [( "menu", True ) - ,( "transition visible", model.menuOpen ) - ] - ] (getOptions model |> List.map renderOption) + div + [ classList + [ ( "menu", True ) + , ( "transition visible", model.menuOpen ) + ] + ] + (getOptions model |> List.map renderOption) - - - -renderPlaceholder: Model a -> Html (Msg a) +renderPlaceholder : Model a -> Html (Msg a) renderPlaceholder model = - div [classList [ ("placeholder-message", True) - , ("text", model.multiple) - ] - ,style "display" "inline-block !important" - ,onClick ToggleMenu + div + [ classList + [ ( "placeholder-message", True ) + , ( "text", model.multiple ) + ] + , style "display" "inline-block !important" + , onClick ToggleMenu + ] + [ text model.placeholder ] - [text model.placeholder - ] -renderOption: Item a -> Html (Msg a) + +renderOption : Item a -> Html (Msg a) renderOption item = - div [classList [ ("item", True) - , ("active", item.active || item.selected) - ] - ,onClick (AddItem item) + div + [ classList + [ ( "item", True ) + , ( "active", item.active || item.selected ) + ] + , onClick (AddItem item) ] - [text item.option.text + [ text item.option.text ] diff --git a/modules/webapp/src/main/elm/Comp/Dropzone.elm b/modules/webapp/src/main/elm/Comp/Dropzone.elm index 84a04a38..3ef12443 100644 --- a/modules/webapp/src/main/elm/Comp/Dropzone.elm +++ b/modules/webapp/src/main/elm/Comp/Dropzone.elm @@ -1,48 +1,57 @@ -- inspired from here: https://ellie-app.com/3T5mNms7SwKa1 -module Comp.Dropzone exposing ( view - , Settings - , defaultSettings - , update - , setActive - , Model - , init - , Msg(..) - ) + + +module Comp.Dropzone exposing + ( Model + , Msg(..) + , Settings + , defaultSettings + , init + , setActive + , update + , view + ) + import File exposing (File) import File.Select -import Json.Decode as D import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Json.Decode as D + type alias State = - { hover: Bool - , active: Bool + { hover : Bool + , active : Bool } type alias Settings = - { classList: State -> List (String, Bool) - , contentTypes: List String + { classList : State -> List ( String, Bool ) + , contentTypes : List String } -defaultSettings: Settings + +defaultSettings : Settings defaultSettings = - { classList = \m -> [("ui placeholder segment", True)] + { classList = \_ -> [ ( "ui placeholder segment", True ) ] , contentTypes = [ "application/pdf" ] } + type alias Model = - { state: State - , settings: Settings + { state : State + , settings : Settings } -init: Settings -> Model + +init : Settings -> Model init settings = { state = State False True , settings = settings } + type Msg = DragEnter | DragLeave @@ -50,45 +59,55 @@ type Msg | PickFiles | SetActive Bool -setActive: Bool -> Msg + +setActive : Bool -> Msg setActive flag = SetActive flag -update: Msg -> Model -> (Model, Cmd Msg, List File) + +update : Msg -> Model -> ( Model, Cmd Msg, List File ) update msg model = case msg of SetActive flag -> let - ns = { hover = model.state.hover, active = flag } + ns = + { hover = model.state.hover, active = flag } in - ({ model | state = ns }, Cmd.none, []) + ( { model | state = ns }, Cmd.none, [] ) PickFiles -> - (model, File.Select.files model.settings.contentTypes GotFiles, []) + ( model, File.Select.files model.settings.contentTypes GotFiles, [] ) DragEnter -> let - ns = {hover = True, active = model.state.active} + ns = + { hover = True, active = model.state.active } in - ({model| state = ns}, Cmd.none, []) + ( { model | state = ns }, Cmd.none, [] ) DragLeave -> let - ns = {hover = False, active = model.state.active} + ns = + { hover = False, active = model.state.active } in - ({model | state = ns}, Cmd.none, []) + ( { model | state = ns }, Cmd.none, [] ) GotFiles file files -> let - ns = {hover = False, active = model.state.active} - newFiles = if model.state.active then filterMime model.settings (file :: files) - else [] + ns = + { hover = False, active = model.state.active } + + newFiles = + if model.state.active then + filterMime model.settings (file :: files) + + else + [] in - ({model | state = ns}, Cmd.none, newFiles) + ( { model | state = ns }, Cmd.none, newFiles ) - -view: Model -> Html Msg +view : Model -> Html Msg view model = div [ classList (model.settings.classList model.state) @@ -97,46 +116,51 @@ view model = , hijackOn "dragleave" (D.succeed DragLeave) , hijackOn "drop" dropDecoder ] - [div [class "ui icon header"] - [i [class "mouse pointer icon"][] - ,div [class "content"] - [text "Drop files here" - ,div [class "sub header"] - [text "PDF files only" - ] - ] - ] - ,div [class "ui horizontal divider"] - [text "Or" + [ div [ class "ui icon header" ] + [ i [ class "mouse pointer icon" ] [] + , div [ class "content" ] + [ text "Drop files here" + , div [ class "sub header" ] + [ text "PDF files only" + ] + ] + ] + , div [ class "ui horizontal divider" ] + [ text "Or" + ] + , a + [ classList + [ ( "ui basic primary button", True ) + , ( "disabled", not model.state.active ) + ] + , onClick PickFiles + , href "" + ] + [ i [ class "folder open icon" ] [] + , text "Select ..." ] - ,a [classList [("ui basic primary button", True) - ,("disabled", not model.state.active) - ] - , onClick PickFiles - , href ""] - [i [class "folder open icon"][] - ,text "Select ..." - ] ] -filterMime: Settings -> List File -> List File + +filterMime : Settings -> List File -> List File filterMime settings files = let pred f = List.member (File.mime f) settings.contentTypes in - List.filter pred files + List.filter pred files + dropDecoder : D.Decoder Msg dropDecoder = - D.at ["dataTransfer","files"] (D.oneOrMore GotFiles File.decoder) + D.at [ "dataTransfer", "files" ] (D.oneOrMore GotFiles File.decoder) hijackOn : String -> D.Decoder msg -> Attribute msg hijackOn event decoder = - preventDefaultOn event (D.map hijack decoder) + preventDefaultOn event (D.map hijack decoder) -hijack : msg -> (msg, Bool) +hijack : msg -> ( msg, Bool ) hijack msg = - (msg, True) + ( msg, True ) diff --git a/modules/webapp/src/main/elm/Comp/EquipmentForm.elm b/modules/webapp/src/main/elm/Comp/EquipmentForm.elm index a57fcd0c..c079bba8 100644 --- a/modules/webapp/src/main/elm/Comp/EquipmentForm.elm +++ b/modules/webapp/src/main/elm/Comp/EquipmentForm.elm @@ -1,62 +1,74 @@ -module Comp.EquipmentForm exposing ( Model - , emptyModel - , Msg(..) - , view - , update - , isValid - , getEquipment) +module Comp.EquipmentForm exposing + ( Model + , Msg(..) + , emptyModel + , getEquipment + , isValid + , update + , view + ) +import Api.Model.Equipment exposing (Equipment) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onInput) -import Data.Flags exposing (Flags) -import Api.Model.Equipment exposing (Equipment) + type alias Model = - { equipment: Equipment - , name: String + { equipment : Equipment + , name : String } -emptyModel: Model + +emptyModel : Model emptyModel = { equipment = Api.Model.Equipment.empty , name = "" } -isValid: Model -> Bool + +isValid : Model -> Bool isValid model = model.name /= "" -getEquipment: Model -> Equipment + +getEquipment : Model -> Equipment getEquipment model = Equipment model.equipment.id model.name model.equipment.created + type Msg = SetName String | SetEquipment Equipment -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetEquipment t -> - ({model | equipment = t, name = t.name }, Cmd.none) + ( { model | equipment = t, name = t.name }, Cmd.none ) SetName n -> - ({model | name = n}, Cmd.none) + ( { model | name = n }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - div [class "ui form"] - [div [classList [("field", True) - ,("error", not (isValid model)) - ] - ] - [label [][text "Name*"] - ,input [type_ "text" - ,onInput SetName - ,placeholder "Name" - ,value model.name - ][] - ] + div [ class "ui form" ] + [ div + [ classList + [ ( "field", True ) + , ( "error", not (isValid model) ) + ] + ] + [ label [] [ text "Name*" ] + , input + [ type_ "text" + , onInput SetName + , placeholder "Name" + , value model.name + ] + [] + ] ] diff --git a/modules/webapp/src/main/elm/Comp/EquipmentManage.elm b/modules/webapp/src/main/elm/Comp/EquipmentManage.elm index caf1a8e9..6ab700f6 100644 --- a/modules/webapp/src/main/elm/Comp/EquipmentManage.elm +++ b/modules/webapp/src/main/elm/Comp/EquipmentManage.elm @@ -1,36 +1,43 @@ -module Comp.EquipmentManage exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.EquipmentManage exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) -import Http import Api +import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.Equipment +import Api.Model.EquipmentList exposing (EquipmentList) +import Comp.EquipmentForm +import Comp.EquipmentTable +import Comp.YesNoDimmer +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick, onSubmit) -import Data.Flags exposing (Flags) -import Comp.EquipmentTable -import Comp.EquipmentForm -import Comp.YesNoDimmer -import Api.Model.Equipment -import Api.Model.EquipmentList exposing (EquipmentList) -import Api.Model.BasicResult exposing (BasicResult) -import Util.Maybe +import Http import Util.Http +import Util.Maybe + type alias Model = - { tableModel: Comp.EquipmentTable.Model - , formModel: Comp.EquipmentForm.Model - , viewMode: ViewMode - , formError: Maybe String - , loading: Bool - , deleteConfirm: Comp.YesNoDimmer.Model + { tableModel : Comp.EquipmentTable.Model + , formModel : Comp.EquipmentForm.Model + , viewMode : ViewMode + , formError : Maybe String + , loading : Bool + , deleteConfirm : Comp.YesNoDimmer.Model } -type ViewMode = Table | Form -emptyModel: Model +type ViewMode + = Table + | Form + + +emptyModel : Model emptyModel = { tableModel = Comp.EquipmentTable.emptyModel , formModel = Comp.EquipmentForm.emptyModel @@ -40,6 +47,7 @@ emptyModel = , deleteConfirm = Comp.YesNoDimmer.emptyModel } + type Msg = TableMsg Comp.EquipmentTable.Msg | FormMsg Comp.EquipmentForm.Msg @@ -52,155 +60,210 @@ type Msg | YesNoMsg Comp.YesNoDimmer.Msg | RequestDelete -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of TableMsg m -> let - (tm, tc) = Comp.EquipmentTable.update flags m model.tableModel - (m2, c2) = ({model | tableModel = tm - , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table - , formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError - } - , Cmd.map TableMsg tc - ) - (m3, c3) = case tm.selected of + ( tm, tc ) = + Comp.EquipmentTable.update flags m model.tableModel + + ( m2, c2 ) = + ( { model + | tableModel = tm + , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table + , formError = + if Util.Maybe.nonEmpty tm.selected then + Nothing + + else + model.formError + } + , Cmd.map TableMsg tc + ) + + ( m3, c3 ) = + case tm.selected of Just equipment -> update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) m2 + Nothing -> - (m2, Cmd.none) + ( m2, Cmd.none ) in - (m3, Cmd.batch [c2, c3]) + ( m3, Cmd.batch [ c2, c3 ] ) FormMsg m -> let - (m2, c2) = Comp.EquipmentForm.update flags m model.formModel + ( m2, c2 ) = + Comp.EquipmentForm.update flags m model.formModel in - ({model | formModel = m2}, Cmd.map FormMsg c2) + ( { model | formModel = m2 }, Cmd.map FormMsg c2 ) LoadEquipments -> - ({model| loading = True}, Api.getEquipments flags EquipmentResp) + ( { model | loading = True }, Api.getEquipments flags EquipmentResp ) EquipmentResp (Ok equipments) -> let - m2 = {model|viewMode = Table, loading = False} + m2 = + { model | viewMode = Table, loading = False } in - update flags (TableMsg (Comp.EquipmentTable.SetEquipments equipments.items)) m2 + update flags (TableMsg (Comp.EquipmentTable.SetEquipments equipments.items)) m2 - EquipmentResp (Err err) -> - ({model|loading = False}, Cmd.none) + EquipmentResp (Err _) -> + ( { model | loading = False }, Cmd.none ) SetViewMode m -> let - m2 = {model | viewMode = m } + m2 = + { model | viewMode = m } in - case m of - Table -> - update flags (TableMsg Comp.EquipmentTable.Deselect) m2 - Form -> - (m2, Cmd.none) + case m of + Table -> + update flags (TableMsg Comp.EquipmentTable.Deselect) m2 + + Form -> + ( m2, Cmd.none ) InitNewEquipment -> let - nm = {model | viewMode = Form, formError = Nothing } - equipment = Api.Model.Equipment.empty + nm = + { model | viewMode = Form, formError = Nothing } + + equipment = + Api.Model.Equipment.empty in - update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) nm + update flags (FormMsg (Comp.EquipmentForm.SetEquipment equipment)) nm Submit -> let - equipment = Comp.EquipmentForm.getEquipment model.formModel - valid = Comp.EquipmentForm.isValid model.formModel - in if valid then - ({model|loading = True}, Api.postEquipment flags equipment SubmitResp) - else - ({model|formError = Just "Please correct the errors in the form."}, Cmd.none) + equipment = + Comp.EquipmentForm.getEquipment model.formModel + + valid = + Comp.EquipmentForm.isValid model.formModel + in + if valid then + ( { model | loading = True }, Api.postEquipment flags equipment SubmitResp ) + + else + ( { model | formError = Just "Please correct the errors in the form." }, Cmd.none ) SubmitResp (Ok res) -> if res.success then let - (m2, c2) = update flags (SetViewMode Table) model - (m3, c3) = update flags LoadEquipments m2 + ( m2, c2 ) = + update flags (SetViewMode Table) model + + ( m3, c3 ) = + update flags LoadEquipments m2 in - ({m3|loading = False}, Cmd.batch [c2,c3]) + ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] ) + else - ({model | formError = Just res.message, loading = False }, Cmd.none) + ( { model | formError = Just res.message, loading = False }, Cmd.none ) SubmitResp (Err err) -> - ({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none) + ( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none ) RequestDelete -> update flags (YesNoMsg Comp.YesNoDimmer.activate) model YesNoMsg m -> let - (cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm - equip = Comp.EquipmentForm.getEquipment model.formModel - cmd = if confirmed then Api.deleteEquip flags equip.id SubmitResp else Cmd.none + ( cm, confirmed ) = + Comp.YesNoDimmer.update m model.deleteConfirm + + equip = + Comp.EquipmentForm.getEquipment model.formModel + + cmd = + if confirmed then + Api.deleteEquip flags equip.id SubmitResp + + else + Cmd.none in - ({model | deleteConfirm = cm}, cmd) + ( { model | deleteConfirm = cm }, cmd ) -view: Model -> Html Msg + +view : Model -> Html Msg view model = - if model.viewMode == Table then viewTable model - else viewForm model + if model.viewMode == Table then + viewTable model -viewTable: Model -> Html Msg + else + viewForm model + + +viewTable : Model -> Html Msg viewTable model = div [] - [button [class "ui basic button", onClick InitNewEquipment] - [i [class "plus icon"][] - ,text "Create new" - ] - ,Html.map TableMsg (Comp.EquipmentTable.view model.tableModel) - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] + [ button [ class "ui basic button", onClick InitNewEquipment ] + [ i [ class "plus icon" ] [] + , text "Create new" + ] + , Html.map TableMsg (Comp.EquipmentTable.view model.tableModel) + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] ] ] -viewForm: Model -> Html Msg + +viewForm : Model -> Html Msg viewForm model = let - newEquipment = model.formModel.equipment.id == "" + newEquipment = + model.formModel.equipment.id == "" in - Html.form [class "ui segment", onSubmit Submit] - [Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) - ,if newEquipment then - h3 [class "ui dividing header"] - [text "Create new equipment" - ] - else - h3 [class "ui dividing header"] - [text ("Edit equipment: " ++ model.formModel.equipment.name) - ,div [class "sub header"] - [text "Id: " - ,text model.formModel.equipment.id - ] - ] - ,Html.map FormMsg (Comp.EquipmentForm.view model.formModel) - ,div [classList [("ui error message", True) - ,("invisible", Util.Maybe.isEmpty model.formError) - ] - ] - [Maybe.withDefault "" model.formError |> text - ] - ,div [class "ui horizontal divider"][] - ,button [class "ui primary button", type_ "submit"] - [text "Submit" + Html.form [ class "ui segment", onSubmit Submit ] + [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) + , if newEquipment then + h3 [ class "ui dividing header" ] + [ text "Create new equipment" ] - ,a [class "ui secondary button", onClick (SetViewMode Table), href ""] - [text "Cancel" + + else + h3 [ class "ui dividing header" ] + [ text ("Edit equipment: " ++ model.formModel.equipment.name) + , div [ class "sub header" ] + [ text "Id: " + , text model.formModel.equipment.id + ] + ] + , Html.map FormMsg (Comp.EquipmentForm.view model.formModel) + , div + [ classList + [ ( "ui error message", True ) + , ( "invisible", Util.Maybe.isEmpty model.formError ) ] - ,if not newEquipment then - a [class "ui right floated red button", href "", onClick RequestDelete] - [text "Delete"] - else - span[][] - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] - ] ] + [ Maybe.withDefault "" model.formError |> text + ] + , div [ class "ui horizontal divider" ] [] + , button [ class "ui primary button", type_ "submit" ] + [ text "Submit" + ] + , a [ class "ui secondary button", onClick (SetViewMode Table), href "" ] + [ text "Cancel" + ] + , if not newEquipment then + a [ class "ui right floated red button", href "", onClick RequestDelete ] + [ text "Delete" ] + + else + span [] [] + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] + ] + ] diff --git a/modules/webapp/src/main/elm/Comp/EquipmentTable.elm b/modules/webapp/src/main/elm/Comp/EquipmentTable.elm index c78a5f49..c72dd898 100644 --- a/modules/webapp/src/main/elm/Comp/EquipmentTable.elm +++ b/modules/webapp/src/main/elm/Comp/EquipmentTable.elm @@ -1,62 +1,70 @@ -module Comp.EquipmentTable exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.EquipmentTable exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) +import Api.Model.Equipment exposing (Equipment) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Data.Flags exposing (Flags) -import Api.Model.Equipment exposing (Equipment) + type alias Model = - { equips: List Equipment - , selected: Maybe Equipment + { equips : List Equipment + , selected : Maybe Equipment } -emptyModel: Model + +emptyModel : Model emptyModel = { equips = [] , selected = Nothing } + type Msg = SetEquipments (List Equipment) | Select Equipment | Deselect -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetEquipments list -> - ({model | equips = list, selected = Nothing }, Cmd.none) + ( { model | equips = list, selected = Nothing }, Cmd.none ) Select equip -> - ({model | selected = Just equip}, Cmd.none) + ( { model | selected = Just equip }, Cmd.none ) Deselect -> - ({model | selected = Nothing}, Cmd.none) + ( { model | selected = Nothing }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - table [class "ui selectable table"] - [thead [] - [tr [] - [th [][text "Name"] - ] - ] - ,tbody [] + table [ class "ui selectable table" ] + [ thead [] + [ tr [] + [ th [] [ text "Name" ] + ] + ] + , tbody [] (List.map (renderEquipmentLine model) model.equips) ] -renderEquipmentLine: Model -> Equipment -> Html Msg + +renderEquipmentLine : Model -> Equipment -> Html Msg renderEquipmentLine model equip = - tr [classList [("active", model.selected == Just equip)] - ,onClick (Select equip) - ] - [td [] - [text equip.name - ] + tr + [ classList [ ( "active", model.selected == Just equip ) ] + , onClick (Select equip) + ] + [ td [] + [ text equip.name + ] ] diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail.elm b/modules/webapp/src/main/elm/Comp/ItemDetail.elm index 5510b9d9..665c7a20 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail.elm +++ b/modules/webapp/src/main/elm/Comp/ItemDetail.elm @@ -1,92 +1,106 @@ -module Comp.ItemDetail exposing ( Model - , emptyModel - , Msg(..) - , UserNav(..) - , update - , view - ) +module Comp.ItemDetail exposing + ( Model + , Msg(..) + , UserNav(..) + , emptyModel + , update + , view + ) import Api -import Http +import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.DirectionValue exposing (DirectionValue) +import Api.Model.EquipmentList exposing (EquipmentList) +import Api.Model.IdName exposing (IdName) +import Api.Model.ItemDetail exposing (ItemDetail) +import Api.Model.ItemProposals exposing (ItemProposals) +import Api.Model.OptionalDate exposing (OptionalDate) +import Api.Model.OptionalId exposing (OptionalId) +import Api.Model.OptionalText exposing (OptionalText) +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 Comp.YesNoDimmer +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 (onClick, onInput) -import Comp.Dropdown exposing (isDropdownChangeMsg) -import Comp.YesNoDimmer -import Comp.DatePicker -import DatePicker exposing (DatePicker) -import Data.Flags exposing (Flags) -import Data.Direction exposing (Direction) -import Api.Model.ItemDetail exposing (ItemDetail) -import Api.Model.Tag exposing (Tag) -import Api.Model.TagList exposing (TagList) -import Api.Model.BasicResult exposing (BasicResult) -import Api.Model.ReferenceList exposing (ReferenceList) -import Api.Model.IdName exposing (IdName) -import Api.Model.DirectionValue exposing (DirectionValue) -import Api.Model.OptionalId exposing (OptionalId) -import Api.Model.OptionalText exposing (OptionalText) -import Api.Model.OptionalDate exposing (OptionalDate) -import Api.Model.EquipmentList exposing (EquipmentList) -import Api.Model.ItemProposals exposing (ItemProposals) -import Util.Time -import Util.String -import Util.Maybe -import Util.Html -import Util.Size +import Http import Markdown +import Util.Maybe +import Util.Size +import Util.String +import Util.Time + type alias Model = - { item: ItemDetail - , visibleAttach: Int - , menuOpen: Bool - , tagModel: Comp.Dropdown.Model Tag - , directionModel: Comp.Dropdown.Model Direction - , corrOrgModel: Comp.Dropdown.Model IdName - , corrPersonModel: Comp.Dropdown.Model IdName - , concPersonModel: Comp.Dropdown.Model IdName - , concEquipModel: Comp.Dropdown.Model IdName - , nameModel: String - , notesModel: Maybe String - , deleteConfirm: Comp.YesNoDimmer.Model - , itemDatePicker: DatePicker - , itemDate: Maybe Int - , itemProposals: ItemProposals - , dueDate: Maybe Int - , dueDatePicker: DatePicker + { item : ItemDetail + , visibleAttach : Int + , menuOpen : Bool + , tagModel : Comp.Dropdown.Model Tag + , directionModel : Comp.Dropdown.Model Direction + , corrOrgModel : Comp.Dropdown.Model IdName + , corrPersonModel : Comp.Dropdown.Model IdName + , concPersonModel : Comp.Dropdown.Model IdName + , concEquipModel : Comp.Dropdown.Model IdName + , nameModel : String + , notesModel : Maybe String + , deleteConfirm : Comp.YesNoDimmer.Model + , itemDatePicker : DatePicker + , itemDate : Maybe Int + , itemProposals : ItemProposals + , dueDate : Maybe Int + , dueDatePicker : DatePicker } -emptyModel: Model + +emptyModel : Model emptyModel = { item = Api.Model.ItemDetail.empty , visibleAttach = 0 , menuOpen = False - , tagModel = Comp.Dropdown.makeMultiple - { makeOption = \tag -> { value = tag.id, text = tag.name } - , labelColor = \tag -> if Util.Maybe.nonEmpty tag.category then "basic blue" else "" - } - , directionModel = Comp.Dropdown.makeSingleList - { makeOption = \entry -> {value = Data.Direction.toString entry, text = Data.Direction.toString entry} - , options = Data.Direction.all - , placeholder = "Choose a direction…" - , selected = Nothing - } - , corrOrgModel = Comp.Dropdown.makeSingle - { makeOption = \e -> {value = e.id, text = e.name} - , placeholder = "" - } - , corrPersonModel = Comp.Dropdown.makeSingle - { makeOption = \e -> {value = e.id, text = e.name} - , placeholder = "" - } - , concPersonModel = Comp.Dropdown.makeSingle - { makeOption = \e -> {value = e.id, text = e.name} - , placeholder = "" - } - , concEquipModel = Comp.Dropdown.makeSingle - { makeOption = \e -> {value = e.id, text = e.name} - , placeholder = "" - } + , tagModel = + Comp.Dropdown.makeMultiple + { makeOption = \tag -> { value = tag.id, text = tag.name } + , labelColor = + \tag -> + if Util.Maybe.nonEmpty tag.category then + "basic blue" + + else + "" + } + , directionModel = + Comp.Dropdown.makeSingleList + { makeOption = \entry -> { value = Data.Direction.toString entry, text = Data.Direction.toString entry } + , options = Data.Direction.all + , placeholder = "Choose a direction…" + , selected = Nothing + } + , corrOrgModel = + Comp.Dropdown.makeSingle + { makeOption = \e -> { value = e.id, text = e.name } + , placeholder = "" + } + , corrPersonModel = + Comp.Dropdown.makeSingle + { makeOption = \e -> { value = e.id, text = e.name } + , placeholder = "" + } + , concPersonModel = + Comp.Dropdown.makeSingle + { makeOption = \e -> { value = e.id, text = e.name } + , placeholder = "" + } + , concEquipModel = + Comp.Dropdown.makeSingle + { makeOption = \e -> { value = e.id, text = e.name } + , placeholder = "" + } , nameModel = "" , notesModel = Nothing , deleteConfirm = Comp.YesNoDimmer.emptyModel @@ -97,12 +111,19 @@ emptyModel = , dueDatePicker = Comp.DatePicker.emptyModel } -type UserNav - = NavBack | NavPrev | NavNext | NavNone | NavNextOrBack -noNav: (Model, Cmd Msg) -> (Model, Cmd Msg, UserNav) -noNav (model, cmd) = - (model, cmd, NavNone) +type UserNav + = NavBack + | NavPrev + | NavNext + | NavNone + | NavNextOrBack + + +noNav : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, UserNav ) +noNav ( model, cmd ) = + ( model, cmd, NavNone ) + type Msg = ToggleMenu @@ -145,9 +166,11 @@ type Msg | RemoveDate + -- update -getOptions: Flags -> Cmd Msg + +getOptions : Flags -> Cmd Msg getOptions flags = Cmd.batch [ Api.getTags flags GetTagsResp @@ -156,678 +179,962 @@ getOptions flags = , Api.getEquipments flags GetEquipResp ] -saveTags: Flags -> Model -> Cmd Msg + +saveTags : Flags -> Model -> Cmd Msg saveTags flags model = let - tags = Comp.Dropdown.getSelected model.tagModel - |> List.map (\t -> IdName t.id t.name) - |> ReferenceList + tags = + Comp.Dropdown.getSelected model.tagModel + |> List.map (\t -> IdName t.id t.name) + |> ReferenceList in - Api.setTags flags model.item.id tags SaveResp + Api.setTags flags model.item.id tags SaveResp -setDirection: Flags -> Model -> Cmd Msg + +setDirection : Flags -> Model -> Cmd Msg setDirection flags model = let - dir = Comp.Dropdown.getSelected model.directionModel |> List.head + dir = + Comp.Dropdown.getSelected model.directionModel |> List.head in - case dir of - Just d -> - Api.setDirection flags model.item.id (DirectionValue (Data.Direction.toString d)) SaveResp - Nothing -> - Cmd.none + case dir of + Just d -> + Api.setDirection flags model.item.id (DirectionValue (Data.Direction.toString d)) SaveResp -setCorrOrg: Flags -> Model -> Maybe IdName -> Cmd Msg + Nothing -> + Cmd.none + + +setCorrOrg : Flags -> Model -> Maybe IdName -> Cmd Msg setCorrOrg flags model mref = let - idref = Maybe.map .id mref - |> OptionalId + idref = + Maybe.map .id mref + |> OptionalId in - Api.setCorrOrg flags model.item.id idref SaveResp + Api.setCorrOrg flags model.item.id idref SaveResp -setCorrPerson: Flags -> Model -> Maybe IdName -> Cmd Msg + +setCorrPerson : Flags -> Model -> Maybe IdName -> Cmd Msg setCorrPerson flags model mref = let - idref = Maybe.map .id mref - |> OptionalId + idref = + Maybe.map .id mref + |> OptionalId in - Api.setCorrPerson flags model.item.id idref SaveResp + Api.setCorrPerson flags model.item.id idref SaveResp -setConcPerson: Flags -> Model -> Maybe IdName -> Cmd Msg + +setConcPerson : Flags -> Model -> Maybe IdName -> Cmd Msg setConcPerson flags model mref = let - idref = Maybe.map .id mref - |> OptionalId + idref = + Maybe.map .id mref + |> OptionalId in - Api.setConcPerson flags model.item.id idref SaveResp + Api.setConcPerson flags model.item.id idref SaveResp -setConcEquip: Flags -> Model -> Maybe IdName -> Cmd Msg + +setConcEquip : Flags -> Model -> Maybe IdName -> Cmd Msg setConcEquip flags model mref = let - idref = Maybe.map .id mref - |> OptionalId + idref = + Maybe.map .id mref + |> OptionalId in - Api.setConcEquip flags model.item.id idref SaveResp + Api.setConcEquip flags model.item.id idref SaveResp -setName: Flags -> Model -> Cmd Msg + +setName : Flags -> Model -> Cmd Msg setName flags model = let - text = OptionalText (Just model.nameModel) + text = + OptionalText (Just model.nameModel) in - if model.nameModel == "" then Cmd.none - else Api.setItemName flags model.item.id text SaveResp + if model.nameModel == "" then + Cmd.none -setNotes: Flags -> Model -> Cmd Msg + else + Api.setItemName flags model.item.id text SaveResp + + +setNotes : Flags -> Model -> Cmd Msg setNotes flags model = let - text = OptionalText model.notesModel + text = + OptionalText model.notesModel in - if model.notesModel == Nothing then Cmd.none - else Api.setItemNotes flags model.item.id text SaveResp + if model.notesModel == Nothing then + Cmd.none -setDate: Flags -> Model-> Maybe Int -> Cmd Msg + else + Api.setItemNotes flags model.item.id text SaveResp + + +setDate : Flags -> Model -> Maybe Int -> Cmd Msg setDate flags model date = Api.setItemDate flags model.item.id (OptionalDate date) SaveResp -setDueDate: Flags -> Model -> Maybe Int -> Cmd Msg + +setDueDate : Flags -> Model -> Maybe Int -> Cmd Msg setDueDate flags model date = Api.setItemDueDate flags model.item.id (OptionalDate date) SaveResp -update: Flags -> Msg -> Model -> (Model, Cmd Msg, UserNav) +update : Flags -> Msg -> Model -> ( Model, Cmd Msg, UserNav ) update flags msg model = case msg of Init -> let - (dp, dpc) = Comp.DatePicker.init + ( dp, dpc ) = + Comp.DatePicker.init in - ( {model | itemDatePicker = dp, dueDatePicker = dp} - , Cmd.batch [getOptions flags - , Cmd.map ItemDatePickerMsg dpc - , Cmd.map DueDatePickerMsg dpc - ] - , NavNone - ) + ( { model | itemDatePicker = dp, dueDatePicker = dp } + , Cmd.batch + [ getOptions flags + , Cmd.map ItemDatePickerMsg dpc + , Cmd.map DueDatePickerMsg dpc + ] + , NavNone + ) SetItem item -> let - (m1, c1, _) = update flags (TagDropdownMsg (Comp.Dropdown.SetSelection item.tags)) model - (m2, c2, _) = update flags (DirDropdownMsg (Comp.Dropdown.SetSelection (Data.Direction.fromString item.direction - |> Maybe.map List.singleton - |> Maybe.withDefault []))) m1 - (m3, c3, _) = update flags (OrgDropdownMsg (Comp.Dropdown.SetSelection (item.corrOrg - |> Maybe.map List.singleton - |> Maybe.withDefault []))) m2 - (m4, c4, _) = update flags (CorrPersonMsg (Comp.Dropdown.SetSelection (item.corrPerson - |> Maybe.map List.singleton - |> Maybe.withDefault []))) m3 - (m5, c5, _) = update flags (ConcPersonMsg (Comp.Dropdown.SetSelection (item.concPerson - |> Maybe.map List.singleton - |> Maybe.withDefault []))) m4 - proposalCmd = if item.state == "created" - then Api.getItemProposals flags item.id GetProposalResp - else Cmd.none + ( m1, c1, _ ) = + update flags (TagDropdownMsg (Comp.Dropdown.SetSelection item.tags)) model + + ( m2, c2, _ ) = + update flags + (DirDropdownMsg + (Comp.Dropdown.SetSelection + (Data.Direction.fromString item.direction + |> Maybe.map List.singleton + |> Maybe.withDefault [] + ) + ) + ) + m1 + + ( m3, c3, _ ) = + update flags + (OrgDropdownMsg + (Comp.Dropdown.SetSelection + (item.corrOrg + |> Maybe.map List.singleton + |> Maybe.withDefault [] + ) + ) + ) + m2 + + ( m4, c4, _ ) = + update flags + (CorrPersonMsg + (Comp.Dropdown.SetSelection + (item.corrPerson + |> Maybe.map List.singleton + |> Maybe.withDefault [] + ) + ) + ) + m3 + + ( m5, c5, _ ) = + update flags + (ConcPersonMsg + (Comp.Dropdown.SetSelection + (item.concPerson + |> Maybe.map List.singleton + |> Maybe.withDefault [] + ) + ) + ) + m4 + + proposalCmd = + if item.state == "created" then + Api.getItemProposals flags item.id GetProposalResp + + else + Cmd.none in - ({m5|item = item, nameModel = item.name, notesModel = item.notes, itemDate = item.itemDate, dueDate = item.dueDate} - ,Cmd.batch [c1, c2, c3,c4,c5, getOptions flags, proposalCmd] - ) |> noNav + ( { m5 | item = item, nameModel = item.name, notesModel = item.notes, itemDate = item.itemDate, dueDate = item.dueDate } + , Cmd.batch [ c1, c2, c3, c4, c5, getOptions flags, proposalCmd ] + ) + |> noNav SetActiveAttachment pos -> - ({model|visibleAttach = pos}, Cmd.none, NavNone) + ( { model | visibleAttach = pos }, Cmd.none, NavNone ) NavClick nav -> - (model, Cmd.none, nav) + ( model, Cmd.none, nav ) ToggleMenu -> - ({model|menuOpen = not model.menuOpen}, Cmd.none, NavNone) + ( { model | menuOpen = not model.menuOpen }, Cmd.none, NavNone ) ReloadItem -> - if model.item.id == "" then (model, Cmd.none, NavNone) - else (model, Api.itemDetail flags model.item.id GetItemResp, NavNone) + if model.item.id == "" then + ( model, Cmd.none, NavNone ) + + else + ( model, Api.itemDetail flags model.item.id GetItemResp, NavNone ) TagDropdownMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.tagModel - newModel = {model|tagModel = m2} - save = if isDropdownChangeMsg m then saveTags flags newModel else Cmd.none + ( m2, c2 ) = + Comp.Dropdown.update m model.tagModel + + newModel = + { model | tagModel = m2 } + + save = + if isDropdownChangeMsg m then + saveTags flags newModel + + else + Cmd.none in - (newModel, Cmd.batch[ save, Cmd.map TagDropdownMsg c2 ], NavNone) + ( newModel, Cmd.batch [ save, Cmd.map TagDropdownMsg c2 ], NavNone ) + DirDropdownMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.directionModel - newModel = {model|directionModel = m2} - save = if isDropdownChangeMsg m then setDirection flags newModel else Cmd.none + ( m2, c2 ) = + Comp.Dropdown.update m model.directionModel + + newModel = + { model | directionModel = m2 } + + save = + if isDropdownChangeMsg m then + setDirection flags newModel + + else + Cmd.none in - (newModel, Cmd.batch [save, Cmd.map DirDropdownMsg c2 ]) |> noNav + ( newModel, Cmd.batch [ save, Cmd.map DirDropdownMsg c2 ] ) |> noNav + OrgDropdownMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.corrOrgModel - newModel = {model|corrOrgModel = m2} - idref = Comp.Dropdown.getSelected m2 |> List.head - save = if isDropdownChangeMsg m then setCorrOrg flags newModel idref else Cmd.none + ( m2, c2 ) = + Comp.Dropdown.update m model.corrOrgModel + + newModel = + { model | corrOrgModel = m2 } + + idref = + Comp.Dropdown.getSelected m2 |> List.head + + save = + if isDropdownChangeMsg m then + setCorrOrg flags newModel idref + + else + Cmd.none in - (newModel, Cmd.batch [save, Cmd.map OrgDropdownMsg c2]) |> noNav + ( newModel, Cmd.batch [ save, Cmd.map OrgDropdownMsg c2 ] ) |> noNav + CorrPersonMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.corrPersonModel - newModel = {model|corrPersonModel = m2} - idref = Comp.Dropdown.getSelected m2 |> List.head - save = if isDropdownChangeMsg m then setCorrPerson flags newModel idref else Cmd.none + ( m2, c2 ) = + Comp.Dropdown.update m model.corrPersonModel + + newModel = + { model | corrPersonModel = m2 } + + idref = + Comp.Dropdown.getSelected m2 |> List.head + + save = + if isDropdownChangeMsg m then + setCorrPerson flags newModel idref + + else + Cmd.none in - (newModel, Cmd.batch [save, Cmd.map CorrPersonMsg c2]) |> noNav + ( newModel, Cmd.batch [ save, Cmd.map CorrPersonMsg c2 ] ) |> noNav + ConcPersonMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.concPersonModel - newModel = {model|concPersonModel = m2} - idref = Comp.Dropdown.getSelected m2 |> List.head - save = if isDropdownChangeMsg m then setConcPerson flags newModel idref else Cmd.none + ( m2, c2 ) = + Comp.Dropdown.update m model.concPersonModel + + newModel = + { model | concPersonModel = m2 } + + idref = + Comp.Dropdown.getSelected m2 |> List.head + + save = + if isDropdownChangeMsg m then + setConcPerson flags newModel idref + + else + Cmd.none in - (newModel, Cmd.batch [save, Cmd.map ConcPersonMsg c2]) |> noNav + ( newModel, Cmd.batch [ save, Cmd.map ConcPersonMsg c2 ] ) |> noNav + ConcEquipMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.concEquipModel - newModel = {model|concEquipModel = m2} - idref = Comp.Dropdown.getSelected m2 |> List.head - save = if isDropdownChangeMsg m then setConcEquip flags newModel idref else Cmd.none + ( m2, c2 ) = + Comp.Dropdown.update m model.concEquipModel + + newModel = + { model | concEquipModel = m2 } + + idref = + Comp.Dropdown.getSelected m2 |> List.head + + save = + if isDropdownChangeMsg m then + setConcEquip flags newModel idref + + else + Cmd.none in - (newModel, Cmd.batch [save, Cmd.map ConcEquipMsg c2]) |> noNav + ( newModel, Cmd.batch [ save, Cmd.map ConcEquipMsg c2 ] ) |> noNav + SetName str -> - ({model|nameModel = str}, Cmd.none) |> noNav + ( { model | nameModel = str }, Cmd.none ) |> noNav SaveName -> - (model, setName flags model) |> noNav + ( model, setName flags model ) |> noNav SetNotes str -> - ({model|notesModel = if str == "" then Nothing else Just str}, Cmd.none) |> noNav + ( { model + | notesModel = + if str == "" then + Nothing + + else + Just str + } + , Cmd.none + ) + |> noNav + SaveNotes -> - (model, setNotes flags model) |> noNav + ( model, setNotes flags model ) |> noNav ConfirmItem -> - (model, Api.setConfirmed flags model.item.id SaveResp) |> noNav + ( model, Api.setConfirmed flags model.item.id SaveResp ) |> noNav UnconfirmItem -> - (model, Api.setUnconfirmed flags model.item.id SaveResp) |> noNav + ( model, Api.setUnconfirmed flags model.item.id SaveResp ) |> noNav ItemDatePickerMsg m -> let - (dp, event) = Comp.DatePicker.updateDefault m model.itemDatePicker + ( dp, event ) = + Comp.DatePicker.updateDefault m model.itemDatePicker in - case event of - DatePicker.Picked date -> - let - newModel = {model|itemDatePicker = dp, itemDate = Just (Comp.DatePicker.midOfDay date)} - in - (newModel, setDate flags newModel newModel.itemDate) |> noNav - _ -> - ({model|itemDatePicker = dp}, Cmd.none) |> noNav + case event of + DatePicker.Picked date -> + let + newModel = + { model | itemDatePicker = dp, itemDate = Just (Comp.DatePicker.midOfDay date) } + in + ( newModel, setDate flags newModel newModel.itemDate ) |> noNav + + _ -> + ( { model | itemDatePicker = dp }, Cmd.none ) |> noNav RemoveDate -> - ({ model | itemDate = Nothing }, setDate flags model Nothing ) |> noNav + ( { model | itemDate = Nothing }, setDate flags model Nothing ) |> noNav DueDatePickerMsg m -> let - (dp, event) = Comp.DatePicker.updateDefault m model.dueDatePicker + ( dp, event ) = + Comp.DatePicker.updateDefault m model.dueDatePicker in - case event of - DatePicker.Picked date -> - let - newModel = {model|dueDatePicker = dp, dueDate = Just (Comp.DatePicker.midOfDay date)} - in - (newModel, setDueDate flags newModel newModel.dueDate) |> noNav - _ -> - ({model|dueDatePicker = dp}, Cmd.none) |> noNav + case event of + DatePicker.Picked date -> + let + newModel = + { model | dueDatePicker = dp, dueDate = Just (Comp.DatePicker.midOfDay date) } + in + ( newModel, setDueDate flags newModel newModel.dueDate ) |> noNav + + _ -> + ( { model | dueDatePicker = dp }, Cmd.none ) |> noNav RemoveDueDate -> - ({ model | dueDate = Nothing }, setDueDate flags model Nothing ) |> noNav + ( { model | dueDate = Nothing }, setDueDate flags model Nothing ) |> noNav YesNoMsg m -> let - (cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm - cmd = if confirmed then Api.deleteItem flags model.item.id DeleteResp else Cmd.none + ( cm, confirmed ) = + Comp.YesNoDimmer.update m model.deleteConfirm + + cmd = + if confirmed then + Api.deleteItem flags model.item.id DeleteResp + + else + Cmd.none in - ({model | deleteConfirm = cm}, cmd) |> noNav + ( { model | deleteConfirm = cm }, cmd ) |> noNav RequestDelete -> update flags (YesNoMsg Comp.YesNoDimmer.activate) model SetCorrOrgSuggestion idname -> - (model, setCorrOrg flags model (Just idname)) |> noNav + ( model, setCorrOrg flags model (Just idname) ) |> noNav + SetCorrPersonSuggestion idname -> - (model, setCorrPerson flags model (Just idname)) |> noNav + ( model, setCorrPerson flags model (Just idname) ) |> noNav + SetConcPersonSuggestion idname -> - (model, setConcPerson flags model (Just idname)) |> noNav + ( model, setConcPerson flags model (Just idname) ) |> noNav + SetConcEquipSuggestion idname -> - (model, setConcEquip flags model (Just idname)) |> noNav + ( model, setConcEquip flags model (Just idname) ) |> noNav + SetItemDateSuggestion date -> - (model, setDate flags model (Just date)) |> noNav + ( model, setDate flags model (Just date) ) |> noNav + SetDueDateSuggestion date -> - (model, setDueDate flags model (Just date)) |> noNav + ( model, setDueDate flags model (Just date) ) |> noNav GetTagsResp (Ok tags) -> let - tagList = Comp.Dropdown.SetOptions tags.items - (m1, c1, _) = update flags (TagDropdownMsg tagList) model + tagList = + Comp.Dropdown.SetOptions tags.items + + ( m1, c1, _ ) = + update flags (TagDropdownMsg tagList) model in - (m1, c1) |> noNav - GetTagsResp (Err err) -> - (model, Cmd.none) |> noNav + ( m1, c1 ) |> noNav + + GetTagsResp (Err _) -> + ( model, Cmd.none ) |> noNav + GetOrgResp (Ok orgs) -> let - opts = Comp.Dropdown.SetOptions orgs.items + opts = + Comp.Dropdown.SetOptions orgs.items in - update flags (OrgDropdownMsg opts) model + update flags (OrgDropdownMsg opts) model + + GetOrgResp (Err _) -> + ( model, Cmd.none ) |> noNav - GetOrgResp (Err err) -> - (model, Cmd.none) |> noNav GetPersonResp (Ok ps) -> let - opts = Comp.Dropdown.SetOptions ps.items - (m1, c1, _) = update flags (CorrPersonMsg opts) model - (m2, c2, _) = update flags (ConcPersonMsg opts) m1 - in - (m2, Cmd.batch [c1, c2]) |> noNav + opts = + Comp.Dropdown.SetOptions ps.items + + ( m1, c1, _ ) = + update flags (CorrPersonMsg opts) model + + ( m2, c2, _ ) = + update flags (ConcPersonMsg opts) m1 + in + ( m2, Cmd.batch [ c1, c2 ] ) |> noNav + + GetPersonResp (Err _) -> + ( model, Cmd.none ) |> noNav - GetPersonResp (Err err) -> - (model, Cmd.none) |> noNav GetEquipResp (Ok equips) -> let - opts = Comp.Dropdown.SetOptions (List.map (\e -> IdName e.id e.name) equips.items) + opts = + Comp.Dropdown.SetOptions + (List.map (\e -> IdName e.id e.name) + equips.items + ) in - update flags (ConcEquipMsg opts) model + update flags (ConcEquipMsg opts) model + + GetEquipResp (Err _) -> + ( model, Cmd.none ) |> noNav - GetEquipResp (Err err) -> - (model, Cmd.none) |> noNav SaveResp (Ok res) -> - if res.success then (model, Api.itemDetail flags model.item.id GetItemResp) |> noNav - else (model, Cmd.none) |> noNav - SaveResp (Err err) -> - (model, Cmd.none) |> noNav + if res.success then + ( model, Api.itemDetail flags model.item.id GetItemResp ) |> noNav + + else + ( model, Cmd.none ) |> noNav + + SaveResp (Err _) -> + ( model, Cmd.none ) |> noNav + DeleteResp (Ok res) -> - if res.success then (model, Cmd.none, NavNextOrBack) - else (model, Cmd.none) |> noNav - DeleteResp (Err err) -> - (model, Cmd.none) |> noNav + if res.success then + ( model, Cmd.none, NavNextOrBack ) + + else + ( model, Cmd.none ) |> noNav + + DeleteResp (Err _) -> + ( model, Cmd.none ) |> noNav + GetItemResp (Ok item) -> update flags (SetItem item) model - GetItemResp (Err err) -> - (model, Cmd.none) |> noNav + + GetItemResp (Err _) -> + ( model, Cmd.none ) |> noNav GetProposalResp (Ok ip) -> - ({model | itemProposals = ip}, Cmd.none) |> noNav - GetProposalResp (Err err) -> - (model, Cmd.none) |> noNav + ( { model | itemProposals = ip }, Cmd.none ) |> noNav + + GetProposalResp (Err _) -> + ( model, Cmd.none ) |> noNav + + -- view -actionInputDatePicker: DatePicker.Settings + +actionInputDatePicker : DatePicker.Settings actionInputDatePicker = let - ds = Comp.DatePicker.defaultSettings + ds = + Comp.DatePicker.defaultSettings in - { ds | containerClassList = [("ui action input", True)] } + { ds | containerClassList = [ ( "ui action input", True ) ] } -view: Model -> Html Msg +view : Model -> Html Msg view model = div [] - [div [classList [("ui ablue-comp menu", True) - ]] - [a [class "item", href "", onClick (NavClick NavBack)] - [i [class "arrow left icon"][] - ] - ,a [class "item", href "", onClick (NavClick NavPrev)] - [i [class "caret square left outline icon"][] - ] - ,a [class "item", href "", onClick (NavClick NavNext)] - [i [class "caret square right outline icon"][] - ] - ,a [classList [("toggle item", True) - ,("active", model.menuOpen) - ] - ,title "Expand Menu" - ,onClick ToggleMenu - ,href "" + [ div + [ classList + [ ( "ui ablue-comp menu", True ) ] - [i [class "edit icon"][] - ] - ] - ,div [class "ui grid"] - [div [classList [("six wide column", True) - ,("invisible", not model.menuOpen) - ]] - (if model.menuOpen then (renderEditMenu model) else []) - ,div [classList [("ten", model.menuOpen) - ,("sixteen", not model.menuOpen) - ,("wide column", True) - ]] - <| List.concat - [ [renderItemInfo model] - , [renderAttachmentsTabMenu model] - , renderAttachmentsTabBody model - , renderNotes model - , renderIdInfo model - ] - ] + ] + [ a [ class "item", href "", onClick (NavClick NavBack) ] + [ i [ class "arrow left icon" ] [] + ] + , a [ class "item", href "", onClick (NavClick NavPrev) ] + [ i [ class "caret square left outline icon" ] [] + ] + , a [ class "item", href "", onClick (NavClick NavNext) ] + [ i [ class "caret square right outline icon" ] [] + ] + , a + [ classList + [ ( "toggle item", True ) + , ( "active", model.menuOpen ) + ] + , title "Expand Menu" + , onClick ToggleMenu + , href "" + ] + [ i [ class "edit icon" ] [] + ] + ] + , div [ class "ui grid" ] + [ div + [ classList + [ ( "six wide column", True ) + , ( "invisible", not model.menuOpen ) + ] + ] + (if model.menuOpen then + renderEditMenu model + + else + [] + ) + , div + [ classList + [ ( "ten", model.menuOpen ) + , ( "sixteen", not model.menuOpen ) + , ( "wide column", True ) + ] + ] + <| + List.concat + [ [ renderItemInfo model ] + , [ renderAttachmentsTabMenu model ] + , renderAttachmentsTabBody model + , renderNotes model + , renderIdInfo model + ] + ] ] -renderIdInfo: Model -> List (Html Msg) +renderIdInfo : Model -> List (Html Msg) renderIdInfo model = - [div [class "ui center aligned container"] - [span [class "small-info"] - [text model.item.id - ,text " • " - ,text "Created: " - ,Util.Time.formatDateTime model.item.created |> text - ,text " • " - ,text "Updated: " - ,Util.Time.formatDateTime model.item.updated |> text - ] - ] + [ div [ class "ui center aligned container" ] + [ span [ class "small-info" ] + [ text model.item.id + , text " • " + , text "Created: " + , Util.Time.formatDateTime model.item.created |> text + , text " • " + , text "Updated: " + , Util.Time.formatDateTime model.item.updated |> text + ] + ] ] -renderNotes: Model -> List (Html Msg) + +renderNotes : Model -> List (Html Msg) renderNotes model = case model.item.notes of - Nothing -> [] + Nothing -> + [] + Just str -> - [h3 [class "ui header"] - [text "Notes" + [ h3 [ class "ui header" ] + [ text "Notes" ] - ,Markdown.toHtml [class "item-notes"] str + , Markdown.toHtml [ class "item-notes" ] str ] -renderAttachmentsTabMenu: Model -> Html Msg + +renderAttachmentsTabMenu : Model -> Html Msg renderAttachmentsTabMenu model = - div [class "ui top attached tabular menu"] - (List.indexedMap (\pos -> \a -> - div [classList [("item", True) - ,("active", pos == model.visibleAttach) - ] - ,onClick (SetActiveAttachment pos) - ] - [a.name |> Maybe.withDefault "No Name" |> text - ,text " (" - ,text (Util.Size.bytesReadable Util.Size.B (toFloat a.size)) - ,text ")" - ]) - model.item.attachments) + div [ class "ui top attached tabular menu" ] + (List.indexedMap + (\pos -> + \a -> + div + [ classList + [ ( "item", True ) + , ( "active", pos == model.visibleAttach ) + ] + , onClick (SetActiveAttachment pos) + ] + [ a.name |> Maybe.withDefault "No Name" |> text + , text " (" + , text (Util.Size.bytesReadable Util.Size.B (toFloat a.size)) + , text ")" + ] + ) + model.item.attachments + ) -renderAttachmentsTabBody: Model -> List (Html Msg) + +renderAttachmentsTabBody : Model -> List (Html Msg) renderAttachmentsTabBody model = - List.indexedMap (\pos -> \a -> - div [classList [("ui attached tab segment", True) - ,("active", pos == model.visibleAttach) - ] - ] - [div [class "ui 4:3 embed doc-embed"] - [embed [src ("/api/v1/sec/attachment/" ++ a.id), type_ a.contentType] - [] - ] - ] - ) model.item.attachments + List.indexedMap + (\pos -> + \a -> + div + [ classList + [ ( "ui attached tab segment", True ) + , ( "active", pos == model.visibleAttach ) + ] + ] + [ div [ class "ui 4:3 embed doc-embed" ] + [ embed [ src ("/api/v1/sec/attachment/" ++ a.id), type_ a.contentType ] + [] + ] + ] + ) + model.item.attachments -renderItemInfo: Model -> Html Msg + +renderItemInfo : Model -> Html Msg renderItemInfo model = let - name = div [class "item"] - [i [class (Data.Direction.iconFromString model.item.direction)][] - ,text model.item.name - ] - date = div [class "item"] - [Maybe.withDefault model.item.created model.item.itemDate - |> Util.Time.formatDate - |> text - ] - duedate = div [class "item"] - [i [class "bell icon"][] - ,Maybe.map Util.Time.formatDate model.item.dueDate - |> Maybe.withDefault "" - |> text - ] - corr = div [class "item"] - [i [class "envelope outline icon"][] - , List.filterMap identity [model.item.corrOrg, model.item.corrPerson] - |> List.map .name - |> String.join ", " - |> Util.String.withDefault "(None)" - |> text - ] - conc = div [class "item"] - [i [class "comment outline icon"][] - ,List.filterMap identity [model.item.concPerson, model.item.concEquipment] - |> List.map .name - |> String.join ", " - |> Util.String.withDefault "(None)" - |> text - ] - src = div [class "item"] - [text model.item.source - ] - in - div [class "ui fluid container"] - ([h2 [class "ui header"] - [i [class (Data.Direction.iconFromString model.item.direction)][] - ,div [class "content"] - [text model.item.name - ,div [classList [("ui teal label", True) - ,("invisible", model.item.state /= "created") - ]] - [text "New!" - ] - ,div [class "sub header"] - [div [class "ui horizontal bulleted list"] <| - List.append - [ date - , corr - , conc - , src - ] (if Util.Maybe.isEmpty model.item.dueDate then [] else [duedate]) - ] - ] + name = + div [ class "item" ] + [ i [ class (Data.Direction.iconFromString model.item.direction) ] [] + , text model.item.name ] - ] ++ (renderTags model)) -renderTags: Model -> List (Html Msg) + date = + div [ class "item" ] + [ Maybe.withDefault model.item.created model.item.itemDate + |> Util.Time.formatDate + |> text + ] + + duedate = + div [ class "item" ] + [ i [ class "bell icon" ] [] + , Maybe.map Util.Time.formatDate model.item.dueDate + |> Maybe.withDefault "" + |> text + ] + + corr = + div [ class "item" ] + [ i [ class "envelope outline icon" ] [] + , List.filterMap identity [ model.item.corrOrg, model.item.corrPerson ] + |> List.map .name + |> String.join ", " + |> Util.String.withDefault "(None)" + |> text + ] + + conc = + div [ class "item" ] + [ i [ class "comment outline icon" ] [] + , List.filterMap identity [ model.item.concPerson, model.item.concEquipment ] + |> List.map .name + |> String.join ", " + |> Util.String.withDefault "(None)" + |> text + ] + + src = + div [ class "item" ] + [ text model.item.source + ] + in + div [ class "ui fluid container" ] + ([ h2 [ class "ui header" ] + [ i [ class (Data.Direction.iconFromString model.item.direction) ] [] + , div [ class "content" ] + [ text model.item.name + , div + [ classList + [ ( "ui teal label", True ) + , ( "invisible", model.item.state /= "created" ) + ] + ] + [ text "New!" + ] + , div [ class "sub header" ] + [ div [ class "ui horizontal bulleted list" ] <| + List.append + [ date + , corr + , conc + , src + ] + (if Util.Maybe.isEmpty model.item.dueDate then + [] + + else + [ duedate ] + ) + ] + ] + ] + ] + ++ renderTags model + ) + + +renderTags : Model -> List (Html Msg) renderTags model = case model.item.tags of - [] -> [] + [] -> + [] + _ -> - [div [class "ui right aligned fluid container"] <| - List.map - (\t -> div [classList [("ui tag label", True) - ,("blue", Util.Maybe.nonEmpty t.category) - ] + [ div [ class "ui right aligned fluid container" ] <| + List.map + (\t -> + div + [ classList + [ ( "ui tag label", True ) + , ( "blue", Util.Maybe.nonEmpty t.category ) ] - [text t.name - ] - ) model.item.tags + ] + [ text t.name + ] + ) + model.item.tags ] -renderEditMenu: Model -> List (Html Msg) +renderEditMenu : Model -> List (Html Msg) renderEditMenu model = - [renderEditButtons model - ,renderEditForm model + [ renderEditButtons model + , renderEditForm model ] -renderEditButtons: Model -> Html Msg + +renderEditButtons : Model -> Html Msg renderEditButtons model = - div [class "ui top attached right aligned segment"] - [ button [classList [("ui primary button", True) - ,("invisible", model.item.state /= "created") - ] - ,onClick ConfirmItem - ] - [ i [class "check icon"][] + div [ class "ui top attached right aligned segment" ] + [ button + [ classList + [ ( "ui primary button", True ) + , ( "invisible", model.item.state /= "created" ) + ] + , onClick ConfirmItem + ] + [ i [ class "check icon" ] [] , text "Confirm" ] - , button [classList [("ui primary button", True) - ,("invisible", model.item.state /= "confirmed") - ] - ,onClick UnconfirmItem - ] - [ i [class "eye slash outline icon"][] + , button + [ classList + [ ( "ui primary button", True ) + , ( "invisible", model.item.state /= "confirmed" ) + ] + , onClick UnconfirmItem + ] + [ i [ class "eye slash outline icon" ] [] , text "Unconfirm" ] - , button [class "ui negative button", onClick RequestDelete] - [ i [class "delete icon"] [] - , text "Delete" - ] + , button [ class "ui negative button", onClick RequestDelete ] + [ i [ class "delete icon" ] [] + , text "Delete" + ] ] -renderEditForm: Model -> Html Msg + +renderEditForm : Model -> Html Msg renderEditForm model = - div [class "ui attached segment"] - [Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) - ,div [class "ui form"] - [div [class "field"] - [label [] - [i [class "tags icon"][] - ,text "Tags" - ] - ,Html.map TagDropdownMsg (Comp.Dropdown.view model.tagModel) - ] - ,div [class " field"] - [label [][text "Name"] - ,div [class "ui action input"] - [input [type_ "text", value model.nameModel, onInput SetName][] - ,button [class "ui icon button", onClick SaveName][i [class "save outline icon"][]] - ] - ] - ,div [class "field"] - [label [][text "Direction"] - ,Html.map DirDropdownMsg (Comp.Dropdown.view model.directionModel) - ] - ,div [class " field"] - [label [][text "Date"] - ,div [class "ui action input"] - [Html.map ItemDatePickerMsg (Comp.DatePicker.viewTime model.itemDate actionInputDatePicker model.itemDatePicker) - ,a [class "ui icon button", href "", onClick RemoveDate] - [i [class "trash alternate outline icon"][] - ] - ] - ,renderItemDateSuggestions model - ] - ,div [class " field"] - [label [][text "Due Date"] - ,div [class "ui action input"] - [Html.map DueDatePickerMsg (Comp.DatePicker.viewTime model.dueDate actionInputDatePicker model.dueDatePicker) - ,a [class "ui icon button", href "", onClick RemoveDueDate] - [i [class "trash alternate outline icon"][]] - ] - ,renderDueDateSuggestions model - ] - ,h4 [class "ui dividing header"] - [i [class "tiny envelope outline icon"][] - ,text "Correspondent" - ] - ,div [class "field"] - [label [][text "Organization"] - ,Html.map OrgDropdownMsg (Comp.Dropdown.view model.corrOrgModel) - ,renderOrgSuggestions model - ] - ,div [class "field"] - [label [][text "Person"] - ,Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel) - ,renderCorrPersonSuggestions model - ] - ,h4 [class "ui dividing header"] - [i [class "tiny comment outline icon"][] - ,text "Concerning" - ] - ,div [class "field"] - [label [][text "Person"] - ,Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel) - ,renderConcPersonSuggestions model - ] - ,div [class "field"] - [label [][text "Equipment"] - ,Html.map ConcEquipMsg (Comp.Dropdown.view model.concEquipModel) - ,renderConcEquipSuggestions model - ] - ,h4 [class "ui dividing header"] - [i [class "tiny edit icon"][] - ,div [class "content"] - [text "Notes" - ,div [class "sub header"] - [a [class "ui link" - ,target "_blank" - ,href "https://guides.github.com/features/mastering-markdown" - ] - [text "Markdown" - ] - ,text " is supported" - ] - ] - ] - ,div [class "field"] - [div [class "ui action input"] - [textarea [ rows 6 - , autocomplete False - , onInput SetNotes - ][Maybe.withDefault "" model.notesModel |> text] - ,button [class "ui icon button", onClick SaveNotes] - [i [class "save outline icon"][] - ] - ] - ] - ] + div [ class "ui attached segment" ] + [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) + , div [ class "ui form" ] + [ div [ class "field" ] + [ label [] + [ i [ class "tags icon" ] [] + , text "Tags" + ] + , Html.map TagDropdownMsg (Comp.Dropdown.view model.tagModel) + ] + , div [ class " field" ] + [ label [] [ text "Name" ] + , div [ class "ui action input" ] + [ input [ type_ "text", value model.nameModel, onInput SetName ] [] + , button [ class "ui icon button", onClick SaveName ] [ i [ class "save outline icon" ] [] ] + ] + ] + , div [ class "field" ] + [ label [] [ text "Direction" ] + , Html.map DirDropdownMsg (Comp.Dropdown.view model.directionModel) + ] + , div [ class " field" ] + [ label [] [ text "Date" ] + , div [ class "ui action input" ] + [ Html.map ItemDatePickerMsg (Comp.DatePicker.viewTime model.itemDate actionInputDatePicker model.itemDatePicker) + , a [ class "ui icon button", href "", onClick RemoveDate ] + [ i [ class "trash alternate outline icon" ] [] + ] + ] + , renderItemDateSuggestions model + ] + , div [ class " field" ] + [ label [] [ text "Due Date" ] + , div [ class "ui action input" ] + [ Html.map DueDatePickerMsg (Comp.DatePicker.viewTime model.dueDate actionInputDatePicker model.dueDatePicker) + , a [ class "ui icon button", href "", onClick RemoveDueDate ] + [ i [ class "trash alternate outline icon" ] [] ] + ] + , renderDueDateSuggestions model + ] + , h4 [ class "ui dividing header" ] + [ i [ class "tiny envelope outline icon" ] [] + , text "Correspondent" + ] + , div [ class "field" ] + [ label [] [ text "Organization" ] + , Html.map OrgDropdownMsg (Comp.Dropdown.view model.corrOrgModel) + , renderOrgSuggestions model + ] + , div [ class "field" ] + [ label [] [ text "Person" ] + , Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel) + , renderCorrPersonSuggestions model + ] + , h4 [ class "ui dividing header" ] + [ i [ class "tiny comment outline icon" ] [] + , text "Concerning" + ] + , div [ class "field" ] + [ label [] [ text "Person" ] + , Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel) + , renderConcPersonSuggestions model + ] + , div [ class "field" ] + [ label [] [ text "Equipment" ] + , Html.map ConcEquipMsg (Comp.Dropdown.view model.concEquipModel) + , renderConcEquipSuggestions model + ] + , h4 [ class "ui dividing header" ] + [ i [ class "tiny edit icon" ] [] + , div [ class "content" ] + [ text "Notes" + , div [ class "sub header" ] + [ a + [ class "ui link" + , target "_blank" + , href "https://guides.github.com/features/mastering-markdown" + ] + [ text "Markdown" + ] + , text " is supported" + ] + ] + ] + , div [ class "field" ] + [ div [ class "ui action input" ] + [ textarea + [ rows 6 + , autocomplete False + , onInput SetNotes + ] + [ Maybe.withDefault "" model.notesModel |> text ] + , button [ class "ui icon button", onClick SaveNotes ] + [ i [ class "save outline icon" ] [] + ] + ] + ] + ] ] - -renderSuggestions: Model -> (a -> String) -> List a -> (a -> Msg) -> Html Msg +renderSuggestions : Model -> (a -> String) -> List a -> (a -> Msg) -> Html Msg renderSuggestions model mkName idnames tagger = - div [classList [("ui secondary vertical menu", True) - ,("invisible", model.item.state /= "created") - ]] - [div [class "item"] - [div [class "header"] - [text "Suggestions" - ] - ,div [class "menu"] <| - (idnames - |> List.take 5 - |> List.map (\p -> a [class "item", href "", onClick (tagger p)][text (mkName p)])) - ] + div + [ classList + [ ( "ui secondary vertical menu", True ) + , ( "invisible", model.item.state /= "created" ) + ] + ] + [ div [ class "item" ] + [ div [ class "header" ] + [ text "Suggestions" + ] + , div [ class "menu" ] <| + (idnames + |> List.take 5 + |> List.map (\p -> a [ class "item", href "", onClick (tagger p) ] [ text (mkName p) ]) + ) + ] ] -renderOrgSuggestions: Model -> Html Msg + +renderOrgSuggestions : Model -> Html Msg renderOrgSuggestions model = renderSuggestions model .name (List.take 5 model.itemProposals.corrOrg) SetCorrOrgSuggestion -renderCorrPersonSuggestions: Model -> Html Msg + +renderCorrPersonSuggestions : Model -> Html Msg renderCorrPersonSuggestions model = renderSuggestions model .name (List.take 5 model.itemProposals.corrPerson) SetCorrPersonSuggestion -renderConcPersonSuggestions: Model -> Html Msg + +renderConcPersonSuggestions : Model -> Html Msg renderConcPersonSuggestions model = renderSuggestions model .name (List.take 5 model.itemProposals.concPerson) SetConcPersonSuggestion -renderConcEquipSuggestions: Model -> Html Msg + +renderConcEquipSuggestions : Model -> Html Msg renderConcEquipSuggestions model = renderSuggestions model .name (List.take 5 model.itemProposals.concEquipment) SetConcEquipSuggestion -renderItemDateSuggestions: Model -> Html Msg + +renderItemDateSuggestions : Model -> Html Msg renderItemDateSuggestions model = renderSuggestions model Util.Time.formatDate (List.take 5 model.itemProposals.itemDate) SetItemDateSuggestion -renderDueDateSuggestions: Model -> Html Msg + +renderDueDateSuggestions : Model -> Html Msg renderDueDateSuggestions model = renderSuggestions model Util.Time.formatDate diff --git a/modules/webapp/src/main/elm/Comp/ItemList.elm b/modules/webapp/src/main/elm/Comp/ItemList.elm index d7716838..7313d16d 100644 --- a/modules/webapp/src/main/elm/Comp/ItemList.elm +++ b/modules/webapp/src/main/elm/Comp/ItemList.elm @@ -1,36 +1,41 @@ -module Comp.ItemList exposing (Model - , emptyModel - , Msg(..) - , prevItem - , nextItem - , update - , view) +module Comp.ItemList exposing + ( Model + , Msg(..) + , emptyModel + , nextItem + , prevItem + , update + , view + ) -import Set exposing (Set) +import Api.Model.ItemLight exposing (ItemLight) +import Api.Model.ItemLightGroup exposing (ItemLightGroup) +import Api.Model.ItemLightList exposing (ItemLightList) +import Data.Direction +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Api.Model.ItemLightList exposing (ItemLightList) -import Api.Model.ItemLightGroup exposing (ItemLightGroup) -import Api.Model.ItemLight exposing (ItemLight) -import Data.Flags exposing (Flags) -import Data.Direction +import Set exposing (Set) import Util.List +import Util.Maybe import Util.String import Util.Time -import Util.Maybe + type alias Model = - { results: ItemLightList - , openGroups: Set String + { results : ItemLightList + , openGroups : Set String } -emptyModel: Model + +emptyModel : Model emptyModel = { results = Api.Model.ItemLightList.empty , openGroups = Set.empty } + type Msg = SetResults ItemLightList | ToggleGroupState ItemLightGroup @@ -38,198 +43,243 @@ type Msg | ExpandAll | SelectItem ItemLight -nextItem: Model -> String -> Maybe ItemLight + +nextItem : Model -> String -> Maybe ItemLight nextItem model id = List.concatMap .items model.results.groups |> Util.List.findNext (\i -> i.id == id) -prevItem: Model -> String -> Maybe ItemLight + +prevItem : Model -> String -> Maybe ItemLight prevItem model id = List.concatMap .items model.results.groups |> Util.List.findPrev (\i -> i.id == id) -openAllGroups: Model -> Set String + +openAllGroups : Model -> Set String openAllGroups model = List.foldl (\g -> \set -> Set.insert g.name set) model.openGroups model.results.groups -update: Flags -> Msg -> Model -> (Model, Cmd Msg, Maybe ItemLight) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe ItemLight ) update flags msg model = case msg of SetResults list -> let - newModel = { model | results = list, openGroups = Set.empty } + newModel = + { model | results = list, openGroups = Set.empty } in - ({newModel|openGroups = openAllGroups newModel}, Cmd.none, Nothing) + ( { newModel | openGroups = openAllGroups newModel }, Cmd.none, Nothing ) ToggleGroupState group -> let - m2 = if isGroupOpen model group then closeGroup model group - else openGroup model group + m2 = + if isGroupOpen model group then + closeGroup model group + + else + openGroup model group in - (m2, Cmd.none, Nothing) + ( m2, Cmd.none, Nothing ) CollapseAll -> - ({model | openGroups = Set.empty }, Cmd.none, Nothing) + ( { model | openGroups = Set.empty }, Cmd.none, Nothing ) ExpandAll -> let - open = openAllGroups model + open = + openAllGroups model in - ({model | openGroups = open }, Cmd.none, Nothing) + ( { model | openGroups = open }, Cmd.none, Nothing ) SelectItem item -> - (model, Cmd.none, Just item) + ( model, Cmd.none, Just item ) -view: Model -> Html Msg +view : Model -> Html Msg view model = div [] - [div [class "ui ablue-comp menu"] - [div [class "right floated menu"] - [a [class "item" - ,title "Expand all" - ,onClick ExpandAll - ,href "" - ] - [i [class "double angle down icon"][] - ] - ,a [class "item" - ,title "Collapse all" - ,onClick CollapseAll - ,href "" - ] - [i [class "double angle up icon"][] - ] - ] - ] - ,div [class "ui middle aligned very relaxed divided basic list segment"] + [ div [ class "ui ablue-comp menu" ] + [ div [ class "right floated menu" ] + [ a + [ class "item" + , title "Expand all" + , onClick ExpandAll + , href "" + ] + [ i [ class "double angle down icon" ] [] + ] + , a + [ class "item" + , title "Collapse all" + , onClick CollapseAll + , href "" + ] + [ i [ class "double angle up icon" ] [] + ] + ] + ] + , div [ class "ui middle aligned very relaxed divided basic list segment" ] (List.map (viewGroup model) model.results.groups) ] -isGroupOpen: Model -> ItemLightGroup -> Bool +isGroupOpen : Model -> ItemLightGroup -> Bool isGroupOpen model group = Set.member group.name model.openGroups -openGroup: Model -> ItemLightGroup -> Model + +openGroup : Model -> ItemLightGroup -> Model openGroup model group = { model | openGroups = Set.insert group.name model.openGroups } -closeGroup: Model -> ItemLightGroup -> Model + +closeGroup : Model -> ItemLightGroup -> Model closeGroup model group = { model | openGroups = Set.remove group.name model.openGroups } -viewGroup: Model -> ItemLightGroup -> Html Msg + +viewGroup : Model -> ItemLightGroup -> Html Msg viewGroup model group = let - groupOpen = isGroupOpen model group + groupOpen = + isGroupOpen model group + children = - [i [classList [("large middle aligned icon", True) - ,("caret right", not groupOpen) - ,("caret down", groupOpen) - ]][] - ,div [class "content"] - [div [class "right floated content"] - [div [class "ui blue label"] - [List.length group.items |> String.fromInt |> text - ] - ] - ,a [class "header" - ,onClick (ToggleGroupState group) - ,href "" - ] - [text group.name - ] - ,div [class "description"] - [makeSummary group |> text + [ i + [ classList + [ ( "large middle aligned icon", True ) + , ( "caret right", not groupOpen ) + , ( "caret down", groupOpen ) + ] + ] + [] + , div [ class "content" ] + [ div [ class "right floated content" ] + [ div [ class "ui blue label" ] + [ List.length group.items |> String.fromInt |> text + ] + ] + , a + [ class "header" + , onClick (ToggleGroupState group) + , href "" + ] + [ text group.name + ] + , div [ class "description" ] + [ makeSummary group |> text ] ] ] + itemTable = - div [class "ui basic content segment no-margin"] - [(renderItemTable model group.items) + div [ class "ui basic content segment no-margin" ] + [ renderItemTable model group.items ] in - if isGroupOpen model group then - div [class "item"] - (List.append children [itemTable]) - else - div [class "item"] - children + if isGroupOpen model group then + div [ class "item" ] + (List.append children [ itemTable ]) + + else + div [ class "item" ] + children -renderItemTable: Model -> List ItemLight -> Html Msg +renderItemTable : Model -> List ItemLight -> Html Msg renderItemTable model items = - table [class "ui selectable padded table"] - [thead [] - [tr [] - [th [class "collapsing"][] - ,th [class "collapsing"][text "Name"] - ,th [class "collapsing"][text "Date"] - ,th [class "collapsing"][text "Source"] - ,th [][text "Correspondent"] - ,th [][text "Concerning"] - ] - ] - ,tbody[] + table [ class "ui selectable padded table" ] + [ thead [] + [ tr [] + [ th [ class "collapsing" ] [] + , th [ class "collapsing" ] [ text "Name" ] + , th [ class "collapsing" ] [ text "Date" ] + , th [ class "collapsing" ] [ text "Source" ] + , th [] [ text "Correspondent" ] + , th [] [ text "Concerning" ] + ] + ] + , tbody [] (List.map (renderItemLine model) items) ] -renderItemLine: Model -> ItemLight -> Html Msg + +renderItemLine : Model -> ItemLight -> Html Msg renderItemLine model item = let - dirIcon = i [class (Data.Direction.iconFromMaybe item.direction)][] - corr = List.filterMap identity [item.corrOrg, item.corrPerson] - |> List.map .name - |> List.intersperse ", " - |> String.concat - conc = List.filterMap identity [item.concPerson, item.concEquip] - |> List.map .name - |> List.intersperse ", " - |> String.concat + dirIcon = + i [ class (Data.Direction.iconFromMaybe item.direction) ] [] + + corr = + List.filterMap identity [ item.corrOrg, item.corrPerson ] + |> List.map .name + |> List.intersperse ", " + |> String.concat + + conc = + List.filterMap identity [ item.concPerson, item.concEquip ] + |> List.map .name + |> List.intersperse ", " + |> String.concat in - tr [onClick (SelectItem item)] - [td [class "collapsing"] - [div [classList [("ui teal ribbon label", True) - ,("invisible", item.state /= "created") - ] - ][text "New" - ] - ] - ,td [class "collapsing"] - [ dirIcon - , Util.String.ellipsis 45 item.name |> text - ] - ,td [class "collapsing"] - [Util.Time.formatDateShort item.date |> text - ,span [classList [("invisible", Util.Maybe.isEmpty item.dueDate) - ] - ] - [text " " - ,div [class "ui basic label"] - [i [class "bell icon"][] - ,Maybe.map Util.Time.formatDateShort item.dueDate |> Maybe.withDefault "" |> text - ] + tr [ onClick (SelectItem item) ] + [ td [ class "collapsing" ] + [ div + [ classList + [ ( "ui teal ribbon label", True ) + , ( "invisible", item.state /= "created" ) ] ] - ,td [class "collapsing"][text item.source] - ,td [][text corr] - ,td [][text conc] + [ text "New" + ] ] + , td [ class "collapsing" ] + [ dirIcon + , Util.String.ellipsis 45 item.name |> text + ] + , td [ class "collapsing" ] + [ Util.Time.formatDateShort item.date |> text + , span + [ classList + [ ( "invisible", Util.Maybe.isEmpty item.dueDate ) + ] + ] + [ text " " + , div [ class "ui basic label" ] + [ i [ class "bell icon" ] [] + , Maybe.map Util.Time.formatDateShort item.dueDate |> Maybe.withDefault "" |> text + ] + ] + ] + , td [ class "collapsing" ] [ text item.source ] + , td [] [ text corr ] + , td [] [ text conc ] + ] -makeSummary: ItemLightGroup -> String + +makeSummary : ItemLightGroup -> String makeSummary group = let - corrOrgs = List.filterMap .corrOrg group.items - corrPers = List.filterMap .corrPerson group.items - concPers = List.filterMap .concPerson group.items - concEqui = List.filterMap .concEquip group.items - all = List.concat [corrOrgs, corrPers, concPers, concEqui] + corrOrgs = + List.filterMap .corrOrg group.items + + corrPers = + List.filterMap .corrPerson group.items + + concPers = + List.filterMap .concPerson group.items + + concEqui = + List.filterMap .concEquip group.items + + all = + List.concat [ corrOrgs, corrPers, concPers, concEqui ] in - List.map .name all - |> Util.List.distinct - |> List.intersperse ", " - |> String.concat + List.map .name all + |> Util.List.distinct + |> List.intersperse ", " + |> String.concat diff --git a/modules/webapp/src/main/elm/Comp/OrgForm.elm b/modules/webapp/src/main/elm/Comp/OrgForm.elm index e25eed70..da1b9861 100644 --- a/modules/webapp/src/main/elm/Comp/OrgForm.elm +++ b/modules/webapp/src/main/elm/Comp/OrgForm.elm @@ -1,28 +1,32 @@ -module Comp.OrgForm exposing ( Model - , emptyModel - , Msg(..) - , view - , update - , isValid - , getOrg) +module Comp.OrgForm exposing + ( Model + , Msg(..) + , emptyModel + , getOrg + , isValid + , update + , view + ) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onInput) -import Data.Flags exposing (Flags) import Api.Model.Organization exposing (Organization) import Comp.AddressForm import Comp.ContactField +import Data.Flags exposing (Flags) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onInput) + type alias Model = - { org: Organization - , name: String - , addressModel: Comp.AddressForm.Model - , contactModel: Comp.ContactField.Model - , notes: Maybe String + { org : Organization + , name : String + , addressModel : Comp.AddressForm.Model + , contactModel : Comp.ContactField.Model + , notes : Maybe String } -emptyModel: Model + +emptyModel : Model emptyModel = { org = Api.Model.Organization.empty , name = "" @@ -31,20 +35,25 @@ emptyModel = , notes = Nothing } -isValid: Model -> Bool + +isValid : Model -> Bool isValid model = model.name /= "" -getOrg: Model -> Organization + +getOrg : Model -> Organization getOrg model = let - o = model.org + o = + model.org in - { o | name = model.name - , address = Comp.AddressForm.getAddress model.addressModel - , contacts = Comp.ContactField.getContacts model.contactModel - , notes = model.notes - } + { o + | name = model.name + , address = Comp.AddressForm.getAddress model.addressModel + , contacts = Comp.ContactField.getContacts model.contactModel + , notes = model.notes + } + type Msg = SetName String @@ -53,61 +62,80 @@ type Msg | ContactMsg Comp.ContactField.Msg | SetNotes String -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetOrg t -> let - (m1, c1) = update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model - (m2, c2) = update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1 + ( m1, c1 ) = + update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model + + ( m2, c2 ) = + update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1 in - ({m2 | org = t, name = t.name, notes = t.notes }, Cmd.none) + ( { m2 | org = t, name = t.name, notes = t.notes }, Cmd.batch [ c1, c2 ] ) AddressMsg am -> let - (m1, c1) = Comp.AddressForm.update am model.addressModel + ( m1, c1 ) = + Comp.AddressForm.update am model.addressModel in - ({model | addressModel = m1}, Cmd.map AddressMsg c1) + ( { model | addressModel = m1 }, Cmd.map AddressMsg c1 ) ContactMsg m -> let - (m1, c1) = Comp.ContactField.update m model.contactModel + ( m1, c1 ) = + Comp.ContactField.update m model.contactModel in - ({model | contactModel = m1}, Cmd.map ContactMsg c1) + ( { model | contactModel = m1 }, Cmd.map ContactMsg c1 ) SetName n -> - ({model | name = n}, Cmd.none) + ( { model | name = n }, Cmd.none ) SetNotes str -> - ({model | notes = if str == "" then Nothing else Just str}, Cmd.none) + ( { model + | notes = + if str == "" then + Nothing + + else + Just str + } + , Cmd.none + ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - div [class "ui form"] - [div [classList [("field", True) - ,("error", not (isValid model)) - ] - ] - [label [][text "Name*"] - ,input [type_ "text" - ,onInput SetName - ,placeholder "Name" - ,value model.name - ][] - ] - ,h3 [class "ui dividing header"] - [text "Address" + div [ class "ui form" ] + [ div + [ classList + [ ( "field", True ) + , ( "error", not (isValid model) ) + ] ] - ,Html.map AddressMsg (Comp.AddressForm.view model.addressModel) - ,h3 [class "ui dividing header"] - [text "Contacts" + [ label [] [ text "Name*" ] + , input + [ type_ "text" + , onInput SetName + , placeholder "Name" + , value model.name + ] + [] ] - ,Html.map ContactMsg (Comp.ContactField.view model.contactModel) - ,h3 [class "ui dividing header"] - [text "Notes" + , h3 [ class "ui dividing header" ] + [ text "Address" ] - ,div [class "field"] - [textarea [onInput SetNotes][Maybe.withDefault "" model.notes |> text ] + , Html.map AddressMsg (Comp.AddressForm.view model.addressModel) + , h3 [ class "ui dividing header" ] + [ text "Contacts" + ] + , Html.map ContactMsg (Comp.ContactField.view model.contactModel) + , h3 [ class "ui dividing header" ] + [ text "Notes" + ] + , div [ class "field" ] + [ textarea [ onInput SetNotes ] [ Maybe.withDefault "" model.notes |> text ] ] ] diff --git a/modules/webapp/src/main/elm/Comp/OrgManage.elm b/modules/webapp/src/main/elm/Comp/OrgManage.elm index 89b45b29..58742efb 100644 --- a/modules/webapp/src/main/elm/Comp/OrgManage.elm +++ b/modules/webapp/src/main/elm/Comp/OrgManage.elm @@ -1,36 +1,43 @@ -module Comp.OrgManage exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.OrgManage exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) -import Http import Api +import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.Organization +import Api.Model.OrganizationList exposing (OrganizationList) +import Comp.OrgForm +import Comp.OrgTable +import Comp.YesNoDimmer +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick, onSubmit) -import Data.Flags exposing (Flags) -import Comp.OrgTable -import Comp.OrgForm -import Comp.YesNoDimmer -import Api.Model.Organization -import Api.Model.OrganizationList exposing (OrganizationList) -import Api.Model.BasicResult exposing (BasicResult) -import Util.Maybe +import Http import Util.Http +import Util.Maybe + type alias Model = - { tableModel: Comp.OrgTable.Model - , formModel: Comp.OrgForm.Model - , viewMode: ViewMode - , formError: Maybe String - , loading: Bool - , deleteConfirm: Comp.YesNoDimmer.Model + { tableModel : Comp.OrgTable.Model + , formModel : Comp.OrgForm.Model + , viewMode : ViewMode + , formError : Maybe String + , loading : Bool + , deleteConfirm : Comp.YesNoDimmer.Model } -type ViewMode = Table | Form -emptyModel: Model +type ViewMode + = Table + | Form + + +emptyModel : Model emptyModel = { tableModel = Comp.OrgTable.emptyModel , formModel = Comp.OrgForm.emptyModel @@ -40,6 +47,7 @@ emptyModel = , deleteConfirm = Comp.YesNoDimmer.emptyModel } + type Msg = TableMsg Comp.OrgTable.Msg | FormMsg Comp.OrgForm.Msg @@ -52,155 +60,210 @@ type Msg | YesNoMsg Comp.YesNoDimmer.Msg | RequestDelete -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of TableMsg m -> let - (tm, tc) = Comp.OrgTable.update flags m model.tableModel - (m2, c2) = ({model | tableModel = tm - , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table - , formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError - } - , Cmd.map TableMsg tc - ) - (m3, c3) = case tm.selected of + ( tm, tc ) = + Comp.OrgTable.update flags m model.tableModel + + ( m2, c2 ) = + ( { model + | tableModel = tm + , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table + , formError = + if Util.Maybe.nonEmpty tm.selected then + Nothing + + else + model.formError + } + , Cmd.map TableMsg tc + ) + + ( m3, c3 ) = + case tm.selected of Just org -> update flags (FormMsg (Comp.OrgForm.SetOrg org)) m2 + Nothing -> - (m2, Cmd.none) + ( m2, Cmd.none ) in - (m3, Cmd.batch [c2, c3]) + ( m3, Cmd.batch [ c2, c3 ] ) FormMsg m -> let - (m2, c2) = Comp.OrgForm.update flags m model.formModel + ( m2, c2 ) = + Comp.OrgForm.update flags m model.formModel in - ({model | formModel = m2}, Cmd.map FormMsg c2) + ( { model | formModel = m2 }, Cmd.map FormMsg c2 ) LoadOrgs -> - ({model| loading = True}, Api.getOrganizations flags OrgResp) + ( { model | loading = True }, Api.getOrganizations flags OrgResp ) OrgResp (Ok orgs) -> let - m2 = {model|viewMode = Table, loading = False} + m2 = + { model | viewMode = Table, loading = False } in - update flags (TableMsg (Comp.OrgTable.SetOrgs orgs.items)) m2 + update flags (TableMsg (Comp.OrgTable.SetOrgs orgs.items)) m2 - OrgResp (Err err) -> - ({model|loading = False}, Cmd.none) + OrgResp (Err _) -> + ( { model | loading = False }, Cmd.none ) SetViewMode m -> let - m2 = {model | viewMode = m } + m2 = + { model | viewMode = m } in - case m of - Table -> - update flags (TableMsg Comp.OrgTable.Deselect) m2 - Form -> - (m2, Cmd.none) + case m of + Table -> + update flags (TableMsg Comp.OrgTable.Deselect) m2 + + Form -> + ( m2, Cmd.none ) InitNewOrg -> let - nm = {model | viewMode = Form, formError = Nothing } - org = Api.Model.Organization.empty + nm = + { model | viewMode = Form, formError = Nothing } + + org = + Api.Model.Organization.empty in - update flags (FormMsg (Comp.OrgForm.SetOrg org)) nm + update flags (FormMsg (Comp.OrgForm.SetOrg org)) nm Submit -> let - org = Comp.OrgForm.getOrg model.formModel - valid = Comp.OrgForm.isValid model.formModel - in if valid then - ({model|loading = True}, Api.postOrg flags org SubmitResp) - else - ({model|formError = Just "Please correct the errors in the form."}, Cmd.none) + org = + Comp.OrgForm.getOrg model.formModel + + valid = + Comp.OrgForm.isValid model.formModel + in + if valid then + ( { model | loading = True }, Api.postOrg flags org SubmitResp ) + + else + ( { model | formError = Just "Please correct the errors in the form." }, Cmd.none ) SubmitResp (Ok res) -> if res.success then let - (m2, c2) = update flags (SetViewMode Table) model - (m3, c3) = update flags LoadOrgs m2 + ( m2, c2 ) = + update flags (SetViewMode Table) model + + ( m3, c3 ) = + update flags LoadOrgs m2 in - ({m3|loading = False}, Cmd.batch [c2,c3]) + ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] ) + else - ({model | formError = Just res.message, loading = False }, Cmd.none) + ( { model | formError = Just res.message, loading = False }, Cmd.none ) SubmitResp (Err err) -> - ({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none) + ( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none ) RequestDelete -> update flags (YesNoMsg Comp.YesNoDimmer.activate) model YesNoMsg m -> let - (cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm - org = Comp.OrgForm.getOrg model.formModel - cmd = if confirmed then Api.deleteOrg flags org.id SubmitResp else Cmd.none + ( cm, confirmed ) = + Comp.YesNoDimmer.update m model.deleteConfirm + + org = + Comp.OrgForm.getOrg model.formModel + + cmd = + if confirmed then + Api.deleteOrg flags org.id SubmitResp + + else + Cmd.none in - ({model | deleteConfirm = cm}, cmd) + ( { model | deleteConfirm = cm }, cmd ) -view: Model -> Html Msg + +view : Model -> Html Msg view model = - if model.viewMode == Table then viewTable model - else viewForm model + if model.viewMode == Table then + viewTable model -viewTable: Model -> Html Msg + else + viewForm model + + +viewTable : Model -> Html Msg viewTable model = div [] - [button [class "ui basic button", onClick InitNewOrg] - [i [class "plus icon"][] - ,text "Create new" - ] - ,Html.map TableMsg (Comp.OrgTable.view model.tableModel) - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] + [ button [ class "ui basic button", onClick InitNewOrg ] + [ i [ class "plus icon" ] [] + , text "Create new" + ] + , Html.map TableMsg (Comp.OrgTable.view model.tableModel) + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] ] ] -viewForm: Model -> Html Msg + +viewForm : Model -> Html Msg viewForm model = let - newOrg = model.formModel.org.id == "" + newOrg = + model.formModel.org.id == "" in - Html.form [class "ui segment", onSubmit Submit] - [Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) - ,if newOrg then - h3 [class "ui dividing header"] - [text "Create new organization" - ] - else - h3 [class "ui dividing header"] - [text ("Edit org: " ++ model.formModel.org.name) - ,div [class "sub header"] - [text "Id: " - ,text model.formModel.org.id - ] - ] - ,Html.map FormMsg (Comp.OrgForm.view model.formModel) - ,div [classList [("ui error message", True) - ,("invisible", Util.Maybe.isEmpty model.formError) - ] - ] - [Maybe.withDefault "" model.formError |> text - ] - ,div [class "ui horizontal divider"][] - ,button [class "ui primary button", type_ "submit"] - [text "Submit" + Html.form [ class "ui segment", onSubmit Submit ] + [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) + , if newOrg then + h3 [ class "ui dividing header" ] + [ text "Create new organization" ] - ,a [class "ui secondary button", onClick (SetViewMode Table), href ""] - [text "Cancel" + + else + h3 [ class "ui dividing header" ] + [ text ("Edit org: " ++ model.formModel.org.name) + , div [ class "sub header" ] + [ text "Id: " + , text model.formModel.org.id + ] + ] + , Html.map FormMsg (Comp.OrgForm.view model.formModel) + , div + [ classList + [ ( "ui error message", True ) + , ( "invisible", Util.Maybe.isEmpty model.formError ) ] - ,if not newOrg then - a [class "ui right floated red button", href "", onClick RequestDelete] - [text "Delete"] - else - span[][] - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] - ] ] + [ Maybe.withDefault "" model.formError |> text + ] + , div [ class "ui horizontal divider" ] [] + , button [ class "ui primary button", type_ "submit" ] + [ text "Submit" + ] + , a [ class "ui secondary button", onClick (SetViewMode Table), href "" ] + [ text "Cancel" + ] + , if not newOrg then + a [ class "ui right floated red button", href "", onClick RequestDelete ] + [ text "Delete" ] + + else + span [] [] + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] + ] + ] diff --git a/modules/webapp/src/main/elm/Comp/OrgTable.elm b/modules/webapp/src/main/elm/Comp/OrgTable.elm index 85b3ea87..7c526137 100644 --- a/modules/webapp/src/main/elm/Comp/OrgTable.elm +++ b/modules/webapp/src/main/elm/Comp/OrgTable.elm @@ -1,74 +1,80 @@ -module Comp.OrgTable exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.OrgTable exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) +import Api.Model.Organization exposing (Organization) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Data.Flags exposing (Flags) -import Api.Model.Organization exposing (Organization) -import Api.Model.Address exposing (Address) -import Api.Model.Contact exposing (Contact) import Util.Address import Util.Contact + type alias Model = - { equips: List Organization - , selected: Maybe Organization + { equips : List Organization + , selected : Maybe Organization } -emptyModel: Model + +emptyModel : Model emptyModel = { equips = [] , selected = Nothing } + type Msg = SetOrgs (List Organization) | Select Organization | Deselect -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetOrgs list -> - ({model | equips = list, selected = Nothing }, Cmd.none) + ( { model | equips = list, selected = Nothing }, Cmd.none ) Select equip -> - ({model | selected = Just equip}, Cmd.none) + ( { model | selected = Just equip }, Cmd.none ) Deselect -> - ({model | selected = Nothing}, Cmd.none) + ( { model | selected = Nothing }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - table [class "ui selectable table"] - [thead [] - [tr [] - [th [class "collapsing"][text "Name"] - ,th [][text "Address"] - ,th [][text "Contact"] - ] - ] - ,tbody [] + table [ class "ui selectable table" ] + [ thead [] + [ tr [] + [ th [ class "collapsing" ] [ text "Name" ] + , th [] [ text "Address" ] + , th [] [ text "Contact" ] + ] + ] + , tbody [] (List.map (renderOrgLine model) model.equips) ] -renderOrgLine: Model -> Organization -> Html Msg + +renderOrgLine : Model -> Organization -> Html Msg renderOrgLine model org = - tr [classList [("active", model.selected == Just org)] - ,onClick (Select org) - ] - [td [class "collapsing"] - [text org.name - ] - ,td [] - [Util.Address.toString org.address |> text + tr + [ classList [ ( "active", model.selected == Just org ) ] + , onClick (Select org) + ] + [ td [ class "collapsing" ] + [ text org.name ] - ,td [] - [Util.Contact.toString org.contacts |> text + , td [] + [ Util.Address.toString org.address |> text + ] + , td [] + [ Util.Contact.toString org.contacts |> text ] ] diff --git a/modules/webapp/src/main/elm/Comp/PersonForm.elm b/modules/webapp/src/main/elm/Comp/PersonForm.elm index aaa9e77a..25680aa2 100644 --- a/modules/webapp/src/main/elm/Comp/PersonForm.elm +++ b/modules/webapp/src/main/elm/Comp/PersonForm.elm @@ -1,30 +1,33 @@ -module Comp.PersonForm exposing ( Model - , emptyModel - , Msg(..) - , view - , update - , isValid - , getPerson) +module Comp.PersonForm exposing + ( Model + , Msg(..) + , emptyModel + , getPerson + , isValid + , update + , view + ) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onInput, onCheck) -import Data.Flags exposing (Flags) import Api.Model.Person exposing (Person) import Comp.AddressForm import Comp.ContactField -import Comp.YesNoDimmer +import Data.Flags exposing (Flags) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onCheck, onInput) + type alias Model = - { org: Person - , name: String - , addressModel: Comp.AddressForm.Model - , contactModel: Comp.ContactField.Model - , notes: Maybe String - , concerning: Bool + { org : Person + , name : String + , addressModel : Comp.AddressForm.Model + , contactModel : Comp.ContactField.Model + , notes : Maybe String + , concerning : Bool } -emptyModel: Model + +emptyModel : Model emptyModel = { org = Api.Model.Person.empty , name = "" @@ -34,21 +37,26 @@ emptyModel = , concerning = False } -isValid: Model -> Bool + +isValid : Model -> Bool isValid model = model.name /= "" -getPerson: Model -> Person + +getPerson : Model -> Person getPerson model = let - o = model.org + o = + model.org in - { o | name = model.name - , address = Comp.AddressForm.getAddress model.addressModel - , contacts = Comp.ContactField.getContacts model.contactModel - , notes = model.notes - , concerning = model.concerning - } + { o + | name = model.name + , address = Comp.AddressForm.getAddress model.addressModel + , contacts = Comp.ContactField.getContacts model.contactModel + , notes = model.notes + , concerning = model.concerning + } + type Msg = SetName String @@ -58,72 +66,101 @@ type Msg | SetNotes String | SetConcerning Bool -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetPerson t -> let - (m1, c1) = update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model - (m2, c2) = update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1 + ( m1, c1 ) = + update flags (AddressMsg (Comp.AddressForm.SetAddress t.address)) model + + ( m2, c2 ) = + update flags (ContactMsg (Comp.ContactField.SetItems t.contacts)) m1 in - ({m2 | org = t, name = t.name, notes = t.notes, concerning = t.concerning }, Cmd.none) + ( { m2 + | org = t + , name = t.name + , notes = t.notes + , concerning = t.concerning + } + , Cmd.batch [ c1, c2 ] + ) AddressMsg am -> let - (m1, c1) = Comp.AddressForm.update am model.addressModel + ( m1, c1 ) = + Comp.AddressForm.update am model.addressModel in - ({model | addressModel = m1}, Cmd.map AddressMsg c1) + ( { model | addressModel = m1 }, Cmd.map AddressMsg c1 ) ContactMsg m -> let - (m1, c1) = Comp.ContactField.update m model.contactModel + ( m1, c1 ) = + Comp.ContactField.update m model.contactModel in - ({model | contactModel = m1}, Cmd.map ContactMsg c1) + ( { model | contactModel = m1 }, Cmd.map ContactMsg c1 ) SetName n -> - ({model | name = n}, Cmd.none) + ( { model | name = n }, Cmd.none ) SetNotes str -> - ({model | notes = if str == "" then Nothing else Just str}, Cmd.none) + ( { model + | notes = + if str == "" then + Nothing - SetConcerning flag -> - ({model | concerning = not model.concerning}, Cmd.none) + else + Just str + } + , Cmd.none + ) + + SetConcerning _ -> + ( { model | concerning = not model.concerning }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - div [class "ui form"] - [div [classList [("field", True) - ,("error", not (isValid model)) - ] - ] - [label [][text "Name*"] - ,input [type_ "text" - ,onInput SetName - ,placeholder "Name" - ,value model.name - ][] - ] - ,div [class "inline field"] - [div [class "ui checkbox"] - [input [type_ "checkbox" - , checked model.concerning - , onCheck SetConcerning][] - ,label [][text "Use for concerning person suggestion only"] - ] + div [ class "ui form" ] + [ div + [ classList + [ ( "field", True ) + , ( "error", not (isValid model) ) + ] ] - ,h3 [class "ui dividing header"] - [text "Address" + [ label [] [ text "Name*" ] + , input + [ type_ "text" + , onInput SetName + , placeholder "Name" + , value model.name + ] + [] ] - ,Html.map AddressMsg (Comp.AddressForm.view model.addressModel) - ,h3 [class "ui dividing header"] - [text "Contacts" + , div [ class "inline field" ] + [ div [ class "ui checkbox" ] + [ input + [ type_ "checkbox" + , checked model.concerning + , onCheck SetConcerning + ] + [] + , label [] [ text "Use for concerning person suggestion only" ] + ] ] - ,Html.map ContactMsg (Comp.ContactField.view model.contactModel) - ,h3 [class "ui dividing header"] - [text "Notes" + , h3 [ class "ui dividing header" ] + [ text "Address" ] - ,div [class "field"] - [textarea [onInput SetNotes][Maybe.withDefault "" model.notes |> text ] + , Html.map AddressMsg (Comp.AddressForm.view model.addressModel) + , h3 [ class "ui dividing header" ] + [ text "Contacts" + ] + , Html.map ContactMsg (Comp.ContactField.view model.contactModel) + , h3 [ class "ui dividing header" ] + [ text "Notes" + ] + , div [ class "field" ] + [ textarea [ onInput SetNotes ] [ Maybe.withDefault "" model.notes |> text ] ] ] diff --git a/modules/webapp/src/main/elm/Comp/PersonManage.elm b/modules/webapp/src/main/elm/Comp/PersonManage.elm index add51e1d..81364df8 100644 --- a/modules/webapp/src/main/elm/Comp/PersonManage.elm +++ b/modules/webapp/src/main/elm/Comp/PersonManage.elm @@ -1,36 +1,43 @@ -module Comp.PersonManage exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.PersonManage exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) -import Http import Api +import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.Person +import Api.Model.PersonList exposing (PersonList) +import Comp.PersonForm +import Comp.PersonTable +import Comp.YesNoDimmer +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick, onSubmit) -import Data.Flags exposing (Flags) -import Comp.PersonTable -import Comp.PersonForm -import Comp.YesNoDimmer -import Api.Model.Person -import Api.Model.PersonList exposing (PersonList) -import Api.Model.BasicResult exposing (BasicResult) -import Util.Maybe +import Http import Util.Http +import Util.Maybe + type alias Model = - { tableModel: Comp.PersonTable.Model - , formModel: Comp.PersonForm.Model - , viewMode: ViewMode - , formError: Maybe String - , loading: Bool - , deleteConfirm: Comp.YesNoDimmer.Model + { tableModel : Comp.PersonTable.Model + , formModel : Comp.PersonForm.Model + , viewMode : ViewMode + , formError : Maybe String + , loading : Bool + , deleteConfirm : Comp.YesNoDimmer.Model } -type ViewMode = Table | Form -emptyModel: Model +type ViewMode + = Table + | Form + + +emptyModel : Model emptyModel = { tableModel = Comp.PersonTable.emptyModel , formModel = Comp.PersonForm.emptyModel @@ -40,6 +47,7 @@ emptyModel = , deleteConfirm = Comp.YesNoDimmer.emptyModel } + type Msg = TableMsg Comp.PersonTable.Msg | FormMsg Comp.PersonForm.Msg @@ -52,156 +60,210 @@ type Msg | YesNoMsg Comp.YesNoDimmer.Msg | RequestDelete -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of TableMsg m -> let - (tm, tc) = Comp.PersonTable.update flags m model.tableModel - (m2, c2) = ({model | tableModel = tm - , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table - , formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError - } - , Cmd.map TableMsg tc - ) - (m3, c3) = case tm.selected of + ( tm, tc ) = + Comp.PersonTable.update flags m model.tableModel + + ( m2, c2 ) = + ( { model + | tableModel = tm + , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table + , formError = + if Util.Maybe.nonEmpty tm.selected then + Nothing + + else + model.formError + } + , Cmd.map TableMsg tc + ) + + ( m3, c3 ) = + case tm.selected of Just org -> update flags (FormMsg (Comp.PersonForm.SetPerson org)) m2 + Nothing -> - (m2, Cmd.none) + ( m2, Cmd.none ) in - (m3, Cmd.batch [c2, c3]) + ( m3, Cmd.batch [ c2, c3 ] ) FormMsg m -> let - (m2, c2) = Comp.PersonForm.update flags m model.formModel + ( m2, c2 ) = + Comp.PersonForm.update flags m model.formModel in - ({model | formModel = m2}, Cmd.map FormMsg c2) + ( { model | formModel = m2 }, Cmd.map FormMsg c2 ) LoadPersons -> - ({model| loading = True}, Api.getPersons flags PersonResp) + ( { model | loading = True }, Api.getPersons flags PersonResp ) PersonResp (Ok orgs) -> let - m2 = {model|viewMode = Table, loading = False} + m2 = + { model | viewMode = Table, loading = False } in - update flags (TableMsg (Comp.PersonTable.SetPersons orgs.items)) m2 + update flags (TableMsg (Comp.PersonTable.SetPersons orgs.items)) m2 - PersonResp (Err err) -> - ({model|loading = False}, Cmd.none) + PersonResp (Err _) -> + ( { model | loading = False }, Cmd.none ) SetViewMode m -> let - m2 = {model | viewMode = m } + m2 = + { model | viewMode = m } in - case m of - Table -> - update flags (TableMsg Comp.PersonTable.Deselect) m2 - Form -> - (m2, Cmd.none) + case m of + Table -> + update flags (TableMsg Comp.PersonTable.Deselect) m2 + + Form -> + ( m2, Cmd.none ) InitNewPerson -> let - nm = {model | viewMode = Form, formError = Nothing } - org = Api.Model.Person.empty + nm = + { model | viewMode = Form, formError = Nothing } + + org = + Api.Model.Person.empty in - update flags (FormMsg (Comp.PersonForm.SetPerson org)) nm + update flags (FormMsg (Comp.PersonForm.SetPerson org)) nm Submit -> let - person = Comp.PersonForm.getPerson model.formModel - valid = Comp.PersonForm.isValid model.formModel - in if valid then - ({model|loading = True}, Api.postPerson flags person SubmitResp) - else - ({model|formError = Just "Please correct the errors in the form."}, Cmd.none) + person = + Comp.PersonForm.getPerson model.formModel + + valid = + Comp.PersonForm.isValid model.formModel + in + if valid then + ( { model | loading = True }, Api.postPerson flags person SubmitResp ) + + else + ( { model | formError = Just "Please correct the errors in the form." }, Cmd.none ) SubmitResp (Ok res) -> if res.success then let - (m2, c2) = update flags (SetViewMode Table) model - (m3, c3) = update flags LoadPersons m2 + ( m2, c2 ) = + update flags (SetViewMode Table) model + + ( m3, c3 ) = + update flags LoadPersons m2 in - ({m3|loading = False}, Cmd.batch [c2,c3]) + ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] ) + else - ({model | formError = Just res.message, loading = False }, Cmd.none) + ( { model | formError = Just res.message, loading = False }, Cmd.none ) SubmitResp (Err err) -> - ({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none) + ( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none ) RequestDelete -> update flags (YesNoMsg Comp.YesNoDimmer.activate) model YesNoMsg m -> let - (cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm - person = Comp.PersonForm.getPerson model.formModel - cmd = if confirmed then Api.deletePerson flags person.id SubmitResp else Cmd.none + ( cm, confirmed ) = + Comp.YesNoDimmer.update m model.deleteConfirm + + person = + Comp.PersonForm.getPerson model.formModel + + cmd = + if confirmed then + Api.deletePerson flags person.id SubmitResp + + else + Cmd.none in - ({model | deleteConfirm = cm}, cmd) + ( { model | deleteConfirm = cm }, cmd ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - if model.viewMode == Table then viewTable model - else viewForm model + if model.viewMode == Table then + viewTable model -viewTable: Model -> Html Msg + else + viewForm model + + +viewTable : Model -> Html Msg viewTable model = div [] - [button [class "ui basic button", onClick InitNewPerson] - [i [class "plus icon"][] - ,text "Create new" - ] - ,Html.map TableMsg (Comp.PersonTable.view model.tableModel) - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] + [ button [ class "ui basic button", onClick InitNewPerson ] + [ i [ class "plus icon" ] [] + , text "Create new" + ] + , Html.map TableMsg (Comp.PersonTable.view model.tableModel) + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] ] ] -viewForm: Model -> Html Msg + +viewForm : Model -> Html Msg viewForm model = let - newPerson = model.formModel.org.id == "" + newPerson = + model.formModel.org.id == "" in - Html.form [class "ui segment", onSubmit Submit] - [Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) - ,if newPerson then - h3 [class "ui dividing header"] - [text "Create new person" - ] - else - h3 [class "ui dividing header"] - [text ("Edit org: " ++ model.formModel.org.name) - ,div [class "sub header"] - [text "Id: " - ,text model.formModel.org.id - ] - ] - ,Html.map FormMsg (Comp.PersonForm.view model.formModel) - ,div [classList [("ui error message", True) - ,("invisible", Util.Maybe.isEmpty model.formError) - ] - ] - [Maybe.withDefault "" model.formError |> text - ] - ,div [class "ui horizontal divider"][] - ,button [class "ui primary button", type_ "submit"] - [text "Submit" + Html.form [ class "ui segment", onSubmit Submit ] + [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) + , if newPerson then + h3 [ class "ui dividing header" ] + [ text "Create new person" ] - ,a [class "ui secondary button", onClick (SetViewMode Table), href ""] - [text "Cancel" + + else + h3 [ class "ui dividing header" ] + [ text ("Edit org: " ++ model.formModel.org.name) + , div [ class "sub header" ] + [ text "Id: " + , text model.formModel.org.id + ] + ] + , Html.map FormMsg (Comp.PersonForm.view model.formModel) + , div + [ classList + [ ( "ui error message", True ) + , ( "invisible", Util.Maybe.isEmpty model.formError ) ] - ,if not newPerson then - a [class "ui right floated red button", href "", onClick RequestDelete] - [text "Delete"] - else - span[][] - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] - ] ] + [ Maybe.withDefault "" model.formError |> text + ] + , div [ class "ui horizontal divider" ] [] + , button [ class "ui primary button", type_ "submit" ] + [ text "Submit" + ] + , a [ class "ui secondary button", onClick (SetViewMode Table), href "" ] + [ text "Cancel" + ] + , if not newPerson then + a [ class "ui right floated red button", href "", onClick RequestDelete ] + [ text "Delete" ] + + else + span [] [] + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] + ] + ] diff --git a/modules/webapp/src/main/elm/Comp/PersonTable.elm b/modules/webapp/src/main/elm/Comp/PersonTable.elm index 413bc2ef..ae1d655a 100644 --- a/modules/webapp/src/main/elm/Comp/PersonTable.elm +++ b/modules/webapp/src/main/elm/Comp/PersonTable.elm @@ -1,81 +1,88 @@ -module Comp.PersonTable exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.PersonTable exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) +import Api.Model.Person exposing (Person) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Data.Flags exposing (Flags) -import Api.Model.Person exposing (Person) -import Api.Model.Address exposing (Address) -import Api.Model.Contact exposing (Contact) import Util.Address import Util.Contact + type alias Model = - { equips: List Person - , selected: Maybe Person + { equips : List Person + , selected : Maybe Person } -emptyModel: Model + +emptyModel : Model emptyModel = { equips = [] , selected = Nothing } + type Msg = SetPersons (List Person) | Select Person | Deselect -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetPersons list -> - ({model | equips = list, selected = Nothing }, Cmd.none) + ( { model | equips = list, selected = Nothing }, Cmd.none ) Select equip -> - ({model | selected = Just equip}, Cmd.none) + ( { model | selected = Just equip }, Cmd.none ) Deselect -> - ({model | selected = Nothing}, Cmd.none) + ( { model | selected = Nothing }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - table [class "ui selectable table"] - [thead [] - [tr [] - [th [class "collapsing"][text "Name"] - ,th [class "collapsing"][text "Concerning"] - ,th [][text "Address"] - ,th [][text "Contact"] - ] - ] - ,tbody [] + table [ class "ui selectable table" ] + [ thead [] + [ tr [] + [ th [ class "collapsing" ] [ text "Name" ] + , th [ class "collapsing" ] [ text "Concerning" ] + , th [] [ text "Address" ] + , th [] [ text "Contact" ] + ] + ] + , tbody [] (List.map (renderPersonLine model) model.equips) ] -renderPersonLine: Model -> Person -> Html Msg + +renderPersonLine : Model -> Person -> Html Msg renderPersonLine model person = - tr [classList [("active", model.selected == Just person)] - ,onClick (Select person) - ] - [td [class "collapsing"] - [text person.name - ] - ,td [class "collapsing"] - [if person.concerning then - i [class "check square outline icon"][] - else - i [class "minus square outline icon"][] + tr + [ classList [ ( "active", model.selected == Just person ) ] + , onClick (Select person) + ] + [ td [ class "collapsing" ] + [ text person.name ] - ,td [] - [Util.Address.toString person.address |> text + , td [ class "collapsing" ] + [ if person.concerning then + i [ class "check square outline icon" ] [] + + else + i [ class "minus square outline icon" ] [] ] - ,td [] - [Util.Contact.toString person.contacts |> text + , td [] + [ Util.Address.toString person.address |> text + ] + , td [] + [ Util.Contact.toString person.contacts |> text ] ] diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index 116910c5..ef4076be 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -1,87 +1,96 @@ -module Comp.SearchMenu exposing ( Model - , emptyModel - , Msg(..) - , update - , NextState - , view - , getItemSearch - ) +module Comp.SearchMenu exposing + ( Model + , Msg(..) + , NextState + , emptyModel + , getItemSearch + , update + , view + ) -import Http +import Api +import Api.Model.Equipment exposing (Equipment) +import Api.Model.EquipmentList exposing (EquipmentList) +import Api.Model.IdName exposing (IdName) +import Api.Model.ItemSearch exposing (ItemSearch) +import Api.Model.ReferenceList exposing (ReferenceList) +import Api.Model.Tag exposing (Tag) +import Api.Model.TagList exposing (TagList) +import Comp.DatePicker +import Comp.Dropdown exposing (isDropdownChangeMsg) +import Data.Direction exposing (Direction) +import Data.Flags exposing (Flags) +import DatePicker exposing (DatePicker) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onCheck, onInput) -import Data.Direction exposing (Direction) -import Data.Flags exposing (Flags) -import Comp.Dropdown exposing (isDropdownChangeMsg) -import Comp.DatePicker -import DatePicker exposing (DatePicker) -import Api -import Api.Model.IdName exposing (IdName) -import Api.Model.ItemSearch exposing (ItemSearch) -import Api.Model.TagList exposing (TagList) -import Api.Model.Tag exposing (Tag) -import Api.Model.Equipment exposing (Equipment) -import Api.Model.ReferenceList exposing (ReferenceList) -import Api.Model.EquipmentList exposing (EquipmentList) +import Http import Util.Maybe import Util.Update + + -- Data Model + type alias Model = - { tagInclModel: Comp.Dropdown.Model Tag - , tagExclModel: Comp.Dropdown.Model Tag - , directionModel: Comp.Dropdown.Model Direction - , orgModel: Comp.Dropdown.Model IdName - , corrPersonModel: Comp.Dropdown.Model IdName - , concPersonModel: Comp.Dropdown.Model IdName - , concEquipmentModel: Comp.Dropdown.Model Equipment - , inboxCheckbox: Bool - , fromDateModel: DatePicker - , fromDate: Maybe Int - , untilDateModel: DatePicker - , untilDate: Maybe Int - , fromDueDateModel: DatePicker - , fromDueDate: Maybe Int - , untilDueDateModel: DatePicker - , untilDueDate: Maybe Int - , nameModel: Maybe String + { tagInclModel : Comp.Dropdown.Model Tag + , tagExclModel : Comp.Dropdown.Model Tag + , directionModel : Comp.Dropdown.Model Direction + , orgModel : Comp.Dropdown.Model IdName + , corrPersonModel : Comp.Dropdown.Model IdName + , concPersonModel : Comp.Dropdown.Model IdName + , concEquipmentModel : Comp.Dropdown.Model Equipment + , inboxCheckbox : Bool + , fromDateModel : DatePicker + , fromDate : Maybe Int + , untilDateModel : DatePicker + , untilDate : Maybe Int + , fromDueDateModel : DatePicker + , fromDueDate : Maybe Int + , untilDueDateModel : DatePicker + , untilDueDate : Maybe Int + , nameModel : Maybe String } -emptyModel: Model +emptyModel : Model emptyModel = { tagInclModel = makeTagModel , tagExclModel = makeTagModel - , directionModel = Comp.Dropdown.makeSingleList - { makeOption = \entry -> {value = Data.Direction.toString entry, text = Data.Direction.toString entry} - , options = Data.Direction.all - , placeholder = "Choose a direction…" - , selected = Nothing - } - , orgModel = Comp.Dropdown.makeModel - { multiple = False - , searchable = \n -> n > 5 - , makeOption = \e -> {value = e.id, text = e.name} - , labelColor = \_ -> "" - , placeholder = "Choose an organization" - } - , corrPersonModel = Comp.Dropdown.makeSingle - { makeOption = \e -> {value = e.id, text = e.name} - , placeholder = "Choose a person" - } - , concPersonModel = Comp.Dropdown.makeSingle - { makeOption = \e -> {value = e.id, text = e.name} - , placeholder = "Choose a person" - } - , concEquipmentModel = Comp.Dropdown.makeModel - { multiple = False - , searchable = \n -> n > 5 - , makeOption = \e -> {value = e.id, text = e.name} - , labelColor = \_ -> "" - , placeholder = "Choosa an equipment" - } + , directionModel = + Comp.Dropdown.makeSingleList + { makeOption = \entry -> { value = Data.Direction.toString entry, text = Data.Direction.toString entry } + , options = Data.Direction.all + , placeholder = "Choose a direction…" + , selected = Nothing + } + , orgModel = + Comp.Dropdown.makeModel + { multiple = False + , searchable = \n -> n > 5 + , makeOption = \e -> { value = e.id, text = e.name } + , labelColor = \_ -> "" + , placeholder = "Choose an organization" + } + , corrPersonModel = + Comp.Dropdown.makeSingle + { makeOption = \e -> { value = e.id, text = e.name } + , placeholder = "Choose a person" + } + , concPersonModel = + Comp.Dropdown.makeSingle + { makeOption = \e -> { value = e.id, text = e.name } + , placeholder = "Choose a person" + } + , concEquipmentModel = + Comp.Dropdown.makeModel + { multiple = False + , searchable = \n -> n > 5 + , makeOption = \e -> { value = e.id, text = e.name } + , labelColor = \_ -> "" + , placeholder = "Choosa an equipment" + } , inboxCheckbox = False , fromDateModel = Comp.DatePicker.emptyModel , fromDate = Nothing @@ -94,6 +103,7 @@ emptyModel = , nameModel = Nothing } + type Msg = Init | TagIncMsg (Comp.Dropdown.Msg Tag) @@ -115,315 +125,386 @@ type Msg | SetName String -makeTagModel: Comp.Dropdown.Model Tag +makeTagModel : Comp.Dropdown.Model Tag makeTagModel = Comp.Dropdown.makeModel { multiple = True , searchable = \n -> n > 4 , makeOption = \tag -> { value = tag.id, text = tag.name } - , labelColor = \tag -> if Util.Maybe.nonEmpty tag.category then "basic blue" else "" + , labelColor = + \tag -> + if Util.Maybe.nonEmpty tag.category then + "basic blue" + + else + "" , placeholder = "Choose a tag…" } -getDirection: Model -> Maybe Direction + +getDirection : Model -> Maybe Direction getDirection model = let - selection = Comp.Dropdown.getSelected model.directionModel + selection = + Comp.Dropdown.getSelected model.directionModel in - case selection of - [d] -> Just d - _ -> Nothing + case selection of + [ d ] -> + Just d -getItemSearch: Model -> ItemSearch + _ -> + Nothing + + +getItemSearch : Model -> ItemSearch getItemSearch model = - let e = Api.Model.ItemSearch.empty in - { e | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id - , tagsExclude = Comp.Dropdown.getSelected model.tagExclModel |> List.map .id - , corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head - , corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head - , concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head - , concEquip = Comp.Dropdown.getSelected model.concEquipmentModel |> List.map .id |> List.head - , direction = Comp.Dropdown.getSelected model.directionModel |> List.head |> Maybe.map Data.Direction.toString - , inbox = model.inboxCheckbox - , dateFrom = model.fromDate - , dateUntil = model.untilDate - , dueDateFrom = model.fromDueDate - , dueDateUntil = model.untilDueDate - , name = model.nameModel + let + e = + Api.Model.ItemSearch.empty + in + { e + | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id + , tagsExclude = Comp.Dropdown.getSelected model.tagExclModel |> List.map .id + , corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head + , corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head + , concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head + , concEquip = Comp.Dropdown.getSelected model.concEquipmentModel |> List.map .id |> List.head + , direction = Comp.Dropdown.getSelected model.directionModel |> List.head |> Maybe.map Data.Direction.toString + , inbox = model.inboxCheckbox + , dateFrom = model.fromDate + , dateUntil = model.untilDate + , dueDateFrom = model.fromDueDate + , dueDateUntil = model.untilDueDate + , name = model.nameModel } + + -- Update -type alias NextState - = { modelCmd: (Model, Cmd Msg) - , stateChange: Bool - } -noChange: (Model, Cmd Msg) -> NextState +type alias NextState = + { modelCmd : ( Model, Cmd Msg ) + , stateChange : Bool + } + + +noChange : ( Model, Cmd Msg ) -> NextState noChange p = NextState p False -update: Flags -> Msg -> Model -> NextState + +update : Flags -> Msg -> Model -> NextState update flags msg model = case msg of Init -> let - (dp, dpc) = Comp.DatePicker.init + ( dp, dpc ) = + Comp.DatePicker.init in - noChange ({model|untilDateModel = dp, fromDateModel = dp, untilDueDateModel = dp, fromDueDateModel = dp} - , Cmd.batch - [Api.getTags flags GetTagsResp - ,Api.getOrgLight flags GetOrgResp - ,Api.getEquipments flags GetEquipResp - ,Api.getPersonsLight flags GetPersonResp - ,Cmd.map UntilDateMsg dpc - ,Cmd.map FromDateMsg dpc - ,Cmd.map UntilDueDateMsg dpc - ,Cmd.map FromDueDateMsg dpc - ] - ) + noChange + ( { model | untilDateModel = dp, fromDateModel = dp, untilDueDateModel = dp, fromDueDateModel = dp } + , Cmd.batch + [ Api.getTags flags GetTagsResp + , Api.getOrgLight flags GetOrgResp + , Api.getEquipments flags GetEquipResp + , Api.getPersonsLight flags GetPersonResp + , Cmd.map UntilDateMsg dpc + , Cmd.map FromDateMsg dpc + , Cmd.map UntilDueDateMsg dpc + , Cmd.map FromDueDateMsg dpc + ] + ) GetTagsResp (Ok tags) -> let - tagList = Comp.Dropdown.SetOptions tags.items + tagList = + Comp.Dropdown.SetOptions tags.items in - noChange <| - Util.Update.andThen1 - [ update flags (TagIncMsg tagList) >> .modelCmd - , update flags (TagExcMsg tagList) >> .modelCmd - ] - model + noChange <| + Util.Update.andThen1 + [ update flags (TagIncMsg tagList) >> .modelCmd + , update flags (TagExcMsg tagList) >> .modelCmd + ] + model - GetTagsResp (Err err) -> - noChange (model, Cmd.none) + GetTagsResp (Err _) -> + noChange ( model, Cmd.none ) GetEquipResp (Ok equips) -> let - opts = Comp.Dropdown.SetOptions equips.items + opts = + Comp.Dropdown.SetOptions equips.items in - update flags (ConcEquipmentMsg opts) model + update flags (ConcEquipmentMsg opts) model - GetEquipResp (Err err) -> - noChange (model, Cmd.none) + GetEquipResp (Err _) -> + noChange ( model, Cmd.none ) GetOrgResp (Ok orgs) -> let - opts = Comp.Dropdown.SetOptions orgs.items + opts = + Comp.Dropdown.SetOptions orgs.items in - update flags (OrgMsg opts) model + update flags (OrgMsg opts) model - GetOrgResp (Err err) -> - noChange (model, Cmd.none) + GetOrgResp (Err _) -> + noChange ( model, Cmd.none ) GetPersonResp (Ok ps) -> let - opts = Comp.Dropdown.SetOptions ps.items + opts = + Comp.Dropdown.SetOptions ps.items in - noChange <| - Util.Update.andThen1 - [ update flags (CorrPersonMsg opts) >> .modelCmd - , update flags (ConcPersonMsg opts) >> .modelCmd - ] - model + noChange <| + Util.Update.andThen1 + [ update flags (CorrPersonMsg opts) >> .modelCmd + , update flags (ConcPersonMsg opts) >> .modelCmd + ] + model - GetPersonResp (Err err) -> - noChange (model, Cmd.none) + GetPersonResp (Err _) -> + noChange ( model, Cmd.none ) TagIncMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.tagInclModel + ( m2, c2 ) = + Comp.Dropdown.update m model.tagInclModel in - NextState ({model|tagInclModel = m2}, Cmd.map TagIncMsg c2) (isDropdownChangeMsg m) + NextState ( { model | tagInclModel = m2 }, Cmd.map TagIncMsg c2 ) (isDropdownChangeMsg m) TagExcMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.tagExclModel + ( m2, c2 ) = + Comp.Dropdown.update m model.tagExclModel in - NextState ({model|tagExclModel = m2}, Cmd.map TagExcMsg c2) (isDropdownChangeMsg m) + NextState ( { model | tagExclModel = m2 }, Cmd.map TagExcMsg c2 ) (isDropdownChangeMsg m) DirectionMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.directionModel + ( m2, c2 ) = + Comp.Dropdown.update m model.directionModel in - NextState ({model|directionModel = m2}, Cmd.map DirectionMsg c2) (isDropdownChangeMsg m) + NextState ( { model | directionModel = m2 }, Cmd.map DirectionMsg c2 ) (isDropdownChangeMsg m) OrgMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.orgModel + ( m2, c2 ) = + Comp.Dropdown.update m model.orgModel in - NextState ({model|orgModel = m2}, Cmd.map OrgMsg c2) (isDropdownChangeMsg m) + NextState ( { model | orgModel = m2 }, Cmd.map OrgMsg c2 ) (isDropdownChangeMsg m) CorrPersonMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.corrPersonModel + ( m2, c2 ) = + Comp.Dropdown.update m model.corrPersonModel in - NextState ({model|corrPersonModel = m2}, Cmd.map CorrPersonMsg c2) (isDropdownChangeMsg m) + NextState ( { model | corrPersonModel = m2 }, Cmd.map CorrPersonMsg c2 ) (isDropdownChangeMsg m) ConcPersonMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.concPersonModel + ( m2, c2 ) = + Comp.Dropdown.update m model.concPersonModel in - NextState ({model|concPersonModel = m2}, Cmd.map ConcPersonMsg c2) (isDropdownChangeMsg m) + NextState ( { model | concPersonModel = m2 }, Cmd.map ConcPersonMsg c2 ) (isDropdownChangeMsg m) ConcEquipmentMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.concEquipmentModel + ( m2, c2 ) = + Comp.Dropdown.update m model.concEquipmentModel in - NextState ({model|concEquipmentModel = m2}, Cmd.map ConcEquipmentMsg c2) (isDropdownChangeMsg m) + NextState ( { model | concEquipmentModel = m2 }, Cmd.map ConcEquipmentMsg c2 ) (isDropdownChangeMsg m) ToggleInbox -> let - current = model.inboxCheckbox + current = + model.inboxCheckbox in - NextState ({model | inboxCheckbox = not current }, Cmd.none) True + NextState ( { model | inboxCheckbox = not current }, Cmd.none ) True FromDateMsg m -> let - (dp, event) = Comp.DatePicker.updateDefault m model.fromDateModel - nextDate = case event of - DatePicker.Picked date -> - Just (Comp.DatePicker.startOfDay date) - _ -> - Nothing + ( dp, event ) = + Comp.DatePicker.updateDefault m model.fromDateModel + + nextDate = + case event of + DatePicker.Picked date -> + Just (Comp.DatePicker.startOfDay date) + + _ -> + Nothing in - NextState ({model|fromDateModel = dp, fromDate = nextDate}, Cmd.none) (model.fromDate /= nextDate) + NextState ( { model | fromDateModel = dp, fromDate = nextDate }, Cmd.none ) (model.fromDate /= nextDate) UntilDateMsg m -> let - (dp, event) = Comp.DatePicker.updateDefault m model.untilDateModel - nextDate = case event of - DatePicker.Picked date -> - Just (Comp.DatePicker.endOfDay date) - _ -> - Nothing + ( dp, event ) = + Comp.DatePicker.updateDefault m model.untilDateModel + + nextDate = + case event of + DatePicker.Picked date -> + Just (Comp.DatePicker.endOfDay date) + + _ -> + Nothing in - NextState ({model|untilDateModel = dp, untilDate = nextDate}, Cmd.none) (model.untilDate /= nextDate) + NextState ( { model | untilDateModel = dp, untilDate = nextDate }, Cmd.none ) (model.untilDate /= nextDate) FromDueDateMsg m -> let - (dp, event) = Comp.DatePicker.updateDefault m model.fromDueDateModel - nextDate = case event of - DatePicker.Picked date -> - Just (Comp.DatePicker.startOfDay date) - _ -> - Nothing + ( dp, event ) = + Comp.DatePicker.updateDefault m model.fromDueDateModel + + nextDate = + case event of + DatePicker.Picked date -> + Just (Comp.DatePicker.startOfDay date) + + _ -> + Nothing in - NextState ({model|fromDueDateModel = dp, fromDueDate = nextDate}, Cmd.none) (model.fromDueDate /= nextDate) + NextState ( { model | fromDueDateModel = dp, fromDueDate = nextDate }, Cmd.none ) (model.fromDueDate /= nextDate) UntilDueDateMsg m -> let - (dp, event) = Comp.DatePicker.updateDefault m model.untilDueDateModel - nextDate = case event of - DatePicker.Picked date -> - Just (Comp.DatePicker.endOfDay date) - _ -> - Nothing + ( dp, event ) = + Comp.DatePicker.updateDefault m model.untilDueDateModel + + nextDate = + case event of + DatePicker.Picked date -> + Just (Comp.DatePicker.endOfDay date) + + _ -> + Nothing in - NextState ({model|untilDueDateModel = dp, untilDueDate = nextDate}, Cmd.none) (model.untilDueDate /= nextDate) + NextState ( { model | untilDueDateModel = dp, untilDueDate = nextDate }, Cmd.none ) (model.untilDueDate /= nextDate) SetName str -> let - next = if str == "" then Nothing else Just str + next = + if str == "" then + Nothing + + else + Just str in - NextState ({model|nameModel = next}, Cmd.none) (model.nameModel /= next) + NextState ( { model | nameModel = next }, Cmd.none ) (model.nameModel /= next) + -- View - -view: Model -> Html Msg +view : Model -> Html Msg view model = - div [class "ui form"] - [div [class "inline field"] - [div [class "ui checkbox"] - [input [type_ "checkbox" - , onCheck (\_ -> ToggleInbox) - , checked model.inboxCheckbox][] - ,label [][text "Only New" - ] - ] - ] - ,div [class "field"] - [label [][text "Name"] - ,input [type_ "text" - ,onInput SetName - ,model.nameModel |> Maybe.withDefault "" |> value - ][] - ,span [class "small-info"] - [text "May contain wildcard " - ,code [][text "*"] - ,text " at beginning or end" - ] - ] - ,div [class "field"] - [label [][text "Direction"] - ,Html.map DirectionMsg (Comp.Dropdown.view model.directionModel) - ] - ,h3 [class "ui header"] - [text "Tags" + div [ class "ui form" ] + [ div [ class "inline field" ] + [ div [ class "ui checkbox" ] + [ input + [ type_ "checkbox" + , onCheck (\_ -> ToggleInbox) + , checked model.inboxCheckbox + ] + [] + , label [] + [ text "Only New" + ] + ] ] - ,div [class "field"] - [label [][text "Include (and)"] - ,Html.map TagIncMsg (Comp.Dropdown.view model.tagInclModel) - ] - ,div [class "field"] - [label [][text "Exclude (or)"] - ,Html.map TagExcMsg (Comp.Dropdown.view model.tagExclModel) - ] - ,h3 [class "ui header"] + , div [ class "field" ] + [ label [] [ text "Name" ] + , input + [ type_ "text" + , onInput SetName + , model.nameModel |> Maybe.withDefault "" |> value + ] + [] + , span [ class "small-info" ] + [ text "May contain wildcard " + , code [] [ text "*" ] + , text " at beginning or end" + ] + ] + , div [ class "field" ] + [ label [] [ text "Direction" ] + , Html.map DirectionMsg (Comp.Dropdown.view model.directionModel) + ] + , h3 [ class "ui header" ] + [ text "Tags" + ] + , div [ class "field" ] + [ label [] [ text "Include (and)" ] + , Html.map TagIncMsg (Comp.Dropdown.view model.tagInclModel) + ] + , div [ class "field" ] + [ label [] [ text "Exclude (or)" ] + , Html.map TagExcMsg (Comp.Dropdown.view model.tagExclModel) + ] + , h3 [ class "ui header" ] [ case getDirection model of - Just Data.Direction.Incoming -> text "Sender" - Just Data.Direction.Outgoing -> text "Recipient" - Nothing -> text "Correspondent" + Just Data.Direction.Incoming -> + text "Sender" + + Just Data.Direction.Outgoing -> + text "Recipient" + + Nothing -> + text "Correspondent" ] - ,div [class "field"] - [label [][text "Organization"] - ,Html.map OrgMsg (Comp.Dropdown.view model.orgModel) - ] - ,div [class "field"] - [label [][text "Person"] - ,Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel) - ] - ,h3 [class "ui header"] - [text "Concerned" + , div [ class "field" ] + [ label [] [ text "Organization" ] + , Html.map OrgMsg (Comp.Dropdown.view model.orgModel) ] - ,div [class "field"] - [label [][text "Person"] - ,Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel) - ] - ,div [class "field"] - [label [][text "Equipment"] - ,Html.map ConcEquipmentMsg (Comp.Dropdown.view model.concEquipmentModel) - ] - ,h3 [class "ui header"] - [text "Date" + , div [ class "field" ] + [ label [] [ text "Person" ] + , Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel) ] - ,div [class "fields"] - [div [class "field"] - [label [][text "From" - ] - ,Html.map FromDateMsg (Comp.DatePicker.viewTimeDefault model.fromDate model.fromDateModel) - ] - ,div [class "field"] - [label [][text "To" - ] - ,Html.map UntilDateMsg (Comp.DatePicker.viewTimeDefault model.untilDate model.untilDateModel) - ] - ] - ,h3 [class "ui header"] - [text "Due Date" + , h3 [ class "ui header" ] + [ text "Concerned" + ] + , div [ class "field" ] + [ label [] [ text "Person" ] + , Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel) + ] + , div [ class "field" ] + [ label [] [ text "Equipment" ] + , Html.map ConcEquipmentMsg (Comp.Dropdown.view model.concEquipmentModel) + ] + , h3 [ class "ui header" ] + [ text "Date" + ] + , div [ class "fields" ] + [ div [ class "field" ] + [ label [] + [ text "From" + ] + , Html.map FromDateMsg (Comp.DatePicker.viewTimeDefault model.fromDate model.fromDateModel) + ] + , div [ class "field" ] + [ label [] + [ text "To" + ] + , Html.map UntilDateMsg (Comp.DatePicker.viewTimeDefault model.untilDate model.untilDateModel) + ] + ] + , h3 [ class "ui header" ] + [ text "Due Date" + ] + , div [ class "fields" ] + [ div [ class "field" ] + [ label [] + [ text "Due From" + ] + , Html.map FromDueDateMsg (Comp.DatePicker.viewTimeDefault model.fromDueDate model.fromDueDateModel) + ] + , div [ class "field" ] + [ label [] + [ text "Due To" + ] + , Html.map UntilDueDateMsg (Comp.DatePicker.viewTimeDefault model.untilDueDate model.untilDueDateModel) + ] ] - ,div [class "fields"] - [div [class "field"] - [label [][text "Due From" - ] - ,Html.map FromDueDateMsg (Comp.DatePicker.viewTimeDefault model.fromDueDate model.fromDueDateModel) - ] - ,div [class "field"] - [label [][text "Due To" - ] - ,Html.map UntilDueDateMsg (Comp.DatePicker.viewTimeDefault model.untilDueDate model.untilDueDateModel) - ] - ] ] diff --git a/modules/webapp/src/main/elm/Comp/Settings.elm b/modules/webapp/src/main/elm/Comp/Settings.elm index 79a61ff4..113ec268 100644 --- a/modules/webapp/src/main/elm/Comp/Settings.elm +++ b/modules/webapp/src/main/elm/Comp/Settings.elm @@ -1,62 +1,88 @@ -module Comp.Settings exposing (..) +module Comp.Settings exposing + ( Model + , Msg + , getSettings + , init + , update + , view + ) +import Api.Model.CollectiveSettings exposing (CollectiveSettings) +import Comp.Dropdown +import Data.Flags exposing (Flags) +import Data.Language exposing (Language) import Html exposing (..) import Html.Attributes exposing (..) -import Data.Language exposing (Language) -import Data.Flags exposing (Flags) -import Comp.Dropdown -import Api.Model.CollectiveSettings exposing (CollectiveSettings) + type alias Model = - { langModel: Comp.Dropdown.Model Language - , initSettings: CollectiveSettings + { langModel : Comp.Dropdown.Model Language + , initSettings : CollectiveSettings } -init: CollectiveSettings -> Model + +init : CollectiveSettings -> Model init settings = let - lang = Data.Language.fromString settings.language |> Maybe.withDefault Data.Language.German + lang = + Data.Language.fromString settings.language + |> Maybe.withDefault Data.Language.German in - { langModel = Comp.Dropdown.makeSingleList - { makeOption = \l -> { value = Data.Language.toIso3 l, text = Data.Language.toName l } - , placeholder = "" - , options = Data.Language.all - , selected = Just lang - } - , initSettings = settings - } + { langModel = + Comp.Dropdown.makeSingleList + { makeOption = + \l -> + { value = Data.Language.toIso3 l + , text = Data.Language.toName l + } + , placeholder = "" + , options = Data.Language.all + , selected = Just lang + } + , initSettings = settings + } -getSettings: Model -> CollectiveSettings + +getSettings : Model -> CollectiveSettings getSettings model = CollectiveSettings (Comp.Dropdown.getSelected model.langModel - |> List.head - |> Maybe.map Data.Language.toIso3 - |> Maybe.withDefault model.initSettings.language + |> List.head + |> Maybe.map Data.Language.toIso3 + |> Maybe.withDefault model.initSettings.language ) + type Msg = LangDropdownMsg (Comp.Dropdown.Msg Language) -update: Flags -> Msg -> Model -> (Model, Cmd Msg, Maybe CollectiveSettings) +update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe CollectiveSettings ) update flags msg model = case msg of LangDropdownMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.langModel - nextModel = {model|langModel = m2} - nextSettings = if Comp.Dropdown.isDropdownChangeMsg m then Just (getSettings nextModel) - else Nothing + ( m2, c2 ) = + Comp.Dropdown.update m model.langModel + + nextModel = + { model | langModel = m2 } + + nextSettings = + if Comp.Dropdown.isDropdownChangeMsg m then + Just (getSettings nextModel) + + else + Nothing in - (nextModel, Cmd.map LangDropdownMsg c2, nextSettings) + ( nextModel, Cmd.map LangDropdownMsg c2, nextSettings ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - div [class "ui form"] - [div [class "field"] - [label [][text "Document Language"] - ,Html.map LangDropdownMsg (Comp.Dropdown.view model.langModel) - ] + div [ class "ui form" ] + [ div [ class "field" ] + [ label [] [ text "Document Language" ] + , Html.map LangDropdownMsg (Comp.Dropdown.view model.langModel) + ] ] diff --git a/modules/webapp/src/main/elm/Comp/SourceForm.elm b/modules/webapp/src/main/elm/Comp/SourceForm.elm index 2f59d1a4..2274adb8 100644 --- a/modules/webapp/src/main/elm/Comp/SourceForm.elm +++ b/modules/webapp/src/main/elm/Comp/SourceForm.elm @@ -1,60 +1,68 @@ -module Comp.SourceForm exposing ( Model - , emptyModel - , Msg(..) - , view - , update - , isValid - , getSource) +module Comp.SourceForm exposing + ( Model + , Msg(..) + , emptyModel + , getSource + , isValid + , update + , view + ) +import Api.Model.Source exposing (Source) +import Comp.Dropdown +import Data.Flags exposing (Flags) +import Data.Priority exposing (Priority) import Html exposing (..) import Html.Attributes exposing (..) -import Html.Events exposing (onInput, onCheck) -import Data.Flags exposing (Flags) -import Data.SourceState exposing (SourceState) -import Data.Priority exposing (Priority) -import Comp.Dropdown -import Api.Model.Source exposing (Source) -import Util.Maybe +import Html.Events exposing (onCheck, onInput) + type alias Model = - { source: Source - , abbrev: String - , description: Maybe String - , priority: Comp.Dropdown.Model Priority - , enabled: Bool + { source : Source + , abbrev : String + , description : Maybe String + , priority : Comp.Dropdown.Model Priority + , enabled : Bool } -emptyModel: Model + +emptyModel : Model emptyModel = { source = Api.Model.Source.empty , abbrev = "" , description = Nothing - , priority = Comp.Dropdown.makeSingleList - { makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p } - , placeholder = "" - , options = Data.Priority.all - , selected = Nothing - } + , priority = + Comp.Dropdown.makeSingleList + { makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p } + , placeholder = "" + , options = Data.Priority.all + , selected = Nothing + } , enabled = False } -isValid: Model -> Bool + +isValid : Model -> Bool isValid model = model.abbrev /= "" -getSource: Model -> Source + +getSource : Model -> Source getSource model = let - s = model.source + s = + model.source in - {s | abbrev = model.abbrev - , description = model.description - , enabled = model.enabled - , priority = Comp.Dropdown.getSelected model.priority - |> List.head - |> Maybe.map Data.Priority.toName - |> Maybe.withDefault s.priority - } + { s + | abbrev = model.abbrev + , description = model.description + , enabled = model.enabled + , priority = + Comp.Dropdown.getSelected model.priority + |> List.head + |> Maybe.map Data.Priority.toName + |> Maybe.withDefault s.priority + } type Msg @@ -64,105 +72,138 @@ type Msg | ToggleEnabled | PrioDropdownMsg (Comp.Dropdown.Msg Priority) -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetSource t -> let - post = model.source - np = {post | id = t.id - , abbrev = t.abbrev - , description = t.description - , priority = t.priority - , enabled = t.enabled - } + post = + model.source + + np = + { post + | id = t.id + , abbrev = t.abbrev + , description = t.description + , priority = t.priority + , enabled = t.enabled + } in - ({model | source = np - , abbrev = t.abbrev - , description = t.description - , priority = Comp.Dropdown.makeSingleList - { makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p } - , placeholder = "" - , options = Data.Priority.all - , selected = Data.Priority.fromString t.priority - } - , enabled = t.enabled }, Cmd.none) + ( { model + | source = np + , abbrev = t.abbrev + , description = t.description + , priority = + Comp.Dropdown.makeSingleList + { makeOption = \p -> { text = Data.Priority.toName p, value = Data.Priority.toName p } + , placeholder = "" + , options = Data.Priority.all + , selected = Data.Priority.fromString t.priority + } + , enabled = t.enabled + } + , Cmd.none + ) ToggleEnabled -> - let - _ = Debug.log "got" model.enabled - in - ({model | enabled = not model.enabled}, Cmd.none) + ( { model | enabled = not model.enabled }, Cmd.none ) SetAbbrev n -> - ({model | abbrev = n}, Cmd.none) + ( { model | abbrev = n }, Cmd.none ) SetDescr d -> - ({model | description = if d /= "" then Just d else Nothing }, Cmd.none) + ( { model + | description = + if d /= "" then + Just d + + else + Nothing + } + , Cmd.none + ) PrioDropdownMsg m -> let - (m2, c2) = Comp.Dropdown.update m model.priority + ( m2, c2 ) = + Comp.Dropdown.update m model.priority in - ({model | priority = m2 }, Cmd.map PrioDropdownMsg c2) + ( { model | priority = m2 }, Cmd.map PrioDropdownMsg c2 ) -view: Flags -> Model -> Html Msg + +view : Flags -> Model -> Html Msg view flags model = - div [class "ui form"] - [div [classList [("field", True) - ,("error", not (isValid model)) - ] - ] - [label [][text "Abbrev*"] - ,input [type_ "text" - ,onInput SetAbbrev - ,placeholder "Abbrev" - ,value model.abbrev - ][] - ] - ,div [class "field"] - [label [][text "Description"] - ,textarea [onInput SetDescr][model.description |> Maybe.withDefault "" |> text] + div [ class "ui form" ] + [ div + [ classList + [ ( "field", True ) + , ( "error", not (isValid model) ) + ] ] - ,div [class "inline field"] - [div [class "ui checkbox"] - [input [type_ "checkbox" - , onCheck (\_ -> ToggleEnabled) - , checked model.enabled][] - ,label [][text "Enabled"] - ] - ] - ,div [class "field"] - [label [][text "Priority"] - ,Html.map PrioDropdownMsg (Comp.Dropdown.view model.priority) + [ label [] [ text "Abbrev*" ] + , input + [ type_ "text" + , onInput SetAbbrev + , placeholder "Abbrev" + , value model.abbrev + ] + [] ] - ,urlInfoMessage flags model + , div [ class "field" ] + [ label [] [ text "Description" ] + , textarea [ onInput SetDescr ] [ model.description |> Maybe.withDefault "" |> text ] + ] + , div [ class "inline field" ] + [ div [ class "ui checkbox" ] + [ input + [ type_ "checkbox" + , onCheck (\_ -> ToggleEnabled) + , checked model.enabled + ] + [] + , label [] [ text "Enabled" ] + ] + ] + , div [ class "field" ] + [ label [] [ text "Priority" ] + , Html.map PrioDropdownMsg (Comp.Dropdown.view model.priority) + ] + , urlInfoMessage flags model ] -urlInfoMessage: Flags -> Model -> Html Msg + +urlInfoMessage : Flags -> Model -> Html Msg urlInfoMessage flags model = - div [classList [("ui info icon message", True) - ,("hidden", not model.enabled || model.source.id == "") - ]] - [i [class "info icon"][] - ,div [class "content"] - [div [class "header"] - [text "Public Uploads" - ] - ,p [][text "This source defines URLs that can be used by anyone to send files to " - ,text "you. There is a web page that you can share or tha API url can be used " - ,text "with other clients." - ] - ,dl [class "ui list"] - [dt [][text "Public Upload Page"] - ,dd [][let - url = flags.config.baseUrl ++ "/app/index.html#/upload/" ++ model.source.id - in - a [href url, target "_blank"][code [][text url]] - ] - ,dt [][text "Public API Upload URL"] - ,dd [][code [][text (flags.config.baseUrl ++ "/api/v1/open/upload/item/" ++ model.source.id)] - ] + div + [ classList + [ ( "ui info icon message", True ) + , ( "hidden", not model.enabled || model.source.id == "" ) + ] + ] + [ i [ class "info icon" ] [] + , div [ class "content" ] + [ div [ class "header" ] + [ text "Public Uploads" + ] + , p [] + [ text "This source defines URLs that can be used by anyone to send files to " + , text "you. There is a web page that you can share or tha API url can be used " + , text "with other clients." + ] + , dl [ class "ui list" ] + [ dt [] [ text "Public Upload Page" ] + , dd [] + [ let + url = + flags.config.baseUrl ++ "/app/index.html#/upload/" ++ model.source.id + in + a [ href url, target "_blank" ] [ code [] [ text url ] ] + ] + , dt [] [ text "Public API Upload URL" ] + , dd [] + [ code [] [ text (flags.config.baseUrl ++ "/api/v1/open/upload/item/" ++ model.source.id) ] + ] ] ] ] diff --git a/modules/webapp/src/main/elm/Comp/SourceManage.elm b/modules/webapp/src/main/elm/Comp/SourceManage.elm index f12cfa63..021f3225 100644 --- a/modules/webapp/src/main/elm/Comp/SourceManage.elm +++ b/modules/webapp/src/main/elm/Comp/SourceManage.elm @@ -1,36 +1,43 @@ -module Comp.SourceManage exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.SourceManage exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) -import Http import Api +import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.Source +import Api.Model.SourceList exposing (SourceList) +import Comp.SourceForm +import Comp.SourceTable +import Comp.YesNoDimmer +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick, onSubmit) -import Data.Flags exposing (Flags) -import Comp.SourceTable -import Comp.SourceForm -import Comp.YesNoDimmer -import Api.Model.Source -import Api.Model.SourceList exposing (SourceList) -import Api.Model.BasicResult exposing (BasicResult) -import Util.Maybe +import Http import Util.Http +import Util.Maybe + type alias Model = - { tableModel: Comp.SourceTable.Model - , formModel: Comp.SourceForm.Model - , viewMode: ViewMode - , formError: Maybe String - , loading: Bool - , deleteConfirm: Comp.YesNoDimmer.Model + { tableModel : Comp.SourceTable.Model + , formModel : Comp.SourceForm.Model + , viewMode : ViewMode + , formError : Maybe String + , loading : Bool + , deleteConfirm : Comp.YesNoDimmer.Model } -type ViewMode = Table | Form -emptyModel: Model +type ViewMode + = Table + | Form + + +emptyModel : Model emptyModel = { tableModel = Comp.SourceTable.emptyModel , formModel = Comp.SourceForm.emptyModel @@ -40,6 +47,7 @@ emptyModel = , deleteConfirm = Comp.YesNoDimmer.emptyModel } + type Msg = TableMsg Comp.SourceTable.Msg | FormMsg Comp.SourceForm.Msg @@ -52,156 +60,211 @@ type Msg | YesNoMsg Comp.YesNoDimmer.Msg | RequestDelete -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of TableMsg m -> let - (tm, tc) = Comp.SourceTable.update flags m model.tableModel - (m2, c2) = ({model | tableModel = tm - , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table - , formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError - } - , Cmd.map TableMsg tc - ) - (m3, c3) = case tm.selected of + ( tm, tc ) = + Comp.SourceTable.update flags m model.tableModel + + ( m2, c2 ) = + ( { model + | tableModel = tm + , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table + , formError = + if Util.Maybe.nonEmpty tm.selected then + Nothing + + else + model.formError + } + , Cmd.map TableMsg tc + ) + + ( m3, c3 ) = + case tm.selected of Just source -> update flags (FormMsg (Comp.SourceForm.SetSource source)) m2 + Nothing -> - (m2, Cmd.none) + ( m2, Cmd.none ) in - (m3, Cmd.batch [c2, c3]) + ( m3, Cmd.batch [ c2, c3 ] ) FormMsg m -> let - (m2, c2) = Comp.SourceForm.update flags m model.formModel + ( m2, c2 ) = + Comp.SourceForm.update flags m model.formModel in - ({model | formModel = m2}, Cmd.map FormMsg c2) + ( { model | formModel = m2 }, Cmd.map FormMsg c2 ) LoadSources -> - ({model| loading = True}, Api.getSources flags SourceResp) + ( { model | loading = True }, Api.getSources flags SourceResp ) SourceResp (Ok sources) -> let - m2 = {model|viewMode = Table, loading = False} + m2 = + { model | viewMode = Table, loading = False } in - update flags (TableMsg (Comp.SourceTable.SetSources sources.items)) m2 + update flags (TableMsg (Comp.SourceTable.SetSources sources.items)) m2 - SourceResp (Err err) -> - ({model|loading = False}, Cmd.none) + SourceResp (Err _) -> + ( { model | loading = False }, Cmd.none ) SetViewMode m -> let - m2 = {model | viewMode = m } + m2 = + { model | viewMode = m } in - case m of - Table -> - update flags (TableMsg Comp.SourceTable.Deselect) m2 - Form -> - (m2, Cmd.none) + case m of + Table -> + update flags (TableMsg Comp.SourceTable.Deselect) m2 + + Form -> + ( m2, Cmd.none ) InitNewSource -> let - nm = {model | viewMode = Form, formError = Nothing } - source = Api.Model.Source.empty + nm = + { model | viewMode = Form, formError = Nothing } + + source = + Api.Model.Source.empty in - update flags (FormMsg (Comp.SourceForm.SetSource source)) nm + update flags (FormMsg (Comp.SourceForm.SetSource source)) nm Submit -> let - source = Comp.SourceForm.getSource model.formModel - valid = Comp.SourceForm.isValid model.formModel - in if valid then - ({model|loading = True}, Api.postSource flags source SubmitResp) - else - ({model|formError = Just "Please correct the errors in the form."}, Cmd.none) + source = + Comp.SourceForm.getSource model.formModel + + valid = + Comp.SourceForm.isValid model.formModel + in + if valid then + ( { model | loading = True }, Api.postSource flags source SubmitResp ) + + else + ( { model | formError = Just "Please correct the errors in the form." }, Cmd.none ) SubmitResp (Ok res) -> if res.success then let - (m2, c2) = update flags (SetViewMode Table) model - (m3, c3) = update flags LoadSources m2 + ( m2, c2 ) = + update flags (SetViewMode Table) model + + ( m3, c3 ) = + update flags LoadSources m2 in - ({m3|loading = False}, Cmd.batch [c2,c3]) + ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] ) + else - ({model | formError = Just res.message, loading = False }, Cmd.none) + ( { model | formError = Just res.message, loading = False }, Cmd.none ) SubmitResp (Err err) -> - ({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none) + ( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none ) RequestDelete -> update flags (YesNoMsg Comp.YesNoDimmer.activate) model YesNoMsg m -> let - (cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm - src = Comp.SourceForm.getSource model.formModel - cmd = if confirmed then Api.deleteSource flags src.id SubmitResp else Cmd.none + ( cm, confirmed ) = + Comp.YesNoDimmer.update m model.deleteConfirm + + src = + Comp.SourceForm.getSource model.formModel + + cmd = + if confirmed then + Api.deleteSource flags src.id SubmitResp + + else + Cmd.none in - ({model | deleteConfirm = cm}, cmd) + ( { model | deleteConfirm = cm }, cmd ) -view: Flags -> Model -> Html Msg + +view : Flags -> Model -> Html Msg view flags model = - if model.viewMode == Table then viewTable model - else div [](viewForm flags model) + if model.viewMode == Table then + viewTable model -viewTable: Model -> Html Msg + else + div [] (viewForm flags model) + + +viewTable : Model -> Html Msg viewTable model = div [] - [button [class "ui basic button", onClick InitNewSource] - [i [class "plus icon"][] - ,text "Create new" - ] - ,Html.map TableMsg (Comp.SourceTable.view model.tableModel) - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] + [ button [ class "ui basic button", onClick InitNewSource ] + [ i [ class "plus icon" ] [] + , text "Create new" + ] + , Html.map TableMsg (Comp.SourceTable.view model.tableModel) + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] ] ] -viewForm: Flags -> Model -> List (Html Msg) + +viewForm : Flags -> Model -> List (Html Msg) viewForm flags model = let - newSource = model.formModel.source.id == "" + newSource = + model.formModel.source.id == "" in - [if newSource then - h3 [class "ui top attached header"] - [text "Create new source" - ] - else - h3 [class "ui top attached header"] - [text ("Edit: " ++ model.formModel.source.abbrev) - ,div [class "sub header"] - [text "Id: " - ,text model.formModel.source.id - ] - ] - ,Html.form [class "ui attached segment", onSubmit Submit] - [Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) - ,Html.map FormMsg (Comp.SourceForm.view flags model.formModel) - ,div [classList [("ui error message", True) - ,("invisible", Util.Maybe.isEmpty model.formError) - ] - ] - [Maybe.withDefault "" model.formError |> text - ] - ,div [class "ui horizontal divider"][] - ,button [class "ui primary button", type_ "submit"] - [text "Submit" + [ if newSource then + h3 [ class "ui top attached header" ] + [ text "Create new source" + ] + + else + h3 [ class "ui top attached header" ] + [ text ("Edit: " ++ model.formModel.source.abbrev) + , div [ class "sub header" ] + [ text "Id: " + , text model.formModel.source.id ] - ,a [class "ui secondary button", onClick (SetViewMode Table), href ""] - [text "Cancel" + ] + , Html.form [ class "ui attached segment", onSubmit Submit ] + [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) + , Html.map FormMsg (Comp.SourceForm.view flags model.formModel) + , div + [ classList + [ ( "ui error message", True ) + , ( "invisible", Util.Maybe.isEmpty model.formError ) ] - ,if not newSource then - a [class "ui right floated red button", href "", onClick RequestDelete] - [text "Delete"] - else - span[][] - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] - ] + ] + [ Maybe.withDefault "" model.formError |> text + ] + , div [ class "ui horizontal divider" ] [] + , button [ class "ui primary button", type_ "submit" ] + [ text "Submit" + ] + , a [ class "ui secondary button", onClick (SetViewMode Table), href "" ] + [ text "Cancel" + ] + , if not newSource then + a [ class "ui right floated red button", href "", onClick RequestDelete ] + [ text "Delete" ] + + else + span [] [] + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] ] ] + ] diff --git a/modules/webapp/src/main/elm/Comp/SourceTable.elm b/modules/webapp/src/main/elm/Comp/SourceTable.elm index 89e98852..49dec59e 100644 --- a/modules/webapp/src/main/elm/Comp/SourceTable.elm +++ b/modules/webapp/src/main/elm/Comp/SourceTable.elm @@ -1,85 +1,94 @@ -module Comp.SourceTable exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.SourceTable exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) +import Api.Model.Source exposing (Source) +import Data.Flags exposing (Flags) +import Data.Priority import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Data.Flags exposing (Flags) -import Data.Priority exposing (Priority) -import Api.Model.Source exposing (Source) + type alias Model = - { sources: List Source - , selected: Maybe Source + { sources : List Source + , selected : Maybe Source } -emptyModel: Model + +emptyModel : Model emptyModel = { sources = [] , selected = Nothing } + type Msg = SetSources (List Source) | Select Source | Deselect -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetSources list -> - ({model | sources = list, selected = Nothing }, Cmd.none) + ( { model | sources = list, selected = Nothing }, Cmd.none ) Select source -> - ({model | selected = Just source}, Cmd.none) + ( { model | selected = Just source }, Cmd.none ) Deselect -> - ({model | selected = Nothing}, Cmd.none) + ( { model | selected = Nothing }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - table [class "ui selectable table"] - [thead [] - [tr [] - [th [class "collapsing"][text "Abbrev"] - ,th [class "collapsing"][text "Enabled"] - ,th [class "collapsing"][text "Counter"] - ,th [class "collapsing"][text "Priority"] - ,th [][text "Id"] - ] - ] - ,tbody [] + table [ class "ui selectable table" ] + [ thead [] + [ tr [] + [ th [ class "collapsing" ] [ text "Abbrev" ] + , th [ class "collapsing" ] [ text "Enabled" ] + , th [ class "collapsing" ] [ text "Counter" ] + , th [ class "collapsing" ] [ text "Priority" ] + , th [] [ text "Id" ] + ] + ] + , tbody [] (List.map (renderSourceLine model) model.sources) ] -renderSourceLine: Model -> Source -> Html Msg + +renderSourceLine : Model -> Source -> Html Msg renderSourceLine model source = - tr [classList [("active", model.selected == Just source)] - ,onClick (Select source) - ] - [td [class "collapsing"] - [text source.abbrev - ] - ,td [class "collapsing"] - [if source.enabled then - i [class "check square outline icon"][] - else - i [class "minus square outline icon"][] + tr + [ classList [ ( "active", model.selected == Just source ) ] + , onClick (Select source) + ] + [ td [ class "collapsing" ] + [ text source.abbrev ] - ,td [class "collapsing"] - [source.counter |> String.fromInt |> text + , td [ class "collapsing" ] + [ if source.enabled then + i [ class "check square outline icon" ] [] + + else + i [ class "minus square outline icon" ] [] ] - ,td [class "collapsing"] - [Data.Priority.fromString source.priority - |> Maybe.map Data.Priority.toName - |> Maybe.withDefault source.priority - |> text + , td [ class "collapsing" ] + [ source.counter |> String.fromInt |> text ] - ,td [] - [text source.id + , td [ class "collapsing" ] + [ Data.Priority.fromString source.priority + |> Maybe.map Data.Priority.toName + |> Maybe.withDefault source.priority + |> text + ] + , td [] + [ text source.id ] ] diff --git a/modules/webapp/src/main/elm/Comp/TagForm.elm b/modules/webapp/src/main/elm/Comp/TagForm.elm index 56a7d4c5..f19f1e25 100644 --- a/modules/webapp/src/main/elm/Comp/TagForm.elm +++ b/modules/webapp/src/main/elm/Comp/TagForm.elm @@ -1,76 +1,90 @@ -module Comp.TagForm exposing ( Model - , emptyModel - , Msg(..) - , view - , update - , isValid - , getTag) +module Comp.TagForm exposing + ( Model + , Msg(..) + , emptyModel + , getTag + , isValid + , update + , view + ) +import Api.Model.Tag exposing (Tag) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onInput) -import Data.Flags exposing (Flags) -import Api.Model.Tag exposing (Tag) + type alias Model = - { tag: Tag - , name: String - , category: Maybe String + { tag : Tag + , name : String + , category : Maybe String } -emptyModel: Model + +emptyModel : Model emptyModel = { tag = Api.Model.Tag.empty , name = "" , category = Nothing } -isValid: Model -> Bool + +isValid : Model -> Bool isValid model = model.name /= "" -getTag: Model -> Tag + +getTag : Model -> Tag getTag model = Tag model.tag.id model.name model.category 0 + type Msg = SetName String | SetCategory String | SetTag Tag -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetTag t -> - ({model | tag = t, name = t.name, category = t.category }, Cmd.none) + ( { model | tag = t, name = t.name, category = t.category }, Cmd.none ) SetName n -> - ({model | name = n}, Cmd.none) + ( { model | name = n }, Cmd.none ) SetCategory n -> - ({model | category = Just n}, Cmd.none) + ( { model | category = Just n }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - div [class "ui form"] - [div [classList [("field", True) - ,("error", not (isValid model)) - ] - ] - [label [][text "Name*"] - ,input [type_ "text" - ,onInput SetName - ,placeholder "Name" - ,value model.name - ][] - ] - ,div [class "field"] - [label [][text "Category"] - ,input [type_ "text" - ,onInput SetCategory - ,placeholder "Category (optional)" - ,value (Maybe.withDefault "" model.category) - ][] + div [ class "ui form" ] + [ div + [ classList + [ ( "field", True ) + , ( "error", not (isValid model) ) + ] + ] + [ label [] [ text "Name*" ] + , input + [ type_ "text" + , onInput SetName + , placeholder "Name" + , value model.name + ] + [] + ] + , div [ class "field" ] + [ label [] [ text "Category" ] + , input + [ type_ "text" + , onInput SetCategory + , placeholder "Category (optional)" + , value (Maybe.withDefault "" model.category) + ] + [] ] ] diff --git a/modules/webapp/src/main/elm/Comp/TagManage.elm b/modules/webapp/src/main/elm/Comp/TagManage.elm index 42fbf9c8..5911f076 100644 --- a/modules/webapp/src/main/elm/Comp/TagManage.elm +++ b/modules/webapp/src/main/elm/Comp/TagManage.elm @@ -1,36 +1,43 @@ -module Comp.TagManage exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.TagManage exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) -import Http import Api +import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.Tag +import Api.Model.TagList exposing (TagList) +import Comp.TagForm +import Comp.TagTable +import Comp.YesNoDimmer +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick, onSubmit) -import Data.Flags exposing (Flags) -import Comp.TagTable -import Comp.TagForm -import Comp.YesNoDimmer -import Api.Model.Tag -import Api.Model.TagList exposing (TagList) -import Api.Model.BasicResult exposing (BasicResult) -import Util.Maybe +import Http import Util.Http +import Util.Maybe + type alias Model = - { tagTableModel: Comp.TagTable.Model - , tagFormModel: Comp.TagForm.Model - , viewMode: ViewMode - , formError: Maybe String - , loading: Bool - , deleteConfirm: Comp.YesNoDimmer.Model + { tagTableModel : Comp.TagTable.Model + , tagFormModel : Comp.TagForm.Model + , viewMode : ViewMode + , formError : Maybe String + , loading : Bool + , deleteConfirm : Comp.YesNoDimmer.Model } -type ViewMode = Table | Form -emptyModel: Model +type ViewMode + = Table + | Form + + +emptyModel : Model emptyModel = { tagTableModel = Comp.TagTable.emptyModel , tagFormModel = Comp.TagForm.emptyModel @@ -40,6 +47,7 @@ emptyModel = , deleteConfirm = Comp.YesNoDimmer.emptyModel } + type Msg = TableMsg Comp.TagTable.Msg | FormMsg Comp.TagForm.Msg @@ -52,155 +60,210 @@ type Msg | YesNoMsg Comp.YesNoDimmer.Msg | RequestDelete -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of TableMsg m -> let - (tm, tc) = Comp.TagTable.update flags m model.tagTableModel - (m2, c2) = ({model | tagTableModel = tm - , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table - , formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError - } - , Cmd.map TableMsg tc - ) - (m3, c3) = case tm.selected of + ( tm, tc ) = + Comp.TagTable.update flags m model.tagTableModel + + ( m2, c2 ) = + ( { model + | tagTableModel = tm + , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table + , formError = + if Util.Maybe.nonEmpty tm.selected then + Nothing + + else + model.formError + } + , Cmd.map TableMsg tc + ) + + ( m3, c3 ) = + case tm.selected of Just tag -> update flags (FormMsg (Comp.TagForm.SetTag tag)) m2 + Nothing -> - (m2, Cmd.none) + ( m2, Cmd.none ) in - (m3, Cmd.batch [c2, c3]) + ( m3, Cmd.batch [ c2, c3 ] ) FormMsg m -> let - (m2, c2) = Comp.TagForm.update flags m model.tagFormModel + ( m2, c2 ) = + Comp.TagForm.update flags m model.tagFormModel in - ({model | tagFormModel = m2}, Cmd.map FormMsg c2) + ( { model | tagFormModel = m2 }, Cmd.map FormMsg c2 ) LoadTags -> - ({model| loading = True}, Api.getTags flags TagResp) + ( { model | loading = True }, Api.getTags flags TagResp ) TagResp (Ok tags) -> let - m2 = {model|viewMode = Table, loading = False} + m2 = + { model | viewMode = Table, loading = False } in - update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2 + update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2 - TagResp (Err err) -> - ({model|loading = False}, Cmd.none) + TagResp (Err _) -> + ( { model | loading = False }, Cmd.none ) SetViewMode m -> let - m2 = {model | viewMode = m } + m2 = + { model | viewMode = m } in - case m of - Table -> - update flags (TableMsg Comp.TagTable.Deselect) m2 - Form -> - (m2, Cmd.none) + case m of + Table -> + update flags (TableMsg Comp.TagTable.Deselect) m2 + + Form -> + ( m2, Cmd.none ) InitNewTag -> let - nm = {model | viewMode = Form, formError = Nothing } - tag = Api.Model.Tag.empty + nm = + { model | viewMode = Form, formError = Nothing } + + tag = + Api.Model.Tag.empty in - update flags (FormMsg (Comp.TagForm.SetTag tag)) nm + update flags (FormMsg (Comp.TagForm.SetTag tag)) nm Submit -> let - tag = Comp.TagForm.getTag model.tagFormModel - valid = Comp.TagForm.isValid model.tagFormModel - in if valid then - ({model|loading = True}, Api.postTag flags tag SubmitResp) - else - ({model|formError = Just "Please correct the errors in the form."}, Cmd.none) + tag = + Comp.TagForm.getTag model.tagFormModel + + valid = + Comp.TagForm.isValid model.tagFormModel + in + if valid then + ( { model | loading = True }, Api.postTag flags tag SubmitResp ) + + else + ( { model | formError = Just "Please correct the errors in the form." }, Cmd.none ) SubmitResp (Ok res) -> if res.success then let - (m2, c2) = update flags (SetViewMode Table) model - (m3, c3) = update flags LoadTags m2 + ( m2, c2 ) = + update flags (SetViewMode Table) model + + ( m3, c3 ) = + update flags LoadTags m2 in - ({m3|loading = False}, Cmd.batch [c2,c3]) + ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] ) + else - ({model | formError = Just res.message, loading = False }, Cmd.none) + ( { model | formError = Just res.message, loading = False }, Cmd.none ) SubmitResp (Err err) -> - ({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none) + ( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none ) RequestDelete -> update flags (YesNoMsg Comp.YesNoDimmer.activate) model YesNoMsg m -> let - (cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm - tag = Comp.TagForm.getTag model.tagFormModel - cmd = if confirmed then Api.deleteTag flags tag.id SubmitResp else Cmd.none + ( cm, confirmed ) = + Comp.YesNoDimmer.update m model.deleteConfirm + + tag = + Comp.TagForm.getTag model.tagFormModel + + cmd = + if confirmed then + Api.deleteTag flags tag.id SubmitResp + + else + Cmd.none in - ({model | deleteConfirm = cm}, cmd) + ( { model | deleteConfirm = cm }, cmd ) -view: Model -> Html Msg + +view : Model -> Html Msg view model = - if model.viewMode == Table then viewTable model - else viewForm model + if model.viewMode == Table then + viewTable model -viewTable: Model -> Html Msg + else + viewForm model + + +viewTable : Model -> Html Msg viewTable model = div [] - [button [class "ui basic button", onClick InitNewTag] - [i [class "plus icon"][] - ,text "Create new" - ] - ,Html.map TableMsg (Comp.TagTable.view model.tagTableModel) - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] + [ button [ class "ui basic button", onClick InitNewTag ] + [ i [ class "plus icon" ] [] + , text "Create new" + ] + , Html.map TableMsg (Comp.TagTable.view model.tagTableModel) + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] ] ] -viewForm: Model -> Html Msg + +viewForm : Model -> Html Msg viewForm model = let - newTag = model.tagFormModel.tag.id == "" + newTag = + model.tagFormModel.tag.id == "" in - Html.form [class "ui segment", onSubmit Submit] - [Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) - ,if newTag then - h3 [class "ui dividing header"] - [text "Create new tag" - ] - else - h3 [class "ui dividing header"] - [text ("Edit tag: " ++ model.tagFormModel.tag.name) - ,div [class "sub header"] - [text "Id: " - ,text model.tagFormModel.tag.id - ] - ] - ,Html.map FormMsg (Comp.TagForm.view model.tagFormModel) - ,div [classList [("ui error message", True) - ,("invisible", Util.Maybe.isEmpty model.formError) - ] - ] - [Maybe.withDefault "" model.formError |> text - ] - ,div [class "ui horizontal divider"][] - ,button [class "ui primary button", type_ "submit"] - [text "Submit" + Html.form [ class "ui segment", onSubmit Submit ] + [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) + , if newTag then + h3 [ class "ui dividing header" ] + [ text "Create new tag" ] - ,a [class "ui secondary button", onClick (SetViewMode Table), href ""] - [text "Cancel" + + else + h3 [ class "ui dividing header" ] + [ text ("Edit tag: " ++ model.tagFormModel.tag.name) + , div [ class "sub header" ] + [ text "Id: " + , text model.tagFormModel.tag.id + ] + ] + , Html.map FormMsg (Comp.TagForm.view model.tagFormModel) + , div + [ classList + [ ( "ui error message", True ) + , ( "invisible", Util.Maybe.isEmpty model.formError ) ] - ,if not newTag then - a [class "ui right floated red button", href "", onClick RequestDelete] - [text "Delete"] - else - span[][] - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] - ] ] + [ Maybe.withDefault "" model.formError |> text + ] + , div [ class "ui horizontal divider" ] [] + , button [ class "ui primary button", type_ "submit" ] + [ text "Submit" + ] + , a [ class "ui secondary button", onClick (SetViewMode Table), href "" ] + [ text "Cancel" + ] + , if not newTag then + a [ class "ui right floated red button", href "", onClick RequestDelete ] + [ text "Delete" ] + + else + span [] [] + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] + ] + ] diff --git a/modules/webapp/src/main/elm/Comp/TagTable.elm b/modules/webapp/src/main/elm/Comp/TagTable.elm index bddf60d1..aabfcd6d 100644 --- a/modules/webapp/src/main/elm/Comp/TagTable.elm +++ b/modules/webapp/src/main/elm/Comp/TagTable.elm @@ -1,66 +1,74 @@ -module Comp.TagTable exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.TagTable exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) +import Api.Model.Tag exposing (Tag) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Data.Flags exposing (Flags) -import Api.Model.Tag exposing (Tag) + type alias Model = - { tags: List Tag - , selected: Maybe Tag + { tags : List Tag + , selected : Maybe Tag } -emptyModel: Model + +emptyModel : Model emptyModel = { tags = [] , selected = Nothing } + type Msg = SetTags (List Tag) | Select Tag | Deselect -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetTags list -> - ({model | tags = list, selected = Nothing }, Cmd.none) + ( { model | tags = list, selected = Nothing }, Cmd.none ) Select tag -> - ({model | selected = Just tag}, Cmd.none) + ( { model | selected = Just tag }, Cmd.none ) Deselect -> - ({model | selected = Nothing}, Cmd.none) + ( { model | selected = Nothing }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - table [class "ui selectable table"] - [thead [] - [tr [] - [th [][text "Name"] - ,th [][text "Category"] - ] - ] - ,tbody [] + table [ class "ui selectable table" ] + [ thead [] + [ tr [] + [ th [] [ text "Name" ] + , th [] [ text "Category" ] + ] + ] + , tbody [] (List.map (renderTagLine model) model.tags) ] -renderTagLine: Model -> Tag -> Html Msg + +renderTagLine : Model -> Tag -> Html Msg renderTagLine model tag = - tr [classList [("active", model.selected == Just tag)] - ,onClick (Select tag) - ] - [td [] - [text tag.name - ] - ,td [] - [Maybe.withDefault "-" tag.category |> text + tr + [ classList [ ( "active", model.selected == Just tag ) ] + , onClick (Select tag) + ] + [ td [] + [ text tag.name + ] + , td [] + [ Maybe.withDefault "-" tag.category |> text ] ] diff --git a/modules/webapp/src/main/elm/Comp/UserForm.elm b/modules/webapp/src/main/elm/Comp/UserForm.elm index b6ba4529..724b3bea 100644 --- a/modules/webapp/src/main/elm/Comp/UserForm.elm +++ b/modules/webapp/src/main/elm/Comp/UserForm.elm @@ -1,68 +1,85 @@ -module Comp.UserForm exposing ( Model - , emptyModel - , Msg(..) - , view - , update - , isValid - , isNewUser - , getUser) +module Comp.UserForm exposing + ( Model + , Msg(..) + , emptyModel + , getUser + , isNewUser + , isValid + , update + , view + ) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onInput, onCheck) +import Api.Model.User exposing (User) +import Comp.Dropdown import Data.Flags exposing (Flags) import Data.UserState exposing (UserState) -import Api.Model.User exposing (User) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onInput) import Util.Maybe -import Comp.Dropdown + type alias Model = - { user: User - , login: String - , email: Maybe String - , state: Comp.Dropdown.Model UserState - , password: Maybe String + { user : User + , login : String + , email : Maybe String + , state : Comp.Dropdown.Model UserState + , password : Maybe String } -emptyModel: Model + +emptyModel : Model emptyModel = { user = Api.Model.User.empty , login = "" , email = Nothing , password = Nothing - , state = Comp.Dropdown.makeSingleList - { makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s } - , placeholder = "" - , options = Data.UserState.all - , selected = List.head Data.UserState.all - } + , state = + Comp.Dropdown.makeSingleList + { makeOption = + \s -> + { value = Data.UserState.toString s + , text = Data.UserState.toString s + } + , placeholder = "" + , options = Data.UserState.all + , selected = List.head Data.UserState.all + } } -isValid: Model -> Bool + +isValid : Model -> Bool isValid model = if model.user.login == "" then model.login /= "" && Util.Maybe.nonEmpty model.password + else True -isNewUser: Model -> Bool + +isNewUser : Model -> Bool isNewUser model = model.user.login == "" -getUser: Model -> User + +getUser : Model -> User getUser model = let - s = model.user - state = Comp.Dropdown.getSelected model.state + s = + model.user + + state = + Comp.Dropdown.getSelected model.state |> List.head |> Maybe.withDefault Data.UserState.Active |> Data.UserState.toString in - {s | login = model.login - , email = model.email - , state = state - , password = model.password - } + { s + | login = model.login + , email = model.email + , state = state + , password = model.password + } type Msg @@ -72,79 +89,115 @@ type Msg | StateMsg (Comp.Dropdown.Msg UserState) | SetPassword String -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetUser t -> let - state = Comp.Dropdown.makeSingleList + state = + Comp.Dropdown.makeSingleList { makeOption = \s -> { value = Data.UserState.toString s, text = Data.UserState.toString s } , placeholder = "" , options = Data.UserState.all - , selected = Data.UserState.fromString t.state - |> Maybe.map (\u -> List.filter ((==) u) Data.UserState.all) - |> Maybe.andThen List.head - |> Util.Maybe.withDefault (List.head Data.UserState.all) + , selected = + Data.UserState.fromString t.state + |> Maybe.map (\u -> List.filter ((==) u) Data.UserState.all) + |> Maybe.andThen List.head + |> Util.Maybe.withDefault (List.head Data.UserState.all) } in - ({model | user = t - , login = t.login - , email = t.email - , password = t.password - , state = state }, Cmd.none) + ( { model + | user = t + , login = t.login + , email = t.email + , password = t.password + , state = state + } + , Cmd.none + ) StateMsg m -> let - (m1, c1) = Comp.Dropdown.update m model.state + ( m1, c1 ) = + Comp.Dropdown.update m model.state in - ({model | state = m1}, Cmd.map StateMsg c1) + ( { model | state = m1 }, Cmd.map StateMsg c1 ) SetLogin n -> - ({model | login = n}, Cmd.none) + ( { model | login = n }, Cmd.none ) SetEmail e -> - ({model | email = if e == "" then Nothing else Just e }, Cmd.none) + ( { model + | email = + if e == "" then + Nothing + + else + Just e + } + , Cmd.none + ) SetPassword p -> - ({model | password = if p == "" then Nothing else Just p}, Cmd.none) + ( { model + | password = + if p == "" then + Nothing + + else + Just p + } + , Cmd.none + ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - div [class "ui form"] - [div [classList [("field", True) - ,("error", model.login == "") - ,("invisible", model.user.login /= "") - ] - ] - [label [][text "Login*"] - ,input [type_ "text" - ,onInput SetLogin - ,placeholder "Login" - ,value model.login - ][] - ] - ,div [class "field"] - [label [][text "E-Mail"] - ,input [ onInput SetEmail - , model.email |> Maybe.withDefault "" |> value - , placeholder "E-Mail" - ][] + div [ class "ui form" ] + [ div + [ classList + [ ( "field", True ) + , ( "error", model.login == "" ) + , ( "invisible", model.user.login /= "" ) + ] ] - ,div [class "field"] - [label [][text "State"] - ,Html.map StateMsg (Comp.Dropdown.view model.state) + [ label [] [ text "Login*" ] + , input + [ type_ "text" + , onInput SetLogin + , placeholder "Login" + , value model.login + ] + [] ] - ,div [classList [("field", True) - ,("invisible", model.user.login /= "") - ,("error", Util.Maybe.isEmpty model.password) - ] - ] - [label [][text "Password*"] - ,input [type_ "text" - , onInput SetPassword - , placeholder "Password" - , Maybe.withDefault "" model.password |> value - ][] + , div [ class "field" ] + [ label [] [ text "E-Mail" ] + , input + [ onInput SetEmail + , model.email |> Maybe.withDefault "" |> value + , placeholder "E-Mail" + ] + [] + ] + , div [ class "field" ] + [ label [] [ text "State" ] + , Html.map StateMsg (Comp.Dropdown.view model.state) + ] + , div + [ classList + [ ( "field", True ) + , ( "invisible", model.user.login /= "" ) + , ( "error", Util.Maybe.isEmpty model.password ) + ] + ] + [ label [] [ text "Password*" ] + , input + [ type_ "text" + , onInput SetPassword + , placeholder "Password" + , Maybe.withDefault "" model.password |> value + ] + [] ] ] diff --git a/modules/webapp/src/main/elm/Comp/UserManage.elm b/modules/webapp/src/main/elm/Comp/UserManage.elm index 7a1cb349..0e60ec21 100644 --- a/modules/webapp/src/main/elm/Comp/UserManage.elm +++ b/modules/webapp/src/main/elm/Comp/UserManage.elm @@ -1,36 +1,43 @@ -module Comp.UserManage exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.UserManage exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) -import Http import Api +import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.User +import Api.Model.UserList exposing (UserList) +import Comp.UserForm +import Comp.UserTable +import Comp.YesNoDimmer +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick, onSubmit) -import Data.Flags exposing (Flags) -import Comp.UserTable -import Comp.UserForm -import Comp.YesNoDimmer -import Api.Model.User -import Api.Model.UserList exposing (UserList) -import Api.Model.BasicResult exposing (BasicResult) -import Util.Maybe +import Http import Util.Http +import Util.Maybe + type alias Model = - { tableModel: Comp.UserTable.Model - , formModel: Comp.UserForm.Model - , viewMode: ViewMode - , formError: Maybe String - , loading: Bool - , deleteConfirm: Comp.YesNoDimmer.Model + { tableModel : Comp.UserTable.Model + , formModel : Comp.UserForm.Model + , viewMode : ViewMode + , formError : Maybe String + , loading : Bool + , deleteConfirm : Comp.YesNoDimmer.Model } -type ViewMode = Table | Form -emptyModel: Model +type ViewMode + = Table + | Form + + +emptyModel : Model emptyModel = { tableModel = Comp.UserTable.emptyModel , formModel = Comp.UserForm.emptyModel @@ -40,6 +47,7 @@ emptyModel = , deleteConfirm = Comp.YesNoDimmer.emptyModel } + type Msg = TableMsg Comp.UserTable.Msg | FormMsg Comp.UserForm.Msg @@ -52,154 +60,213 @@ type Msg | YesNoMsg Comp.YesNoDimmer.Msg | RequestDelete -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of TableMsg m -> let - (tm, tc) = Comp.UserTable.update flags m model.tableModel - (m2, c2) = ({model | tableModel = tm - , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table - , formError = if Util.Maybe.nonEmpty tm.selected then Nothing else model.formError - } - , Cmd.map TableMsg tc - ) - (m3, c3) = case tm.selected of + ( tm, tc ) = + Comp.UserTable.update flags m model.tableModel + + ( m2, c2 ) = + ( { model + | tableModel = tm + , viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table + , formError = + if Util.Maybe.nonEmpty tm.selected then + Nothing + + else + model.formError + } + , Cmd.map TableMsg tc + ) + + ( m3, c3 ) = + case tm.selected of Just user -> update flags (FormMsg (Comp.UserForm.SetUser user)) m2 + Nothing -> - (m2, Cmd.none) + ( m2, Cmd.none ) in - (m3, Cmd.batch [c2, c3]) + ( m3, Cmd.batch [ c2, c3 ] ) FormMsg m -> let - (m2, c2) = Comp.UserForm.update flags m model.formModel + ( m2, c2 ) = + Comp.UserForm.update flags m model.formModel in - ({model | formModel = m2}, Cmd.map FormMsg c2) + ( { model | formModel = m2 }, Cmd.map FormMsg c2 ) LoadUsers -> - ({model| loading = True}, Api.getUsers flags UserResp) + ( { model | loading = True }, Api.getUsers flags UserResp ) UserResp (Ok users) -> let - m2 = {model|viewMode = Table, loading = False} + m2 = + { model | viewMode = Table, loading = False } in - update flags (TableMsg (Comp.UserTable.SetUsers users.items)) m2 + update flags (TableMsg (Comp.UserTable.SetUsers users.items)) m2 - UserResp (Err err) -> - ({model|loading = False}, Cmd.none) + UserResp (Err _) -> + ( { model | loading = False }, Cmd.none ) SetViewMode m -> let - m2 = {model | viewMode = m } + m2 = + { model | viewMode = m } in - case m of - Table -> - update flags (TableMsg Comp.UserTable.Deselect) m2 - Form -> - (m2, Cmd.none) + case m of + Table -> + update flags (TableMsg Comp.UserTable.Deselect) m2 + + Form -> + ( m2, Cmd.none ) InitNewUser -> let - nm = {model | viewMode = Form, formError = Nothing } - user = Api.Model.User.empty + nm = + { model | viewMode = Form, formError = Nothing } + + user = + Api.Model.User.empty in - update flags (FormMsg (Comp.UserForm.SetUser user)) nm + update flags (FormMsg (Comp.UserForm.SetUser user)) nm Submit -> let - user = Comp.UserForm.getUser model.formModel - valid = Comp.UserForm.isValid model.formModel - cmd = if Comp.UserForm.isNewUser model.formModel - then Api.postNewUser flags user SubmitResp - else Api.putUser flags user SubmitResp - in if valid then - ({model|loading = True}, cmd) - else - ({model|formError = Just "Please correct the errors in the form."}, Cmd.none) + user = + Comp.UserForm.getUser model.formModel + + valid = + Comp.UserForm.isValid model.formModel + + cmd = + if Comp.UserForm.isNewUser model.formModel then + Api.postNewUser flags user SubmitResp + + else + Api.putUser flags user SubmitResp + in + if valid then + ( { model | loading = True }, cmd ) + + else + ( { model | formError = Just "Please correct the errors in the form." }, Cmd.none ) SubmitResp (Ok res) -> if res.success then let - (m2, c2) = update flags (SetViewMode Table) model - (m3, c3) = update flags LoadUsers m2 + ( m2, c2 ) = + update flags (SetViewMode Table) model + + ( m3, c3 ) = + update flags LoadUsers m2 in - ({m3|loading = False}, Cmd.batch [c2,c3]) + ( { m3 | loading = False }, Cmd.batch [ c2, c3 ] ) + else - ({model | formError = Just res.message, loading = False }, Cmd.none) + ( { model | formError = Just res.message, loading = False }, Cmd.none ) SubmitResp (Err err) -> - ({model | formError = Just (Util.Http.errorToString err), loading = False}, Cmd.none) + ( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none ) RequestDelete -> update flags (YesNoMsg Comp.YesNoDimmer.activate) model YesNoMsg m -> let - (cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm - user = Comp.UserForm.getUser model.formModel - cmd = if confirmed then Api.deleteUser flags user.login SubmitResp else Cmd.none + ( cm, confirmed ) = + Comp.YesNoDimmer.update m model.deleteConfirm + + user = + Comp.UserForm.getUser model.formModel + + cmd = + if confirmed then + Api.deleteUser flags user.login SubmitResp + + else + Cmd.none in - ({model | deleteConfirm = cm}, cmd) + ( { model | deleteConfirm = cm }, cmd ) -view: Model -> Html Msg + +view : Model -> Html Msg view model = - if model.viewMode == Table then viewTable model - else viewForm model + if model.viewMode == Table then + viewTable model -viewTable: Model -> Html Msg + else + viewForm model + + +viewTable : Model -> Html Msg viewTable model = div [] - [button [class "ui basic button", onClick InitNewUser] - [i [class "plus icon"][] - ,text "Create new" - ] - ,Html.map TableMsg (Comp.UserTable.view model.tableModel) - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] + [ button [ class "ui basic button", onClick InitNewUser ] + [ i [ class "plus icon" ] [] + , text "Create new" + ] + , Html.map TableMsg (Comp.UserTable.view model.tableModel) + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] ] ] -viewForm: Model -> Html Msg + +viewForm : Model -> Html Msg viewForm model = let - newUser = Comp.UserForm.isNewUser model.formModel + newUser = + Comp.UserForm.isNewUser model.formModel in - Html.form [class "ui segment", onSubmit Submit] - [Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) - ,if newUser then - h3 [class "ui dividing header"] - [text "Create new user" - ] - else - h3 [class "ui dividing header"] - [text ("Edit user: " ++ model.formModel.user.login) - ] - ,Html.map FormMsg (Comp.UserForm.view model.formModel) - ,div [classList [("ui error message", True) - ,("invisible", Util.Maybe.isEmpty model.formError) - ] - ] - [Maybe.withDefault "" model.formError |> text - ] - ,div [class "ui horizontal divider"][] - ,button [class "ui primary button", type_ "submit"] - [text "Submit" + Html.form [ class "ui segment", onSubmit Submit ] + [ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm) + , if newUser then + h3 [ class "ui dividing header" ] + [ text "Create new user" ] - ,a [class "ui secondary button", onClick (SetViewMode Table), href ""] - [text "Cancel" + + else + h3 [ class "ui dividing header" ] + [ text ("Edit user: " ++ model.formModel.user.login) + ] + , Html.map FormMsg (Comp.UserForm.view model.formModel) + , div + [ classList + [ ( "ui error message", True ) + , ( "invisible", Util.Maybe.isEmpty model.formError ) ] - ,if not newUser then - a [class "ui right floated red button", href "", onClick RequestDelete] - [text "Delete"] - else - span[][] - ,div [classList [("ui dimmer", True) - ,("active", model.loading) - ]] - [div [class "ui loader"][] - ] ] + [ Maybe.withDefault "" model.formError |> text + ] + , div [ class "ui horizontal divider" ] [] + , button [ class "ui primary button", type_ "submit" ] + [ text "Submit" + ] + , a [ class "ui secondary button", onClick (SetViewMode Table), href "" ] + [ text "Cancel" + ] + , if not newUser then + a [ class "ui right floated red button", href "", onClick RequestDelete ] + [ text "Delete" ] + + else + span [] [] + , div + [ classList + [ ( "ui dimmer", True ) + , ( "active", model.loading ) + ] + ] + [ div [ class "ui loader" ] [] + ] + ] diff --git a/modules/webapp/src/main/elm/Comp/UserTable.elm b/modules/webapp/src/main/elm/Comp/UserTable.elm index fd85f7eb..565e44e2 100644 --- a/modules/webapp/src/main/elm/Comp/UserTable.elm +++ b/modules/webapp/src/main/elm/Comp/UserTable.elm @@ -1,83 +1,91 @@ -module Comp.UserTable exposing ( Model - , emptyModel - , Msg(..) - , view - , update) +module Comp.UserTable exposing + ( Model + , Msg(..) + , emptyModel + , update + , view + ) +import Api.Model.User exposing (User) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Data.Flags exposing (Flags) -import Api.Model.User exposing (User) import Util.Time exposing (formatDateTime) + type alias Model = - { users: List User - , selected: Maybe User + { users : List User + , selected : Maybe User } -emptyModel: Model + +emptyModel : Model emptyModel = { users = [] , selected = Nothing } + type Msg = SetUsers (List User) | Select User | Deselect -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetUsers list -> - ({model | users = list, selected = Nothing }, Cmd.none) + ( { model | users = list, selected = Nothing }, Cmd.none ) Select user -> - ({model | selected = Just user}, Cmd.none) + ( { model | selected = Just user }, Cmd.none ) Deselect -> - ({model | selected = Nothing}, Cmd.none) + ( { model | selected = Nothing }, Cmd.none ) -view: Model -> Html Msg +view : Model -> Html Msg view model = - table [class "ui selectable table"] - [thead [] - [tr [] - [th [class "collapsing"][text "Login"] - ,th [class "collapsing"][text "State"] - ,th [class "collapsing"][text "Email"] - ,th [class "collapsing"][text "Logins"] - ,th [class "collapsing"][text "Last Login"] - ,th [class "collapsing"][text "Created"] - ] - ] - ,tbody [] + table [ class "ui selectable table" ] + [ thead [] + [ tr [] + [ th [ class "collapsing" ] [ text "Login" ] + , th [ class "collapsing" ] [ text "State" ] + , th [ class "collapsing" ] [ text "Email" ] + , th [ class "collapsing" ] [ text "Logins" ] + , th [ class "collapsing" ] [ text "Last Login" ] + , th [ class "collapsing" ] [ text "Created" ] + ] + ] + , tbody [] (List.map (renderUserLine model) model.users) ] -renderUserLine: Model -> User -> Html Msg + +renderUserLine : Model -> User -> Html Msg renderUserLine model user = - tr [classList [("active", model.selected == Just user)] - ,onClick (Select user) - ] - [td [class "collapsing"] - [text user.login - ] - ,td [class "collapsing"] - [text user.state + tr + [ classList [ ( "active", model.selected == Just user ) ] + , onClick (Select user) + ] + [ td [ class "collapsing" ] + [ text user.login ] - ,td [class "collapsing"] - [Maybe.withDefault "" user.email |> text + , td [ class "collapsing" ] + [ text user.state ] - ,td [class "collapsing"] - [String.fromInt user.loginCount |> text + , td [ class "collapsing" ] + [ Maybe.withDefault "" user.email |> text ] - ,td [class "collapsing"] - [Maybe.map formatDateTime user.lastLogin |> Maybe.withDefault "" |> text + , td [ class "collapsing" ] + [ String.fromInt user.loginCount |> text ] - ,td [class "collapsing"] - [formatDateTime user.created |> text + , td [ class "collapsing" ] + [ Maybe.map formatDateTime user.lastLogin |> Maybe.withDefault "" |> text + ] + , td [ class "collapsing" ] + [ formatDateTime user.created |> text ] ] diff --git a/modules/webapp/src/main/elm/Comp/YesNoDimmer.elm b/modules/webapp/src/main/elm/Comp/YesNoDimmer.elm index 5c3216db..927d6463 100644 --- a/modules/webapp/src/main/elm/Comp/YesNoDimmer.elm +++ b/modules/webapp/src/main/elm/Comp/YesNoDimmer.elm @@ -1,43 +1,49 @@ -module Comp.YesNoDimmer exposing ( Model - , Msg(..) - , emptyModel - , update - , view - , view2 - , activate - , disable - , Settings - , defaultSettings - ) +module Comp.YesNoDimmer exposing + ( Model + , Msg(..) + , Settings + , activate + , defaultSettings + , disable + , emptyModel + , update + , view + , view2 + ) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) + type alias Model = - { active: Bool + { active : Bool } -emptyModel: Model + +emptyModel : Model emptyModel = { active = False } + type Msg = Activate | Disable | ConfirmDelete + type alias Settings = - { message: String - , headerIcon: String - , headerClass: String - , confirmButton: String - , cancelButton: String - , invertedDimmer: Bool + { message : String + , headerIcon : String + , headerClass : String + , confirmButton : String + , cancelButton : String + , invertedDimmer : Bool } -defaultSettings: Settings + +defaultSettings : Settings defaultSettings = { message = "Delete this item permanently?" , headerIcon = "exclamation icon" @@ -48,48 +54,62 @@ defaultSettings = } -activate: Msg -activate = Activate +activate : Msg +activate = + Activate -disable: Msg -disable = Disable -update: Msg -> Model -> (Model, Bool) +disable : Msg +disable = + Disable + + +update : Msg -> Model -> ( Model, Bool ) update msg model = case msg of Activate -> - ({model | active = True}, False) - Disable -> - ({model | active = False}, False) - ConfirmDelete -> - ({model | active = False}, True) + ( { model | active = True }, False ) -view: Model -> Html Msg + Disable -> + ( { model | active = False }, False ) + + ConfirmDelete -> + ( { model | active = False }, True ) + + +view : Model -> Html Msg view model = view2 True defaultSettings model - -view2: Bool -> Settings -> Model -> Html Msg + + +view2 : Bool -> Settings -> Model -> Html Msg view2 active settings model = - div [classList [("ui dimmer", True) - ,("inverted", settings.invertedDimmer) - ,("active", (active && model.active)) - ] - ] - [div [class "content"] - [h3 [class settings.headerClass] - [if settings.headerIcon == "" then span[][] else i [class settings.headerIcon][] - ,text settings.message - ] - ] - ,div [class "content"] - [div [class "ui buttons"] - [a [class "ui primary button", onClick ConfirmDelete, href ""] - [text settings.confirmButton - ] - ,div [class "or"][] - ,a [class "ui secondary button", onClick Disable, href ""] - [text settings.cancelButton - ] - ] - ] - ] + div + [ classList + [ ( "ui dimmer", True ) + , ( "inverted", settings.invertedDimmer ) + , ( "active", active && model.active ) + ] + ] + [ div [ class "content" ] + [ h3 [ class settings.headerClass ] + [ if settings.headerIcon == "" then + span [] [] + + else + i [ class settings.headerIcon ] [] + , text settings.message + ] + ] + , div [ class "content" ] + [ div [ class "ui buttons" ] + [ a [ class "ui primary button", onClick ConfirmDelete, href "" ] + [ text settings.confirmButton + ] + , div [ class "or" ] [] + , a [ class "ui secondary button", onClick Disable, href "" ] + [ text settings.cancelButton + ] + ] + ] + ] diff --git a/modules/webapp/src/main/elm/Data/ContactType.elm b/modules/webapp/src/main/elm/Data/ContactType.elm index dc21cd8d..2ba2055d 100644 --- a/modules/webapp/src/main/elm/Data/ContactType.elm +++ b/modules/webapp/src/main/elm/Data/ContactType.elm @@ -1,4 +1,10 @@ -module Data.ContactType exposing (..) +module Data.ContactType exposing + ( ContactType(..) + , all + , fromString + , toString + ) + type ContactType = Phone @@ -9,28 +15,54 @@ type ContactType | Website -fromString: String -> Maybe ContactType +fromString : String -> Maybe ContactType fromString str = case String.toLower str of - "phone" -> Just Phone - "mobile" -> Just Mobile - "fax" -> Just Fax - "email" -> Just Email - "docspell" -> Just Docspell - "website" -> Just Website - _ -> Nothing + "phone" -> + Just Phone -toString: ContactType -> String + "mobile" -> + Just Mobile + + "fax" -> + Just Fax + + "email" -> + Just Email + + "docspell" -> + Just Docspell + + "website" -> + Just Website + + _ -> + Nothing + + +toString : ContactType -> String toString ct = case ct of - Phone -> "Phone" - Mobile -> "Mobile" - Fax -> "Fax" - Email -> "Email" - Docspell -> "Docspell" - Website -> "Website" + Phone -> + "Phone" -all: List ContactType + Mobile -> + "Mobile" + + Fax -> + "Fax" + + Email -> + "Email" + + Docspell -> + "Docspell" + + Website -> + "Website" + + +all : List ContactType all = [ Mobile , Phone diff --git a/modules/webapp/src/main/elm/Data/Direction.elm b/modules/webapp/src/main/elm/Data/Direction.elm index e4f6009e..85e6f10c 100644 --- a/modules/webapp/src/main/elm/Data/Direction.elm +++ b/modules/webapp/src/main/elm/Data/Direction.elm @@ -1,45 +1,72 @@ -module Data.Direction exposing (..) +module Data.Direction exposing + ( Direction(..) + , all + , fromString + , icon + , iconFromMaybe + , iconFromString + , toString + ) + type Direction = Incoming | Outgoing -fromString: String -> Maybe Direction + +fromString : String -> Maybe Direction fromString str = case String.toLower str of - "outgoing" -> Just Outgoing - "incoming" -> Just Incoming - _ -> Nothing + "outgoing" -> + Just Outgoing -all: List Direction + "incoming" -> + Just Incoming + + _ -> + Nothing + + +all : List Direction all = [ Incoming , Outgoing ] -toString: Direction -> String + +toString : Direction -> String toString dir = case dir of - Incoming -> "Incoming" - Outgoing -> "Outgoing" + Incoming -> + "Incoming" -icon: Direction -> String + Outgoing -> + "Outgoing" + + +icon : Direction -> String icon dir = case dir of - Incoming -> "level down alternate icon" - Outgoing -> "level up alternate icon" + Incoming -> + "level down alternate icon" -unknownIcon: String + Outgoing -> + "level up alternate icon" + + +unknownIcon : String unknownIcon = "question circle outline icon" -iconFromString: String -> String + +iconFromString : String -> String iconFromString dir = fromString dir |> Maybe.map icon |> Maybe.withDefault unknownIcon -iconFromMaybe: Maybe String -> String + +iconFromMaybe : Maybe String -> String iconFromMaybe ms = Maybe.map iconFromString ms |> Maybe.withDefault unknownIcon diff --git a/modules/webapp/src/main/elm/Data/Flags.elm b/modules/webapp/src/main/elm/Data/Flags.elm index 659d9284..a129e76f 100644 --- a/modules/webapp/src/main/elm/Data/Flags.elm +++ b/modules/webapp/src/main/elm/Data/Flags.elm @@ -1,28 +1,39 @@ -module Data.Flags exposing (..) +module Data.Flags exposing + ( Config + , Flags + , getToken + , withAccount + , withoutAccount + ) import Api.Model.AuthResult exposing (AuthResult) + type alias Config = - { appName: String - , baseUrl: String - , signupMode: String - , docspellAssetPath: String + { appName : String + , baseUrl : String + , signupMode : String + , docspellAssetPath : String } + type alias Flags = - { account: Maybe AuthResult - , config: Config + { account : Maybe AuthResult + , config : Config } -getToken: Flags -> Maybe String + +getToken : Flags -> Maybe String getToken flags = flags.account |> Maybe.andThen (\a -> a.token) -withAccount: Flags -> AuthResult -> Flags + +withAccount : Flags -> AuthResult -> Flags withAccount flags acc = { flags | account = Just acc } -withoutAccount: Flags -> Flags + +withoutAccount : Flags -> Flags withoutAccount flags = { flags | account = Nothing } diff --git a/modules/webapp/src/main/elm/Data/Language.elm b/modules/webapp/src/main/elm/Data/Language.elm index 3b29fa22..6704ec3e 100644 --- a/modules/webapp/src/main/elm/Data/Language.elm +++ b/modules/webapp/src/main/elm/Data/Language.elm @@ -1,27 +1,49 @@ -module Data.Language exposing (..) +module Data.Language exposing + ( Language(..) + , all + , fromString + , toIso3 + , toName + ) + type Language = German | English -fromString: String -> Maybe Language -fromString str = - if str == "deu" || str == "de" || str == "german" then Just German - else if str == "eng" || str == "en" || str == "english" then Just English - else Nothing -toIso3: Language -> String +fromString : String -> Maybe Language +fromString str = + if str == "deu" || str == "de" || str == "german" then + Just German + + else if str == "eng" || str == "en" || str == "english" then + Just English + + else + Nothing + + +toIso3 : Language -> String toIso3 lang = case lang of - German -> "deu" - English -> "eng" + German -> + "deu" -toName: Language -> String + English -> + "eng" + + +toName : Language -> String toName lang = case lang of - German -> "German" - English -> "English" + German -> + "German" -all: List Language + English -> + "English" + + +all : List Language all = [ German, English ] diff --git a/modules/webapp/src/main/elm/Data/Priority.elm b/modules/webapp/src/main/elm/Data/Priority.elm index 290feef4..2fefd347 100644 --- a/modules/webapp/src/main/elm/Data/Priority.elm +++ b/modules/webapp/src/main/elm/Data/Priority.elm @@ -1,25 +1,43 @@ -module Data.Priority exposing (..) +module Data.Priority exposing + ( Priority(..) + , all + , fromString + , toName + ) + type Priority = High | Low -fromString: String -> Maybe Priority + +fromString : String -> Maybe Priority fromString str = let - s = String.toLower str + s = + String.toLower str in - case s of - "low" -> Just Low - "high" -> Just High - _ -> Nothing + case s of + "low" -> + Just Low -toName: Priority -> String + "high" -> + Just High + + _ -> + Nothing + + +toName : Priority -> String toName lang = case lang of - Low -> "Low" - High-> "High" + Low -> + "Low" -all: List Priority + High -> + "High" + + +all : List Priority all = [ Low, High ] diff --git a/modules/webapp/src/main/elm/Data/SourceState.elm b/modules/webapp/src/main/elm/Data/SourceState.elm index 78dda709..fc9de838 100644 --- a/modules/webapp/src/main/elm/Data/SourceState.elm +++ b/modules/webapp/src/main/elm/Data/SourceState.elm @@ -1,24 +1,41 @@ -module Data.SourceState exposing (..) +module Data.SourceState exposing + ( SourceState(..) + , all + , fromString + , toString + ) + type SourceState = Active | Disabled -fromString: String -> Maybe SourceState + +fromString : String -> Maybe SourceState fromString str = case String.toLower str of - "active" -> Just Active - "disabled" -> Just Disabled - _ -> Nothing + "active" -> + Just Active -all: List SourceState + "disabled" -> + Just Disabled + + _ -> + Nothing + + +all : List SourceState all = [ Active , Disabled ] -toString: SourceState -> String + +toString : SourceState -> String toString dir = case dir of - Active -> "Active" - Disabled -> "Disabled" + Active -> + "Active" + + Disabled -> + "Disabled" diff --git a/modules/webapp/src/main/elm/Data/UserState.elm b/modules/webapp/src/main/elm/Data/UserState.elm index fa1c52a4..0d55649f 100644 --- a/modules/webapp/src/main/elm/Data/UserState.elm +++ b/modules/webapp/src/main/elm/Data/UserState.elm @@ -1,24 +1,41 @@ -module Data.UserState exposing (..) +module Data.UserState exposing + ( UserState(..) + , all + , fromString + , toString + ) + type UserState = Active | Disabled -fromString: String -> Maybe UserState + +fromString : String -> Maybe UserState fromString str = case String.toLower str of - "active" -> Just Active - "disabled" -> Just Disabled - _ -> Nothing + "active" -> + Just Active -all: List UserState + "disabled" -> + Just Disabled + + _ -> + Nothing + + +all : List UserState all = [ Active , Disabled ] -toString: UserState -> String + +toString : UserState -> String toString dir = case dir of - Active -> "Active" - Disabled -> "Disabled" + Active -> + "Active" + + Disabled -> + "Disabled" diff --git a/modules/webapp/src/main/elm/Main.elm b/modules/webapp/src/main/elm/Main.elm index 795f15c7..df4cf4d2 100644 --- a/modules/webapp/src/main/elm/Main.elm +++ b/modules/webapp/src/main/elm/Main.elm @@ -1,58 +1,75 @@ -module Main exposing (..) - -import Browser exposing (Document) -import Browser.Navigation exposing (Key) -import Url exposing (Url) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) +module Main exposing (init, main) import Api -import Ports -import Page -import Data.Flags exposing (Flags) import App.Data exposing (..) import App.Update exposing (..) import App.View exposing (..) +import Browser exposing (Document) +import Browser.Navigation exposing (Key) +import Data.Flags exposing (Flags) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Page +import Ports +import Url exposing (Url) + -- MAIN -main: Program Flags Model Msg + +main : Program Flags Model Msg main = - Browser.application - { init = init - , view = viewDoc - , update = update - , subscriptions = subscriptions - , onUrlRequest = NavRequest - , onUrlChange = NavChange - } + Browser.application + { init = init + , view = viewDoc + , update = update + , subscriptions = subscriptions + , onUrlRequest = NavRequest + , onUrlChange = NavChange + } + -- MODEL -init : Flags -> Url -> Key -> (Model, Cmd Msg) +init : Flags -> Url -> Key -> ( Model, Cmd Msg ) init flags url key = let - im = App.Data.init key url flags - page = checkPage flags im.page - (m, cmd) = if im.page == page then App.Update.initPage im page - else (im, Page.goto page) + im = + App.Data.init key url flags + + page = + checkPage flags im.page + + ( m, cmd ) = + if im.page == page then + App.Update.initPage im page + + else + ( im, Page.goto page ) + sessionCheck = case m.flags.account of - Just _ -> Api.loginSession flags SessionCheckResp - Nothing -> Cmd.none - in - (m, Cmd.batch [ cmd, Ports.initElements(), Api.versionInfo flags VersionResp, sessionCheck ]) + Just _ -> + Api.loginSession flags SessionCheckResp -viewDoc: Model -> Document Msg + Nothing -> + Cmd.none + in + ( m, Cmd.batch [ cmd, Api.versionInfo flags VersionResp, sessionCheck ] ) + + +viewDoc : Model -> Document Msg viewDoc model = - { title = model.flags.config.appName ++ ": " ++ (Page.pageName model.page) - , body = [ (view model) ] + { title = model.flags.config.appName ++ ": " ++ Page.pageName model.page + , body = [ view model ] } + + -- SUBSCRIPTIONS diff --git a/modules/webapp/src/main/elm/Page.elm b/modules/webapp/src/main/elm/Page.elm index c088028c..12dafa24 100644 --- a/modules/webapp/src/main/elm/Page.elm +++ b/modules/webapp/src/main/elm/Page.elm @@ -1,25 +1,26 @@ -module Page exposing ( Page(..) - , href - , goto - , pageToString - , pageFromString - , pageName - , loginPage - , loginPageReferrer - , uploadId - , fromUrl - , isSecured - , isOpen - ) +module Page exposing + ( Page(..) + , fromUrl + , goto + , href + , isOpen + , isSecured + , loginPage + , loginPageReferrer + , pageFromString + , pageName + , pageToString + , uploadId + ) -import Url exposing (Url) -import Url.Parser as Parser exposing ((), (), Parser, oneOf, s, string) -import Url.Parser.Query as Query +import Browser.Navigation as Nav import Html exposing (Attribute) import Html.Attributes as Attr -import Browser.Navigation as Nav +import Url exposing (Url) +import Url.Parser as Parser exposing ((), Parser, oneOf, s, string) import Util.Maybe + type Page = HomePage | LoginPage (Maybe String) @@ -32,108 +33,178 @@ type Page | NewInvitePage -isSecured: Page -> Bool +isSecured : Page -> Bool isSecured page = case page of - HomePage -> True - LoginPage _ -> False - ManageDataPage -> True - CollectiveSettingPage -> True - UserSettingPage -> True - QueuePage -> True - RegisterPage -> False - NewInvitePage -> False + HomePage -> + True + + LoginPage _ -> + False + + ManageDataPage -> + True + + CollectiveSettingPage -> + True + + UserSettingPage -> + True + + QueuePage -> + True + + RegisterPage -> + False + + NewInvitePage -> + False + UploadPage arg -> Util.Maybe.isEmpty arg -isOpen: Page -> Bool + +isOpen : Page -> Bool isOpen page = not (isSecured page) -loginPage: Page -> Page + +loginPage : Page -> Page loginPage p = case p of - LoginPage _ -> LoginPage Nothing - _ -> LoginPage (Just (pageToString p |> String.dropLeft 2)) + LoginPage _ -> + LoginPage Nothing + + _ -> + LoginPage (Just (pageToString p |> String.dropLeft 2)) -pageName: Page -> String +pageName : Page -> String pageName page = case page of - HomePage -> "Home" - LoginPage _ -> "Login" - ManageDataPage -> "Manage Data" - CollectiveSettingPage -> "Collective Settings" - UserSettingPage -> "User Settings" - QueuePage -> "Processing" - RegisterPage -> "Register" - NewInvitePage -> "New Invite" + HomePage -> + "Home" + + LoginPage _ -> + "Login" + + ManageDataPage -> + "Manage Data" + + CollectiveSettingPage -> + "Collective Settings" + + UserSettingPage -> + "User Settings" + + QueuePage -> + "Processing" + + RegisterPage -> + "Register" + + NewInvitePage -> + "New Invite" + UploadPage arg -> case arg of - Just _ -> "Anonymous Upload" - Nothing -> "Upload" + Just _ -> + "Anonymous Upload" -loginPageReferrer: Page -> Maybe Page + Nothing -> + "Upload" + + +loginPageReferrer : Page -> Maybe Page loginPageReferrer page = case page of - LoginPage r -> Maybe.andThen pageFromString r - _ -> Nothing + LoginPage r -> + Maybe.andThen pageFromString r -uploadId: Page -> Maybe String + _ -> + Nothing + + +uploadId : Page -> Maybe String uploadId page = case page of - UploadPage id -> id - _ -> Nothing + UploadPage id -> + id -pageToString: Page -> String + _ -> + Nothing + + +pageToString : Page -> String pageToString page = case page of - HomePage -> "#/home" + HomePage -> + "#/home" + LoginPage referer -> Maybe.map (\p -> "/" ++ p) referer |> Maybe.withDefault "" |> (++) "#/login" - ManageDataPage -> "#/manageData" - CollectiveSettingPage -> "#/collectiveSettings" - UserSettingPage -> "#/userSettings" - QueuePage -> "#/queue" - RegisterPage -> "#/register" + + ManageDataPage -> + "#/manageData" + + CollectiveSettingPage -> + "#/collectiveSettings" + + UserSettingPage -> + "#/userSettings" + + QueuePage -> + "#/queue" + + RegisterPage -> + "#/register" + UploadPage sourceId -> Maybe.map (\id -> "/" ++ id) sourceId |> Maybe.withDefault "" |> (++) "#/upload" - NewInvitePage -> "#/newinvite" -pageFromString: String -> Maybe Page + NewInvitePage -> + "#/newinvite" + + +pageFromString : String -> Maybe Page pageFromString str = let - url = Url.Url Url.Http "" Nothing str Nothing Nothing + url = + Url.Url Url.Http "" Nothing str Nothing Nothing in - Parser.parse parser url + Parser.parse parser url -href: Page -> Attribute msg + +href : Page -> Attribute msg href page = Attr.href (pageToString page) -goto: Page -> Cmd msg + +goto : Page -> Cmd msg goto page = Nav.load (pageToString page) -parser: Parser (Page -> a) a + +parser : Parser (Page -> a) a parser = oneOf - [ Parser.map HomePage (oneOf [s"", s "home"]) - , Parser.map (\s -> LoginPage (Just s)) (s "login" string) - , Parser.map (LoginPage Nothing) (s "login") - , Parser.map ManageDataPage (s "manageData") - , Parser.map CollectiveSettingPage (s "collectiveSettings") - , Parser.map UserSettingPage (s "userSettings") - , Parser.map QueuePage (s "queue") - , Parser.map RegisterPage (s "register") - , Parser.map (\s -> UploadPage (Just s)) (s "upload" string) - , Parser.map (UploadPage Nothing) (s "upload") - , Parser.map NewInvitePage (s "newinvite") - ] + [ Parser.map HomePage (oneOf [ s "", s "home" ]) + , Parser.map (\s -> LoginPage (Just s)) (s "login" string) + , Parser.map (LoginPage Nothing) (s "login") + , Parser.map ManageDataPage (s "manageData") + , Parser.map CollectiveSettingPage (s "collectiveSettings") + , Parser.map UserSettingPage (s "userSettings") + , Parser.map QueuePage (s "queue") + , Parser.map RegisterPage (s "register") + , Parser.map (\s -> UploadPage (Just s)) (s "upload" string) + , Parser.map (UploadPage Nothing) (s "upload") + , Parser.map NewInvitePage (s "newinvite") + ] + fromUrl : Url -> Maybe Page fromUrl url = diff --git a/modules/webapp/src/main/elm/Page/CollectiveSettings/Data.elm b/modules/webapp/src/main/elm/Page/CollectiveSettings/Data.elm index d8689559..b55ba06c 100644 --- a/modules/webapp/src/main/elm/Page/CollectiveSettings/Data.elm +++ b/modules/webapp/src/main/elm/Page/CollectiveSettings/Data.elm @@ -1,24 +1,30 @@ -module Page.CollectiveSettings.Data exposing (..) +module Page.CollectiveSettings.Data exposing + ( Model + , Msg(..) + , Tab(..) + , emptyModel + ) -import Http -import Comp.SourceManage -import Comp.UserManage -import Comp.Settings -import Data.Language import Api.Model.BasicResult exposing (BasicResult) import Api.Model.CollectiveSettings exposing (CollectiveSettings) import Api.Model.ItemInsights exposing (ItemInsights) +import Comp.Settings +import Comp.SourceManage +import Comp.UserManage +import Http + type alias Model = - { currentTab: Maybe Tab - , sourceModel: Comp.SourceManage.Model - , userModel: Comp.UserManage.Model - , settingsModel: Comp.Settings.Model - , insights: ItemInsights - , submitResult: Maybe BasicResult + { currentTab : Maybe Tab + , sourceModel : Comp.SourceManage.Model + , userModel : Comp.UserManage.Model + , settingsModel : Comp.Settings.Model + , insights : ItemInsights + , submitResult : Maybe BasicResult } -emptyModel: Model + +emptyModel : Model emptyModel = { currentTab = Just InsightsTab , sourceModel = Comp.SourceManage.emptyModel @@ -28,12 +34,14 @@ emptyModel = , submitResult = Nothing } + type Tab = SourceTab | UserTab | InsightsTab | SettingsTab + type Msg = SetTab Tab | SourceMsg Comp.SourceManage.Msg diff --git a/modules/webapp/src/main/elm/Page/CollectiveSettings/Update.elm b/modules/webapp/src/main/elm/Page/CollectiveSettings/Update.elm index 9a17704a..7b4f8cf8 100644 --- a/modules/webapp/src/main/elm/Page/CollectiveSettings/Update.elm +++ b/modules/webapp/src/main/elm/Page/CollectiveSettings/Update.elm @@ -2,80 +2,90 @@ module Page.CollectiveSettings.Update exposing (update) import Api import Api.Model.BasicResult exposing (BasicResult) -import Page.CollectiveSettings.Data exposing (..) -import Data.Flags exposing (Flags) +import Comp.Settings import Comp.SourceManage import Comp.UserManage -import Comp.Settings +import Data.Flags exposing (Flags) +import Page.CollectiveSettings.Data exposing (..) import Util.Http -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetTab t -> let - m = { model | currentTab = Just t } + m = + { model | currentTab = Just t } in - case t of - SourceTab -> - update flags (SourceMsg Comp.SourceManage.LoadSources) m + case t of + SourceTab -> + update flags (SourceMsg Comp.SourceManage.LoadSources) m - UserTab -> - update flags (UserMsg Comp.UserManage.LoadUsers) m + UserTab -> + update flags (UserMsg Comp.UserManage.LoadUsers) m - InsightsTab -> - update flags Init m + InsightsTab -> + update flags Init m - SettingsTab -> - update flags Init m + SettingsTab -> + update flags Init m SourceMsg m -> let - (m2, c2) = Comp.SourceManage.update flags m model.sourceModel + ( m2, c2 ) = + Comp.SourceManage.update flags m model.sourceModel in - ({model | sourceModel = m2}, Cmd.map SourceMsg c2) + ( { model | sourceModel = m2 }, Cmd.map SourceMsg c2 ) UserMsg m -> let - (m2, c2) = Comp.UserManage.update flags m model.userModel + ( m2, c2 ) = + Comp.UserManage.update flags m model.userModel in - ({model | userModel = m2}, Cmd.map UserMsg c2) + ( { model | userModel = m2 }, Cmd.map UserMsg c2 ) SettingsMsg m -> let - (m2, c2, msett) = Comp.Settings.update flags m model.settingsModel - cmd = case msett of - Nothing -> Cmd.none - Just sett -> - Api.setCollectiveSettings flags sett SubmitResp + ( m2, c2, msett ) = + Comp.Settings.update flags m model.settingsModel + + cmd = + case msett of + Nothing -> + Cmd.none + + Just sett -> + Api.setCollectiveSettings flags sett SubmitResp in - ({model | settingsModel = m2, submitResult = Nothing}, Cmd.batch [cmd, Cmd.map SettingsMsg c2]) + ( { model | settingsModel = m2, submitResult = Nothing }, Cmd.batch [ cmd, Cmd.map SettingsMsg c2 ] ) Init -> - ({model|submitResult = Nothing} - ,Cmd.batch + ( { model | submitResult = Nothing } + , Cmd.batch [ Api.getInsights flags GetInsightsResp , Api.getCollectiveSettings flags CollectiveSettingsResp ] ) GetInsightsResp (Ok data) -> - ({model|insights = data}, Cmd.none) + ( { model | insights = data }, Cmd.none ) - GetInsightsResp (Err err) -> - (model, Cmd.none) + GetInsightsResp (Err _) -> + ( model, Cmd.none ) CollectiveSettingsResp (Ok data) -> - ({model | settingsModel = Comp.Settings.init data }, Cmd.none) + ( { model | settingsModel = Comp.Settings.init data }, Cmd.none ) - CollectiveSettingsResp (Err err) -> - (model, Cmd.none) + CollectiveSettingsResp (Err _) -> + ( model, Cmd.none ) SubmitResp (Ok res) -> - ({model | submitResult = Just res}, Cmd.none) + ( { model | submitResult = Just res }, Cmd.none ) SubmitResp (Err err) -> let - res = BasicResult False (Util.Http.errorToString err) + res = + BasicResult False (Util.Http.errorToString err) in - ({model | submitResult = Just res}, Cmd.none) + ( { model | submitResult = Just res }, Cmd.none ) diff --git a/modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm b/modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm index abac4d5f..7e12dec4 100644 --- a/modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm +++ b/modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm @@ -1,197 +1,217 @@ module Page.CollectiveSettings.View exposing (view) +import Api.Model.NameCount exposing (NameCount) +import Comp.Settings +import Comp.SourceManage +import Comp.UserManage +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Api.Model.NameCount exposing (NameCount) -import Util.Html exposing (classActive) -import Data.Flags exposing (Flags) import Page.CollectiveSettings.Data exposing (..) -import Comp.SourceManage -import Comp.UserManage -import Comp.Settings -import Util.Size +import Util.Html exposing (classActive) import Util.Maybe +import Util.Size -view: Flags -> Model -> Html Msg + +view : Flags -> Model -> Html Msg view flags model = - div [class "collectivesetting-page ui padded grid"] - [div [class "four wide column"] - [h4 [class "ui top attached ablue-comp header"] - [text "Collective" - ] - ,div [class "ui attached fluid segment"] - [div [class "ui fluid vertical secondary menu"] - [div [classActive (model.currentTab == Just InsightsTab) "link icon item" - ,onClick (SetTab InsightsTab) - ] - [i [class "chart bar outline icon"][] - ,text "Insights" - ] - ,div [classActive (model.currentTab == Just SourceTab) "link icon item" - ,onClick (SetTab SourceTab) - ] - [i [class "upload icon"][] - ,text "Sources" - ] - , div [classActive (model.currentTab == Just SettingsTab) "link icon item" - ,onClick (SetTab SettingsTab) + div [ class "collectivesetting-page ui padded grid" ] + [ div [ class "four wide column" ] + [ h4 [ class "ui top attached ablue-comp header" ] + [ text "Collective" + ] + , div [ class "ui attached fluid segment" ] + [ div [ class "ui fluid vertical secondary menu" ] + [ div + [ classActive (model.currentTab == Just InsightsTab) "link icon item" + , onClick (SetTab InsightsTab) ] - [i [class "language icon"][] - ,text "Document Language" - ] - ,div [classActive (model.currentTab == Just UserTab) "link icon item" - ,onClick (SetTab UserTab) - ] - [i [class "user icon"][] - ,text "Users" - ] - ] - ] - ] - ,div [class "twelve wide column"] - [div [class ""] - (case model.currentTab of - Just SourceTab -> viewSources flags model - Just UserTab -> viewUsers model - Just InsightsTab -> viewInsights model - Just SettingsTab -> viewSettings model - Nothing -> [] - ) + [ i [ class "chart bar outline icon" ] [] + , text "Insights" + ] + , div + [ classActive (model.currentTab == Just SourceTab) "link icon item" + , onClick (SetTab SourceTab) + ] + [ i [ class "upload icon" ] [] + , text "Sources" + ] + , div + [ classActive (model.currentTab == Just SettingsTab) "link icon item" + , onClick (SetTab SettingsTab) + ] + [ i [ class "language icon" ] [] + , text "Document Language" + ] + , div + [ classActive (model.currentTab == Just UserTab) "link icon item" + , onClick (SetTab UserTab) + ] + [ i [ class "user icon" ] [] + , text "Users" + ] + ] + ] + ] + , div [ class "twelve wide column" ] + [ div [ class "" ] + (case model.currentTab of + Just SourceTab -> + viewSources flags model + + Just UserTab -> + viewUsers model + + Just InsightsTab -> + viewInsights model + + Just SettingsTab -> + viewSettings model + + Nothing -> + [] + ) ] ] -viewInsights: Model -> List (Html Msg) + +viewInsights : Model -> List (Html Msg) viewInsights model = - [h1 [class "ui header"] - [i [class "chart bar outline icon"][] - ,div [class "content"] - [text "Insights" - ] + [ h1 [ class "ui header" ] + [ i [ class "chart bar outline icon" ] [] + , div [ class "content" ] + [ text "Insights" + ] + ] + , div [ class "ui basic blue segment" ] + [ h4 [ class "ui header" ] + [ text "Items" + ] + , div [ class "ui statistics" ] + [ div [ class "ui statistic" ] + [ div [ class "value" ] + [ String.fromInt (model.insights.incomingCount + model.insights.outgoingCount) |> text + ] + , div [ class "label" ] + [ text "Items" + ] + ] + , div [ class "ui statistic" ] + [ div [ class "value" ] + [ String.fromInt model.insights.incomingCount |> text + ] + , div [ class "label" ] + [ text "Incoming" + ] + ] + , div [ class "ui statistic" ] + [ div [ class "value" ] + [ String.fromInt model.insights.outgoingCount |> text + ] + , div [ class "label" ] + [ text "Outgoing" + ] + ] + ] + ] + , div [ class "ui basic blue segment" ] + [ h4 [ class "ui header" ] + [ text "Size" + ] + , div [ class "ui statistics" ] + [ div [ class "ui statistic" ] + [ div [ class "value" ] + [ toFloat model.insights.itemSize |> Util.Size.bytesReadable Util.Size.B |> text + ] + , div [ class "label" ] + [ text "Size" + ] + ] + ] + ] + , div [ class "ui basic blue segment" ] + [ h4 [ class "ui header" ] + [ text "Tags" + ] + , div [ class "ui statistics" ] + (List.map makeTagStats model.insights.tagCloud.items) ] - ,div [class "ui basic blue segment"] - [h4 [class "ui header"] - [text "Items" - ] - ,div [class "ui statistics"] - [div [class "ui statistic"] - [div [class "value"] - [String.fromInt (model.insights.incomingCount + model.insights.outgoingCount) |> text - ] - ,div [class "label"] - [text "Items" - ] - ] - ,div [class "ui statistic"] - [div [class "value"] - [String.fromInt model.insights.incomingCount |> text - ] - ,div [class "label"] - [text "Incoming" - ] - ] - ,div [class "ui statistic"] - [div [class "value"] - [String.fromInt model.insights.outgoingCount |> text - ] - ,div [class "label"] - [text "Outgoing" - ] - ] - ] - ] - ,div [class "ui basic blue segment"] - [h4 [class "ui header"] - [text "Size" - ] - ,div [class "ui statistics"] - [div [class "ui statistic"] - [div [class "value"] - [toFloat model.insights.itemSize |> Util.Size.bytesReadable Util.Size.B |> text - ] - ,div [class "label"] - [text "Size" - ] - ] - ] - ] - ,div [class "ui basic blue segment"] - [h4 [class "ui header"] - [text "Tags" - ] - ,div [class "ui statistics"] - (List.map makeTagStats model.insights.tagCloud.items) - ] ] -makeTagStats: NameCount -> Html Msg + +makeTagStats : NameCount -> Html Msg makeTagStats nc = - div [class "ui statistic"] - [div [class "value"] - [String.fromInt nc.count |> text - ] - ,div [class "label"] - [text nc.name + div [ class "ui statistic" ] + [ div [ class "value" ] + [ String.fromInt nc.count |> text + ] + , div [ class "label" ] + [ text nc.name ] ] -viewSources: Flags -> Model -> List (Html Msg) +viewSources : Flags -> Model -> List (Html Msg) viewSources flags model = - [h2 [class "ui header"] - [i [class "ui upload icon"][] - ,div [class "content"] - [text "Sources" + [ h2 [ class "ui header" ] + [ i [ class "ui upload icon" ] [] + , div [ class "content" ] + [ text "Sources" ] ] - ,Html.map SourceMsg (Comp.SourceManage.view flags model.sourceModel) + , Html.map SourceMsg (Comp.SourceManage.view flags model.sourceModel) ] -viewUsers: Model -> List (Html Msg) +viewUsers : Model -> List (Html Msg) viewUsers model = - [h2 [class "ui header"] - [i [class "ui user icon"][] - ,div [class "content"] - [text "Users" + [ h2 [ class "ui header" ] + [ i [ class "ui user icon" ] [] + , div [ class "content" ] + [ text "Users" ] ] - ,Html.map UserMsg (Comp.UserManage.view model.userModel) + , Html.map UserMsg (Comp.UserManage.view model.userModel) ] -viewSettings: Model -> List (Html Msg) + +viewSettings : Model -> List (Html Msg) viewSettings model = - [div [class "ui grid"] - [div [class "row"] - [div [class "sixteen wide colum"] - [h2 [class "ui header"] - [i [class "ui language icon"][] - ,div [class "content"] - [text "Document Language" - ] + [ div [ class "ui grid" ] + [ div [ class "row" ] + [ div [ class "sixteen wide colum" ] + [ h2 [ class "ui header" ] + [ i [ class "ui language icon" ] [] + , div [ class "content" ] + [ text "Document Language" ] - ] - ] - ,div [class "row"] - [div [class "six wide column"] - [div [class "ui basic segment"] - [text "The language of your documents. This helps text recognition (OCR) and text analysis." + ] + ] + ] + , div [ class "row" ] + [ div [ class "six wide column" ] + [ div [ class "ui basic segment" ] + [ text "The language of your documents. This helps text recognition (OCR) and text analysis." + ] + ] + ] + , div [ class "row" ] + [ div [ class "six wide column" ] + [ Html.map SettingsMsg (Comp.Settings.view model.settingsModel) + , div + [ classList + [ ( "ui message", True ) + , ( "hidden", Util.Maybe.isEmpty model.submitResult ) + , ( "success", Maybe.map .success model.submitResult |> Maybe.withDefault False ) + , ( "error", Maybe.map .success model.submitResult |> Maybe.map not |> Maybe.withDefault False ) ] - ] - ] - ,div [class "row"] - [div [class "six wide column"] - [Html.map SettingsMsg (Comp.Settings.view model.settingsModel) - ,div [classList [("ui message", True) - ,("hidden", Util.Maybe.isEmpty model.submitResult) - ,("success", Maybe.map .success model.submitResult |> Maybe.withDefault False) - ,("error", Maybe.map .success model.submitResult |> Maybe.map not |> Maybe.withDefault False) - ]] - [Maybe.map .message model.submitResult - |> Maybe.withDefault "" - |> text - ] - ] - ] + ] + [ Maybe.map .message model.submitResult + |> Maybe.withDefault "" + |> text + ] + ] + ] ] ] diff --git a/modules/webapp/src/main/elm/Page/Home/Data.elm b/modules/webapp/src/main/elm/Page/Home/Data.elm index 5f0d13fc..7fbd38ae 100644 --- a/modules/webapp/src/main/elm/Page/Home/Data.elm +++ b/modules/webapp/src/main/elm/Page/Home/Data.elm @@ -1,22 +1,29 @@ -module Page.Home.Data exposing (..) +module Page.Home.Data exposing + ( Model + , Msg(..) + , ViewMode(..) + , emptyModel + ) -import Http -import Comp.SearchMenu -import Comp.ItemList -import Comp.ItemDetail -import Api.Model.ItemLightList exposing (ItemLightList) import Api.Model.ItemDetail exposing (ItemDetail) +import Api.Model.ItemLightList exposing (ItemLightList) +import Comp.ItemDetail +import Comp.ItemList +import Comp.SearchMenu +import Http + type alias Model = - { searchMenuModel: Comp.SearchMenu.Model - , itemListModel: Comp.ItemList.Model - , searchInProgress: Bool - , itemDetailModel: Comp.ItemDetail.Model - , viewMode: ViewMode + { searchMenuModel : Comp.SearchMenu.Model + , itemListModel : Comp.ItemList.Model + , searchInProgress : Bool + , itemDetailModel : Comp.ItemDetail.Model + , viewMode : ViewMode } -emptyModel: Model -emptyModel = + +emptyModel : Model +emptyModel = { searchMenuModel = Comp.SearchMenu.emptyModel , itemListModel = Comp.ItemList.emptyModel , itemDetailModel = Comp.ItemDetail.emptyModel @@ -24,6 +31,7 @@ emptyModel = , viewMode = Listing } + type Msg = Init | SearchMenuMsg Comp.SearchMenu.Msg @@ -33,4 +41,7 @@ type Msg | ItemDetailMsg Comp.ItemDetail.Msg | ItemDetailResp (Result Http.Error ItemDetail) -type ViewMode = Listing | Detail + +type ViewMode + = Listing + | Detail diff --git a/modules/webapp/src/main/elm/Page/Home/Update.elm b/modules/webapp/src/main/elm/Page/Home/Update.elm index e30d4b88..01513a00 100644 --- a/modules/webapp/src/main/elm/Page/Home/Update.elm +++ b/modules/webapp/src/main/elm/Page/Home/Update.elm @@ -1,14 +1,15 @@ module Page.Home.Update exposing (update) import Api +import Comp.ItemDetail +import Comp.ItemList +import Comp.SearchMenu import Data.Flags exposing (Flags) import Page.Home.Data exposing (..) -import Comp.SearchMenu -import Comp.ItemList -import Comp.ItemDetail import Util.Update -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of Init -> @@ -21,80 +22,108 @@ update flags msg model = SearchMenuMsg m -> let - nextState = Comp.SearchMenu.update flags m model.searchMenuModel - newModel = {model | searchMenuModel = Tuple.first nextState.modelCmd} - (m2, c2) = if nextState.stateChange then doSearch flags newModel else (newModel, Cmd.none) + nextState = + Comp.SearchMenu.update flags m model.searchMenuModel + + newModel = + { model | searchMenuModel = Tuple.first nextState.modelCmd } + + ( m2, c2 ) = + if nextState.stateChange then + doSearch flags newModel + + else + ( newModel, Cmd.none ) in - (m2, Cmd.batch [c2, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd)]) + ( m2, Cmd.batch [ c2, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd) ] ) ItemListMsg m -> let - (m2, c2, mitem) = Comp.ItemList.update flags m model.itemListModel - cmd = case mitem of - Just item -> - Api.itemDetail flags item.id ItemDetailResp - Nothing -> - Cmd.none + ( m2, c2, mitem ) = + Comp.ItemList.update flags m model.itemListModel + + cmd = + case mitem of + Just item -> + Api.itemDetail flags item.id ItemDetailResp + + Nothing -> + Cmd.none in - ({model | itemListModel = m2}, Cmd.batch [ Cmd.map ItemListMsg c2, cmd ]) + ( { model | itemListModel = m2 }, Cmd.batch [ Cmd.map ItemListMsg c2, cmd ] ) ItemSearchResp (Ok list) -> let - m = {model|searchInProgress = False, viewMode = Listing} + m = + { model | searchInProgress = False, viewMode = Listing } in - update flags (ItemListMsg (Comp.ItemList.SetResults list)) m + update flags (ItemListMsg (Comp.ItemList.SetResults list)) m - ItemSearchResp (Err err) -> - ({model|searchInProgress = False}, Cmd.none) + ItemSearchResp (Err _) -> + ( { model | searchInProgress = False }, Cmd.none ) DoSearch -> doSearch flags model ItemDetailMsg m -> let - (m2, c2, nav) = Comp.ItemDetail.update flags m model.itemDetailModel - newModel = {model | itemDetailModel = m2} - newCmd = Cmd.map ItemDetailMsg c2 + ( m2, c2, nav ) = + Comp.ItemDetail.update flags m model.itemDetailModel + + newModel = + { model | itemDetailModel = m2 } + + newCmd = + Cmd.map ItemDetailMsg c2 in - case nav of - Comp.ItemDetail.NavBack -> - doSearch flags newModel - Comp.ItemDetail.NavPrev -> - case Comp.ItemList.prevItem model.itemListModel m2.item.id of - Just n -> - (newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp]) - Nothing -> - (newModel, newCmd) - Comp.ItemDetail.NavNext -> - case Comp.ItemList.nextItem model.itemListModel m2.item.id of - Just n -> - (newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp]) - Nothing -> - (newModel, newCmd) - Comp.ItemDetail.NavNextOrBack -> - case Comp.ItemList.nextItem model.itemListModel m2.item.id of - Just n -> - (newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp]) - Nothing -> - doSearch flags newModel - Comp.ItemDetail.NavNone -> - (newModel, newCmd) + case nav of + Comp.ItemDetail.NavBack -> + doSearch flags newModel + + Comp.ItemDetail.NavPrev -> + case Comp.ItemList.prevItem model.itemListModel m2.item.id of + Just n -> + ( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] ) + + Nothing -> + ( newModel, newCmd ) + + Comp.ItemDetail.NavNext -> + case Comp.ItemList.nextItem model.itemListModel m2.item.id of + Just n -> + ( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] ) + + Nothing -> + ( newModel, newCmd ) + + Comp.ItemDetail.NavNextOrBack -> + case Comp.ItemList.nextItem model.itemListModel m2.item.id of + Just n -> + ( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] ) + + Nothing -> + doSearch flags newModel + + Comp.ItemDetail.NavNone -> + ( newModel, newCmd ) ItemDetailResp (Ok item) -> let - m = {model | viewMode = Detail} + m = + { model | viewMode = Detail } in - update flags (ItemDetailMsg (Comp.ItemDetail.SetItem item)) m + update flags (ItemDetailMsg (Comp.ItemDetail.SetItem item)) m - ItemDetailResp (Err err) -> - let - _ = Debug.log "Error" err - in - (model, Cmd.none) + ItemDetailResp (Err _) -> + ( model, Cmd.none ) -doSearch: Flags -> Model -> (Model, Cmd Msg) + +doSearch : Flags -> Model -> ( Model, Cmd Msg ) doSearch flags model = let - mask = Comp.SearchMenu.getItemSearch model.searchMenuModel + mask = + Comp.SearchMenu.getItemSearch model.searchMenuModel in - ({model|searchInProgress = True, viewMode = Listing}, Api.itemSearch flags mask ItemSearchResp) + ( { model | searchInProgress = True, viewMode = Listing } + , Api.itemSearch flags mask ItemSearchResp + ) diff --git a/modules/webapp/src/main/elm/Page/Home/View.elm b/modules/webapp/src/main/elm/Page/Home/View.elm index b75c8e12..046a511a 100644 --- a/modules/webapp/src/main/elm/Page/Home/View.elm +++ b/modules/webapp/src/main/elm/Page/Home/View.elm @@ -1,74 +1,78 @@ module Page.Home.View exposing (view) +import Comp.ItemDetail +import Comp.ItemList +import Comp.SearchMenu import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) - import Page exposing (Page(..)) import Page.Home.Data exposing (..) -import Comp.SearchMenu -import Comp.ItemList -import Comp.ItemDetail -import Data.Flags -import Util.Html exposing (onClickk) -view: Model -> Html Msg + +view : Model -> Html Msg view model = - div [class "home-page ui padded grid"] - [div [class "four wide column"] - [div [class "ui top attached ablue-comp menu"] - [h4 [class "header item"] - [text "Search" - ] - ,div [class "right floated menu"] - [a [class "item" - ,onClick DoSearch - ,href "" - ] - [i [class "ui search icon"][] - ] - ] - ] - ,div [class "ui attached fluid segment"] - [(Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel)) - ] - ] - ,div [class "twelve wide column"] - [case model.viewMode of - Listing -> - if model.searchInProgress then resultPlaceholder - else (Html.map ItemListMsg (Comp.ItemList.view model.itemListModel)) - Detail -> - Html.map ItemDetailMsg (Comp.ItemDetail.view model.itemDetailModel) + div [ class "home-page ui padded grid" ] + [ div [ class "four wide column" ] + [ div [ class "ui top attached ablue-comp menu" ] + [ h4 [ class "header item" ] + [ text "Search" + ] + , div [ class "right floated menu" ] + [ a + [ class "item" + , onClick DoSearch + , href "" + ] + [ i [ class "ui search icon" ] [] + ] + ] + ] + , div [ class "ui attached fluid segment" ] + [ Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel) + ] + ] + , div [ class "twelve wide column" ] + [ case model.viewMode of + Listing -> + if model.searchInProgress then + resultPlaceholder + + else + Html.map ItemListMsg (Comp.ItemList.view model.itemListModel) + + Detail -> + Html.map ItemDetailMsg (Comp.ItemDetail.view model.itemDetailModel) ] ] -resultPlaceholder: Html Msg + +resultPlaceholder : Html Msg resultPlaceholder = - div [class "ui basic segment"] - [div [class "ui active inverted dimmer"] - [div [class "ui medium text loader"] - [text "Searching …" - ] - ] - ,div [class "ui middle aligned very relaxed divided basic list segment"] - [div [class "item"] - [div [class "ui fluid placeholder"] - [div [class "full line"][] - ,div [class "full line"][] - ] - ] - ,div [class "item"] - [div [class "ui fluid placeholder"] - [div [class "full line"][] - ,div [class "full line"][] - ] - ] - ,div [class "item"] - [div [class "ui fluid placeholder"] - [div [class "full line"][] - ,div [class "full line"][] - ] - ] - ] + div [ class "ui basic segment" ] + [ div [ class "ui active inverted dimmer" ] + [ div [ class "ui medium text loader" ] + [ text "Searching …" + ] + ] + , div [ class "ui middle aligned very relaxed divided basic list segment" ] + [ div [ class "item" ] + [ div [ class "ui fluid placeholder" ] + [ div [ class "full line" ] [] + , div [ class "full line" ] [] + ] + ] + , div [ class "item" ] + [ div [ class "ui fluid placeholder" ] + [ div [ class "full line" ] [] + , div [ class "full line" ] [] + ] + ] + , div [ class "item" ] + [ div [ class "ui fluid placeholder" ] + [ div [ class "full line" ] [] + , div [ class "full line" ] [] + ] + ] + ] ] diff --git a/modules/webapp/src/main/elm/Page/Login/Data.elm b/modules/webapp/src/main/elm/Page/Login/Data.elm index eb3376ea..8e41309f 100644 --- a/modules/webapp/src/main/elm/Page/Login/Data.elm +++ b/modules/webapp/src/main/elm/Page/Login/Data.elm @@ -1,22 +1,29 @@ -module Page.Login.Data exposing (..) +module Page.Login.Data exposing + ( Model + , Msg(..) + , emptyModel + ) +import Api.Model.AuthResult exposing (AuthResult) import Http import Page exposing (Page(..)) -import Api.Model.AuthResult exposing (AuthResult) + type alias Model = - { username: String - , password: String - , result: Maybe AuthResult + { username : String + , password : String + , result : Maybe AuthResult } -emptyModel: Model + +emptyModel : Model emptyModel = { username = "" , password = "" , result = Nothing } + type Msg = SetUsername String | SetPassword String diff --git a/modules/webapp/src/main/elm/Page/Login/Update.elm b/modules/webapp/src/main/elm/Page/Login/Update.elm index 4a9d3123..539d2f02 100644 --- a/modules/webapp/src/main/elm/Page/Login/Update.elm +++ b/modules/webapp/src/main/elm/Page/Login/Update.elm @@ -1,42 +1,53 @@ module Page.Login.Update exposing (update) import Api -import Ports +import Api.Model.AuthResult exposing (AuthResult) +import Api.Model.UserPass exposing (UserPass) import Data.Flags exposing (Flags) import Page exposing (Page(..)) import Page.Login.Data exposing (..) -import Api.Model.UserPass exposing (UserPass) -import Api.Model.AuthResult exposing (AuthResult) +import Ports import Util.Http -update: Maybe Page -> Flags -> Msg -> Model -> (Model, Cmd Msg, Maybe AuthResult) + +update : Maybe Page -> Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe AuthResult ) update referrer flags msg model = case msg of SetUsername str -> - ({model | username = str}, Cmd.none, Nothing) + ( { model | username = str }, Cmd.none, Nothing ) + SetPassword str -> - ({model | password = str}, Cmd.none, Nothing) + ( { model | password = str }, Cmd.none, Nothing ) Authenticate -> - (model, Api.login flags (UserPass model.username model.password) AuthResp, Nothing) + ( model, Api.login flags (UserPass model.username model.password) AuthResp, Nothing ) AuthResp (Ok lr) -> let - gotoRef = Maybe.withDefault HomePage referrer |> Page.goto + gotoRef = + Maybe.withDefault HomePage referrer |> Page.goto in - if lr.success - then ({model|result = Just lr, password = ""}, Cmd.batch [setAccount lr, gotoRef], Just lr) - else ({model|result = Just lr, password = ""}, Ports.removeAccount (), Just lr) + if lr.success then + ( { model | result = Just lr, password = "" }, Cmd.batch [ setAccount lr, gotoRef ], Just lr ) + + else + ( { model | result = Just lr, password = "" }, Ports.removeAccount (), Just lr ) AuthResp (Err err) -> let - empty = Api.Model.AuthResult.empty - lr = {empty|message = Util.Http.errorToString err} - in - ({model|password = "", result = Just lr}, Ports.removeAccount (), Just empty) + empty = + Api.Model.AuthResult.empty -setAccount: AuthResult -> Cmd msg + lr = + { empty | message = Util.Http.errorToString err } + in + ( { model | password = "", result = Just lr }, Ports.removeAccount (), Just empty ) + + +setAccount : AuthResult -> Cmd msg setAccount result = - if result.success - then Ports.setAccount result - else Ports.removeAccount () + if result.success then + Ports.setAccount result + + else + Ports.removeAccount () diff --git a/modules/webapp/src/main/elm/Page/Login/View.elm b/modules/webapp/src/main/elm/Page/Login/View.elm index f7d35c84..55c73a2b 100644 --- a/modules/webapp/src/main/elm/Page/Login/View.elm +++ b/modules/webapp/src/main/elm/Page/Login/View.elm @@ -1,87 +1,97 @@ module Page.Login.View exposing (view) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) -import Html.Events exposing (onClick, onInput, onSubmit) +import Html.Events exposing (onInput, onSubmit) import Page exposing (Page(..)) import Page.Login.Data exposing (..) -import Data.Flags exposing (Flags) -view: Flags -> Model -> Html Msg + +view : Flags -> Model -> Html Msg view flags model = - div [class "login-page"] - [div [class "ui centered grid"] - [div [class "row"] - [div [class "six wide column ui segment login-view"] - [h1 [class "ui center aligned icon header"] - [img [class "ui image" - ,src (flags.config.docspellAssetPath ++ "/img/logo-96.png") - ][] - ,div [class "content"] - [text "Sign in to Docspell" - ] + div [ class "login-page" ] + [ div [ class "ui centered grid" ] + [ div [ class "row" ] + [ div [ class "six wide column ui segment login-view" ] + [ h1 [ class "ui center aligned icon header" ] + [ img + [ class "ui image" + , src (flags.config.docspellAssetPath ++ "/img/logo-96.png") ] - ,Html.form [ class "ui large error raised form segment" - , onSubmit Authenticate - , autocomplete False - ] - [div [class "field"] - [label [][text "Username"] - ,div [class "ui left icon input"] - [input [type_ "text" - ,autocomplete False - ,onInput SetUsername - ,value model.username - ,placeholder "Collective / Login" - ,autofocus True - ][] - ,i [class "user icon"][] - ] - ] - ,div [class "field"] - [label [][text "Password"] - ,div [class "ui left icon input"] - [input [type_ "password" - ,autocomplete False - ,onInput SetPassword - ,value model.password - ,placeholder "Password" - ][] - ,i [class "lock icon"][] + [] + , div [ class "content" ] + [ text "Sign in to Docspell" + ] + ] + , Html.form + [ class "ui large error raised form segment" + , onSubmit Authenticate + , autocomplete False + ] + [ div [ class "field" ] + [ label [] [ text "Username" ] + , div [ class "ui left icon input" ] + [ input + [ type_ "text" + , autocomplete False + , onInput SetUsername + , value model.username + , placeholder "Collective / Login" + , autofocus True ] - ] - ,button [class "ui primary fluid button" - ,type_ "submit" - ] - [text "Login" + [] + , i [ class "user icon" ] [] ] - ] - ,(resultMessage model) - ,div[class "ui very basic right aligned segment"] - [text "No account? " - ,a [class "ui icon link", Page.href RegisterPage] - [i [class "edit icon"][] - ,text "Sign up!" - ] - ] - ] - ] - ] + ] + , div [ class "field" ] + [ label [] [ text "Password" ] + , div [ class "ui left icon input" ] + [ input + [ type_ "password" + , autocomplete False + , onInput SetPassword + , value model.password + , placeholder "Password" + ] + [] + , i [ class "lock icon" ] [] + ] + ] + , button + [ class "ui primary fluid button" + , type_ "submit" + ] + [ text "Login" + ] + ] + , resultMessage model + , div [ class "ui very basic right aligned segment" ] + [ text "No account? " + , a [ class "ui icon link", Page.href RegisterPage ] + [ i [ class "edit icon" ] [] + , text "Sign up!" + ] + ] + ] + ] + ] ] -resultMessage: Model -> Html Msg + +resultMessage : Model -> Html Msg resultMessage model = case model.result of Just r -> - if r.success - then - div [class "ui success message"] - [text "Login successful." + if r.success then + div [ class "ui success message" ] + [ text "Login successful." ] + else - div [class "ui error message"] - [text r.message + div [ class "ui error message" ] + [ text r.message ] Nothing -> - span [][] + span [] [] diff --git a/modules/webapp/src/main/elm/Page/ManageData/Data.elm b/modules/webapp/src/main/elm/Page/ManageData/Data.elm index bbe1def1..35b92d79 100644 --- a/modules/webapp/src/main/elm/Page/ManageData/Data.elm +++ b/modules/webapp/src/main/elm/Page/ManageData/Data.elm @@ -1,19 +1,26 @@ -module Page.ManageData.Data exposing (..) +module Page.ManageData.Data exposing + ( Model + , Msg(..) + , Tab(..) + , emptyModel + ) -import Comp.TagManage import Comp.EquipmentManage import Comp.OrgManage import Comp.PersonManage +import Comp.TagManage + type alias Model = - { currentTab: Maybe Tab - , tagManageModel: Comp.TagManage.Model - , equipManageModel: Comp.EquipmentManage.Model - , orgManageModel: Comp.OrgManage.Model - , personManageModel: Comp.PersonManage.Model + { currentTab : Maybe Tab + , tagManageModel : Comp.TagManage.Model + , equipManageModel : Comp.EquipmentManage.Model + , orgManageModel : Comp.OrgManage.Model + , personManageModel : Comp.PersonManage.Model } -emptyModel: Model + +emptyModel : Model emptyModel = { currentTab = Nothing , tagManageModel = Comp.TagManage.emptyModel @@ -22,12 +29,14 @@ emptyModel = , personManageModel = Comp.PersonManage.emptyModel } + type Tab = TagTab | EquipTab | OrgTab | PersonTab + type Msg = SetTab Tab | TagManageMsg Comp.TagManage.Msg diff --git a/modules/webapp/src/main/elm/Page/ManageData/Update.elm b/modules/webapp/src/main/elm/Page/ManageData/Update.elm index 51d58daa..a7239ab2 100644 --- a/modules/webapp/src/main/elm/Page/ManageData/Update.elm +++ b/modules/webapp/src/main/elm/Page/ManageData/Update.elm @@ -1,52 +1,58 @@ module Page.ManageData.Update exposing (update) -import Page.ManageData.Data exposing (..) -import Data.Flags exposing (Flags) -import Comp.TagManage import Comp.EquipmentManage import Comp.OrgManage import Comp.PersonManage +import Comp.TagManage +import Data.Flags exposing (Flags) +import Page.ManageData.Data exposing (..) -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetTab t -> let - m = { model | currentTab = Just t } + m = + { model | currentTab = Just t } in - case t of - TagTab -> - update flags (TagManageMsg Comp.TagManage.LoadTags) m + case t of + TagTab -> + update flags (TagManageMsg Comp.TagManage.LoadTags) m - EquipTab -> - update flags (EquipManageMsg Comp.EquipmentManage.LoadEquipments) m + EquipTab -> + update flags (EquipManageMsg Comp.EquipmentManage.LoadEquipments) m - OrgTab -> - update flags (OrgManageMsg Comp.OrgManage.LoadOrgs) m + OrgTab -> + update flags (OrgManageMsg Comp.OrgManage.LoadOrgs) m - PersonTab -> - update flags (PersonManageMsg Comp.PersonManage.LoadPersons) m + PersonTab -> + update flags (PersonManageMsg Comp.PersonManage.LoadPersons) m TagManageMsg m -> let - (m2, c2) = Comp.TagManage.update flags m model.tagManageModel + ( m2, c2 ) = + Comp.TagManage.update flags m model.tagManageModel in - ({model | tagManageModel = m2}, Cmd.map TagManageMsg c2) + ( { model | tagManageModel = m2 }, Cmd.map TagManageMsg c2 ) EquipManageMsg m -> let - (m2, c2) = Comp.EquipmentManage.update flags m model.equipManageModel + ( m2, c2 ) = + Comp.EquipmentManage.update flags m model.equipManageModel in - ({model | equipManageModel = m2}, Cmd.map EquipManageMsg c2) + ( { model | equipManageModel = m2 }, Cmd.map EquipManageMsg c2 ) OrgManageMsg m -> let - (m2, c2) = Comp.OrgManage.update flags m model.orgManageModel + ( m2, c2 ) = + Comp.OrgManage.update flags m model.orgManageModel in - ({model | orgManageModel = m2}, Cmd.map OrgManageMsg c2) + ( { model | orgManageModel = m2 }, Cmd.map OrgManageMsg c2 ) PersonManageMsg m -> let - (m2, c2) = Comp.PersonManage.update flags m model.personManageModel + ( m2, c2 ) = + Comp.PersonManage.update flags m model.personManageModel in - ({model | personManageModel = m2}, Cmd.map PersonManageMsg c2) + ( { model | personManageModel = m2 }, Cmd.map PersonManageMsg c2 ) diff --git a/modules/webapp/src/main/elm/Page/ManageData/View.elm b/modules/webapp/src/main/elm/Page/ManageData/View.elm index 8eacbbe8..2b2c94ad 100644 --- a/modules/webapp/src/main/elm/Page/ManageData/View.elm +++ b/modules/webapp/src/main/elm/Page/ManageData/View.elm @@ -1,104 +1,121 @@ module Page.ManageData.View exposing (view) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onClick) - -import Util.Html exposing (classActive) -import Page.ManageData.Data exposing (..) -import Comp.TagManage import Comp.EquipmentManage import Comp.OrgManage import Comp.PersonManage +import Comp.TagManage +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onClick) +import Page.ManageData.Data exposing (..) +import Util.Html exposing (classActive) -view: Model -> Html Msg + +view : Model -> Html Msg view model = - div [class "managedata-page ui padded grid"] - [div [class "four wide column"] - [h4 [class "ui top attached ablue-comp header"] - [text "Manage Data" - ] - ,div [class "ui attached fluid segment"] - [div [class "ui fluid vertical secondary menu"] - [div [classActive (model.currentTab == Just TagTab) "link icon item" - ,onClick (SetTab TagTab) - ] - [i [class "tag icon"][] - ,text "Tag" - ] - ,div [classActive (model.currentTab == Just EquipTab) "link icon item" - ,onClick (SetTab EquipTab) - ] - [i [class "box icon"][] - ,text "Equipment" - ] - ,div [classActive (model.currentTab == Just OrgTab) "link icon item" - ,onClick (SetTab OrgTab) - ] - [i [class "factory icon"][] - ,text "Organization" - ] - ,div [classActive (model.currentTab == Just PersonTab) "link icon item" - ,onClick (SetTab PersonTab) - ] - [i [class "user icon"][] - ,text "Person" - ] - ] - ] - ] - ,div [class "twelve wide column"] - [div [class ""] - (case model.currentTab of - Just TagTab -> viewTags model - Just EquipTab -> viewEquip model - Just OrgTab -> viewOrg model - Just PersonTab -> viewPerson model - Nothing -> [] - ) + div [ class "managedata-page ui padded grid" ] + [ div [ class "four wide column" ] + [ h4 [ class "ui top attached ablue-comp header" ] + [ text "Manage Data" + ] + , div [ class "ui attached fluid segment" ] + [ div [ class "ui fluid vertical secondary menu" ] + [ div + [ classActive (model.currentTab == Just TagTab) "link icon item" + , onClick (SetTab TagTab) + ] + [ i [ class "tag icon" ] [] + , text "Tag" + ] + , div + [ classActive (model.currentTab == Just EquipTab) "link icon item" + , onClick (SetTab EquipTab) + ] + [ i [ class "box icon" ] [] + , text "Equipment" + ] + , div + [ classActive (model.currentTab == Just OrgTab) "link icon item" + , onClick (SetTab OrgTab) + ] + [ i [ class "factory icon" ] [] + , text "Organization" + ] + , div + [ classActive (model.currentTab == Just PersonTab) "link icon item" + , onClick (SetTab PersonTab) + ] + [ i [ class "user icon" ] [] + , text "Person" + ] + ] + ] + ] + , div [ class "twelve wide column" ] + [ div [ class "" ] + (case model.currentTab of + Just TagTab -> + viewTags model + + Just EquipTab -> + viewEquip model + + Just OrgTab -> + viewOrg model + + Just PersonTab -> + viewPerson model + + Nothing -> + [] + ) ] ] -viewTags: Model -> List (Html Msg) + +viewTags : Model -> List (Html Msg) viewTags model = - [h2 [class "ui header"] - [i [class "ui tag icon"][] - ,div [class "content"] - [text "Tags" + [ h2 [ class "ui header" ] + [ i [ class "ui tag icon" ] [] + , div [ class "content" ] + [ text "Tags" ] ] - ,Html.map TagManageMsg (Comp.TagManage.view model.tagManageModel) + , Html.map TagManageMsg (Comp.TagManage.view model.tagManageModel) ] -viewEquip: Model -> List (Html Msg) + +viewEquip : Model -> List (Html Msg) viewEquip model = - [h2 [class "ui header"] - [i [class "ui box icon"][] - ,div [class "content"] - [text "Equipment" + [ h2 [ class "ui header" ] + [ i [ class "ui box icon" ] [] + , div [ class "content" ] + [ text "Equipment" ] ] - ,Html.map EquipManageMsg (Comp.EquipmentManage.view model.equipManageModel) + , Html.map EquipManageMsg (Comp.EquipmentManage.view model.equipManageModel) ] -viewOrg: Model -> List (Html Msg) + +viewOrg : Model -> List (Html Msg) viewOrg model = - [h2 [class "ui header"] - [i [class "ui factory icon"][] - ,div [class "content"] - [text "Organizations" + [ h2 [ class "ui header" ] + [ i [ class "ui factory icon" ] [] + , div [ class "content" ] + [ text "Organizations" ] ] - ,Html.map OrgManageMsg (Comp.OrgManage.view model.orgManageModel) + , Html.map OrgManageMsg (Comp.OrgManage.view model.orgManageModel) ] -viewPerson: Model -> List (Html Msg) + +viewPerson : Model -> List (Html Msg) viewPerson model = - [h2 [class "ui header"] - [i [class "ui user icon"][] - ,div [class "content"] - [text "Person" + [ h2 [ class "ui header" ] + [ i [ class "ui user icon" ] [] + , div [ class "content" ] + [ text "Person" ] ] - ,Html.map PersonManageMsg (Comp.PersonManage.view model.personManageModel) + , Html.map PersonManageMsg (Comp.PersonManage.view model.personManageModel) ] diff --git a/modules/webapp/src/main/elm/Page/NewInvite/Data.elm b/modules/webapp/src/main/elm/Page/NewInvite/Data.elm index a9944c41..478d2c0d 100644 --- a/modules/webapp/src/main/elm/Page/NewInvite/Data.elm +++ b/modules/webapp/src/main/elm/Page/NewInvite/Data.elm @@ -1,37 +1,55 @@ -module Page.NewInvite.Data exposing (..) +module Page.NewInvite.Data exposing + ( Model + , Msg(..) + , State(..) + , emptyModel + , isFailed + , isSuccess + ) -import Http import Api.Model.InviteResult exposing (InviteResult) +import Http + type alias Model = - { password: String - , result: State + { password : String + , result : State } + type State = Empty | Failed String | Success InviteResult -isFailed: State -> Bool +isFailed : State -> Bool isFailed state = case state of - Failed _ -> True - _ -> False + Failed _ -> + True -isSuccess: State -> Bool + _ -> + False + + +isSuccess : State -> Bool isSuccess state = case state of - Success _ -> True - _ -> False + Success _ -> + True -emptyModel: Model + _ -> + False + + +emptyModel : Model emptyModel = { password = "" , result = Empty } + type Msg = SetPassword String | GenerateInvite diff --git a/modules/webapp/src/main/elm/Page/NewInvite/Update.elm b/modules/webapp/src/main/elm/Page/NewInvite/Update.elm index 508b9b48..40d9a479 100644 --- a/modules/webapp/src/main/elm/Page/NewInvite/Update.elm +++ b/modules/webapp/src/main/elm/Page/NewInvite/Update.elm @@ -1,27 +1,30 @@ module Page.NewInvite.Update exposing (update) import Api +import Api.Model.GenInvite exposing (GenInvite) import Data.Flags exposing (Flags) import Page.NewInvite.Data exposing (..) -import Api.Model.GenInvite exposing (GenInvite) -import Api.Model.InviteResult import Util.Http -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetPassword str -> - ({model|password = str}, Cmd.none) + ( { model | password = str }, Cmd.none ) Reset -> - (emptyModel, Cmd.none) + ( emptyModel, Cmd.none ) GenerateInvite -> - (model, Api.newInvite flags (GenInvite model.password) InviteResp) + ( model, Api.newInvite flags (GenInvite model.password) InviteResp ) InviteResp (Ok res) -> - if res.success then ({model | result = (Success res)}, Cmd.none) - else ({model | result = (Failed res.message)}, Cmd.none) + if res.success then + ( { model | result = Success res }, Cmd.none ) + + else + ( { model | result = Failed res.message }, Cmd.none ) InviteResp (Err err) -> - ({model|result = Failed (Util.Http.errorToString err)}, Cmd.none) + ( { model | result = Failed (Util.Http.errorToString err) }, Cmd.none ) diff --git a/modules/webapp/src/main/elm/Page/NewInvite/View.elm b/modules/webapp/src/main/elm/Page/NewInvite/View.elm index 2c2cc750..de645310 100644 --- a/modules/webapp/src/main/elm/Page/NewInvite/View.elm +++ b/modules/webapp/src/main/elm/Page/NewInvite/View.elm @@ -1,106 +1,121 @@ module Page.NewInvite.View exposing (view) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick, onInput, onSubmit) -import Data.Flags exposing (Flags) import Page.NewInvite.Data exposing (..) -import Api.Model.InviteResult -import Util.Maybe -view: Flags -> Model -> Html Msg + +view : Flags -> Model -> Html Msg view flags model = - div [class "newinvite-page"] - [div [class "ui centered grid"] - [div [class "row"] - [div [class "eight wide column ui segment newinvite-view"] - [h1 [class "ui cener aligned icon header"] - [img [class "ui image" - ,src (flags.config.docspellAssetPath ++ "/img/logo-96.png") - ][] - ,div [class "content"] - [text "Create new invitations" + div [ class "newinvite-page" ] + [ div [ class "ui centered grid" ] + [ div [ class "row" ] + [ div [ class "eight wide column ui segment newinvite-view" ] + [ h1 [ class "ui cener aligned icon header" ] + [ img + [ class "ui image" + , src (flags.config.docspellAssetPath ++ "/img/logo-96.png") + ] + [] + , div [ class "content" ] + [ text "Create new invitations" + ] + ] + , inviteMessage flags + , Html.form + [ classList + [ ( "ui large form raised segment", True ) + , ( "error", isFailed model.result ) + , ( "success", isSuccess model.result ) + ] + , onSubmit GenerateInvite + ] + [ div [ class "required field" ] + [ label [] [ text "New Invitation Password" ] + , div [ class "ui left icon input" ] + [ input + [ type_ "password" + , onInput SetPassword + , value model.password + , autofocus True + ] + [] + , i [ class "key icon" ] [] ] - ] - ,inviteMessage flags - ,Html.form [classList [("ui large form raised segment", True) - ,("error", isFailed model.result) - ,("success", isSuccess model.result) - ] - , onSubmit GenerateInvite] - [div [class "required field"] - [label [][text "New Invitation Password"] - ,div [class "ui left icon input"] - [input [type_ "password" - ,onInput SetPassword - ,value model.password - ,autofocus True - ][] - ,i [class "key icon"][] - ] - ] - ,button [class "ui primary button" - ,type_ "submit" - ] - [text "Submit" - ] - ,a [class "ui right floated button", href "", onClick Reset] - [text "Reset" - ] - ,resultMessage model - ] - ] - ] - ] + ] + , button + [ class "ui primary button" + , type_ "submit" + ] + [ text "Submit" + ] + , a [ class "ui right floated button", href "", onClick Reset ] + [ text "Reset" + ] + , resultMessage model + ] + ] + ] + ] ] -resultMessage: Model -> Html Msg + +resultMessage : Model -> Html Msg resultMessage model = - div [classList [("ui message", True) - ,("error", isFailed model.result) - ,("success", isSuccess model.result) - ,("hidden", model.result == Empty) - ]] - [case model.result of - Failed m -> - div [class "content"] - [div [class "header"][text "Error"] - ,p [][text m] - ] - Success r -> - div [class "content"] - [div [class "header"][text "Success"] - ,p [][text r.message] - ,p [][text "Invitation Key:"] - ,pre[][Maybe.withDefault "" r.key |> text - ] - ] - Empty -> - span[][] + div + [ classList + [ ( "ui message", True ) + , ( "error", isFailed model.result ) + , ( "success", isSuccess model.result ) + , ( "hidden", model.result == Empty ) + ] + ] + [ case model.result of + Failed m -> + div [ class "content" ] + [ div [ class "header" ] [ text "Error" ] + , p [] [ text m ] + ] + + Success r -> + div [ class "content" ] + [ div [ class "header" ] [ text "Success" ] + , p [] [ text r.message ] + , p [] [ text "Invitation Key:" ] + , pre [] + [ Maybe.withDefault "" r.key |> text + ] + ] + + Empty -> + span [] [] ] -inviteMessage: Flags -> Html Msg -inviteMessage flags = - div [classList [("ui message", True) - ,("hidden", flags.config.signupMode /= "invite") - ]] - [p [][text - """Docspell requires an invite when signing up. You can +inviteMessage : Flags -> Html Msg +inviteMessage flags = + div + [ classList + [ ( "ui message", True ) + , ( "hidden", flags.config.signupMode /= "invite" ) + ] + ] + [ p [] + [ text + """Docspell requires an invite when signing up. You can create these invites here and send them to friends so they can signup with docspell.""" - - ] - ,p [][text - - """Each invite can only be used once. You'll need to + ] + , p [] + [ text + """Each invite can only be used once. You'll need to create one key for each person you want to invite.""" - - ] - ,p [][text - - """Creating an invite requires providing the password + ] + , p [] + [ text + """Creating an invite requires providing the password from the configuration.""" - - ] + ] ] diff --git a/modules/webapp/src/main/elm/Page/Queue/Data.elm b/modules/webapp/src/main/elm/Page/Queue/Data.elm index ad719f06..be6a5b5b 100644 --- a/modules/webapp/src/main/elm/Page/Queue/Data.elm +++ b/modules/webapp/src/main/elm/Page/Queue/Data.elm @@ -1,27 +1,35 @@ -module Page.Queue.Data exposing (..) +module Page.Queue.Data exposing + ( Model + , Msg(..) + , emptyModel + , getDuration + , getRunningTime + ) -import Http -import Api.Model.JobQueueState exposing (JobQueueState) -import Api.Model.JobDetail exposing (JobDetail) import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.JobDetail exposing (JobDetail) +import Api.Model.JobQueueState exposing (JobQueueState) +import Comp.YesNoDimmer +import Http import Time import Util.Duration import Util.Maybe -import Comp.YesNoDimmer + type alias Model = - { state: JobQueueState - , error: String - , pollingInterval: Float - , init: Bool - , stopRefresh: Bool - , currentMillis: Int - , showLog: Maybe JobDetail - , deleteConfirm: Comp.YesNoDimmer.Model - , cancelJobRequest: Maybe String + { state : JobQueueState + , error : String + , pollingInterval : Float + , init : Bool + , stopRefresh : Bool + , currentMillis : Int + , showLog : Maybe JobDetail + , deleteConfirm : Comp.YesNoDimmer.Model + , cancelJobRequest : Maybe String } -emptyModel: Model + +emptyModel : Model emptyModel = { state = Api.Model.JobQueueState.empty , error = "" @@ -34,6 +42,7 @@ emptyModel = , cancelJobRequest = Nothing } + type Msg = Init | StateResp (Result Http.Error JobQueueState) @@ -45,35 +54,45 @@ type Msg | DimmerMsg JobDetail Comp.YesNoDimmer.Msg | CancelResp (Result Http.Error BasicResult) -getRunningTime: Model -> JobDetail -> Maybe String + +getRunningTime : Model -> JobDetail -> Maybe String getRunningTime model job = let - mkTime: Int -> Int -> Maybe String + mkTime : Int -> Int -> Maybe String mkTime start end = - if start < end then Just <| Util.Duration.toHuman (end - start) - else Nothing - in - case (job.started, job.finished) of - (Just sn, Just fn) -> - Util.Maybe.or - [ mkTime sn fn - , mkTime sn model.currentMillis - ] + if start < end then + Just <| Util.Duration.toHuman (end - start) - (Just sn, Nothing) -> - mkTime sn model.currentMillis - - (Nothing, _) -> + else Nothing + in + case ( job.started, job.finished ) of + ( Just sn, Just fn ) -> + Util.Maybe.or + [ mkTime sn fn + , mkTime sn model.currentMillis + ] -getSubmittedTime: Model -> JobDetail -> Maybe String + ( Just sn, Nothing ) -> + mkTime sn model.currentMillis + + ( Nothing, _ ) -> + Nothing + + +getSubmittedTime : Model -> JobDetail -> Maybe String getSubmittedTime model job = if model.currentMillis > job.submitted then Just <| Util.Duration.toHuman (model.currentMillis - job.submitted) + else Nothing -getDuration: Model -> JobDetail -> Maybe String + +getDuration : Model -> JobDetail -> Maybe String getDuration model job = - if job.state == "stuck" then getSubmittedTime model job - else Util.Maybe.or [ (getRunningTime model job), (getSubmittedTime model job) ] + if job.state == "stuck" then + getSubmittedTime model job + + else + Util.Maybe.or [ getRunningTime model job, getSubmittedTime model job ] diff --git a/modules/webapp/src/main/elm/Page/Queue/Update.elm b/modules/webapp/src/main/elm/Page/Queue/Update.elm index f91b17db..31a5d6e4 100644 --- a/modules/webapp/src/main/elm/Page/Queue/Update.elm +++ b/modules/webapp/src/main/elm/Page/Queue/Update.elm @@ -1,76 +1,92 @@ module Page.Queue.Update exposing (update) import Api -import Ports -import Page.Queue.Data exposing (..) -import Data.Flags exposing (Flags) -import Util.Http -import Time -import Task import Comp.YesNoDimmer +import Data.Flags exposing (Flags) +import Page.Queue.Data exposing (..) +import Ports +import Task +import Time +import Util.Http -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of Init -> let - start = if model.init - then Cmd.none - else Cmd.batch - [Api.getJobQueueState flags StateResp - ,getNewTime + start = + if model.init then + Cmd.none + + else + Cmd.batch + [ Api.getJobQueueState flags StateResp + , getNewTime ] in - ({model|init = True, stopRefresh = False}, start) + ( { model | init = True, stopRefresh = False }, start ) StateResp (Ok s) -> let progressCmd = - List.map (\job -> Ports.setProgress (job.id, job.progress)) s.progress - _ = Debug.log "stopRefresh" model.stopRefresh + List.map (\job -> Ports.setProgress ( job.id, job.progress )) s.progress + refresh = - if model.pollingInterval <= 0 || model.stopRefresh then Cmd.none - else Cmd.batch - [Api.getJobQueueStateIn flags model.pollingInterval StateResp - ,getNewTime - ] + if model.pollingInterval <= 0 || model.stopRefresh then + Cmd.none + + else + Cmd.batch + [ Api.getJobQueueStateIn flags model.pollingInterval StateResp + , getNewTime + ] in - ({model | state = s, stopRefresh = False}, Cmd.batch (refresh :: progressCmd)) + ( { model | state = s, stopRefresh = False }, Cmd.batch (refresh :: progressCmd) ) StateResp (Err err) -> - ({model | error = Util.Http.errorToString err }, Cmd.none) + ( { model | error = Util.Http.errorToString err }, Cmd.none ) StopRefresh -> - ({model | stopRefresh = True, init = False }, Cmd.none) + ( { model | stopRefresh = True, init = False }, Cmd.none ) NewTime t -> - ({model | currentMillis = Time.posixToMillis t}, Cmd.none) + ( { model | currentMillis = Time.posixToMillis t }, Cmd.none ) ShowLog job -> - ({model | showLog = Just job}, Cmd.none) + ( { model | showLog = Just job }, Cmd.none ) QuitShowLog -> - ({model | showLog = Nothing}, Cmd.none) + ( { model | showLog = Nothing }, Cmd.none ) RequestCancelJob job -> let - newModel = {model|cancelJobRequest = Just job.id} + newModel = + { model | cancelJobRequest = Just job.id } in - update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel + update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel DimmerMsg job m -> let - (cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm - cmd = if confirmed then Api.cancelJob flags job.id CancelResp else Cmd.none - in - ({model | deleteConfirm = cm}, cmd) + ( cm, confirmed ) = + Comp.YesNoDimmer.update m model.deleteConfirm - CancelResp (Ok r) -> - (model, Cmd.none) - CancelResp (Err err) -> - (model, Cmd.none) + cmd = + if confirmed then + Api.cancelJob flags job.id CancelResp + + else + Cmd.none + in + ( { model | deleteConfirm = cm }, cmd ) + + CancelResp (Ok _) -> + ( model, Cmd.none ) + + CancelResp (Err _) -> + ( model, Cmd.none ) getNewTime : Cmd Msg getNewTime = - Task.perform NewTime Time.now + Task.perform NewTime Time.now diff --git a/modules/webapp/src/main/elm/Page/Queue/View.elm b/modules/webapp/src/main/elm/Page/Queue/View.elm index 905de30d..c0285e29 100644 --- a/modules/webapp/src/main/elm/Page/Queue/View.elm +++ b/modules/webapp/src/main/elm/Page/Queue/View.elm @@ -1,217 +1,256 @@ module Page.Queue.View exposing (view) +import Api.Model.JobDetail exposing (JobDetail) +import Api.Model.JobLogEvent exposing (JobLogEvent) +import Comp.YesNoDimmer +import Data.Priority import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) - import Page.Queue.Data exposing (..) -import Api.Model.JobQueueState exposing (JobQueueState) -import Api.Model.JobDetail exposing (JobDetail) -import Api.Model.JobLogEvent exposing (JobLogEvent) -import Data.Priority -import Comp.YesNoDimmer import Util.Time exposing (formatDateTime, formatIsoDateTime) -import Util.Duration -view: Model -> Html Msg + +view : Model -> Html Msg view model = - div [class "queue-page ui grid container"] <| + div [ class "queue-page ui grid container" ] <| List.concat - [ case model.showLog of - Just job -> - [renderJobLog job] - Nothing -> - List.map (renderProgressCard model) model.state.progress - |> List.map (\el -> div [class "row"][div [class "column"][el]]) - , [div [class "two column row"] - [renderWaiting model - ,renderCompleted model + [ case model.showLog of + Just job -> + [ renderJobLog job ] + + Nothing -> + List.map (renderProgressCard model) model.state.progress + |> List.map (\el -> div [ class "row" ] [ div [ class "column" ] [ el ] ]) + , [ div [ class "two column row" ] + [ renderWaiting model + , renderCompleted model ] - ] - ] + ] + ] -renderJobLog: JobDetail -> Html Msg + +renderJobLog : JobDetail -> Html Msg renderJobLog job = - div [class "ui fluid card"] - [div [class "content"] - [i [class "delete link icon", onClick QuitShowLog][] - ,text job.name - ] - ,div [class "content"] - [div [class "job-log"] - (List.map renderLogLine job.logs) - ] - ] - - -renderWaiting: Model -> Html Msg -renderWaiting model = - div [class "column"] - [div [class "ui center aligned basic segment"] - [i [class "ui large angle double up icon"][] - ] - ,div [class "ui centered cards"] - (List.map (renderInfoCard model) model.state.queued) - ] - -renderCompleted: Model -> Html Msg -renderCompleted model = - div [class "column"] - [div [class "ui center aligned basic segment"] - [i [class "ui large angle double down icon"][] - ] - ,div [class "ui centered cards"] - (List.map (renderInfoCard model) model.state.completed) - ] - -renderProgressCard: Model -> JobDetail -> Html Msg -renderProgressCard model job = - div [class "ui fluid card"] - [div [id job.id, class "ui top attached indicating progress"] - [div [class "bar"] - [] - ] - ,Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm) - ,div [class "content"] - [ div [class "right floated meta"] - [div [class "ui label"] - [text job.state - ,div [class "detail"] - [Maybe.withDefault "" job.worker |> text - ] - ] - ,div [class "ui basic label"] - [i [class "clock icon"][] - ,div [class "detail"] - [getDuration model job |> Maybe.withDefault "-:-" |> text - ] - ] - ] - , i [class "asterisk loading icon"][] - , text job.name - ] - ,div [class "content"] - [div [class "job-log"] - (List.map renderLogLine job.logs) - ] - ,div [class "meta"] - [div [class "right floated"] - [button [class "ui button", onClick (RequestCancelJob job)] - [text "Cancel" - ] - ] + div [ class "ui fluid card" ] + [ div [ class "content" ] + [ i [ class "delete link icon", onClick QuitShowLog ] [] + , text job.name + ] + , div [ class "content" ] + [ div [ class "job-log" ] + (List.map renderLogLine job.logs) ] ] -renderLogLine: JobLogEvent -> Html Msg -renderLogLine log = - span [class (String.toLower log.level)] - [formatIsoDateTime log.time |> text - ,text ": " - ,text log.message - , br[][] + +renderWaiting : Model -> Html Msg +renderWaiting model = + div [ class "column" ] + [ div [ class "ui center aligned basic segment" ] + [ i [ class "ui large angle double up icon" ] [] + ] + , div [ class "ui centered cards" ] + (List.map (renderInfoCard model) model.state.queued) ] -isFinal: JobDetail -> Bool -isFinal job = - case job.state of - "failed" -> True - "success" -> True - "cancelled" -> True - _ -> False -dimmerSettings: Comp.YesNoDimmer.Settings -dimmerSettings = - let - defaults = Comp.YesNoDimmer.defaultSettings - in - { defaults | headerClass = "ui inverted header", headerIcon = "", message = "Cancel/Delete this job?"} - -renderInfoCard: Model -> JobDetail -> Html Msg -renderInfoCard model job = - div [classList [("ui fluid card", True) - ,(jobStateColor job, True) - ] +renderCompleted : Model -> Html Msg +renderCompleted model = + div [ class "column" ] + [ div [ class "ui center aligned basic segment" ] + [ i [ class "ui large angle double down icon" ] [] + ] + , div [ class "ui centered cards" ] + (List.map (renderInfoCard model) model.state.completed) ] - [Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm) - ,div [class "content"] - [div [class "right floated"] - [if isFinal job || job.state == "stuck" then - span [onClick (ShowLog job)] - [i [class "file link icon", title "Show log"][] + + +renderProgressCard : Model -> JobDetail -> Html Msg +renderProgressCard model job = + div [ class "ui fluid card" ] + [ div [ id job.id, class "ui top attached indicating progress" ] + [ div [ class "bar" ] + [] + ] + , Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm) + , div [ class "content" ] + [ div [ class "right floated meta" ] + [ div [ class "ui label" ] + [ text job.state + , div [ class "detail" ] + [ Maybe.withDefault "" job.worker |> text ] - else - span[][] - ,i [class "delete link icon", title "Remove", onClick (RequestCancelJob job)][] - ] - ,if isFinal job then - span [class "invisible"][] - else - div [class "right floated"] - [div [class "meta"] - [getDuration model job |> Maybe.withDefault "-:-" |> text - ] - ] - ,i [classList [("check icon", job.state == "success") - ,("redo icon", job.state == "stuck") - ,("bolt icon", job.state == "failed") - ,("meh outline icon", job.state == "canceled") - ,("cog icon", not (isFinal job) && job.state /= "stuck") - ] - ][] - ,text job.name - ] - ,div [class "content"] - [div [class "right floated"] - [if isFinal job then - div [class ("ui basic label " ++ jobStateColor job)] - [i [class "clock icon"][] - ,div [class "detail"] - [getDuration model job |> Maybe.withDefault "-:-" |> text - ] - ] - else - span [class "invisible"][] - ,div [class ("ui basic label " ++ jobStateColor job)] - [text "Prio" - ,div [class "detail"] - [code [][Data.Priority.fromString job.priority - |> Maybe.map Data.Priority.toName - |> Maybe.withDefault job.priority - |> text - ] - ] - ] - ,div [class ("ui basic label " ++ jobStateColor job)] - [text "Retries" - ,div [class "detail"] - [job.retries |> String.fromInt |> text - ] - ] - ] - ,jobStateLabel job - ,div [class "ui basic label"] - [Util.Time.formatDateTime job.submitted |> text + ] + , div [ class "ui basic label" ] + [ i [ class "clock icon" ] [] + , div [ class "detail" ] + [ getDuration model job |> Maybe.withDefault "-:-" |> text + ] + ] + ] + , i [ class "asterisk loading icon" ] [] + , text job.name + ] + , div [ class "content" ] + [ div [ class "job-log" ] + (List.map renderLogLine job.logs) + ] + , div [ class "meta" ] + [ div [ class "right floated" ] + [ button [ class "ui button", onClick (RequestCancelJob job) ] + [ text "Cancel" + ] ] ] ] -jobStateColor: JobDetail -> String + +renderLogLine : JobLogEvent -> Html Msg +renderLogLine log = + span [ class (String.toLower log.level) ] + [ formatIsoDateTime log.time |> text + , text ": " + , text log.message + , br [] [] + ] + + +isFinal : JobDetail -> Bool +isFinal job = + case job.state of + "failed" -> + True + + "success" -> + True + + "cancelled" -> + True + + _ -> + False + + +dimmerSettings : Comp.YesNoDimmer.Settings +dimmerSettings = + let + defaults = + Comp.YesNoDimmer.defaultSettings + in + { defaults | headerClass = "ui inverted header", headerIcon = "", message = "Cancel/Delete this job?" } + + +renderInfoCard : Model -> JobDetail -> Html Msg +renderInfoCard model job = + div + [ classList + [ ( "ui fluid card", True ) + , ( jobStateColor job, True ) + ] + ] + [ Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm) + , div [ class "content" ] + [ div [ class "right floated" ] + [ if isFinal job || job.state == "stuck" then + span [ onClick (ShowLog job) ] + [ i [ class "file link icon", title "Show log" ] [] + ] + + else + span [] [] + , i [ class "delete link icon", title "Remove", onClick (RequestCancelJob job) ] [] + ] + , if isFinal job then + span [ class "invisible" ] [] + + else + div [ class "right floated" ] + [ div [ class "meta" ] + [ getDuration model job |> Maybe.withDefault "-:-" |> text + ] + ] + , i + [ classList + [ ( "check icon", job.state == "success" ) + , ( "redo icon", job.state == "stuck" ) + , ( "bolt icon", job.state == "failed" ) + , ( "meh outline icon", job.state == "canceled" ) + , ( "cog icon", not (isFinal job) && job.state /= "stuck" ) + ] + ] + [] + , text job.name + ] + , div [ class "content" ] + [ div [ class "right floated" ] + [ if isFinal job then + div [ class ("ui basic label " ++ jobStateColor job) ] + [ i [ class "clock icon" ] [] + , div [ class "detail" ] + [ getDuration model job |> Maybe.withDefault "-:-" |> text + ] + ] + + else + span [ class "invisible" ] [] + , div [ class ("ui basic label " ++ jobStateColor job) ] + [ text "Prio" + , div [ class "detail" ] + [ code [] + [ Data.Priority.fromString job.priority + |> Maybe.map Data.Priority.toName + |> Maybe.withDefault job.priority + |> text + ] + ] + ] + , div [ class ("ui basic label " ++ jobStateColor job) ] + [ text "Retries" + , div [ class "detail" ] + [ job.retries |> String.fromInt |> text + ] + ] + ] + , jobStateLabel job + , div [ class "ui basic label" ] + [ Util.Time.formatDateTime job.submitted |> text + ] + ] + ] + + +jobStateColor : JobDetail -> String jobStateColor job = case job.state of - "success" -> "green" - "failed" -> "red" - "canceled" -> "orange" - "stuck" -> "purple" - "scheduled" -> "blue" - "waiting" -> "grey" - _ -> "" + "success" -> + "green" -jobStateLabel: JobDetail -> Html Msg + "failed" -> + "red" + + "canceled" -> + "orange" + + "stuck" -> + "purple" + + "scheduled" -> + "blue" + + "waiting" -> + "grey" + + _ -> + "" + + +jobStateLabel : JobDetail -> Html Msg jobStateLabel job = let - col = jobStateColor job + col = + jobStateColor job in - div [class ("ui label " ++ col)] - [text job.state - ] + div [ class ("ui label " ++ col) ] + [ text job.state + ] diff --git a/modules/webapp/src/main/elm/Page/Register/Data.elm b/modules/webapp/src/main/elm/Page/Register/Data.elm index b9b8d6c0..925b0922 100644 --- a/modules/webapp/src/main/elm/Page/Register/Data.elm +++ b/modules/webapp/src/main/elm/Page/Register/Data.elm @@ -1,23 +1,29 @@ -module Page.Register.Data exposing (..) +module Page.Register.Data exposing + ( Model + , Msg(..) + , emptyModel + ) -import Http import Api.Model.BasicResult exposing (BasicResult) +import Http + type alias Model = - { result: Maybe BasicResult - , collId: String - , login: String - , pass1: String - , pass2: String - , showPass1: Bool - , showPass2: Bool - , errorMsg: List String - , loading: Bool - , successMsg: String - , invite: Maybe String + { result : Maybe BasicResult + , collId : String + , login : String + , pass1 : String + , pass2 : String + , showPass1 : Bool + , showPass2 : Bool + , errorMsg : List String + , loading : Bool + , successMsg : String + , invite : Maybe String } -emptyModel: Model + +emptyModel : Model emptyModel = { result = Nothing , collId = "" @@ -32,6 +38,7 @@ emptyModel = , invite = Nothing } + type Msg = SetCollId String | SetLogin String diff --git a/modules/webapp/src/main/elm/Page/Register/Update.elm b/modules/webapp/src/main/elm/Page/Register/Update.elm index 4d78054a..aeaeceb7 100644 --- a/modules/webapp/src/main/elm/Page/Register/Update.elm +++ b/modules/webapp/src/main/elm/Page/Register/Update.elm @@ -1,84 +1,131 @@ module Page.Register.Update exposing (update) import Api -import Api.Model.Registration exposing (Registration) -import Page.Register.Data exposing (..) import Data.Flags exposing (Flags) import Page exposing (Page(..)) +import Page.Register.Data exposing (..) -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of RegisterSubmit -> case model.errorMsg of [] -> let - reg = { collectiveName = model.collId - , login = model.login - , password = model.pass1 - , invite = model.invite - } + reg = + { collectiveName = model.collId + , login = model.login + , password = model.pass1 + , invite = model.invite + } in - (model, Api.register flags reg SubmitResp) + ( model, Api.register flags reg SubmitResp ) _ -> - (model, Cmd.none) + ( model, Cmd.none ) SetCollId str -> let - m = {model|collId = str} - err = validateForm m + m = + { model | collId = str } + + err = + validateForm m in - ({m|errorMsg = err}, Cmd.none) + ( { m | errorMsg = err }, Cmd.none ) SetLogin str -> let - m = {model|login = str} - err = validateForm m + m = + { model | login = str } + + err = + validateForm m in - ({m|errorMsg = err}, Cmd.none) + ( { m | errorMsg = err }, Cmd.none ) SetPass1 str -> let - m = {model|pass1 = str} - err = validateForm m + m = + { model | pass1 = str } + + err = + validateForm m in - ({m|errorMsg = err}, Cmd.none) + ( { m | errorMsg = err }, Cmd.none ) SetPass2 str -> let - m = {model|pass2 = str} - err = validateForm m + m = + { model | pass2 = str } + + err = + validateForm m in - ({m|errorMsg = err}, Cmd.none) + ( { m | errorMsg = err }, Cmd.none ) SetInvite str -> - ({model | invite = if str == "" then Nothing else Just str}, Cmd.none) + ( { model + | invite = + if str == "" then + Nothing + + else + Just str + } + , Cmd.none + ) ToggleShowPass1 -> - ({model|showPass1 = not model.showPass1}, Cmd.none) + ( { model | showPass1 = not model.showPass1 }, Cmd.none ) ToggleShowPass2 -> - ({model|showPass2 = not model.showPass2}, Cmd.none) + ( { model | showPass2 = not model.showPass2 }, Cmd.none ) SubmitResp (Ok r) -> let - m = emptyModel - cmd = if r.success then Page.goto (LoginPage Nothing) else Cmd.none + m = + emptyModel + + cmd = + if r.success then + Page.goto (LoginPage Nothing) + + else + Cmd.none in - ({m|result = if r.success then Nothing else Just r}, cmd) + ( { m + | result = + if r.success then + Nothing + + else + Just r + } + , cmd + ) SubmitResp (Err err) -> - (model, Cmd.none) + ( model, Cmd.none ) -validateForm: Model -> List String + +validateForm : Model -> List String validateForm model = - if model.collId == "" || - model.login == "" || - model.pass1 == "" || - model.pass2 == "" then - [ "All fields are required!"] + if + model.collId + == "" + || model.login + == "" + || model.pass1 + == "" + || model.pass2 + == "" + then + [ "All fields are required!" ] + else if model.pass1 /= model.pass2 then - ["The passwords do not match."] + [ "The passwords do not match." ] + else [] diff --git a/modules/webapp/src/main/elm/Page/Register/View.elm b/modules/webapp/src/main/elm/Page/Register/View.elm index 835b201e..fc287ec0 100644 --- a/modules/webapp/src/main/elm/Page/Register/View.elm +++ b/modules/webapp/src/main/elm/Page/Register/View.elm @@ -1,131 +1,164 @@ module Page.Register.View exposing (view) +import Data.Flags exposing (Flags) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick, onInput, onSubmit) -import Data.Flags exposing (Flags) -import Page.Register.Data exposing (..) import Page exposing (Page(..)) +import Page.Register.Data exposing (..) -view: Flags -> Model -> Html Msg + +view : Flags -> Model -> Html Msg view flags model = - div [class "register-page"] - [div [class "ui centered grid"] - [div [class "row"] - [div [class "six wide column ui segment register-view"] - [h1 [class "ui cener aligned icon header"] - [img [class "ui image" - ,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")][] - ,div [class "content"] - [text "Sign up @ Docspell" - ] - ] - ,Html.form [ class "ui large error form raised segment" - , onSubmit RegisterSubmit - , autocomplete False - ] - [div [class "required field"] - [label [][text "Collective ID"] - ,div [class "ui left icon input"] - [input [type_ "text" - ,autocomplete False - ,onInput SetCollId - ,value model.collId - ,autofocus True - ][] - ,i [class "users icon"][] - ] - ] - ,div [class "required field"] - [label [][text "User Login"] - ,div [class "ui left icon input"] - [input [type_ "text" - ,autocomplete False - ,onInput SetLogin - ,value model.login - ][] - ,i [class "user icon"][] - ] - ] - ,div [class "required field" - ] - [label [][text "Password"] - ,div [class "ui left icon action input"] - [input [type_ <| if model.showPass1 then "text" else "password" - ,autocomplete False - ,onInput SetPass1 - ,value model.pass1 - ][] - ,i [class "lock icon"][] - ,button [class "ui icon button", onClick ToggleShowPass1] - [i [class "eye icon"][] - ] - ] - ] - ,div [class "required field" - ] - [label [][text "Password (repeat)"] - ,div [class "ui left icon action input"] - [input [type_ <| if model.showPass2 then "text" else "password" - ,autocomplete False - ,onInput SetPass2 - ,value model.pass2 - ][] - ,i [class "lock icon"][] - ,button [class "ui icon button", onClick ToggleShowPass2] - [i [class "eye icon"][] - ] - ] - ] - ,div [classList [("field", True) - ,("invisible", flags.config.signupMode /= "invite") - ]] - [label [][text "Invitation Key"] - ,div [class "ui left icon input"] - [input [type_ "text" - ,autocomplete False - ,onInput SetInvite - ,model.invite |> Maybe.withDefault "" |> value - ][] - ,i [class "key icon"][] - ] - ] - ,button [class "ui primary button" - ,type_ "submit" - ] - [text "Submit" - ] - ] - ,(resultMessage model) - ,div [class "ui very basic right aligned segment"] - [text "Already signed up? " - ,a [class "ui link", Page.href (LoginPage Nothing)] - [i [class "sign-in icon"][] - ,text "Sign in" - ] + div [ class "register-page" ] + [ div [ class "ui centered grid" ] + [ div [ class "row" ] + [ div [ class "six wide column ui segment register-view" ] + [ h1 [ class "ui cener aligned icon header" ] + [ img + [ class "ui image" + , src (flags.config.docspellAssetPath ++ "/img/logo-96.png") ] - ] - ] - ] + [] + , div [ class "content" ] + [ text "Sign up @ Docspell" + ] + ] + , Html.form + [ class "ui large error form raised segment" + , onSubmit RegisterSubmit + , autocomplete False + ] + [ div [ class "required field" ] + [ label [] [ text "Collective ID" ] + , div [ class "ui left icon input" ] + [ input + [ type_ "text" + , autocomplete False + , onInput SetCollId + , value model.collId + , autofocus True + ] + [] + , i [ class "users icon" ] [] + ] + ] + , div [ class "required field" ] + [ label [] [ text "User Login" ] + , div [ class "ui left icon input" ] + [ input + [ type_ "text" + , autocomplete False + , onInput SetLogin + , value model.login + ] + [] + , i [ class "user icon" ] [] + ] + ] + , div + [ class "required field" + ] + [ label [] [ text "Password" ] + , div [ class "ui left icon action input" ] + [ input + [ type_ <| + if model.showPass1 then + "text" + + else + "password" + , autocomplete False + , onInput SetPass1 + , value model.pass1 + ] + [] + , i [ class "lock icon" ] [] + , button [ class "ui icon button", onClick ToggleShowPass1 ] + [ i [ class "eye icon" ] [] + ] + ] + ] + , div + [ class "required field" + ] + [ label [] [ text "Password (repeat)" ] + , div [ class "ui left icon action input" ] + [ input + [ type_ <| + if model.showPass2 then + "text" + + else + "password" + , autocomplete False + , onInput SetPass2 + , value model.pass2 + ] + [] + , i [ class "lock icon" ] [] + , button [ class "ui icon button", onClick ToggleShowPass2 ] + [ i [ class "eye icon" ] [] + ] + ] + ] + , div + [ classList + [ ( "field", True ) + , ( "invisible", flags.config.signupMode /= "invite" ) + ] + ] + [ label [] [ text "Invitation Key" ] + , div [ class "ui left icon input" ] + [ input + [ type_ "text" + , autocomplete False + , onInput SetInvite + , model.invite |> Maybe.withDefault "" |> value + ] + [] + , i [ class "key icon" ] [] + ] + ] + , button + [ class "ui primary button" + , type_ "submit" + ] + [ text "Submit" + ] + ] + , resultMessage model + , div [ class "ui very basic right aligned segment" ] + [ text "Already signed up? " + , a [ class "ui link", Page.href (LoginPage Nothing) ] + [ i [ class "sign-in icon" ] [] + , text "Sign in" + ] + ] + ] + ] + ] ] -resultMessage: Model -> Html Msg + +resultMessage : Model -> Html Msg resultMessage model = case model.result of Just r -> - if r.success - then - div [class "ui success message"] - [text "Registration successful." + if r.success then + div [ class "ui success message" ] + [ text "Registration successful." ] + else - div [class "ui error message"] - [text r.message + div [ class "ui error message" ] + [ text r.message ] Nothing -> if List.isEmpty model.errorMsg then - span [class "invisible"][] + span [ class "invisible" ] [] + else - div [class "ui error message"] - (List.map (\s -> div[][text s]) model.errorMsg) + div [ class "ui error message" ] + (List.map (\s -> div [] [ text s ]) model.errorMsg) diff --git a/modules/webapp/src/main/elm/Page/Upload/Data.elm b/modules/webapp/src/main/elm/Page/Upload/Data.elm index 19ac5819..9ed5ff66 100644 --- a/modules/webapp/src/main/elm/Page/Upload/Data.elm +++ b/modules/webapp/src/main/elm/Page/Upload/Data.elm @@ -1,35 +1,53 @@ -module Page.Upload.Data exposing (..) +module Page.Upload.Data exposing + ( Model + , Msg(..) + , emptyModel + , hasErrors + , isCompleted + , isDone + , isError + , isIdle + , isLoading + , isSuccessAll + , uploadAllTracker + ) +import Api.Model.BasicResult exposing (BasicResult) +import Comp.Dropzone +import File exposing (File) import Http import Set exposing (Set) -import File exposing (File) -import Api.Model.BasicResult exposing (BasicResult) import Util.File exposing (makeFileId) -import Comp.Dropzone + type alias Model = - { incoming: Bool - , singleItem: Bool - , files: List File - , completed: Set String - , errored: Set String - , loading: Set String - , dropzone: Comp.Dropzone.Model + { incoming : Bool + , singleItem : Bool + , files : List File + , completed : Set String + , errored : Set String + , loading : Set String + , dropzone : Comp.Dropzone.Model } -dropzoneSettings: Comp.Dropzone.Settings + +dropzoneSettings : Comp.Dropzone.Settings dropzoneSettings = let - ds = Comp.Dropzone.defaultSettings + ds = + Comp.Dropzone.defaultSettings in - {ds | classList = (\m -> [("ui attached blue placeholder segment dropzone", True) - ,("dragging", m.hover) - ,("disabled", not m.active) - ]) - } + { ds + | classList = + \m -> + [ ( "ui attached blue placeholder segment dropzone", True ) + , ( "dragging", m.hover ) + , ( "disabled", not m.active ) + ] + } -emptyModel: Model +emptyModel : Model emptyModel = { incoming = True , singleItem = False @@ -40,6 +58,7 @@ emptyModel = , dropzone = Comp.Dropzone.init dropzoneSettings } + type Msg = SubmitUpload | SingleUploadResp String (Result Http.Error BasicResult) @@ -50,42 +69,50 @@ type Msg | DropzoneMsg Comp.Dropzone.Msg -isLoading: Model -> File -> Bool +isLoading : Model -> File -> Bool isLoading model file = - Set.member (makeFileId file)model.loading + Set.member (makeFileId file) model.loading -isCompleted: Model -> File -> Bool + +isCompleted : Model -> File -> Bool isCompleted model file = - Set.member (makeFileId file)model.completed + Set.member (makeFileId file) model.completed -isError: Model -> File -> Bool + +isError : Model -> File -> Bool isError model file = Set.member (makeFileId file) model.errored -isIdle: Model -> File -> Bool + +isIdle : Model -> File -> Bool isIdle model file = not (isLoading model file || isCompleted model file || isError model file) -uploadAllTracker: String + +uploadAllTracker : String uploadAllTracker = "upload-all" -isInitial: Model -> Bool -isInitial model = - Set.isEmpty model.loading && - Set.isEmpty model.completed && - Set.isEmpty model.errored -isDone: Model -> Bool +isInitial : Model -> Bool +isInitial model = + Set.isEmpty model.loading + && Set.isEmpty model.completed + && Set.isEmpty model.errored + + +isDone : Model -> Bool isDone model = List.map makeFileId model.files |> List.all (\id -> Set.member id model.completed || Set.member id model.errored) -isSuccessAll: Model -> Bool + +isSuccessAll : Model -> Bool isSuccessAll model = List.map makeFileId model.files |> List.all (\id -> Set.member id model.completed) -hasErrors: Model -> Bool + +hasErrors : Model -> Bool hasErrors model = not (Set.isEmpty model.errored) diff --git a/modules/webapp/src/main/elm/Page/Upload/Update.elm b/modules/webapp/src/main/elm/Page/Upload/Update.elm index 5f9e6075..b12e8904 100644 --- a/modules/webapp/src/main/elm/Page/Upload/Update.elm +++ b/modules/webapp/src/main/elm/Page/Upload/Update.elm @@ -1,94 +1,156 @@ module Page.Upload.Update exposing (update) import Api -import Http -import Set exposing (Set) -import Page.Upload.Data exposing (..) -import Data.Flags exposing (Flags) -import Comp.Dropzone -import File -import File.Select -import Ports import Api.Model.ItemUploadMeta +import Comp.Dropzone +import Data.Flags exposing (Flags) +import Http +import Page.Upload.Data exposing (..) +import Ports +import Set exposing (Set) import Util.File exposing (makeFileId) -import Util.Http -update: (Maybe String) -> Flags -> Msg -> Model -> (Model, Cmd Msg, Sub Msg) + +update : Maybe String -> Flags -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) update sourceId flags msg model = case msg of ToggleIncoming -> - ({model|incoming = not model.incoming}, Cmd.none, Sub.none) + ( { model | incoming = not model.incoming }, Cmd.none, Sub.none ) ToggleSingleItem -> - ({model|singleItem = not model.singleItem}, Cmd.none, Sub.none) + ( { model | singleItem = not model.singleItem }, Cmd.none, Sub.none ) SubmitUpload -> let - emptyMeta = Api.Model.ItemUploadMeta.empty - meta = {emptyMeta | multiple = not model.singleItem - , direction = if model.incoming then Just "incoming" else Just "outgoing" - } - fileids = List.map makeFileId model.files - uploads = if model.singleItem then Api.uploadSingle flags sourceId meta uploadAllTracker model.files (SingleUploadResp uploadAllTracker) - else Cmd.batch (Api.upload flags sourceId meta model.files SingleUploadResp) - tracker = if model.singleItem then Http.track uploadAllTracker (GotProgress uploadAllTracker) - else Sub.batch <| List.map (\id -> Http.track id (GotProgress id)) fileids - (cm2, _, _) = Comp.Dropzone.update (Comp.Dropzone.setActive False) model.dropzone + emptyMeta = + Api.Model.ItemUploadMeta.empty + + meta = + { emptyMeta + | multiple = not model.singleItem + , direction = + if model.incoming then + Just "incoming" + + else + Just "outgoing" + } + + fileids = + List.map makeFileId model.files + + uploads = + if model.singleItem then + Api.uploadSingle flags sourceId meta uploadAllTracker model.files (SingleUploadResp uploadAllTracker) + + else + Cmd.batch (Api.upload flags sourceId meta model.files SingleUploadResp) + + tracker = + if model.singleItem then + Http.track uploadAllTracker (GotProgress uploadAllTracker) + + else + Sub.batch <| List.map (\id -> Http.track id (GotProgress id)) fileids + + ( cm2, _, _ ) = + Comp.Dropzone.update (Comp.Dropzone.setActive False) model.dropzone in - ({model|loading = Set.fromList fileids, dropzone = cm2}, uploads, tracker) + ( { model | loading = Set.fromList fileids, dropzone = cm2 }, uploads, tracker ) SingleUploadResp fileid (Ok res) -> let - compl = if res.success then setCompleted model fileid - else model.completed - errs = if not res.success then setErrored model fileid - else model.errored - load = if fileid == uploadAllTracker then Set.empty - else Set.remove fileid model.loading - in - ({model|completed = compl, errored = errs, loading = load} - , Ports.setProgress (fileid, 100), Sub.none - ) + compl = + if res.success then + setCompleted model fileid - SingleUploadResp fileid (Err err) -> - let - _ = Debug.log "error" err - errs = setErrored model fileid - load = if fileid == uploadAllTracker then Set.empty - else Set.remove fileid model.loading + else + model.completed + + errs = + if not res.success then + setErrored model fileid + + else + model.errored + + load = + if fileid == uploadAllTracker then + Set.empty + + else + Set.remove fileid model.loading in - ({model|errored = errs, loading = load}, Cmd.none, Sub.none) + ( { model | completed = compl, errored = errs, loading = load } + , Ports.setProgress ( fileid, 100 ) + , Sub.none + ) + + SingleUploadResp fileid (Err _) -> + let + errs = + setErrored model fileid + + load = + if fileid == uploadAllTracker then + Set.empty + + else + Set.remove fileid model.loading + in + ( { model | errored = errs, loading = load }, Cmd.none, Sub.none ) GotProgress fileid progress -> let - percent = case progress of - Http.Sending p -> - Http.fractionSent p - |> (*) 100 - |> round - _ -> 0 - updateBars = if percent == 0 then Cmd.none - else if model.singleItem then Ports.setAllProgress (uploadAllTracker, percent) - else Ports.setProgress (fileid, percent) + percent = + case progress of + Http.Sending p -> + Http.fractionSent p + |> (*) 100 + |> round + + _ -> + 0 + + updateBars = + if percent == 0 then + Cmd.none + + else if model.singleItem then + Ports.setAllProgress ( uploadAllTracker, percent ) + + else + Ports.setProgress ( fileid, percent ) in - (model, updateBars, Sub.none) + ( model, updateBars, Sub.none ) Clear -> - (emptyModel, Cmd.none, Sub.none) + ( emptyModel, Cmd.none, Sub.none ) DropzoneMsg m -> let - (m2, c2, files) = Comp.Dropzone.update m model.dropzone - nextFiles = List.append model.files files + ( m2, c2, files ) = + Comp.Dropzone.update m model.dropzone + + nextFiles = + List.append model.files files in - ({model| files = nextFiles, dropzone = m2}, Cmd.map DropzoneMsg c2, Sub.none) + ( { model | files = nextFiles, dropzone = m2 }, Cmd.map DropzoneMsg c2, Sub.none ) -setCompleted: Model -> String -> Set String + +setCompleted : Model -> String -> Set String setCompleted model fileid = - if fileid == uploadAllTracker then List.map makeFileId model.files |> Set.fromList - else Set.insert fileid model.completed + if fileid == uploadAllTracker then + List.map makeFileId model.files |> Set.fromList -setErrored: Model -> String -> Set String + else + Set.insert fileid model.completed + + +setErrored : Model -> String -> Set String setErrored model fileid = - if fileid == uploadAllTracker then List.map makeFileId model.files |> Set.fromList - else Set.insert fileid model.errored + if fileid == uploadAllTracker then + List.map makeFileId model.files |> Set.fromList + + else + Set.insert fileid model.errored diff --git a/modules/webapp/src/main/elm/Page/Upload/View.elm b/modules/webapp/src/main/elm/Page/Upload/View.elm index 5ed4ff5a..cc6e4be7 100644 --- a/modules/webapp/src/main/elm/Page/Upload/View.elm +++ b/modules/webapp/src/main/elm/Page/Upload/View.elm @@ -1,166 +1,190 @@ module Page.Upload.View exposing (view) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onClick, onCheck) import Comp.Dropzone import File exposing (File) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onCheck, onClick) import Page exposing (Page(..)) import Page.Upload.Data exposing (..) import Util.File exposing (makeFileId) import Util.Maybe import Util.Size -view: (Maybe String) -> Model -> Html Msg + +view : Maybe String -> Model -> Html Msg view mid model = - div [class "upload-page ui grid container"] - [div [class "row"] - [div [class "sixteen wide column"] - [div [class "ui top attached segment"] - [renderForm model - ] - ,Html.map DropzoneMsg (Comp.Dropzone.view model.dropzone) - ,div [class "ui bottom attached segment"] - [a [class "ui primary button", href "", onClick SubmitUpload] - [text "Submit" - ] - ,a [class "ui secondary button", href "", onClick Clear] - [text "Reset" - ] - ] - ] - ] - ,if isDone model && hasErrors model then renderErrorMsg model - else span[class "invisible"][] - ,if List.isEmpty model.files then span[][] - else if isSuccessAll model then renderSuccessMsg (Util.Maybe.nonEmpty mid) model - else renderUploads model - ] - - -renderErrorMsg: Model -> Html Msg -renderErrorMsg model = - div [class "row"] - [div [class "sixteen wide column"] - [div [class "ui large error message"] - [h3 [class "ui header"] - [i [class "meh outline icon"][] - ,text "Some files failed to upload" - ] - ,text "There were errors uploading some files." - ] - ] - ] - -renderSuccessMsg: Bool -> Model -> Html Msg -renderSuccessMsg public model = - div [class "row"] - [div [class "sixteen wide column"] - [div [class "ui large success message"] - [h3 [class "ui header"] - [i [class "smile outline icon"][] - ,text "All files uploaded" - ] - ,if public then p [][] else p [] - [text "Your files have been successfully uploaded. They are now being processed. Check the " - ,a [class "ui link", Page.href HomePage] - [text "Items page" - ] - ,text " later where the files will arrive eventually. Or go to the " - ,a [class "ui link", Page.href QueuePage] - [text "Processing Page" - ] - ,text " to view the current processing state." - ] - ,p [] - [text "Click " - ,a [class "ui link", href "", onClick Clear] - [text "Reset" - ] - ,text " to upload more files." - ] - ] - ] - ] - - -renderUploads: Model -> Html Msg -renderUploads model = - div [class "row"] - [div [class "sixteen wide column"] - [div [class "ui basic segment"] - [h2 [class "ui header"] - [text "Selected Files" - ] - ,div [class "ui items"] <| - if model.singleItem then - (List.map (renderFileItem model (Just uploadAllTracker)) model.files) - else - (List.map (renderFileItem model Nothing) model.files) - ] - ] - ] - - -renderFileItem: Model -> Maybe String -> File -> Html Msg -renderFileItem model mtracker file = - let - name = File.name file - size = File.size file - |> toFloat - |> Util.Size.bytesReadable Util.Size.B - in - div [class "item"] - [i [classList [("large", True) - ,("file outline icon", isIdle model file) - ,("loading spinner icon", isLoading model file) - ,("green check icon", isCompleted model file) - ,("red bolt icon", isError model file) - ]][] - ,div [class "middle aligned content"] - [div [class "header"] - [text name - ] - ,div [class "right floated meta"] - [text size - ] - ,div [class "description"] - [div [classList [("ui small indicating progress", True) - ,(uploadAllTracker, Util.Maybe.nonEmpty mtracker) - ] - , id (makeFileId file) - ] - [div [class "bar"] - [] - ] + div [ class "upload-page ui grid container" ] + [ div [ class "row" ] + [ div [ class "sixteen wide column" ] + [ div [ class "ui top attached segment" ] + [ renderForm model + ] + , Html.map DropzoneMsg (Comp.Dropzone.view model.dropzone) + , div [ class "ui bottom attached segment" ] + [ a [ class "ui primary button", href "", onClick SubmitUpload ] + [ text "Submit" + ] + , a [ class "ui secondary button", href "", onClick Clear ] + [ text "Reset" + ] ] ] ] + , if isDone model && hasErrors model then + renderErrorMsg model + else + span [ class "invisible" ] [] + , if List.isEmpty model.files then + span [] [] -renderForm: Model -> Html Msg -renderForm model = - div [class "row"] - [Html.form [class "ui form"] - [div [class "grouped fields"] - [div [class "field"] - [div [class "ui radio checkbox"] - [input [type_ "radio", checked model.incoming, onCheck (\_ ->ToggleIncoming)][] - ,label [][text "Incoming"] - ] - ] - ,div [class "field"] - [div [class "ui radio checkbox"] - [input [type_ "radio", checked (not model.incoming), onCheck (\_ -> ToggleIncoming)][] - ,label [][text "Outgoing"] - ] - ] - ] - ,div [class "inline field"] - [div [class "ui checkbox"] - [input [type_ "checkbox", checked model.singleItem, onCheck (\_ -> ToggleSingleItem)][] - ,label [][text "All files are one single item"] - ] - ] - ] + else if isSuccessAll model then + renderSuccessMsg (Util.Maybe.nonEmpty mid) model + + else + renderUploads model + ] + + +renderErrorMsg : Model -> Html Msg +renderErrorMsg model = + div [ class "row" ] + [ div [ class "sixteen wide column" ] + [ div [ class "ui large error message" ] + [ h3 [ class "ui header" ] + [ i [ class "meh outline icon" ] [] + , text "Some files failed to upload" + ] + , text "There were errors uploading some files." + ] + ] + ] + + +renderSuccessMsg : Bool -> Model -> Html Msg +renderSuccessMsg public model = + div [ class "row" ] + [ div [ class "sixteen wide column" ] + [ div [ class "ui large success message" ] + [ h3 [ class "ui header" ] + [ i [ class "smile outline icon" ] [] + , text "All files uploaded" + ] + , if public then + p [] [] + + else + p [] + [ text "Your files have been successfully uploaded. They are now being processed. Check the " + , a [ class "ui link", Page.href HomePage ] + [ text "Items page" + ] + , text " later where the files will arrive eventually. Or go to the " + , a [ class "ui link", Page.href QueuePage ] + [ text "Processing Page" + ] + , text " to view the current processing state." + ] + , p [] + [ text "Click " + , a [ class "ui link", href "", onClick Clear ] + [ text "Reset" + ] + , text " to upload more files." + ] + ] + ] + ] + + +renderUploads : Model -> Html Msg +renderUploads model = + div [ class "row" ] + [ div [ class "sixteen wide column" ] + [ div [ class "ui basic segment" ] + [ h2 [ class "ui header" ] + [ text "Selected Files" + ] + , div [ class "ui items" ] <| + if model.singleItem then + List.map (renderFileItem model (Just uploadAllTracker)) model.files + + else + List.map (renderFileItem model Nothing) model.files + ] + ] + ] + + +renderFileItem : Model -> Maybe String -> File -> Html Msg +renderFileItem model mtracker file = + let + name = + File.name file + + size = + File.size file + |> toFloat + |> Util.Size.bytesReadable Util.Size.B + in + div [ class "item" ] + [ i + [ classList + [ ( "large", True ) + , ( "file outline icon", isIdle model file ) + , ( "loading spinner icon", isLoading model file ) + , ( "green check icon", isCompleted model file ) + , ( "red bolt icon", isError model file ) + ] + ] + [] + , div [ class "middle aligned content" ] + [ div [ class "header" ] + [ text name + ] + , div [ class "right floated meta" ] + [ text size + ] + , div [ class "description" ] + [ div + [ classList + [ ( "ui small indicating progress", True ) + , ( uploadAllTracker, Util.Maybe.nonEmpty mtracker ) + ] + , id (makeFileId file) + ] + [ div [ class "bar" ] + [] + ] + ] + ] + ] + + +renderForm : Model -> Html Msg +renderForm model = + div [ class "row" ] + [ Html.form [ class "ui form" ] + [ div [ class "grouped fields" ] + [ div [ class "field" ] + [ div [ class "ui radio checkbox" ] + [ input [ type_ "radio", checked model.incoming, onCheck (\_ -> ToggleIncoming) ] [] + , label [] [ text "Incoming" ] + ] + ] + , div [ class "field" ] + [ div [ class "ui radio checkbox" ] + [ input [ type_ "radio", checked (not model.incoming), onCheck (\_ -> ToggleIncoming) ] [] + , label [] [ text "Outgoing" ] + ] + ] + ] + , div [ class "inline field" ] + [ div [ class "ui checkbox" ] + [ input [ type_ "checkbox", checked model.singleItem, onCheck (\_ -> ToggleSingleItem) ] [] + , label [] [ text "All files are one single item" ] + ] + ] + ] ] diff --git a/modules/webapp/src/main/elm/Page/UserSettings/Data.elm b/modules/webapp/src/main/elm/Page/UserSettings/Data.elm index 2aecc50e..e56608a7 100644 --- a/modules/webapp/src/main/elm/Page/UserSettings/Data.elm +++ b/modules/webapp/src/main/elm/Page/UserSettings/Data.elm @@ -1,19 +1,29 @@ -module Page.UserSettings.Data exposing (..) +module Page.UserSettings.Data exposing + ( Model + , Msg(..) + , Tab(..) + , emptyModel + ) import Comp.ChangePasswordForm + type alias Model = - { currentTab: Maybe Tab - , changePassModel: Comp.ChangePasswordForm.Model + { currentTab : Maybe Tab + , changePassModel : Comp.ChangePasswordForm.Model } -emptyModel: Model + +emptyModel : Model emptyModel = { currentTab = Nothing , changePassModel = Comp.ChangePasswordForm.emptyModel } -type Tab = ChangePassTab + +type Tab + = ChangePassTab + type Msg = SetTab Tab diff --git a/modules/webapp/src/main/elm/Page/UserSettings/Update.elm b/modules/webapp/src/main/elm/Page/UserSettings/Update.elm index 86864206..40e34e18 100644 --- a/modules/webapp/src/main/elm/Page/UserSettings/Update.elm +++ b/modules/webapp/src/main/elm/Page/UserSettings/Update.elm @@ -1,20 +1,23 @@ module Page.UserSettings.Update exposing (update) -import Page.UserSettings.Data exposing (..) -import Data.Flags exposing (Flags) import Comp.ChangePasswordForm +import Data.Flags exposing (Flags) +import Page.UserSettings.Data exposing (..) -update: Flags -> Msg -> Model -> (Model, Cmd Msg) + +update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update flags msg model = case msg of SetTab t -> let - m = { model | currentTab = Just t } + m = + { model | currentTab = Just t } in - (m, Cmd.none) + ( m, Cmd.none ) ChangePassMsg m -> let - (m2, c2) = Comp.ChangePasswordForm.update flags m model.changePassModel + ( m2, c2 ) = + Comp.ChangePasswordForm.update flags m model.changePassModel in - ({model | changePassModel = m2}, Cmd.map ChangePassMsg c2) + ( { model | changePassModel = m2 }, Cmd.map ChangePassMsg c2 ) diff --git a/modules/webapp/src/main/elm/Page/UserSettings/View.elm b/modules/webapp/src/main/elm/Page/UserSettings/View.elm index 120effc1..6e1aee04 100644 --- a/modules/webapp/src/main/elm/Page/UserSettings/View.elm +++ b/modules/webapp/src/main/elm/Page/UserSettings/View.elm @@ -1,47 +1,52 @@ module Page.UserSettings.View exposing (view) +import Comp.ChangePasswordForm import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) +import Page.UserSettings.Data exposing (..) import Util.Html exposing (classActive) -import Page.UserSettings.Data exposing (..) -import Comp.ChangePasswordForm -view: Model -> Html Msg +view : Model -> Html Msg view model = - div [class "usersetting-page ui padded grid"] - [div [class "four wide column"] - [h4 [class "ui top attached ablue-comp header"] - [text "User" - ] - ,div [class "ui attached fluid segment"] - [div [class "ui fluid vertical secondary menu"] - [div [classActive (model.currentTab == Just ChangePassTab) "link icon item" - ,onClick (SetTab ChangePassTab) - ] - [i [class "user secret icon"][] - ,text "Change Password" - ] - ] - ] - ] - ,div [class "twelve wide column"] - [div [class ""] - (case model.currentTab of - Just ChangePassTab -> viewChangePassword model - Nothing -> [] - ) + div [ class "usersetting-page ui padded grid" ] + [ div [ class "four wide column" ] + [ h4 [ class "ui top attached ablue-comp header" ] + [ text "User" + ] + , div [ class "ui attached fluid segment" ] + [ div [ class "ui fluid vertical secondary menu" ] + [ div + [ classActive (model.currentTab == Just ChangePassTab) "link icon item" + , onClick (SetTab ChangePassTab) + ] + [ i [ class "user secret icon" ] [] + , text "Change Password" + ] + ] + ] + ] + , div [ class "twelve wide column" ] + [ div [ class "" ] + (case model.currentTab of + Just ChangePassTab -> + viewChangePassword model + + Nothing -> + [] + ) ] ] -viewChangePassword: Model -> List (Html Msg) + +viewChangePassword : Model -> List (Html Msg) viewChangePassword model = - [h2 [class "ui header"] - [i [class "ui user secret icon"][] - ,div [class "content"] - [text "Change Password" + [ h2 [ class "ui header" ] + [ i [ class "ui user secret icon" ] [] + , div [ class "content" ] + [ text "Change Password" ] ] - ,Html.map ChangePassMsg (Comp.ChangePasswordForm.view model.changePassModel) + , Html.map ChangePassMsg (Comp.ChangePasswordForm.view model.changePassModel) ] diff --git a/modules/webapp/src/main/elm/Ports.elm b/modules/webapp/src/main/elm/Ports.elm index 6cab6915..343fb19c 100644 --- a/modules/webapp/src/main/elm/Ports.elm +++ b/modules/webapp/src/main/elm/Ports.elm @@ -2,10 +2,14 @@ port module Ports exposing (..) import Api.Model.AuthResult exposing (AuthResult) -port initElements: () -> Cmd msg -port setAccount: AuthResult -> Cmd msg -port removeAccount: () -> Cmd msg +port setAccount : AuthResult -> Cmd msg -port setProgress: (String, Int) -> Cmd msg -port setAllProgress: (String, Int) -> Cmd msg + +port removeAccount : () -> Cmd msg + + +port setProgress : ( String, Int ) -> Cmd msg + + +port setAllProgress : ( String, Int ) -> Cmd msg diff --git a/modules/webapp/src/main/elm/Util/Address.elm b/modules/webapp/src/main/elm/Util/Address.elm index 51737202..f8d121b0 100644 --- a/modules/webapp/src/main/elm/Util/Address.elm +++ b/modules/webapp/src/main/elm/Util/Address.elm @@ -1,8 +1,9 @@ -module Util.Address exposing (..) +module Util.Address exposing (toString) import Api.Model.Address exposing (Address) -toString: Address -> String + +toString : Address -> String toString a = [ a.street, a.zip, a.city, a.country ] |> List.filter (String.isEmpty >> not) diff --git a/modules/webapp/src/main/elm/Util/Contact.elm b/modules/webapp/src/main/elm/Util/Contact.elm index 85e86160..8be494d9 100644 --- a/modules/webapp/src/main/elm/Util/Contact.elm +++ b/modules/webapp/src/main/elm/Util/Contact.elm @@ -1,8 +1,9 @@ -module Util.Contact exposing (..) +module Util.Contact exposing (toString) import Api.Model.Contact exposing (Contact) -toString: List Contact -> String + +toString : List Contact -> String toString contacts = List.map (\c -> c.kind ++ ": " ++ c.value) contacts |> List.intersperse ", " diff --git a/modules/webapp/src/main/elm/Util/Duration.elm b/modules/webapp/src/main/elm/Util/Duration.elm index 22d778ea..dae1894c 100644 --- a/modules/webapp/src/main/elm/Util/Duration.elm +++ b/modules/webapp/src/main/elm/Util/Duration.elm @@ -2,46 +2,65 @@ module Util.Duration exposing (Duration, toHuman) -- 486ms -> 12s -> 1:05 -> 59:45 -> 1:02:12 -type alias Duration = Int -toHuman: Duration -> String +type alias Duration = + Int + + +toHuman : Duration -> String toHuman dur = fromMillis dur + -- implementation -fromMillis: Int -> String + +fromMillis : Int -> String fromMillis ms = case ms // 1000 of 0 -> - (String.fromInt ms) ++ "ms" + String.fromInt ms ++ "ms" + n -> fromSeconds n -fromSeconds: Int -> String + +fromSeconds : Int -> String fromSeconds sec = case sec // 60 of 0 -> - (String.fromInt sec) ++ "s" + String.fromInt sec ++ "s" + n -> let - s = sec - (n * 60) + s = + sec - (n * 60) in - (fromMinutes n) ++ ":" ++ (num s) + fromMinutes n ++ ":" ++ num s -fromMinutes: Int -> String + +fromMinutes : Int -> String fromMinutes min = case min // 60 of 0 -> - (num min) + num min + n -> let - m = min - (n * 60) + m = + min - (n * 60) in - (num n) ++ ":" ++ (num m) + num n ++ ":" ++ num m -num: Int -> String + +num : Int -> String num n = String.fromInt n - |> (++) (if n < 10 then "0" else "") + |> (++) + (if n < 10 then + "0" + + else + "" + ) diff --git a/modules/webapp/src/main/elm/Util/File.elm b/modules/webapp/src/main/elm/Util/File.elm index f0785dec..33c466c5 100644 --- a/modules/webapp/src/main/elm/Util/File.elm +++ b/modules/webapp/src/main/elm/Util/File.elm @@ -1,9 +1,12 @@ -module Util.File exposing (..) +module Util.File exposing (makeFileId) import File exposing (File) import Util.String -makeFileId: File -> String + +makeFileId : File -> String makeFileId file = - (File.name file) ++ "-" ++ (File.size file |> String.fromInt) + File.name file + ++ "-" + ++ (File.size file |> String.fromInt) |> Util.String.crazyEncode diff --git a/modules/webapp/src/main/elm/Util/Html.elm b/modules/webapp/src/main/elm/Util/Html.elm index 8c58ebcc..9131386b 100644 --- a/modules/webapp/src/main/elm/Util/Html.elm +++ b/modules/webapp/src/main/elm/Util/Html.elm @@ -1,10 +1,17 @@ -module Util.Html exposing (..) +module Util.Html exposing + ( KeyCode(..) + , classActive + , intToKeyCode + , onClickk + , onKeyUp + ) import Html exposing (Attribute) import Html.Attributes exposing (class) -import Html.Events exposing (on, keyCode) +import Html.Events exposing (keyCode, on) import Json.Decode as Decode + type KeyCode = Up | Down @@ -12,29 +19,52 @@ type KeyCode | Right | Enter -intToKeyCode: Int -> Maybe KeyCode + +intToKeyCode : Int -> Maybe KeyCode intToKeyCode code = case code of - 38 -> Just Up - 40 -> Just Down - 39 -> Just Right - 37 -> Just Left - 13 -> Just Enter - _ -> Nothing + 38 -> + Just Up + + 40 -> + Just Down + + 39 -> + Just Right + + 37 -> + Just Left + + 13 -> + Just Enter + + _ -> + Nothing + onKeyUp : (Int -> msg) -> Attribute msg onKeyUp tagger = - on "keyup" (Decode.map tagger keyCode) + on "keyup" (Decode.map tagger keyCode) onClickk : msg -> Attribute msg onClickk msg = - Html.Events.preventDefaultOn "click" (Decode.map alwaysPreventDefault (Decode.succeed msg)) + Html.Events.preventDefaultOn "click" (Decode.map alwaysPreventDefault (Decode.succeed msg)) + alwaysPreventDefault : msg -> ( msg, Bool ) alwaysPreventDefault msg = - ( msg, True ) + ( msg, True ) -classActive: Bool -> String -> Attribute msg + +classActive : Bool -> String -> Attribute msg classActive active classes = - class (classes ++ (if active then " active" else "")) + class + (classes + ++ (if active then + " active" + + else + "" + ) + ) diff --git a/modules/webapp/src/main/elm/Util/Http.elm b/modules/webapp/src/main/elm/Util/Http.elm index 959676b8..684ae04e 100644 --- a/modules/webapp/src/main/elm/Util/Http.elm +++ b/modules/webapp/src/main/elm/Util/Http.elm @@ -1,37 +1,55 @@ -module Util.Http exposing (..) +module Util.Http exposing + ( authDelete + , authGet + , authPost + , authPostTrack + , authPut + , authTask + , errorToString + , executeIn + , jsonResolver + ) +import Api.Model.AuthResult exposing (AuthResult) import Http +import Json.Decode as D import Process import Task exposing (Task) -import Api.Model.AuthResult exposing (AuthResult) -import Json.Decode as D + + -- Authenticated Requests -authReq: {url: String - ,account: AuthResult - ,method: String - ,headers: List Http.Header - ,body: Http.Body - ,expect: Http.Expect msg - ,tracker: Maybe String - } -> Cmd msg + +authReq : + { url : String + , account : AuthResult + , method : String + , headers : List Http.Header + , body : Http.Body + , expect : Http.Expect msg + , tracker : Maybe String + } + -> Cmd msg authReq req = Http.request { url = req.url , method = req.method - , headers = (Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token)) :: req.headers + , headers = Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token) :: req.headers , expect = req.expect , body = req.body , timeout = Nothing , tracker = req.tracker } -authPost: {url: String - ,account: AuthResult - ,body: Http.Body - ,expect: Http.Expect msg - } -> Cmd msg + +authPost : + { url : String + , account : AuthResult + , body : Http.Body + , expect : Http.Expect msg + } + -> Cmd msg authPost req = authReq { url = req.url @@ -43,12 +61,15 @@ authPost req = , tracker = Nothing } -authPostTrack: {url: String - ,account: AuthResult - ,body: Http.Body - ,expect: Http.Expect msg - ,tracker: String - } -> Cmd msg + +authPostTrack : + { url : String + , account : AuthResult + , body : Http.Body + , expect : Http.Expect msg + , tracker : String + } + -> Cmd msg authPostTrack req = authReq { url = req.url @@ -60,11 +81,14 @@ authPostTrack req = , tracker = Just req.tracker } -authPut: {url: String - ,account: AuthResult - ,body: Http.Body - ,expect: Http.Expect msg - } -> Cmd msg + +authPut : + { url : String + , account : AuthResult + , body : Http.Body + , expect : Http.Expect msg + } + -> Cmd msg authPut req = authReq { url = req.url @@ -76,10 +100,13 @@ authPut req = , tracker = Nothing } -authGet: {url: String - ,account: AuthResult - ,expect: Http.Expect msg - } -> Cmd msg + +authGet : + { url : String + , account : AuthResult + , expect : Http.Expect msg + } + -> Cmd msg authGet req = authReq { url = req.url @@ -91,10 +118,13 @@ authGet req = , tracker = Nothing } -authDelete: {url: String - ,account: AuthResult - ,expect: Http.Expect msg - } -> Cmd msg + +authDelete : + { url : String + , account : AuthResult + , expect : Http.Expect msg + } + -> Cmd msg authDelete req = authReq { url = req.url @@ -110,69 +140,81 @@ authDelete req = -- Error Utilities -errorToStringStatus: Http.Error -> (Int -> String) -> String + +errorToStringStatus : Http.Error -> (Int -> String) -> String errorToStringStatus error statusString = case error of Http.BadUrl url -> "There is something wrong with this url: " ++ url + Http.Timeout -> "There was a network timeout." + Http.NetworkError -> "There was a network error." + Http.BadStatus status -> statusString status + Http.BadBody str -> "There was an error decoding the response: " ++ str -errorToString: Http.Error -> String + +errorToString : Http.Error -> String errorToString error = let - f sc = case sc of - 404 -> - "The requested resource doesn't exist." - _ -> - "There was an invalid response status: " ++ (String.fromInt sc) + f sc = + case sc of + 404 -> + "The requested resource doesn't exist." + + _ -> + "There was an invalid response status: " ++ String.fromInt sc in - errorToStringStatus error f + errorToStringStatus error f + -- Http.Task Utilities -jsonResolver : D.Decoder a -> Http.Resolver Http.Error a + +jsonResolver : D.Decoder a -> Http.Resolver Http.Error a jsonResolver decoder = - Http.stringResolver <| - \response -> - case response of - Http.BadUrl_ url -> - Err (Http.BadUrl url) + Http.stringResolver <| + \response -> + case response of + Http.BadUrl_ url -> + Err (Http.BadUrl url) - Http.Timeout_ -> - Err Http.Timeout + Http.Timeout_ -> + Err Http.Timeout - Http.NetworkError_ -> - Err Http.NetworkError + Http.NetworkError_ -> + Err Http.NetworkError - Http.BadStatus_ metadata body -> - Err (Http.BadStatus metadata.statusCode) + Http.BadStatus_ metadata body -> + Err (Http.BadStatus metadata.statusCode) - Http.GoodStatus_ metadata body -> - case D.decodeString decoder body of - Ok value -> - Ok value + Http.GoodStatus_ metadata body -> + case D.decodeString decoder body of + Ok value -> + Ok value - Err err -> - Err (Http.BadBody (D.errorToString err)) + Err err -> + Err (Http.BadBody (D.errorToString err)) -executeIn: Float -> ((Result Http.Error a) -> msg) -> Task Http.Error a -> Cmd msg + +executeIn : Float -> (Result Http.Error a -> msg) -> Task Http.Error a -> Cmd msg executeIn delay receive task = Process.sleep delay |> Task.andThen (\_ -> task) |> Task.attempt receive -authTask: + +authTask : { method : String , headers : List Http.Header - , account: AuthResult + , account : AuthResult , url : String , body : Http.Body , resolver : Http.Resolver x a @@ -182,7 +224,7 @@ authTask: authTask req = Http.task { method = req.method - , headers = (Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token)) :: req.headers + , headers = Http.header "X-Docspell-Auth" (Maybe.withDefault "" req.account.token) :: req.headers , url = req.url , body = req.body , resolver = req.resolver diff --git a/modules/webapp/src/main/elm/Util/List.elm b/modules/webapp/src/main/elm/Util/List.elm index 99071e71..fca6efce 100644 --- a/modules/webapp/src/main/elm/Util/List.elm +++ b/modules/webapp/src/main/elm/Util/List.elm @@ -1,51 +1,80 @@ -module Util.List exposing ( find - , findIndexed - , get - , distinct - , findNext - , findPrev - ) +module Util.List exposing + ( distinct + , find + , findIndexed + , findNext + , findPrev + , get + ) -get: List a -> Int -> Maybe a + +get : List a -> Int -> Maybe a get list index = - if index < 0 then Nothing - else case list of - [] -> - Nothing - x :: xs -> - if index == 0 - then Just x - else get xs (index - 1) + if index < 0 then + Nothing -find: (a -> Bool) -> List a -> Maybe a + else + case list of + [] -> + Nothing + + x :: xs -> + if index == 0 then + Just x + + else + get xs (index - 1) + + +find : (a -> Bool) -> List a -> Maybe a find pred list = findIndexed pred list |> Maybe.map Tuple.first -findIndexed: (a -> Bool) -> List a -> Maybe (a, Int) + +findIndexed : (a -> Bool) -> List a -> Maybe ( a, Int ) findIndexed pred list = findIndexed1 pred list 0 -findIndexed1: (a -> Bool) -> List a -> Int -> Maybe (a, Int) + +findIndexed1 : (a -> Bool) -> List a -> Int -> Maybe ( a, Int ) findIndexed1 pred list index = case list of - [] -> Nothing - x :: xs -> - if pred x then Just (x, index) - else findIndexed1 pred xs (index + 1) + [] -> + Nothing -distinct: List a -> List a + x :: xs -> + if pred x then + Just ( x, index ) + + else + findIndexed1 pred xs (index + 1) + + +distinct : List a -> List a distinct list = List.reverse <| - List.foldl (\a -> \r -> if (List.member a r) then r else a :: r) [] list + List.foldl + (\a -> + \r -> + if List.member a r then + r -findPrev: (a -> Bool) -> List a -> Maybe a + else + a :: r + ) + [] + list + + +findPrev : (a -> Bool) -> List a -> Maybe a findPrev pred list = findIndexed pred list |> Maybe.map Tuple.second |> Maybe.map (\i -> i - 1) |> Maybe.andThen (get list) -findNext: (a -> Bool) -> List a -> Maybe a + +findNext : (a -> Bool) -> List a -> Maybe a findNext pred list = findIndexed pred list |> Maybe.map Tuple.second diff --git a/modules/webapp/src/main/elm/Util/Maybe.elm b/modules/webapp/src/main/elm/Util/Maybe.elm index e4f895a6..00de8c40 100644 --- a/modules/webapp/src/main/elm/Util/Maybe.elm +++ b/modules/webapp/src/main/elm/Util/Maybe.elm @@ -1,23 +1,40 @@ -module Util.Maybe exposing (..) +module Util.Maybe exposing + ( isEmpty + , nonEmpty + , or + , withDefault + ) -nonEmpty: Maybe a -> Bool + +nonEmpty : Maybe a -> Bool nonEmpty ma = - Maybe.map (\_ -> True) ma - |> Maybe.withDefault False + not (isEmpty ma) -isEmpty: Maybe a -> Bool + +isEmpty : Maybe a -> Bool isEmpty ma = - not (nonEmpty ma) + ma == Nothing -withDefault: Maybe a -> Maybe a -> Maybe a + +withDefault : Maybe a -> Maybe a -> Maybe a withDefault ma1 ma2 = - if isEmpty ma2 then ma1 else ma2 + if isEmpty ma2 then + ma1 -or: List (Maybe a) -> Maybe a + else + ma2 + + +or : List (Maybe a) -> Maybe a or listma = case listma of - [] -> Nothing + [] -> + Nothing + el :: els -> case el of - Just _ -> el - Nothing -> or els + Just _ -> + el + + Nothing -> + or els diff --git a/modules/webapp/src/main/elm/Util/Size.elm b/modules/webapp/src/main/elm/Util/Size.elm index cba32c40..f9a72e80 100644 --- a/modules/webapp/src/main/elm/Util/Size.elm +++ b/modules/webapp/src/main/elm/Util/Size.elm @@ -1,24 +1,60 @@ -module Util.Size exposing (..) +module Util.Size exposing + ( SizeUnit(..) + , bytesReadable + ) -type SizeUnit = G|M|K|B -prettyNumber: Float -> String +type SizeUnit + = G + | M + | K + | B + + +prettyNumber : Float -> String prettyNumber n = let - parts = String.split "." (String.fromFloat n) + parts = + String.split "." (String.fromFloat n) in - case parts of - n0 :: d :: [] -> n0 ++ "." ++ (String.left 2 d) - _ -> String.join "." parts + case parts of + n0 :: d :: [] -> + n0 ++ "." ++ String.left 2 d -bytesReadable: SizeUnit -> Float -> String + _ -> + String.join "." parts + + +bytesReadable : SizeUnit -> Float -> String bytesReadable unit n = let - k = n / 1024 - num = prettyNumber n + k = + n / 1024 + + num = + prettyNumber n in case unit of - G -> num ++ "G" - M -> if k > 1 then (bytesReadable G k) else num ++ "M" - K -> if k > 1 then (bytesReadable M k) else num ++ "K" - B -> if k > 1 then (bytesReadable K k) else num ++ "B" + G -> + num ++ "G" + + M -> + if k > 1 then + bytesReadable G k + + else + num ++ "M" + + K -> + if k > 1 then + bytesReadable M k + + else + num ++ "K" + + B -> + if k > 1 then + bytesReadable K k + + else + num ++ "B" diff --git a/modules/webapp/src/main/elm/Util/String.elm b/modules/webapp/src/main/elm/Util/String.elm index b2a6de04..e16f6801 100644 --- a/modules/webapp/src/main/elm/Util/String.elm +++ b/modules/webapp/src/main/elm/Util/String.elm @@ -1,28 +1,45 @@ -module Util.String exposing (..) +module Util.String exposing + ( crazyEncode + , ellipsis + , withDefault + ) import Base64 -crazyEncode: String -> String + +crazyEncode : String -> String crazyEncode str = let - b64 = Base64.encode str - len = String.length b64 + b64 = + Base64.encode str + + len = + String.length b64 in - case (String.right 2 b64 |> String.toList) of - '=' :: '=' :: [] -> - (String.dropRight 2 b64) ++ "0" + case String.right 2 b64 |> String.toList of + '=' :: '=' :: [] -> + String.dropRight 2 b64 ++ "0" - _ :: '=' :: [] -> - (String.dropRight 1 b64) ++ "1" + _ :: '=' :: [] -> + String.dropRight 1 b64 ++ "1" - _ -> - b64 + _ -> + b64 -ellipsis: Int -> String -> String + +ellipsis : Int -> String -> String ellipsis len str = - if String.length str <= len then str - else (String.left (len - 3) str) ++ "..." + if String.length str <= len then + str -withDefault: String -> String -> String + else + String.left (len - 3) str ++ "..." + + +withDefault : String -> String -> String withDefault default str = - if str == "" then default else str + if str == "" then + default + + else + str diff --git a/modules/webapp/src/main/elm/Util/Time.elm b/modules/webapp/src/main/elm/Util/Time.elm index 51381277..38f5922e 100644 --- a/modules/webapp/src/main/elm/Util/Time.elm +++ b/modules/webapp/src/main/elm/Util/Time.elm @@ -1,4 +1,9 @@ -module Util.Time exposing (..) +module Util.Time exposing + ( formatDate + , formatDateShort + , formatDateTime + , formatIsoDateTime + ) import DateFormat import Time exposing (Posix, Zone, utc) @@ -16,7 +21,8 @@ dateFormatter = , DateFormat.yearNumber ] -dateFormatterShort: Zone -> Posix -> String + +dateFormatterShort : Zone -> Posix -> String dateFormatterShort = DateFormat.format [ DateFormat.yearNumber @@ -26,7 +32,8 @@ dateFormatterShort = , DateFormat.dayOfMonthFixed ] -timeFormatter: Zone -> Posix -> String + +timeFormatter : Zone -> Posix -> String timeFormatter = DateFormat.format [ DateFormat.hourMilitaryNumber @@ -34,7 +41,8 @@ timeFormatter = , DateFormat.minuteFixed ] -isoDateTimeFormatter: Zone -> Posix -> String + +isoDateTimeFormatter : Zone -> Posix -> String isoDateTimeFormatter = DateFormat.format [ DateFormat.yearNumber @@ -51,37 +59,49 @@ isoDateTimeFormatter = ] -timeZone: Zone +timeZone : Zone timeZone = utc -{- Format millis into "Wed, 10. Jan 2018, 18:57" --} -formatDateTime: Int -> String -formatDateTime millis = - (formatDate millis) ++ ", " ++ (formatTime millis) -formatIsoDateTime: Int -> String + +{- Format millis into "Wed, 10. Jan 2018, 18:57" -} + + +formatDateTime : Int -> String +formatDateTime millis = + formatDate millis ++ ", " ++ formatTime millis + + +formatIsoDateTime : Int -> String formatIsoDateTime millis = Time.millisToPosix millis |> isoDateTimeFormatter timeZone + + {- Format millis into "18:57". The current time (not the duration of the millis). -} -formatTime: Int -> String + + +formatTime : Int -> String formatTime millis = Time.millisToPosix millis |> timeFormatter timeZone -{- Format millis into "Wed, 10. Jan 2018" --} -formatDate: Int -> String + + +{- Format millis into "Wed, 10. Jan 2018" -} + + +formatDate : Int -> String formatDate millis = Time.millisToPosix millis |> dateFormatter timeZone -formatDateShort: Int -> String + +formatDateShort : Int -> String formatDateShort millis = Time.millisToPosix millis |> dateFormatterShort timeZone diff --git a/modules/webapp/src/main/elm/Util/Update.elm b/modules/webapp/src/main/elm/Util/Update.elm index 32da4b33..dee7dfe4 100644 --- a/modules/webapp/src/main/elm/Util/Update.elm +++ b/modules/webapp/src/main/elm/Util/Update.elm @@ -1,15 +1,18 @@ -module Util.Update exposing (..) +module Util.Update exposing (andThen1) -andThen1: List (a -> (a, Cmd b)) -> a -> (a, Cmd b) +andThen1 : List (a -> ( a, Cmd b )) -> a -> ( a, Cmd b ) andThen1 fs a = let - init = (a, []) + init = + ( a, [] ) + update el tuple = let - (a2, c2) = el (Tuple.first tuple) + ( a2, c2 ) = + el (Tuple.first tuple) in - (a2, c2 :: (Tuple.second tuple)) + ( a2, c2 :: Tuple.second tuple ) in - List.foldl update init fs - |> Tuple.mapSecond Cmd.batch + List.foldl update init fs + |> Tuple.mapSecond Cmd.batch diff --git a/modules/webapp/src/main/webjar/docspell.js b/modules/webapp/src/main/webjar/docspell.js index a09bad28..9bea1f26 100644 --- a/modules/webapp/src/main/webjar/docspell.js +++ b/modules/webapp/src/main/webjar/docspell.js @@ -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));