TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-04-04 10:29:34 +00:00
Code Issues Packages Projects Releases Wiki Activity

Save and load dashboards

Browse Source
This commit is contained in:
eikek 2022-01-26 21:23:48 +01:00
parent e83bf6b750
commit 3ff7e255b4
24 changed files with 1647 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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

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

@ -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

2
modules/webapp/src/main/elm/Comp/BookmarkChooser.elm
View File

@ -144,8 +144,6 @@ titleDiv : String -> Html msg
titleDiv label =
div [ class "text-sm opacity-75 py-0.5 italic" ]
[ text label
--, text " ──"
]

174
modules/webapp/src/main/elm/Comp/DashboardEdit.elm
View File

@ -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
)
]
]

312
modules/webapp/src/main/elm/Comp/DashboardManage.elm Normal file
View File

@ -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 ""

26
modules/webapp/src/main/elm/Comp/DashboardView.elm
View File

@ -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

26
modules/webapp/src/main/elm/Data/AccountScope.elm Normal file
View File

@ -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

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

@ -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 )
]

207
modules/webapp/src/main/elm/Data/BoxContent.elm
View File

@ -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"

42
modules/webapp/src/main/elm/Data/Dashboard.elm
View File

@ -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)

289
modules/webapp/src/main/elm/Data/Dashboards.elm Normal file
View File

@ -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 )
]

25
modules/webapp/src/main/elm/Data/ItemColumn.elm
View File

@ -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

10
modules/webapp/src/main/elm/Messages/Comp/BookmarkChooser.elm
View File

@ -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"
}

10
modules/webapp/src/main/elm/Messages/Comp/DashboardEdit.elm
View File

@ -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"
}

44
modules/webapp/src/main/elm/Messages/Comp/DashboardManage.elm Normal file
View File

@ -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"
}

17
modules/webapp/src/main/elm/Messages/Data/AccountScope.elm Normal file
View File

@ -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"

18
modules/webapp/src/main/elm/Messages/Page/Dashboard.elm
View File

@ -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."
}

121
modules/webapp/src/main/elm/Page/Dashboard/Data.elm
View File

@ -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

1
modules/webapp/src/main/elm/Page/Dashboard/DefaultDashboard.elm
View File

@ -15,6 +15,7 @@ value : Texts -> Dashboard
value texts =
{ name = texts.default
, columns = 2
, gap = 2
, boxes =
[ messageBox texts
, fieldStats

99
modules/webapp/src/main/elm/Page/Dashboard/SideMenu.elm
View File

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

182
modules/webapp/src/main/elm/Page/Dashboard/Update.elm
View File

@ -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)

28
modules/webapp/src/main/elm/Page/Dashboard/View.elm
View File

@ -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

14
modules/webapp/src/main/elm/Util/Result.elm
View File

@ -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 ", "
)

28
modules/webapp/src/main/styles/keep.txt
View File

@ -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