diff --git a/modules/webapp/src/main/elm/Api.elm b/modules/webapp/src/main/elm/Api.elm index 7c184135..5a5cff99 100644 --- a/modules/webapp/src/main/elm/Api.elm +++ b/modules/webapp/src/main/elm/Api.elm @@ -11,6 +11,7 @@ module Api exposing , addConcPerson , addCorrOrg , addCorrPerson + , addDashboard , addMember , addShare , addTag @@ -39,6 +40,7 @@ module Api exposing , deleteCustomField , deleteCustomValue , deleteCustomValueMultiple + , deleteDashboard , deleteEquip , deleteFolder , deleteHook @@ -56,6 +58,7 @@ module Api exposing , deleteUser , disableOtp , fileURL + , getAllDashboards , getAttachmentMeta , getBookmarks , getChannels @@ -126,6 +129,7 @@ module Api exposing , register , removeMember , removeTagsMultiple + , replaceDashboard , reprocessItem , reprocessMultiple , restoreAllItems @@ -277,9 +281,12 @@ 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.AccountScope exposing (AccountScope) import Data.Bookmarks exposing (AllBookmarks, Bookmarks) import Data.ContactType exposing (ContactType) import Data.CustomFieldOrder exposing (CustomFieldOrder) +import Data.Dashboard exposing (Dashboard) +import Data.Dashboards exposing (AllDashboards, Dashboards) import Data.EquipmentOrder exposing (EquipmentOrder) import Data.EventType exposing (EventType) import Data.Flags exposing (Flags) @@ -299,6 +306,7 @@ import Task import Url import Util.File import Util.Http as Http2 +import Util.Result @@ -2362,6 +2370,132 @@ saveClientSettings flags settings receive = +--- Dashboards + + +dashboardsUrl : Flags -> AccountScope -> String +dashboardsUrl flags scope = + let + part = + Data.AccountScope.fold "user" "collective" scope + in + flags.config.baseUrl ++ "/api/v1/sec/clientSettings/" ++ part ++ "/webClientDashboards" + + +getDashboardsScopeTask : Flags -> AccountScope -> Task.Task Http.Error Dashboards +getDashboardsScopeTask flags scope = + Http2.authTask + { method = "GET" + , url = dashboardsUrl flags scope + , account = getAccount flags + , body = Http.emptyBody + , resolver = Http2.jsonResolver Data.Dashboards.decoder + , headers = [] + , timeout = Nothing + } + + +pushDashbordsScopeTask : Flags -> AccountScope -> Dashboards -> Task.Task Http.Error BasicResult +pushDashbordsScopeTask flags scope boards = + Http2.authTask + { method = "PUT" + , url = dashboardsUrl flags scope + , account = getAccount flags + , body = Http.jsonBody (Data.Dashboards.encode boards) + , resolver = Http2.jsonResolver Api.Model.BasicResult.decoder + , headers = [] + , timeout = Nothing + } + + +getAllDashboardsTask : Flags -> Task.Task Http.Error AllDashboards +getAllDashboardsTask flags = + let + coll = + getDashboardsScopeTask flags Data.AccountScope.Collective + + user = + getDashboardsScopeTask flags Data.AccountScope.User + in + Task.map2 AllDashboards coll user + + +getAllDashboards : Flags -> (Result Http.Error AllDashboards -> msg) -> Cmd msg +getAllDashboards flags receive = + getAllDashboardsTask flags |> Task.attempt receive + + +saveDashboardTask : Flags -> String -> Dashboard -> AccountScope -> Bool -> Task.Task Http.Error BasicResult +saveDashboardTask flags original board scope isDefault = + let + boardsTask = + getAllDashboardsTask flags + + setDefault all = + if isDefault then + Data.Dashboards.setDefaultAll board.name all + + else + Data.Dashboards.unsetDefaultAll board.name all + + removeOriginal boards = + Data.Dashboards.removeFromAll original boards + + insert all = + Data.Dashboards.insertIn scope board all + + update all = + let + next = + (removeOriginal >> insert >> setDefault) all + + saveU = + if all.user == next.user then + Task.succeed (BasicResult True "") + + else + pushDashbordsScopeTask flags Data.AccountScope.User next.user + + saveC = + if all.collective == next.collective then + Task.succeed (BasicResult True "") + + else + pushDashbordsScopeTask flags Data.AccountScope.Collective next.collective + in + Task.map2 Util.Result.combine saveU saveC + in + Task.andThen update boardsTask + + +addDashboard : Flags -> Dashboard -> AccountScope -> Bool -> (Result Http.Error BasicResult -> msg) -> Cmd msg +addDashboard flags board scope isDefault receive = + saveDashboardTask flags board.name board scope isDefault |> Task.attempt receive + + +replaceDashboard : Flags -> String -> Dashboard -> AccountScope -> Bool -> (Result Http.Error BasicResult -> msg) -> Cmd msg +replaceDashboard flags originalName board scope isDefault receive = + saveDashboardTask flags originalName board scope isDefault |> Task.attempt receive + + +deleteDashboardTask : Flags -> String -> AccountScope -> Task.Task Http.Error BasicResult +deleteDashboardTask flags name scope = + let + boardsTask = + getDashboardsScopeTask flags scope + + remove boards = + Data.Dashboards.remove name boards + in + Task.andThen (remove >> pushDashbordsScopeTask flags scope) boardsTask + + +deleteDashboard : Flags -> String -> AccountScope -> (Result Http.Error BasicResult -> msg) -> Cmd msg +deleteDashboard flags name scope receive = + deleteDashboardTask flags name scope |> Task.attempt receive + + + --- Query Bookmarks diff --git a/modules/webapp/src/main/elm/App/Data.elm b/modules/webapp/src/main/elm/App/Data.elm index ee63ea96..0facd89b 100644 --- a/modules/webapp/src/main/elm/App/Data.elm +++ b/modules/webapp/src/main/elm/App/Data.elm @@ -105,7 +105,6 @@ init key url flags_ settings = ( dbm, dbc ) = Page.Dashboard.Data.init flags - (Page.Dashboard.DefaultDashboard.getDefaultDashboard flags settings) searchViewMode = if settings.searchMenuVisible then diff --git a/modules/webapp/src/main/elm/Comp/BookmarkChooser.elm b/modules/webapp/src/main/elm/Comp/BookmarkChooser.elm index ad0af5e3..26eb6069 100644 --- a/modules/webapp/src/main/elm/Comp/BookmarkChooser.elm +++ b/modules/webapp/src/main/elm/Comp/BookmarkChooser.elm @@ -144,8 +144,6 @@ titleDiv : String -> Html msg titleDiv label = div [ class "text-sm opacity-75 py-0.5 italic" ] [ text label - - --, text " ──" ] diff --git a/modules/webapp/src/main/elm/Comp/DashboardEdit.elm b/modules/webapp/src/main/elm/Comp/DashboardEdit.elm index 126d24d2..8c72d31b 100644 --- a/modules/webapp/src/main/elm/Comp/DashboardEdit.elm +++ b/modules/webapp/src/main/elm/Comp/DashboardEdit.elm @@ -1,30 +1,34 @@ -module Comp.DashboardEdit exposing (Model, Msg, SubmitAction(..), init, update, view, viewBox) +module Comp.DashboardEdit exposing (Model, Msg, getBoard, init, update, view, viewBox) +import Comp.Basic as B import Comp.BoxEdit import Comp.FixedDropdown import Comp.MenuBar as MB +import Data.AccountScope exposing (AccountScope) import Data.Box exposing (Box) import Data.Dashboard exposing (Dashboard) import Data.DropdownStyle as DS import Data.Flags exposing (Flags) import Data.UiSettings exposing (UiSettings) import Dict exposing (Dict) -import Html exposing (Html, div, i, input, label, text) -import Html.Attributes exposing (class, classList, href, placeholder, type_, value) -import Html.Events exposing (onClick, onInput) +import Html exposing (Html, div, i, input, label, span, text) +import Html.Attributes exposing (checked, class, classList, href, placeholder, type_, value) +import Html.Events exposing (onCheck, onClick, onInput) import Html5.DragDrop as DD import Messages.Comp.DashboardEdit exposing (Texts) import Styles as S -import Util.Maybe type alias Model = { dashboard : Dashboard - , originalName : String , boxModels : Dict Int Comp.BoxEdit.Model - , nameValue : Maybe String + , nameValue : String , columnsModel : Comp.FixedDropdown.Model Int , columnsValue : Maybe Int + , gapModel : Comp.FixedDropdown.Model Int + , gapValue : Maybe Int + , defaultDashboard : Bool + , scope : AccountScope , newBoxMenuOpen : Bool , boxDragDrop : DD.Model Int Int } @@ -32,25 +36,18 @@ type alias Model = type Msg = BoxMsg Int Comp.BoxEdit.Msg - | SaveDashboard - | Cancel - | RequestDelete | SetName String | ColumnsMsg (Comp.FixedDropdown.Msg Int) + | GapMsg (Comp.FixedDropdown.Msg Int) | ToggleNewBoxMenu + | SetScope AccountScope + | ToggleDefault | PrependNew Box | DragDropMsg (DD.Msg Int Int) -type SubmitAction - = SubmitSave Dashboard - | SubmitCancel - | SubmitDelete String - | SubmitNone - - -init : Flags -> Dashboard -> ( Model, Cmd Msg, Sub Msg ) -init flags db = +init : Flags -> Dashboard -> AccountScope -> Bool -> ( Model, Cmd Msg, Sub Msg ) +init flags db scope default = let ( boxModels, cmdsAndSubs ) = List.map (Comp.BoxEdit.init flags) db.boxes @@ -65,10 +62,13 @@ init flags db = List.unzip cmdsAndSubs in ( { dashboard = db - , originalName = db.name - , nameValue = Just db.name + , nameValue = db.name , columnsModel = Comp.FixedDropdown.init [ 1, 2, 3, 4, 5 ] , columnsValue = Just db.columns + , gapModel = Comp.FixedDropdown.init (List.range 0 12) + , gapValue = Just db.gap + , defaultDashboard = default + , scope = scope , newBoxMenuOpen = False , boxModels = List.indexedMap Tuple.pair boxModels @@ -80,6 +80,11 @@ init flags db = ) +getBoard : Model -> ( Dashboard, AccountScope, Bool ) +getBoard model = + ( model.dashboard, model.scope, model.defaultDashboard ) + + --- Update @@ -88,7 +93,6 @@ type alias UpdateResult = { model : Model , cmd : Cmd Msg , sub : Sub Msg - , action : SubmitAction } @@ -115,26 +119,20 @@ update flags msg model = { model = { model | boxModels = newBoxes, dashboard = db_ } , cmd = Cmd.map (BoxMsg index) result.cmd , sub = Sub.map (BoxMsg index) result.sub - , action = SubmitNone } Nothing -> unit model SetName str -> - case Util.Maybe.fromString str of - Just s -> - let - db = - model.dashboard + let + db = + model.dashboard - db_ = - { db | name = s } - in - unit { model | dashboard = db_, nameValue = Just s } - - Nothing -> - unit { model | nameValue = Nothing } + db_ = + { db | name = String.trim str } + in + unit { model | dashboard = db_, nameValue = str } ColumnsMsg lm -> let @@ -149,14 +147,18 @@ update flags msg model = in unit { model | columnsValue = value, columnsModel = cm, dashboard = db_ } - SaveDashboard -> - UpdateResult model Cmd.none Sub.none (SubmitSave model.dashboard) + GapMsg lm -> + let + ( gm, value ) = + Comp.FixedDropdown.update lm model.gapModel - Cancel -> - UpdateResult model Cmd.none Sub.none SubmitCancel + db = + model.dashboard - RequestDelete -> - UpdateResult model Cmd.none Sub.none (SubmitDelete model.originalName) + db_ = + { db | gap = Maybe.withDefault db.gap value } + in + unit { model | gapModel = gm, gapValue = value, dashboard = db_ } ToggleNewBoxMenu -> unit { model | newBoxMenuOpen = not model.newBoxMenuOpen } @@ -186,7 +188,6 @@ update flags msg model = { model = { model | boxModels = newBoxes, dashboard = db_, newBoxMenuOpen = False } , cmd = Cmd.map (BoxMsg index) bc , sub = Sub.map (BoxMsg index) bs - , action = SubmitNone } DragDropMsg lm -> @@ -207,10 +208,16 @@ update flags msg model = in unit nextModel + SetScope s -> + unit { model | scope = s } + + ToggleDefault -> + unit { model | defaultDashboard = not model.defaultDashboard } + unit : Model -> UpdateResult unit model = - UpdateResult model Cmd.none Sub.none SubmitNone + UpdateResult model Cmd.none Sub.none applyBoxAction : @@ -365,34 +372,18 @@ viewMain texts _ _ model = } in div [ class "my-2 " ] - [ MB.view - { start = - [ MB.PrimaryButton - { tagger = SaveDashboard - , title = texts.basics.submitThisForm - , icon = Just "fa fa-save" - , label = texts.basics.submit - } - , MB.SecondaryButton - { tagger = Cancel - , title = texts.basics.cancel - , icon = Just "fa fa-times" - , label = texts.basics.cancel - } - ] - , end = [] - , rootClasses = "" - } - , div [ class "flex flex-col" ] + [ div [ class "flex flex-col" ] [ div [ class "mt-2" ] [ label [ class S.inputLabel ] [ text texts.basics.name + , B.inputRequired ] , input [ type_ "text" , placeholder texts.namePlaceholder , class S.textInput - , value (Maybe.withDefault "" model.nameValue) + , classList [ ( S.inputErrorBorder, String.trim model.nameValue == "" ) ] + , value model.nameValue , onInput SetName ] [] @@ -401,13 +392,58 @@ viewMain texts _ _ model = [ label [ class S.inputLabel ] [ text texts.columns ] + , Html.map ColumnsMsg + (Comp.FixedDropdown.viewStyled2 columnsSettings + False + model.columnsValue + model.columnsModel + ) + ] + , div [ class "mt-2" ] + [ label [ class S.inputLabel ] + [ text texts.gap + ] + , Html.map GapMsg + (Comp.FixedDropdown.viewStyled2 columnsSettings + False + model.gapValue + model.gapModel + ) + ] + , div [ class "mt-2" ] + [ div [ class "flex flex-row space-x-4" ] + [ label [ class "inline-flex items-center" ] + [ input + [ type_ "radio" + , checked (Data.AccountScope.isUser model.scope) + , onCheck (\_ -> SetScope Data.AccountScope.User) + , class S.radioInput + ] + [] + , span [ class "ml-2" ] [ text <| texts.accountScope Data.AccountScope.User ] + ] + , label [ class "inline-flex items-center" ] + [ input + [ type_ "radio" + , checked (Data.AccountScope.isCollective model.scope) + , onCheck (\_ -> SetScope Data.AccountScope.Collective) + , class S.radioInput + ] + [] + , span [ class "ml-2" ] + [ text <| texts.accountScope Data.AccountScope.Collective ] + ] + ] + ] + , div [ class "mt-2" ] + [ MB.viewItem <| + MB.Checkbox + { tagger = \_ -> ToggleDefault + , label = texts.defaultDashboard + , id = "" + , value = model.defaultDashboard + } ] - , Html.map ColumnsMsg - (Comp.FixedDropdown.viewStyled2 columnsSettings - False - model.columnsValue - model.columnsModel - ) ] ] diff --git a/modules/webapp/src/main/elm/Comp/DashboardManage.elm b/modules/webapp/src/main/elm/Comp/DashboardManage.elm new file mode 100644 index 00000000..111cb63d --- /dev/null +++ b/modules/webapp/src/main/elm/Comp/DashboardManage.elm @@ -0,0 +1,312 @@ +module Comp.DashboardManage exposing (Model, Msg, SubmitAction(..), UpdateResult, init, update, view) + +import Api +import Api.Model.BasicResult exposing (BasicResult) +import Comp.Basic as B +import Comp.DashboardEdit +import Comp.MenuBar as MB +import Data.AccountScope exposing (AccountScope) +import Data.Dashboard exposing (Dashboard) +import Data.Flags exposing (Flags) +import Data.UiSettings exposing (UiSettings) +import Html exposing (Html, div, i, text) +import Html.Attributes exposing (class, classList) +import Http +import Messages.Comp.DashboardManage exposing (Texts) +import Styles as S + + +type alias Model = + { edit : Comp.DashboardEdit.Model + , initData : InitData + , deleteRequested : Bool + , formError : Maybe FormError + } + + +type Msg + = SaveDashboard + | Cancel + | DeleteDashboard + | SetRequestDelete Bool + | EditMsg Comp.DashboardEdit.Msg + | DeleteResp (Result Http.Error BasicResult) + | SaveResp String (Result Http.Error BasicResult) + | CreateNew + | CopyCurrent + + +type FormError + = FormInvalid String + | FormHttpError Http.Error + | FormNameEmpty + | FormNameExists + + +type alias InitData = + { flags : Flags + , dashboard : Dashboard + , scope : AccountScope + , isDefault : Bool + } + + +init : InitData -> ( Model, Cmd Msg, Sub Msg ) +init data = + let + ( em, ec, es ) = + Comp.DashboardEdit.init data.flags data.dashboard data.scope data.isDefault + + model = + { edit = em + , initData = data + , deleteRequested = False + , formError = Nothing + } + in + ( model, Cmd.map EditMsg ec, Sub.map EditMsg es ) + + + +--- Update + + +type SubmitAction + = SubmitNone + | SubmitCancel String + | SubmitSaved String + | SubmitDeleted + + +type alias UpdateResult = + { model : Model + , cmd : Cmd Msg + , sub : Sub Msg + , action : SubmitAction + } + + +update : Flags -> (String -> Bool) -> Msg -> Model -> UpdateResult +update flags nameExists msg model = + case msg of + EditMsg lm -> + let + result = + Comp.DashboardEdit.update flags lm model.edit + in + { model = { model | edit = result.model } + , cmd = Cmd.map EditMsg result.cmd + , sub = Sub.map EditMsg result.sub + , action = SubmitNone + } + + CreateNew -> + let + initData = + { flags = flags + , dashboard = Data.Dashboard.empty + , scope = Data.AccountScope.User + , isDefault = False + } + + ( m, c, s ) = + init initData + in + UpdateResult m c s SubmitNone + + CopyCurrent -> + let + ( current, scope, isDefault ) = + Comp.DashboardEdit.getBoard model.edit + + initData = + { flags = flags + , dashboard = { current | name = "" } + , scope = scope + , isDefault = isDefault + } + + ( m, c, s ) = + init initData + in + UpdateResult m c s SubmitNone + + SetRequestDelete flag -> + unit { model | deleteRequested = flag } + + SaveDashboard -> + let + ( tosave, scope, isDefault ) = + Comp.DashboardEdit.getBoard model.edit + + saveCmd = + Api.replaceDashboard flags + model.initData.dashboard.name + tosave + scope + isDefault + (SaveResp tosave.name) + in + if tosave.name == "" then + unit { model | formError = Just FormNameEmpty } + + else if tosave.name /= model.initData.dashboard.name && nameExists tosave.name then + unit { model | formError = Just FormNameExists } + + else + UpdateResult model saveCmd Sub.none SubmitNone + + Cancel -> + unitAction model (SubmitCancel model.initData.dashboard.name) + + DeleteDashboard -> + let + deleteCmd = + Api.deleteDashboard flags model.initData.dashboard.name model.initData.scope DeleteResp + in + UpdateResult model deleteCmd Sub.none SubmitNone + + SaveResp name (Ok result) -> + if result.success then + unitAction model (SubmitSaved name) + + else + unit { model | formError = Just (FormInvalid result.message) } + + SaveResp _ (Err err) -> + unit { model | formError = Just (FormHttpError err) } + + DeleteResp (Ok result) -> + if result.success then + unitAction model SubmitDeleted + + else + unit { model | formError = Just (FormInvalid result.message) } + + DeleteResp (Err err) -> + unit { model | formError = Just (FormHttpError err) } + + +unit : Model -> UpdateResult +unit model = + UpdateResult model Cmd.none Sub.none SubmitNone + + +unitAction : Model -> SubmitAction -> UpdateResult +unitAction model action = + UpdateResult model Cmd.none Sub.none action + + + +--- View + + +type alias ViewSettings = + { showDeleteButton : Bool + , showCopyButton : Bool + } + + +view : Texts -> Flags -> ViewSettings -> UiSettings -> Model -> Html Msg +view texts flags cfg settings model = + div [] + [ B.contentDimmer model.deleteRequested + (div [ class "flex flex-col" ] + [ div [ class "text-xl" ] + [ i [ class "fa fa-info-circle mr-2" ] [] + , text texts.reallyDeleteDashboard + ] + , div [ class "mt-4 flex flex-row items-center space-x-2" ] + [ MB.viewItem <| + MB.DeleteButton + { tagger = DeleteDashboard + , title = "" + , label = texts.basics.yes + , icon = Just "fa fa-check" + } + , MB.viewItem <| + MB.SecondaryButton + { tagger = SetRequestDelete False + , title = "" + , label = texts.basics.no + , icon = Just "fa fa-times" + } + ] + ] + ) + , MB.view + { start = + [ MB.PrimaryButton + { tagger = SaveDashboard + , title = texts.basics.submitThisForm + , icon = Just "fa fa-save" + , label = texts.basics.submit + } + , MB.SecondaryButton + { tagger = Cancel + , title = texts.basics.cancel + , icon = Just "fa fa-times" + , label = texts.basics.cancel + } + ] + , end = + [ MB.BasicButton + { tagger = CreateNew + , title = texts.createDashboard + , icon = Just "fa fa-plus" + , label = texts.createDashboard + } + , MB.CustomButton + { tagger = CopyCurrent + , title = texts.copyDashboard + , icon = Just "fa fa-copy" + , label = texts.copyDashboard + , inputClass = + [ ( S.secondaryBasicButton, True ) + , ( "hidden", not cfg.showCopyButton ) + ] + } + , MB.CustomButton + { tagger = SetRequestDelete True + , title = texts.basics.delete + , icon = Just "fa fa-times" + , label = texts.basics.delete + , inputClass = + [ ( S.deleteButton, True ) + , ( "hidden", not cfg.showDeleteButton ) + ] + } + ] + , rootClasses = "" + } + , div + [ class S.errorMessage + , class "mt-2" + , classList [ ( "hidden", model.formError == Nothing ) ] + ] + [ errorMessage texts model + ] + , div [] + [ Html.map EditMsg + (Comp.DashboardEdit.view texts.dashboardEdit flags settings model.edit) + ] + ] + + +errorMessage : Texts -> Model -> Html Msg +errorMessage texts model = + case model.formError of + Just (FormInvalid errMsg) -> + text errMsg + + Just (FormHttpError err) -> + text (texts.httpError err) + + Just FormNameEmpty -> + text texts.nameEmpty + + Just FormNameExists -> + text texts.nameExists + + Nothing -> + text "" diff --git a/modules/webapp/src/main/elm/Comp/DashboardView.elm b/modules/webapp/src/main/elm/Comp/DashboardView.elm index 0cf20b72..e80f0301 100644 --- a/modules/webapp/src/main/elm/Comp/DashboardView.elm +++ b/modules/webapp/src/main/elm/Comp/DashboardView.elm @@ -103,24 +103,28 @@ viewBox texts flags settings index box = --- Helpers +{-| note due to tailwinds purging css that is not found in source +files, need to spell them out somewhere - which is done it keep.txt in +this case. +-} gridStyle : Dashboard -> String gridStyle db = let + cappedGap = + min db.gap 12 + + cappedCol = + min db.columns 12 + + gapStyle = + " gap-" ++ String.fromInt cappedGap ++ " " + colStyle = case db.columns of 1 -> "" - 2 -> - "md:grid-cols-2" - - 3 -> - "md:grid-cols-3" - - 4 -> - "md:grid-cols-4" - _ -> - "md:grid-cols-5" + " md:grid-cols-" ++ String.fromInt cappedCol ++ " " in - "grid gap-4 grid-cols-1 " ++ colStyle + "grid grid-cols-1 " ++ gapStyle ++ colStyle diff --git a/modules/webapp/src/main/elm/Data/AccountScope.elm b/modules/webapp/src/main/elm/Data/AccountScope.elm new file mode 100644 index 00000000..60476f11 --- /dev/null +++ b/modules/webapp/src/main/elm/Data/AccountScope.elm @@ -0,0 +1,26 @@ +module Data.AccountScope exposing (..) + + +type AccountScope + = User + | Collective + + +fold : a -> a -> AccountScope -> a +fold user coll scope = + case scope of + User -> + user + + Collective -> + coll + + +isUser : AccountScope -> Bool +isUser scope = + fold True False scope + + +isCollective : AccountScope -> Bool +isCollective scope = + fold False True scope diff --git a/modules/webapp/src/main/elm/Data/Box.elm b/modules/webapp/src/main/elm/Data/Box.elm index 16629034..32308347 100644 --- a/modules/webapp/src/main/elm/Data/Box.elm +++ b/modules/webapp/src/main/elm/Data/Box.elm @@ -1,6 +1,8 @@ -module Data.Box exposing (Box, boxIcon, empty, messageBox, queryBox, statsBox, uploadBox) +module Data.Box exposing (Box, boxIcon, decoder, empty, encode, messageBox, queryBox, statsBox, uploadBox) import Data.BoxContent exposing (BoxContent(..)) +import Json.Decode as D +import Json.Encode as E type alias Box = @@ -45,3 +47,28 @@ messageBox = uploadBox : Box uploadBox = empty (BoxUpload Data.BoxContent.emptyUploadData) + + + +--- JSON + + +decoder : D.Decoder Box +decoder = + D.map5 Box + (D.field "name" D.string) + (D.field "visible" D.bool) + (D.field "decoration" D.bool) + (D.field "colspan" D.int) + (D.field "content" Data.BoxContent.boxContentDecoder) + + +encode : Box -> E.Value +encode box = + E.object + [ ( "name", E.string box.name ) + , ( "visible", E.bool box.visible ) + , ( "decoration", E.bool box.decoration ) + , ( "colspan", E.int box.colspan ) + , ( "content", Data.BoxContent.boxContentEncode box.content ) + ] diff --git a/modules/webapp/src/main/elm/Data/BoxContent.elm b/modules/webapp/src/main/elm/Data/BoxContent.elm index a898d4a8..c638d185 100644 --- a/modules/webapp/src/main/elm/Data/BoxContent.elm +++ b/modules/webapp/src/main/elm/Data/BoxContent.elm @@ -6,6 +6,8 @@ module Data.BoxContent exposing , StatsData , SummaryShow(..) , UploadData + , boxContentDecoder + , boxContentEncode , boxContentIcon , emptyMessageData , emptyQueryData @@ -14,6 +16,9 @@ module Data.BoxContent exposing ) import Data.ItemColumn exposing (ItemColumn) +import Html exposing (datalist) +import Json.Decode as D +import Json.Encode as E type BoxContent @@ -89,6 +94,28 @@ type SearchQuery | SearchQueryBookmark String +searchQueryAsString : SearchQuery -> String +searchQueryAsString q = + case q of + SearchQueryBookmark id -> + "bookmark:" ++ id + + SearchQueryString str -> + "query:" ++ str + + +searchQueryFromString : String -> Maybe SearchQuery +searchQueryFromString str = + if String.startsWith "bookmark:" str then + Just (SearchQueryBookmark <| String.dropLeft 9 str) + + else if String.startsWith "query:" str then + Just (SearchQueryString <| String.dropLeft 6 str) + + else + Nothing + + boxContentIcon : BoxContent -> String boxContentIcon content = case content of @@ -103,3 +130,183 @@ boxContentIcon content = BoxStats _ -> "fa fa-chart-bar font-thin" + + + +--- JSON + + +boxContentDecoder : D.Decoder BoxContent +boxContentDecoder = + let + from discr = + case String.toLower discr of + "message" -> + D.field "data" <| + D.map BoxMessage messageDataDecoder + + "upload" -> + D.field "data" <| + D.map BoxUpload uploadDataDecoder + + "query" -> + D.field "data" <| + D.map BoxQuery queryDataDecoder + + "stats" -> + D.field "data" <| + D.map BoxStats statsDataDecoder + + _ -> + D.fail ("Unknown box content: " ++ discr) + in + D.andThen from (D.field discriminator D.string) + + +boxContentEncode : BoxContent -> E.Value +boxContentEncode cnt = + case cnt of + BoxMessage data -> + E.object + [ ( discriminator, E.string "message" ) + , ( "data", messageDataEncode data ) + ] + + BoxUpload data -> + E.object + [ ( discriminator, E.string "upload" ) + , ( "data", uploadDataEncode data ) + ] + + BoxQuery data -> + E.object + [ ( discriminator, E.string "query" ) + , ( "data", queryDataEncode data ) + ] + + BoxStats data -> + E.object + [ ( discriminator, E.string "stats" ) + , ( "data", statsDataEncode data ) + ] + + +messageDataDecoder : D.Decoder MessageData +messageDataDecoder = + D.map2 MessageData + (D.field "title" D.string) + (D.field "body" D.string) + + +messageDataEncode : MessageData -> E.Value +messageDataEncode data = + E.object + [ ( "title", E.string data.title ) + , ( "body", E.string data.body ) + ] + + +uploadDataDecoder : D.Decoder UploadData +uploadDataDecoder = + D.map UploadData + (D.maybe (D.field "sourceId" D.string)) + + +uploadDataEncode : UploadData -> E.Value +uploadDataEncode data = + E.object + [ ( "sourceId", Maybe.map E.string data.sourceId |> Maybe.withDefault E.null ) + ] + + +queryDataDecoder : D.Decoder QueryData +queryDataDecoder = + D.map5 QueryData + (D.field "query" searchQueryDecoder) + (D.field "limit" D.int) + (D.field "details" D.bool) + (D.field "columns" <| D.list Data.ItemColumn.decode) + (D.field "showHeaders" D.bool) + + +queryDataEncode : QueryData -> E.Value +queryDataEncode data = + E.object + [ ( "query", searchQueryEncode data.query ) + , ( "limit", E.int data.limit ) + , ( "details", E.bool data.details ) + , ( "columns", E.list Data.ItemColumn.encode data.columns ) + , ( "showHeaders", E.bool data.showHeaders ) + ] + + +statsDataDecoder : D.Decoder StatsData +statsDataDecoder = + D.map2 StatsData + (D.field "query" searchQueryDecoder) + (D.field "show" summaryShowDecoder) + + +statsDataEncode : StatsData -> E.Value +statsDataEncode data = + E.object + [ ( "query", searchQueryEncode data.query ) + , ( "show", summaryShowEncode data.show ) + ] + + +searchQueryDecoder : D.Decoder SearchQuery +searchQueryDecoder = + let + fromString str = + case searchQueryFromString str of + Just q -> + D.succeed q + + Nothing -> + D.fail ("Invalid search query: " ++ str) + in + D.andThen fromString D.string + + +searchQueryEncode : SearchQuery -> E.Value +searchQueryEncode q = + E.string (searchQueryAsString q) + + +summaryShowDecoder : D.Decoder SummaryShow +summaryShowDecoder = + let + decode discr = + case String.toLower discr of + "fields" -> + D.field "showItemCount" D.bool + |> D.map SummaryShowFields + + "general" -> + D.succeed SummaryShowGeneral + + _ -> + D.fail ("Unknown summary show for: " ++ discr) + in + D.andThen decode (D.field discriminator D.string) + + +summaryShowEncode : SummaryShow -> E.Value +summaryShowEncode show = + case show of + SummaryShowFields flag -> + E.object + [ ( discriminator, E.string "fields" ) + , ( "showItemCount", E.bool flag ) + ] + + SummaryShowGeneral -> + E.object + [ ( "discriminator", E.string "general" ) + ] + + +discriminator : String +discriminator = + "discriminator" diff --git a/modules/webapp/src/main/elm/Data/Dashboard.elm b/modules/webapp/src/main/elm/Data/Dashboard.elm index 9aae25d6..e342f9a0 100644 --- a/modules/webapp/src/main/elm/Data/Dashboard.elm +++ b/modules/webapp/src/main/elm/Data/Dashboard.elm @@ -1,10 +1,50 @@ -module Data.Dashboard exposing (Dashboard) +module Data.Dashboard exposing (Dashboard, decoder, empty, encode, isEmpty) import Data.Box exposing (Box) +import Json.Decode as D +import Json.Encode as E type alias Dashboard = { name : String , columns : Int + , gap : Int , boxes : List Box } + + +empty : Dashboard +empty = + { name = "" + , columns = 1 + , gap = 2 + , boxes = [] + } + + +isEmpty : Dashboard -> Bool +isEmpty board = + List.isEmpty board.boxes + + + +--- JSON + + +encode : Dashboard -> E.Value +encode b = + E.object + [ ( "name", E.string b.name ) + , ( "columns", E.int b.columns ) + , ( "gap", E.int b.gap ) + , ( "boxes", E.list Data.Box.encode b.boxes ) + ] + + +decoder : D.Decoder Dashboard +decoder = + D.map4 Dashboard + (D.field "name" D.string) + (D.field "columns" D.int) + (D.field "gap" D.int) + (D.field "boxes" <| D.list Data.Box.decoder) diff --git a/modules/webapp/src/main/elm/Data/Dashboards.elm b/modules/webapp/src/main/elm/Data/Dashboards.elm new file mode 100644 index 00000000..3cea9480 --- /dev/null +++ b/modules/webapp/src/main/elm/Data/Dashboards.elm @@ -0,0 +1,289 @@ +module Data.Dashboards exposing + ( AllDashboards + , Dashboards + , countAll + , decoder + , empty + , emptyAll + , encode + , exists + , existsAll + , find + , findInAll + , foldl + , getAllDefault + , getDefault + , getScope + , insert + , insertIn + , isDefaultAll + , isEmpty + , isEmptyAll + , map + , remove + , removeFromAll + , selectBoards + , setDefaultAll + , singleton + , singletonAll + , unsetDefaultAll + ) + +import Data.AccountScope exposing (AccountScope) +import Data.Dashboard exposing (Dashboard) +import Dict exposing (Dict) +import Json.Decode as D +import Json.Encode as E +import Util.Maybe + + +type Dashboards + = Dashboards Info + + +empty : Dashboards +empty = + Dashboards { default = "", boards = Dict.empty } + + +isEmpty : Dashboards -> Bool +isEmpty (Dashboards info) = + Dict.isEmpty info.boards + + +insert : Dashboard -> Dashboards -> Dashboards +insert board (Dashboards info) = + let + nb = + Dict.insert (String.toLower board.name) board info.boards + in + Dashboards { info | boards = nb } + + +singleton : Dashboard -> Dashboards +singleton board = + insert board empty + + +remove : String -> Dashboards -> Dashboards +remove name (Dashboards info) = + let + nb = + Dict.remove (String.toLower name) info.boards + in + Dashboards { info | boards = nb } + + +map : (Dashboard -> a) -> Dashboards -> List a +map f (Dashboards info) = + List.map f (Dict.values info.boards) + + +find : String -> Dashboards -> Maybe Dashboard +find name (Dashboards info) = + Dict.get (String.toLower name) info.boards + + +foldl : (Dashboard -> a -> a) -> a -> Dashboards -> a +foldl f init (Dashboards info) = + List.foldl f init (Dict.values info.boards) + + +exists : String -> Dashboards -> Bool +exists name (Dashboards info) = + Dict.member (String.toLower name) info.boards + + +getDefault : Dashboards -> Maybe Dashboard +getDefault (Dashboards info) = + Dict.get (String.toLower info.default) info.boards + + +isDefault : String -> Dashboards -> Bool +isDefault name (Dashboards info) = + String.toLower name == String.toLower info.default + + +setDefault : String -> Dashboards -> Dashboards +setDefault name (Dashboards info) = + Dashboards { info | default = String.toLower name } + + +unsetDefault : String -> Dashboards -> Dashboards +unsetDefault name dbs = + if isDefault name dbs then + setDefault "" dbs + + else + dbs + + +getFirst : Dashboards -> Maybe Dashboard +getFirst (Dashboards info) = + List.head (Dict.values info.boards) + + + +--- AllDashboards + + +type alias AllDashboards = + { collective : Dashboards + , user : Dashboards + } + + +emptyAll : AllDashboards +emptyAll = + AllDashboards empty empty + + +isEmptyAll : AllDashboards -> Bool +isEmptyAll all = + isEmpty all.collective && isEmpty all.user + + +insertIn : AccountScope -> Dashboard -> AllDashboards -> AllDashboards +insertIn scope board all = + Data.AccountScope.fold + { user = insert board all.user + , collective = all.collective + } + { user = all.user + , collective = insert board all.collective + } + scope + + +selectBoards : AccountScope -> AllDashboards -> Dashboards +selectBoards scope all = + Data.AccountScope.fold all.user all.collective scope + + +getAllDefault : AllDashboards -> Maybe Dashboard +getAllDefault boards = + Util.Maybe.or + [ getDefault boards.user + , getDefault boards.collective + , getFirst boards.user + , getFirst boards.collective + ] + + +existsAll : String -> AllDashboards -> Bool +existsAll name boards = + exists name boards.collective || exists name boards.user + + +singletonAll : Dashboard -> AllDashboards +singletonAll board = + AllDashboards empty (singleton board) + + +isDefaultAll : String -> AllDashboards -> Bool +isDefaultAll name all = + isDefault name all.user || isDefault name all.collective + + +findInAll : String -> AllDashboards -> Maybe Dashboard +findInAll name all = + Util.Maybe.or + [ find name all.user + , find name all.collective + ] + + +removeFromAll : String -> AllDashboards -> AllDashboards +removeFromAll name all = + { user = remove name all.user + , collective = remove name all.collective + } + + +setDefaultAll : String -> AllDashboards -> AllDashboards +setDefaultAll name all = + if isDefaultAll name all then + all + + else + { user = setDefault name all.user + , collective = setDefault name all.collective + } + + +unsetDefaultAll : String -> AllDashboards -> AllDashboards +unsetDefaultAll name all = + if isDefaultAll name all then + { user = unsetDefault name all.user + , collective = unsetDefault name all.collective + } + + else + all + + +getScope : String -> AllDashboards -> Maybe AccountScope +getScope name all = + if exists name all.user then + Just Data.AccountScope.User + + else if exists name all.collective then + Just Data.AccountScope.Collective + + else + Nothing + + +countAll : AllDashboards -> Int +countAll all = + List.sum + [ foldl (\_ -> \n -> n + 1) 0 all.user + , foldl (\_ -> \n -> n + 1) 0 all.collective + ] + + + +--- Helper + + +type alias Info = + { boards : Dict String Dashboard + , default : String + } + + + +--- JSON + + +decoder : D.Decoder Dashboards +decoder = + D.oneOf + [ D.map Dashboards infoDecoder + , emptyObjectDecoder + ] + + +encode : Dashboards -> E.Value +encode (Dashboards info) = + infoEncode info + + +infoDecoder : D.Decoder Info +infoDecoder = + D.map2 Info + (D.field "boards" <| D.dict Data.Dashboard.decoder) + (D.field "default" D.string) + + +emptyObjectDecoder : D.Decoder Dashboards +emptyObjectDecoder = + D.dict (D.fail "non-empty") |> D.map (\_ -> empty) + + +infoEncode : Info -> E.Value +infoEncode info = + E.object + [ ( "boards", E.dict identity Data.Dashboard.encode info.boards ) + , ( "default", E.string info.default ) + ] diff --git a/modules/webapp/src/main/elm/Data/ItemColumn.elm b/modules/webapp/src/main/elm/Data/ItemColumn.elm index 15c5a288..93877861 100644 --- a/modules/webapp/src/main/elm/Data/ItemColumn.elm +++ b/modules/webapp/src/main/elm/Data/ItemColumn.elm @@ -2,6 +2,8 @@ module Data.ItemColumn exposing (..) import Api.Model.ItemLight exposing (ItemLight) import Data.ItemTemplate as IT exposing (TemplateContext) +import Json.Decode as D +import Json.Encode as E type ItemColumn @@ -75,7 +77,7 @@ asString col = "folder" Correspondent -> - "correspodnent" + "correspondent" Concerning -> "concerning" @@ -105,7 +107,7 @@ fromString str = "folder" -> Just Folder - "correspodnent" -> + "correspondent" -> Just Correspondent "concerning" -> @@ -116,3 +118,22 @@ fromString str = _ -> Nothing + + +encode : ItemColumn -> E.Value +encode col = + asString col |> E.string + + +decode : D.Decoder ItemColumn +decode = + let + from str = + case fromString str of + Just col -> + D.succeed col + + Nothing -> + D.fail ("Invalid column: " ++ str) + in + D.andThen from D.string diff --git a/modules/webapp/src/main/elm/Messages/Comp/BookmarkChooser.elm b/modules/webapp/src/main/elm/Messages/Comp/BookmarkChooser.elm index a878a8e0..ff5c2efe 100644 --- a/modules/webapp/src/main/elm/Messages/Comp/BookmarkChooser.elm +++ b/modules/webapp/src/main/elm/Messages/Comp/BookmarkChooser.elm @@ -11,7 +11,9 @@ module Messages.Comp.BookmarkChooser exposing , gb ) +import Data.AccountScope exposing (AccountScope(..)) import Messages.Basics +import Messages.Data.AccountScope type alias Texts = @@ -25,8 +27,8 @@ type alias Texts = gb : Texts gb = { basics = Messages.Basics.gb - , userLabel = "Personal" - , collectiveLabel = "Collective" + , userLabel = Messages.Data.AccountScope.gb User + , collectiveLabel = Messages.Data.AccountScope.gb Collective , shareLabel = "Shares" } @@ -34,7 +36,7 @@ gb = de : Texts de = { basics = Messages.Basics.de - , userLabel = "Persönlich" - , collectiveLabel = "Kollektiv" + , userLabel = Messages.Data.AccountScope.de User + , collectiveLabel = Messages.Data.AccountScope.de Collective , shareLabel = "Freigaben" } diff --git a/modules/webapp/src/main/elm/Messages/Comp/DashboardEdit.elm b/modules/webapp/src/main/elm/Messages/Comp/DashboardEdit.elm index 70d2e468..bf2a4559 100644 --- a/modules/webapp/src/main/elm/Messages/Comp/DashboardEdit.elm +++ b/modules/webapp/src/main/elm/Messages/Comp/DashboardEdit.elm @@ -2,6 +2,7 @@ module Messages.Comp.DashboardEdit exposing (Texts, de, gb) import Messages.Basics import Messages.Comp.BoxEdit +import Messages.Data.AccountScope import Messages.Data.BoxContent @@ -9,10 +10,13 @@ type alias Texts = { boxView : Messages.Comp.BoxEdit.Texts , boxContent : Messages.Data.BoxContent.Texts , basics : Messages.Basics.Texts + , accountScope : Messages.Data.AccountScope.Texts , namePlaceholder : String , columns : String , dashboardBoxes : String , newBox : String + , defaultDashboard : String + , gap : String } @@ -21,10 +25,13 @@ gb = { boxView = Messages.Comp.BoxEdit.gb , boxContent = Messages.Data.BoxContent.gb , basics = Messages.Basics.gb + , accountScope = Messages.Data.AccountScope.gb , namePlaceholder = "Dashboard name" , columns = "Columns" , dashboardBoxes = "Dashboard Boxes" , newBox = "New box" + , defaultDashboard = "Default Dashboard" + , gap = "Gap" } @@ -33,8 +40,11 @@ de = { boxView = Messages.Comp.BoxEdit.de , boxContent = Messages.Data.BoxContent.de , basics = Messages.Basics.de + , accountScope = Messages.Data.AccountScope.de , namePlaceholder = "Dashboardname" , columns = "Spalten" , dashboardBoxes = "Dashboard Kacheln" , newBox = "Neue Kachel" + , defaultDashboard = "Standard Dashboard" + , gap = "Abstand" } diff --git a/modules/webapp/src/main/elm/Messages/Comp/DashboardManage.elm b/modules/webapp/src/main/elm/Messages/Comp/DashboardManage.elm new file mode 100644 index 00000000..80ecc756 --- /dev/null +++ b/modules/webapp/src/main/elm/Messages/Comp/DashboardManage.elm @@ -0,0 +1,44 @@ +module Messages.Comp.DashboardManage exposing (Texts, de, gb) + +import Http +import Messages.Basics +import Messages.Comp.DashboardEdit +import Messages.Comp.HttpError + + +type alias Texts = + { basics : Messages.Basics.Texts + , dashboardEdit : Messages.Comp.DashboardEdit.Texts + , httpError : Http.Error -> String + , reallyDeleteDashboard : String + , nameEmpty : String + , nameExists : String + , createDashboard : String + , copyDashboard : String + } + + +gb : Texts +gb = + { basics = Messages.Basics.gb + , dashboardEdit = Messages.Comp.DashboardEdit.gb + , httpError = Messages.Comp.HttpError.gb + , reallyDeleteDashboard = "Really delete this dashboard?" + , nameEmpty = "The name must not be empty." + , nameExists = "The name is already in use." + , createDashboard = "New" + , copyDashboard = "Copy" + } + + +de : Texts +de = + { basics = Messages.Basics.de + , dashboardEdit = Messages.Comp.DashboardEdit.de + , httpError = Messages.Comp.HttpError.de + , reallyDeleteDashboard = "Das Dashboard wirklich entfernen?" + , nameEmpty = "Ein Name muss angegeben werden." + , nameExists = "Der Name wird bereits verwendet." + , createDashboard = "Neu" + , copyDashboard = "Kopie" + } diff --git a/modules/webapp/src/main/elm/Messages/Data/AccountScope.elm b/modules/webapp/src/main/elm/Messages/Data/AccountScope.elm new file mode 100644 index 00000000..022a3723 --- /dev/null +++ b/modules/webapp/src/main/elm/Messages/Data/AccountScope.elm @@ -0,0 +1,17 @@ +module Messages.Data.AccountScope exposing (Texts, de, gb) + +import Data.AccountScope exposing (AccountScope) + + +type alias Texts = + AccountScope -> String + + +gb : Texts +gb = + Data.AccountScope.fold "Personal" "Collective" + + +de : Texts +de = + Data.AccountScope.fold "Persönlich" "Kollektiv" diff --git a/modules/webapp/src/main/elm/Messages/Page/Dashboard.elm b/modules/webapp/src/main/elm/Messages/Page/Dashboard.elm index f8c85467..144747c5 100644 --- a/modules/webapp/src/main/elm/Messages/Page/Dashboard.elm +++ b/modules/webapp/src/main/elm/Messages/Page/Dashboard.elm @@ -2,7 +2,7 @@ module Messages.Page.Dashboard exposing (Texts, de, gb) import Messages.Basics import Messages.Comp.BookmarkChooser -import Messages.Comp.DashboardEdit +import Messages.Comp.DashboardManage import Messages.Comp.DashboardView import Messages.Comp.EquipmentManage import Messages.Comp.FolderManage @@ -14,6 +14,7 @@ import Messages.Comp.ShareManage import Messages.Comp.SourceManage import Messages.Comp.TagManage import Messages.Comp.UploadForm +import Messages.Data.AccountScope import Messages.Page.DefaultDashboard @@ -31,8 +32,9 @@ type alias Texts = , folderManage : Messages.Comp.FolderManage.Texts , uploadForm : Messages.Comp.UploadForm.Texts , dashboard : Messages.Comp.DashboardView.Texts - , dashboardEdit : Messages.Comp.DashboardEdit.Texts + , dashboardManage : Messages.Comp.DashboardManage.Texts , defaultDashboard : Messages.Page.DefaultDashboard.Texts + , accountScope : Messages.Data.AccountScope.Texts , manage : String , dashboardLink : String , bookmarks : String @@ -41,6 +43,8 @@ type alias Texts = , documentation : String , uploadFiles : String , editDashboard : String + , dashboards : String + , predefinedMessage : String } @@ -59,8 +63,9 @@ gb = , folderManage = Messages.Comp.FolderManage.gb , uploadForm = Messages.Comp.UploadForm.gb , dashboard = Messages.Comp.DashboardView.gb - , dashboardEdit = Messages.Comp.DashboardEdit.gb + , dashboardManage = Messages.Comp.DashboardManage.gb , defaultDashboard = Messages.Page.DefaultDashboard.gb + , accountScope = Messages.Data.AccountScope.gb , manage = "Manage" , dashboardLink = "Dasbhoard" , bookmarks = "Bookmarks" @@ -69,6 +74,8 @@ gb = , documentation = "Documentation" , uploadFiles = "Upload documents" , editDashboard = "Edit Dashboard" + , dashboards = "Dashboards" + , predefinedMessage = "This dashboard is predefined one that cannot be deleted." } @@ -87,8 +94,9 @@ de = , folderManage = Messages.Comp.FolderManage.de , uploadForm = Messages.Comp.UploadForm.de , dashboard = Messages.Comp.DashboardView.de - , dashboardEdit = Messages.Comp.DashboardEdit.de + , dashboardManage = Messages.Comp.DashboardManage.de , defaultDashboard = Messages.Page.DefaultDashboard.de + , accountScope = Messages.Data.AccountScope.de , manage = "Verwalten" , dashboardLink = "Dasbhoard" , bookmarks = "Bookmarks" @@ -97,4 +105,6 @@ de = , documentation = "Dokumentation" , uploadFiles = "Dokumente hochladen" , editDashboard = "Dashboard ändern" + , dashboards = "Dashboards" + , predefinedMessage = "Dieses Dashboard ist vordefiniert und kann nicht entfernt werden." } diff --git a/modules/webapp/src/main/elm/Page/Dashboard/Data.elm b/modules/webapp/src/main/elm/Page/Dashboard/Data.elm index 04a33328..c3aa9215 100644 --- a/modules/webapp/src/main/elm/Page/Dashboard/Data.elm +++ b/modules/webapp/src/main/elm/Page/Dashboard/Data.elm @@ -9,8 +9,11 @@ module Page.Dashboard.Data exposing ( Content(..) , Model , Msg(..) + , PageError(..) , SideMenuModel , init + , isDashboardDefault + , isDashboardVisible , isHomeContent , reloadDashboardData , reloadUiSettings @@ -18,7 +21,7 @@ module Page.Dashboard.Data exposing import Api import Comp.BookmarkChooser -import Comp.DashboardEdit +import Comp.DashboardManage import Comp.DashboardView import Comp.EquipmentManage import Comp.FolderManage @@ -32,7 +35,9 @@ import Comp.TagManage import Comp.UploadForm import Data.Bookmarks exposing (AllBookmarks) import Data.Dashboard exposing (Dashboard) +import Data.Dashboards exposing (AllDashboards) import Data.Flags exposing (Flags) +import Http type alias SideMenuModel = @@ -43,19 +48,59 @@ type alias SideMenuModel = type alias Model = { sideMenu : SideMenuModel , content : Content + , pageError : Maybe PageError + , dashboards : AllDashboards + , isPredefined : Bool } -init : Flags -> Dashboard -> ( Model, Cmd Msg ) -init flags db = +type Msg + = GetBookmarksResp AllBookmarks + | GetAllDashboardsResp (Maybe Msg) (Result Http.Error AllDashboards) + | BookmarkMsg Comp.BookmarkChooser.Msg + | NotificationHookMsg Comp.NotificationHookManage.Msg + | PeriodicQueryMsg Comp.PeriodicQueryTaskManage.Msg + | SourceMsg Comp.SourceManage.Msg + | ShareMsg Comp.ShareManage.Msg + | OrganizationMsg Comp.OrgManage.Msg + | PersonMsg Comp.PersonManage.Msg + | EquipmentMsg Comp.EquipmentManage.Msg + | TagMsg Comp.TagManage.Msg + | FolderMsg Comp.FolderManage.Msg + | UploadMsg Comp.UploadForm.Msg + | DashboardMsg Comp.DashboardView.Msg + | DashboardManageMsg Comp.DashboardManage.Msg + | InitNotificationHook + | InitPeriodicQuery + | InitSource + | InitShare + | InitOrganization + | InitPerson + | InitEquipment + | InitTags + | InitFolder + | InitUpload + | InitEditDashboard + | ReloadDashboardData + | HardReloadDashboard + | SetDashboard Dashboard + | SetDashboardByName String + | SetDefaultDashboard + + +init : Flags -> ( Model, Cmd Msg ) +init flags = let ( dm, dc ) = - Comp.DashboardView.init flags db + Comp.DashboardView.init flags Data.Dashboard.empty in ( { sideMenu = { bookmarkChooser = Comp.BookmarkChooser.init Data.Bookmarks.empty } , content = Home dm + , pageError = Nothing + , dashboards = Data.Dashboards.emptyAll + , isPredefined = True } , Cmd.batch [ initCmd flags @@ -71,7 +116,10 @@ initCmd flags = Result.withDefault Data.Bookmarks.empty r |> GetBookmarksResp in - Api.getBookmarks flags ignoreBookmarkError + Cmd.batch + [ Api.getBookmarks flags ignoreBookmarkError + , Api.getAllDashboards flags (GetAllDashboardsResp (Just SetDefaultDashboard)) + ] reloadDashboardData : Msg @@ -81,38 +129,11 @@ reloadDashboardData = reloadUiSettings : Msg reloadUiSettings = - ReloadDashboard + HardReloadDashboard -type Msg - = GetBookmarksResp AllBookmarks - | BookmarkMsg Comp.BookmarkChooser.Msg - | NotificationHookMsg Comp.NotificationHookManage.Msg - | PeriodicQueryMsg Comp.PeriodicQueryTaskManage.Msg - | SourceMsg Comp.SourceManage.Msg - | ShareMsg Comp.ShareManage.Msg - | OrganizationMsg Comp.OrgManage.Msg - | PersonMsg Comp.PersonManage.Msg - | EquipmentMsg Comp.EquipmentManage.Msg - | TagMsg Comp.TagManage.Msg - | FolderMsg Comp.FolderManage.Msg - | UploadMsg Comp.UploadForm.Msg - | DashboardMsg Comp.DashboardView.Msg - | DashboardEditMsg Comp.DashboardEdit.Msg - | InitNotificationHook - | InitDashboard - | InitPeriodicQuery - | InitSource - | InitShare - | InitOrganization - | InitPerson - | InitEquipment - | InitTags - | InitFolder - | InitUpload - | InitEditDashboard - | ReloadDashboardData - | ReloadDashboard + +--- Content type Content @@ -127,7 +148,7 @@ type Content | Tags Comp.TagManage.Model | Folder Comp.FolderManage.Model | Upload Comp.UploadForm.Model - | Edit Comp.DashboardEdit.Model + | Edit Comp.DashboardManage.Model isHomeContent : Content -> Bool @@ -138,3 +159,31 @@ isHomeContent cnt = _ -> False + + +isDashboardVisible : Model -> String -> Bool +isDashboardVisible model name = + case model.content of + Home m -> + m.dashboard.name == name + + Edit m -> + m.initData.dashboard.name == name + + _ -> + False + + +isDashboardDefault : Model -> String -> Bool +isDashboardDefault model name = + Data.Dashboards.isDefaultAll name model.dashboards + + + +--- Errors + + +type PageError + = PageErrorHttp Http.Error + | PageErrorNoDashboard + | PageErrorInvalid String diff --git a/modules/webapp/src/main/elm/Page/Dashboard/DefaultDashboard.elm b/modules/webapp/src/main/elm/Page/Dashboard/DefaultDashboard.elm index ca3a57d8..4d833cec 100644 --- a/modules/webapp/src/main/elm/Page/Dashboard/DefaultDashboard.elm +++ b/modules/webapp/src/main/elm/Page/Dashboard/DefaultDashboard.elm @@ -15,6 +15,7 @@ value : Texts -> Dashboard value texts = { name = texts.default , columns = 2 + , gap = 2 , boxes = [ messageBox texts , fieldStats diff --git a/modules/webapp/src/main/elm/Page/Dashboard/SideMenu.elm b/modules/webapp/src/main/elm/Page/Dashboard/SideMenu.elm index 2105e8b6..238212a0 100644 --- a/modules/webapp/src/main/elm/Page/Dashboard/SideMenu.elm +++ b/modules/webapp/src/main/elm/Page/Dashboard/SideMenu.elm @@ -2,15 +2,17 @@ module Page.Dashboard.SideMenu exposing (view) import Api.Model.VersionInfo exposing (VersionInfo) import Comp.BookmarkChooser -import Data.Flags exposing (Flags) +import Data.AccountScope +import Data.Dashboard exposing (Dashboard) +import Data.Dashboards import Data.Icons as Icons import Data.UiSettings exposing (UiSettings) -import Html exposing (Attribute, Html, a, div, h3, span, text) -import Html.Attributes exposing (class, classList, href, target) +import Html exposing (Attribute, Html, a, div, h3, i, span, text) +import Html.Attributes exposing (class, classList, href, target, title) import Html.Events exposing (onClick) import Messages.Page.Dashboard exposing (Texts) import Page exposing (Page(..)) -import Page.Dashboard.Data exposing (Model, Msg(..), isHomeContent) +import Page.Dashboard.Data exposing (Model, Msg(..), isDashboardDefault, isDashboardVisible, isHomeContent) import Styles as S @@ -18,8 +20,9 @@ view : Texts -> VersionInfo -> UiSettings -> Model -> Html Msg view texts versionInfo _ model = div [ class "flex flex-col flex-grow" ] [ div [ class "mt-2" ] - [ menuLink [ onClick InitDashboard, href "#" ] (Icons.dashboardIcon "") texts.dashboardLink + [ menuLink [ onClick SetDefaultDashboard, href "#" ] (Icons.dashboardIcon "") texts.dashboardLink , menuLink [ Page.href (SearchPage Nothing) ] (Icons.searchIcon "") texts.basics.items + , menuLink [ onClick InitUpload, href "#" ] (Icons.fileUploadIcon "") texts.uploadFiles ] , h3 [ class S.header3 @@ -61,6 +64,28 @@ view texts versionInfo _ model = , menuLink [ onClick InitTags, href "#" ] (Icons.tagsIcon "") texts.basics.tags , menuLink [ onClick InitFolder, href "#" ] (Icons.folderIcon "") texts.basics.folder ] + , h3 + [ class S.header3 + , class "italic mt-3" + , classList [ ( "hidden", Data.Dashboards.countAll model.dashboards <= 1 ) ] + ] + [ text texts.dashboards + ] + , div + [ class "ml-2" + , classList [ ( "hidden", Data.Dashboards.countAll model.dashboards <= 1 ) ] + ] + [ titleDiv <| texts.accountScope Data.AccountScope.User + , div + [ classList [ ( "hidden", Data.Dashboards.isEmpty model.dashboards.user ) ] + ] + (Data.Dashboards.map (dashboardLink texts model) model.dashboards.user) + , titleDiv <| texts.accountScope Data.AccountScope.Collective + , div + [ classList [ ( "hidden", Data.Dashboards.isEmpty model.dashboards.collective ) ] + ] + (Data.Dashboards.map (dashboardLink texts model) model.dashboards.collective) + ] , h3 [ class S.header3 , class "italic mt-3" @@ -68,17 +93,18 @@ view texts versionInfo _ model = [ text texts.misc ] , div [ class "ml-2" ] - [ menuLink [ onClick InitUpload, href "#" ] (Icons.fileUploadIcon "") texts.uploadFiles - , menuLink + [ menuLink [ onClick InitEditDashboard , classList [ ( "hidden", not (isHomeContent model.content) ) ] , href "#" ] (Icons.editIcon "") texts.editDashboard - ] - , div [ class "mt-2 opacity-75" ] - [ menuLink [ href Data.UiSettings.documentationSite, target "_blank" ] (Icons.documentationIcon "") texts.documentation + , div [ class "mt-2 opacity-75" ] + [ menuLink [ href Data.UiSettings.documentationSite, target "_blank" ] + (Icons.documentationIcon "") + texts.documentation + ] ] , div [ class "flex flex-grow items-end" ] [ div [ class "text-center text-xs w-full opacity-50" ] @@ -89,16 +115,59 @@ view texts versionInfo _ model = ] +titleDiv : String -> Html msg +titleDiv label = + div [ class "text-sm opacity-75 py-0.5 italic" ] + [ text label + ] + + +menuLinkStyle : String +menuLinkStyle = + "my-1 flex flex-row items-center rounded px-1 py-1 hover:bg-blue-100 dark:hover:bg-slate-600" + + menuLink : List (Attribute Msg) -> Html Msg -> String -> Html Msg menuLink attrs icon label = a - (attrs - ++ [ class "my-1" - , class "flex flex-row items-center rounded px-1 py-1 hover:bg-blue-100 dark:hover:bg-slate-600" - ] - ) + (attrs ++ [ class menuLinkStyle ]) [ icon , span [ class "ml-2" ] [ text label ] ] + + +dashboardLink : Texts -> Model -> Dashboard -> Html Msg +dashboardLink texts model db = + let + ( visible, default ) = + ( isDashboardVisible model db.name + , isDashboardDefault model db.name + ) + in + a + [ class menuLinkStyle + , classList [ ( "italic", visible ) ] + , href "#" + , onClick (SetDashboard db) + ] + [ if visible then + i [ class "fa fa-check mr-2" ] [] + + else + i [ class "fa fa-columns mr-2" ] [] + , div [ class "flex flex-row flex-grow space-x-1" ] + [ div [ class "flex flex-grow" ] + [ text db.name + ] + , div [ class "opacity-50" ] + [ i + [ classList [ ( "hidden", not default ) ] + , class "fa fa-house-user" + , title texts.defaultDashboard.default + ] + [] + ] + ] + ] diff --git a/modules/webapp/src/main/elm/Page/Dashboard/Update.elm b/modules/webapp/src/main/elm/Page/Dashboard/Update.elm index 3bd1b44d..f0988cc5 100644 --- a/modules/webapp/src/main/elm/Page/Dashboard/Update.elm +++ b/modules/webapp/src/main/elm/Page/Dashboard/Update.elm @@ -7,9 +7,10 @@ module Page.Dashboard.Update exposing (update) +import Api import Browser.Navigation as Nav import Comp.BookmarkChooser -import Comp.DashboardEdit +import Comp.DashboardManage import Comp.DashboardView import Comp.EquipmentManage import Comp.FolderManage @@ -21,6 +22,8 @@ import Comp.ShareManage import Comp.SourceManage import Comp.TagManage import Comp.UploadForm +import Data.AccountScope +import Data.Dashboards import Data.Flags exposing (Flags) import Data.UiSettings exposing (UiSettings) import Messages.Page.Dashboard exposing (Texts) @@ -32,6 +35,13 @@ import Set update : Texts -> UiSettings -> Nav.Key -> Flags -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) update texts settings navKey flags msg model = + let + nextRun amsg = + nextRunModel amsg model + + nextRunModel amsg amodel = + update texts settings navKey flags amsg amodel + in case msg of GetBookmarksResp list -> let @@ -41,6 +51,31 @@ update texts settings navKey flags msg model = unit { model | sideMenu = { sideMenu | bookmarkChooser = Comp.BookmarkChooser.init list } } + GetAllDashboardsResp next (Ok boards) -> + let + nextModel = + if Data.Dashboards.isEmptyAll boards then + { model + | dashboards = + Data.Dashboards.singletonAll <| + Page.Dashboard.DefaultDashboard.value texts.defaultDashboard + , isPredefined = True + , pageError = Nothing + } + + else + { model | dashboards = boards, isPredefined = False, pageError = Nothing } + in + case next of + Just nextMsg -> + nextRunModel nextMsg nextModel + + Nothing -> + unit nextModel + + GetAllDashboardsResp _ (Err err) -> + unit { model | pageError = Just <| PageErrorHttp err } + BookmarkMsg lm -> let sideMenu = @@ -60,23 +95,66 @@ update texts settings navKey flags msg model = , Sub.none ) - InitDashboard -> + ReloadDashboardData -> + let + lm = + DashboardMsg Comp.DashboardView.reloadData + in + update texts settings navKey flags lm model + + HardReloadDashboard -> case model.content of - Home _ -> - update texts settings navKey flags ReloadDashboardData model + Home dm -> + let + board = + dm.dashboard + + ( dm_, dc ) = + Comp.DashboardView.init flags board + in + ( { model | content = Home dm_ }, Cmd.map DashboardMsg dc, Sub.none ) _ -> - update texts settings navKey flags ReloadDashboard model + unit model - ReloadDashboard -> + SetDashboard db -> let - board = - Page.Dashboard.DefaultDashboard.getDefaultDashboard flags settings + isVisible = + case model.content of + Home dm -> + dm.dashboard.name == db.name - ( dm, dc ) = - Comp.DashboardView.init flags board + _ -> + False in - ( { model | content = Home dm }, Cmd.map DashboardMsg dc, Sub.none ) + if isVisible then + update texts settings navKey flags ReloadDashboardData model + + else + let + ( dbm, dbc ) = + Comp.DashboardView.init flags db + in + ( { model | content = Home dbm, pageError = Nothing } + , Cmd.map DashboardMsg dbc + , Sub.none + ) + + SetDefaultDashboard -> + case Data.Dashboards.getAllDefault model.dashboards of + Just db -> + nextRun (SetDashboard db) + + Nothing -> + unit model + + SetDashboardByName name -> + case Data.Dashboards.findInAll name model.dashboards of + Just db -> + nextRun (SetDashboard db) + + Nothing -> + unit model InitNotificationHook -> let @@ -152,12 +230,24 @@ update texts settings navKey flags msg model = case model.content of Home m -> let + default = + Data.Dashboards.isDefaultAll m.dashboard.name model.dashboards + + scope = + Data.Dashboards.getScope m.dashboard.name model.dashboards + |> Maybe.withDefault Data.AccountScope.User + ( dm, dc, ds ) = - Comp.DashboardEdit.init flags m.dashboard + Comp.DashboardManage.init + { flags = flags + , dashboard = m.dashboard + , scope = scope + , isDefault = default + } in ( { model | content = Edit dm } - , Cmd.map DashboardEditMsg dc - , Sub.map DashboardEditMsg ds + , Cmd.map DashboardManageMsg dc + , Sub.map DashboardManageMsg ds ) _ -> @@ -301,47 +391,61 @@ update texts settings navKey flags msg model = _ -> unit model - DashboardEditMsg lm -> + DashboardManageMsg lm -> case model.content of Edit m -> let + nameExists name = + Data.Dashboards.existsAll name model.dashboards + result = - Comp.DashboardEdit.update flags lm m + Comp.DashboardManage.update flags nameExists lm m in case result.action of - Comp.DashboardEdit.SubmitNone -> + Comp.DashboardManage.SubmitNone -> ( { model | content = Edit result.model } - , Cmd.map DashboardEditMsg result.cmd - , Sub.map DashboardEditMsg result.sub + , Cmd.map DashboardManageMsg result.cmd + , Sub.map DashboardManageMsg result.sub ) - Comp.DashboardEdit.SubmitSave board -> - let - ( dm, dc ) = - Comp.DashboardView.init flags board - in - ( { model | content = Home dm }, Cmd.map DashboardMsg dc, Sub.none ) - - Comp.DashboardEdit.SubmitCancel -> - update texts settings navKey flags ReloadDashboard model - - Comp.DashboardEdit.SubmitDelete _ -> + Comp.DashboardManage.SubmitSaved name -> ( { model | content = Edit result.model } - , Cmd.map DashboardEditMsg result.cmd - , Sub.map DashboardEditMsg result.sub + , Cmd.batch + [ Cmd.map DashboardManageMsg result.cmd + , getDashboards flags (Just <| SetDashboardByName name) + ] + , Sub.map DashboardManageMsg result.sub + ) + + Comp.DashboardManage.SubmitCancel name -> + case Data.Dashboards.findInAll name model.dashboards of + Just db -> + update texts settings navKey flags (SetDashboard db) model + + Nothing -> + ( { model | content = Edit result.model } + , Cmd.map DashboardManageMsg result.cmd + , Sub.map DashboardManageMsg result.sub + ) + + Comp.DashboardManage.SubmitDeleted -> + ( { model | content = Edit result.model } + , Cmd.batch + [ Cmd.map DashboardManageMsg result.cmd + , getDashboards flags (Just SetDefaultDashboard) + ] + , Sub.map DashboardManageMsg result.sub ) _ -> unit model - ReloadDashboardData -> - let - lm = - DashboardMsg Comp.DashboardView.reloadData - in - update texts settings navKey flags lm model - unit : Model -> ( Model, Cmd Msg, Sub Msg ) unit m = ( m, Cmd.none, Sub.none ) + + +getDashboards : Flags -> Maybe Msg -> Cmd Msg +getDashboards flags nextMsg = + Api.getAllDashboards flags (GetAllDashboardsResp nextMsg) diff --git a/modules/webapp/src/main/elm/Page/Dashboard/View.elm b/modules/webapp/src/main/elm/Page/Dashboard/View.elm index 5bbd4091..d6f556cf 100644 --- a/modules/webapp/src/main/elm/Page/Dashboard/View.elm +++ b/modules/webapp/src/main/elm/Page/Dashboard/View.elm @@ -8,7 +8,7 @@ module Page.Dashboard.View exposing (viewContent, viewSidebar) import Api.Model.VersionInfo exposing (VersionInfo) -import Comp.DashboardEdit +import Comp.DashboardManage import Comp.DashboardView import Comp.EquipmentManage import Comp.FolderManage @@ -31,7 +31,7 @@ import Styles as S viewSidebar : Texts -> Bool -> Flags -> VersionInfo -> UiSettings -> Model -> Html Msg -viewSidebar texts visible flags versionInfo settings model = +viewSidebar texts visible _ versionInfo settings model = div [ id "sidebar" , class S.sidebar @@ -44,18 +44,34 @@ viewSidebar texts visible flags versionInfo settings model = viewContent : Texts -> Flags -> UiSettings -> Model -> Html Msg viewContent texts flags settings model = + let + editSettings = + { showDeleteButton = not model.isPredefined + , showCopyButton = not model.isPredefined + } + in div [ id "content" , class S.content ] [ case model.content of Home m -> - Html.map DashboardMsg - (Comp.DashboardView.view texts.dashboard flags settings m) + div [ class "mt-1" ] + [ Html.map DashboardMsg + (Comp.DashboardView.view texts.dashboard flags settings m) + ] Edit m -> - Html.map DashboardEditMsg - (Comp.DashboardEdit.view texts.dashboardEdit flags settings m) + div [ class "mt-1" ] + [ div + [ class S.infoMessage + , class "my-1" + , classList [ ( "hidden", not model.isPredefined ) ] + ] + [ text texts.predefinedMessage ] + , Html.map DashboardManageMsg + (Comp.DashboardManage.view texts.dashboardManage flags editSettings settings m) + ] Webhook m -> viewHookManage texts settings m diff --git a/modules/webapp/src/main/elm/Util/Result.elm b/modules/webapp/src/main/elm/Util/Result.elm index cc8844cc..b93432cd 100644 --- a/modules/webapp/src/main/elm/Util/Result.elm +++ b/modules/webapp/src/main/elm/Util/Result.elm @@ -5,7 +5,10 @@ -} -module Util.Result exposing (fold) +module Util.Result exposing (combine, fold) + +import Api.Model.BasicResult exposing (BasicResult) +import Set fold : (a -> x) -> (b -> x) -> Result b a -> x @@ -16,3 +19,12 @@ fold fa fb rba = Err b -> fb b + + +combine : BasicResult -> BasicResult -> BasicResult +combine r1 r2 = + BasicResult (r1.success && r2.success) + (Set.fromList [ r1.message, r2.message ] + |> Set.toList + |> String.join ", " + ) diff --git a/modules/webapp/src/main/styles/keep.txt b/modules/webapp/src/main/styles/keep.txt index 02ecc86f..d7588992 100644 --- a/modules/webapp/src/main/styles/keep.txt +++ b/modules/webapp/src/main/styles/keep.txt @@ -33,3 +33,31 @@ them using string concatenation, which cannot be detected by postcss. elm-datepicker--other-month ds-card-search-hl strong + + +gap-0 +gap-1 +gap-2 +gap-3 +gap-4 +gap-5 +gap-6 +gap-7 +gap-8 +gap-9 +gap-10 +gap-11 +gap-12 + +md:grid-cols-1 +md:grid-cols-2 +md:grid-cols-3 +md:grid-cols-4 +md:grid-cols-5 +md:grid-cols-6 +md:grid-cols-7 +md:grid-cols-8 +md:grid-cols-9 +md:grid-cols-10 +md:grid-cols-11 +md:grid-cols-12