Save and load dashboards

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

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

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
+                    ]
+                    []
+                ]
+            ]
+        ]

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)

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