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

Merge pull request #141 from eikek/colored-tags

Browse Source 
Colored tags
This commit is contained in:
eikek 2020-06-08 21:58:18 +02:00 committed by GitHub
commit f2c5135ef4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
44 changed files with 1081 additions and 390 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -44,33 +44,40 @@ type alias Model =
, itemDetailModel : Page.ItemDetail.Data.Model
, navMenuOpen : Bool
, subs : Sub Msg
, uiSettings : UiSettings
}
init : Key -> Url -> Flags -> Model
init key url flags =
init : Key -> Url -> Flags -> UiSettings -> ( Model, Cmd Msg )
init key url flags settings =
let
page =
Page.fromUrl url
|> Maybe.withDefault (defaultPage flags)
( um, uc ) =
Page.UserSettings.Data.init flags settings
in
{ flags = flags
, key = key
, page = page
, version = Api.Model.VersionInfo.empty
, homeModel = Page.Home.Data.init flags
, loginModel = Page.Login.Data.emptyModel
, manageDataModel = Page.ManageData.Data.emptyModel
, collSettingsModel = Page.CollectiveSettings.Data.emptyModel
, userSettingsModel = Page.UserSettings.Data.emptyModel flags
, queueModel = Page.Queue.Data.emptyModel
, registerModel = Page.Register.Data.emptyModel
, uploadModel = Page.Upload.Data.emptyModel
, newInviteModel = Page.NewInvite.Data.emptyModel
, itemDetailModel = Page.ItemDetail.Data.emptyModel
, navMenuOpen = False
, subs = Sub.none
}
( { flags = flags
, key = key
, page = page
, version = Api.Model.VersionInfo.empty
, homeModel = Page.Home.Data.init flags
, loginModel = Page.Login.Data.emptyModel
, manageDataModel = Page.ManageData.Data.emptyModel
, collSettingsModel = Page.CollectiveSettings.Data.emptyModel
, userSettingsModel = um
, queueModel = Page.Queue.Data.emptyModel
, registerModel = Page.Register.Data.emptyModel
, uploadModel = Page.Upload.Data.emptyModel
, newInviteModel = Page.NewInvite.Data.emptyModel
, itemDetailModel = Page.ItemDetail.Data.emptyModel
, navMenuOpen = False
, subs = Sub.none
, uiSettings = settings
}
, Cmd.map UserSettingsMsg uc
)
type Msg

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

@ -176,10 +176,10 @@ updateWithSub msg model =
GetUiSettings settings ->
Util.Update.andThen1
[ updateUserSettings (Page.UserSettings.Data.GetUiSettings settings)
, updateHome (Page.Home.Data.GetUiSettings settings)
[ updateUserSettings Page.UserSettings.Data.UpdateSettings
, updateHome Page.Home.Data.DoSearch
]
model
{ model | uiSettings = settings }
|> noSub
@ -253,7 +253,7 @@ updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg )
updateUserSettings lmsg model =
let
( lm, lc, ls ) =
Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel
Page.UserSettings.Update.update model.flags model.uiSettings lmsg model.userSettingsModel
in
( { model
| userSettingsModel = lm
@ -302,7 +302,7 @@ updateHome : Page.Home.Data.Msg -> Model -> ( Model, Cmd Msg )
updateHome lmsg model =
let
( lm, lc ) =
Page.Home.Update.update model.key model.flags lmsg model.homeModel
Page.Home.Update.update model.key model.flags model.uiSettings lmsg model.homeModel
in
( { model | homeModel = lm }
, Cmd.map HomeMsg lc

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

@ -121,7 +121,7 @@ viewItemDetail id model =
inav =
Page.Home.Data.itemNav id model.homeModel
in
Html.map ItemDetailMsg (Page.ItemDetail.View.view inav model.itemDetailModel)
Html.map ItemDetailMsg (Page.ItemDetail.View.view inav model.uiSettings model.itemDetailModel)
viewNewInvite : Model -> Html Msg
@ -146,17 +146,21 @@ viewQueue model =
viewUserSettings : Model -> Html Msg
viewUserSettings model =
Html.map UserSettingsMsg (Page.UserSettings.View.view model.userSettingsModel)
Html.map UserSettingsMsg (Page.UserSettings.View.view model.uiSettings model.userSettingsModel)
viewCollectiveSettings : Model -> Html Msg
viewCollectiveSettings model =
Html.map CollSettingsMsg (Page.CollectiveSettings.View.view model.flags model.collSettingsModel)
Html.map CollSettingsMsg
(Page.CollectiveSettings.View.view model.flags
model.uiSettings
model.collSettingsModel
)
viewManageData : Model -> Html Msg
viewManageData model =
Html.map ManageDataMsg (Page.ManageData.View.view model.manageDataModel)
Html.map ManageDataMsg (Page.ManageData.View.view model.uiSettings model.manageDataModel)
viewLogin : Model -> Html Msg
@ -166,7 +170,7 @@ viewLogin model =
viewHome : Model -> Html Msg
viewHome model =
Html.map HomeMsg (Page.Home.View.view model.homeModel)
Html.map HomeMsg (Page.Home.View.view model.uiSettings model.homeModel)
menuEntry : Model -> Page -> List (Html Msg) -> Html Msg

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

@ -9,6 +9,7 @@ module Comp.AddressForm exposing
import Api.Model.Address exposing (Address)
import Comp.Dropdown
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
@ -105,8 +106,8 @@ update msg model =
( { model | country = m1 }, Cmd.map CountryMsg c1 )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "ui form" ]
[ div
[ class "field"
@ -146,6 +147,6 @@ view model =
]
, div [ class "field" ]
[ label [] [ text "Country" ]
, Html.map CountryMsg (Comp.Dropdown.view model.country)
, Html.map CountryMsg (Comp.Dropdown.view settings model.country)
]
]

7
modules/webapp/src/main/elm/Comp/CollectiveSettingsForm.elm
View File

@ -11,6 +11,7 @@ import Api.Model.CollectiveSettings exposing (CollectiveSettings)
import Comp.Dropdown
import Data.Flags exposing (Flags)
import Data.Language exposing (Language)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck)
@ -90,12 +91,12 @@ update _ msg model =
( nextModel, Cmd.none, Just (getSettings nextModel) )
view : Flags -> Model -> Html Msg
view flags model =
view : Flags -> UiSettings -> Model -> Html Msg
view flags settings model =
div [ class "ui form" ]
[ div [ class "field" ]
[ label [] [ text "Document Language" ]
, Html.map LangDropdownMsg (Comp.Dropdown.view model.langModel)
, Html.map LangDropdownMsg (Comp.Dropdown.view settings model.langModel)
, span [ class "small-info" ]
[ text "The language of your documents. This helps text recognition (OCR) and text analysis."
]

171
modules/webapp/src/main/elm/Comp/ColorTagger.elm Normal file
View File

@ -0,0 +1,171 @@
module Comp.ColorTagger exposing
( Model
, Msg
, ViewOpts
, init
, update
, view
)
import Comp.FixedDropdown
import Data.Color exposing (Color)
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Util.Maybe
type alias FormData =
Dict String Color
type alias Model =
{ leftDropdown : Comp.FixedDropdown.Model String
, colors : List Color
, leftSelect : Maybe String
}
type Msg
= AddPair FormData Color
| DeleteItem FormData String
| EditItem String Color
| LeftMsg (Comp.FixedDropdown.Msg String)
init : List String -> List Color -> Model
init leftSel colors =
{ leftDropdown = Comp.FixedDropdown.initString leftSel
, colors = colors
, leftSelect = Nothing
}
--- Update
update : Msg -> Model -> ( Model, Maybe FormData )
update msg model =
case msg of
AddPair data color ->
case model.leftSelect of
Just l ->
( model
, Just (Dict.insert l color data)
)
_ ->
( model, Nothing )
DeleteItem data k ->
( model, Just (Dict.remove k data) )
EditItem k _ ->
( { model
| leftSelect = Just k
}
, Nothing
)
LeftMsg lm ->
let
( m_, la ) =
Comp.FixedDropdown.update lm model.leftDropdown
in
( { model
| leftDropdown = m_
, leftSelect = Util.Maybe.withDefault model.leftSelect la
}
, Nothing
)
--- View
type alias ViewOpts =
{ renderItem : ( String, Color ) -> Html Msg
, label : String
, description : Maybe String
}
view : FormData -> ViewOpts -> Model -> Html Msg
view data opts model =
div [ class "field" ]
[ label [] [ text opts.label ]
, div [ class "inline field" ]
[ Html.map LeftMsg
(Comp.FixedDropdown.viewString
model.leftSelect
model.leftDropdown
)
]
, div [ class "field" ]
[ chooseColor
(AddPair data)
Data.Color.all
Nothing
]
, renderFormData opts data
, span
[ classList
[ ( "small-info", True )
, ( "invisible hidden", opts.description == Nothing )
]
]
[ Maybe.withDefault "" opts.description
|> text
]
]
renderFormData : ViewOpts -> FormData -> Html Msg
renderFormData opts data =
let
values =
Dict.toList data
renderItem ( k, v ) =
div [ class "item" ]
[ a
[ class "link icon"
, href "#"
, onClick (DeleteItem data k)
]
[ i [ class "trash icon" ] []
]
, a
[ class "link icon"
, href "#"
, onClick (EditItem k v)
]
[ i [ class "edit icon" ] []
]
, opts.renderItem ( k, v )
]
in
div [ class "ui list" ]
(List.map renderItem values)
chooseColor : (Color -> msg) -> List Color -> Maybe String -> Html msg
chooseColor tagger colors mtext =
let
renderLabel color =
a
[ class ("ui large label " ++ Data.Color.toString color)
, href "#"
, onClick (tagger color)
]
[ Maybe.withDefault
(Data.Color.toString color)
mtext
|> text
]
in
div [ class "ui labels" ] <|
List.map renderLabel colors

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

@ -10,6 +10,7 @@ module Comp.ContactField exposing
import Api.Model.Contact exposing (Contact)
import Comp.Dropdown
import Data.ContactType exposing (ContactType)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput)
@ -96,12 +97,12 @@ update msg model =
( { m1 | value = contact.value, items = newItems }, c1 )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div []
[ div [ class "fields" ]
[ div [ class "four wide field" ]
[ Html.map TypeMsg (Comp.Dropdown.view model.kind)
[ Html.map TypeMsg (Comp.Dropdown.view settings model.kind)
]
, div [ class "twelve wide field" ]
[ div [ class "ui action input" ]

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

@ -12,6 +12,7 @@ module Comp.Dropdown exposing
, view
)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput)
@ -52,7 +53,7 @@ type alias Model a =
, makeOption : a -> Option
, menuOpen : Bool
, filterString : String
, labelColor : a -> String
, labelColor : a -> UiSettings -> String
, searchable : Int -> Bool
, placeholder : String
}
@ -62,7 +63,7 @@ makeModel :
{ multiple : Bool
, searchable : Int -> Bool
, makeOption : a -> Option
, labelColor : a -> String
, labelColor : a -> UiSettings -> String
, placeholder : String
}
-> Model a
@ -89,7 +90,7 @@ makeSingle opts =
{ multiple = False
, searchable = \n -> n > 8
, makeOption = opts.makeOption
, labelColor = \_ -> ""
, labelColor = \_ -> \_ -> ""
, placeholder = opts.placeholder
}
@ -119,7 +120,7 @@ makeSingleList opts =
makeMultiple :
{ makeOption : a -> Option
, labelColor : a -> String
, labelColor : a -> UiSettings -> String
}
-> Model a
makeMultiple opts =
@ -363,10 +364,10 @@ update msg model =
-- View
view : Model a -> Html (Msg a)
view model =
view : UiSettings -> Model a -> Html (Msg a)
view settings model =
if model.multiple then
viewMultiple model
viewMultiple settings model
else
viewSingle model
@ -422,15 +423,15 @@ viewSingle model =
)
viewMultiple : Model a -> Html (Msg a)
viewMultiple model =
viewMultiple : UiSettings -> Model a -> Html (Msg a)
viewMultiple settings model =
let
renderSelectMultiple : Item a -> Html (Msg a)
renderSelectMultiple item =
div
[ classList
[ ( "ui label", True )
, ( model.labelColor item.value, True )
, ( model.labelColor item.value settings, True )
]
, style "display" "inline-block !important"
, onClick (RemoveItem item)

7
modules/webapp/src/main/elm/Comp/EmailSettingsForm.elm
View File

@ -14,6 +14,7 @@ import Comp.Dropdown
import Comp.IntField
import Comp.PasswordInput
import Data.SSLType exposing (SSLType)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onInput)
@ -165,8 +166,8 @@ update msg model =
( { model | ignoreCertificates = not model.ignoreCertificates }, Cmd.none )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div
[ classList
[ ( "ui form", True )
@ -258,7 +259,7 @@ view model =
, div [ class "two fields" ]
[ div [ class "field" ]
[ label [] [ text "SSL" ]
, Html.map SSLTypeMsg (Comp.Dropdown.view model.sslType)
, Html.map SSLTypeMsg (Comp.Dropdown.view settings model.sslType)
]
]
]

13
modules/webapp/src/main/elm/Comp/EmailSettingsManage.elm
View File

@ -15,6 +15,7 @@ import Comp.EmailSettingsForm
import Comp.EmailSettingsTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput)
@ -199,14 +200,14 @@ update flags msg model =
( { model | loading = False }, Cmd.none )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
case model.viewMode of
Table ->
viewTable model
Form ->
viewForm model
viewForm settings model
viewTable : Model -> Html Msg
@ -243,11 +244,11 @@ viewTable model =
]
viewForm : Model -> Html Msg
viewForm model =
viewForm : UiSettings -> Model -> Html Msg
viewForm settings model =
div [ class "ui segment" ]
[ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
, Html.map FormMsg (Comp.EmailSettingsForm.view model.formModel)
, Html.map FormMsg (Comp.EmailSettingsForm.view settings model.formModel)
, div
[ classList
[ ( "ui error message", True )

6
modules/webapp/src/main/elm/Comp/FixedDropdown.elm
View File

@ -8,6 +8,7 @@ module Comp.FixedDropdown exposing
, initTuple
, update
, view
, viewString
)
import Html exposing (..)
@ -101,6 +102,11 @@ view selected model =
]
viewString : Maybe String -> Model String -> Html (Msg String)
viewString selected model =
view (Maybe.map (\s -> Item s s) selected) model
renderItems : Item a -> Html (Msg a)
renderItems item =
div [ class "item", onClick (SelectItem item) ]

7
modules/webapp/src/main/elm/Comp/ImapSettingsForm.elm
View File

@ -14,6 +14,7 @@ import Comp.Dropdown
import Comp.IntField
import Comp.PasswordInput
import Data.SSLType exposing (SSLType)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onInput)
@ -149,8 +150,8 @@ update msg model =
( { model | ignoreCertificates = not model.ignoreCertificates }, Cmd.none )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div
[ classList
[ ( "ui form", True )
@ -220,7 +221,7 @@ view model =
, div [ class "two fields" ]
[ div [ class "field" ]
[ label [] [ text "SSL" ]
, Html.map SSLTypeMsg (Comp.Dropdown.view model.sslType)
, Html.map SSLTypeMsg (Comp.Dropdown.view settings model.sslType)
]
]
]

13
modules/webapp/src/main/elm/Comp/ImapSettingsManage.elm
View File

@ -15,6 +15,7 @@ import Comp.ImapSettingsForm
import Comp.ImapSettingsTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput)
@ -199,14 +200,14 @@ update flags msg model =
( { model | loading = False }, Cmd.none )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
case model.viewMode of
Table ->
viewTable model
Form ->
viewForm model
viewForm settings model
viewTable : Model -> Html Msg
@ -243,11 +244,11 @@ viewTable model =
]
viewForm : Model -> Html Msg
viewForm model =
viewForm : UiSettings -> Model -> Html Msg
viewForm settings model =
div [ class "ui segment" ]
[ Html.map YesNoMsg (Comp.YesNoDimmer.view model.deleteConfirm)
, Html.map FormMsg (Comp.ImapSettingsForm.view model.formModel)
, Html.map FormMsg (Comp.ImapSettingsForm.view settings model.formModel)
, div
[ classList
[ ( "ui error message", True )

19
modules/webapp/src/main/elm/Comp/ItemCardList.elm
View File

@ -15,6 +15,7 @@ import Data.Direction
import Data.Flags exposing (Flags)
import Data.Icons as Icons
import Data.Items
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
@ -97,26 +98,26 @@ update _ msg model =
--- View
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "ui container" ]
(List.map viewGroup model.results.groups)
(List.map (viewGroup settings) model.results.groups)
viewGroup : ItemLightGroup -> Html Msg
viewGroup group =
viewGroup : UiSettings -> ItemLightGroup -> Html Msg
viewGroup settings group =
div [ class "item-group" ]
[ div [ class "ui horizontal divider header item-list" ]
[ i [ class "calendar alternate outline icon" ] []
, text group.name
]
, div [ class "ui stackable three cards" ]
(List.map viewItem group.items)
(List.map (viewItem settings) group.items)
]
viewItem : ItemLight -> Html Msg
viewItem item =
viewItem : UiSettings -> ItemLight -> Html Msg
viewItem settings item =
let
dirIcon =
i [ class (Data.Direction.iconFromMaybe item.direction) ] []
@ -193,7 +194,7 @@ viewItem item =
div
[ classList
[ ( "ui basic label", True )
, ( "blue", tag.category /= Nothing )
, ( Data.UiSettings.tagColorString tag settings, True )
]
]
[ text tag.name ]

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

@ -34,6 +34,7 @@ import Comp.YesNoDimmer
import Data.Direction exposing (Direction)
import Data.Flags exposing (Flags)
import Data.Icons as Icons
import Data.UiSettings exposing (UiSettings)
import DatePicker exposing (DatePicker)
import Dict exposing (Dict)
import File exposing (File)
@ -52,6 +53,7 @@ import Util.List
import Util.Maybe
import Util.Size
import Util.String
import Util.Tag
import Util.Time
@ -82,7 +84,7 @@ type alias Model =
, sentMailsOpen : Bool
, attachMeta : Dict String Comp.AttachmentMeta.Model
, attachMetaOpen : Bool
, pdfNativeView : Bool
, pdfNativeView : Maybe Bool
, deleteAttachConfirm : Comp.YesNoDimmer.Model
, addFilesOpen : Bool
, addFilesModel : Comp.Dropzone.Model
@ -119,16 +121,7 @@ emptyModel =
, visibleAttach = 0
, menuOpen = False
, tagModel =
Comp.Dropdown.makeMultiple
{ makeOption = \tag -> { value = tag.id, text = tag.name }
, labelColor =
\tag ->
if Util.Maybe.nonEmpty tag.category then
"basic blue"
else
""
}
Util.Tag.makeDropdownModel
, directionModel =
Comp.Dropdown.makeSingleList
{ makeOption =
@ -177,7 +170,7 @@ emptyModel =
, sentMailsOpen = False
, attachMeta = Dict.empty
, attachMetaOpen = False
, pdfNativeView = False
, pdfNativeView = Nothing
, deleteAttachConfirm = Comp.YesNoDimmer.emptyModel
, addFilesOpen = False
, addFilesModel = Comp.Dropzone.init Comp.Dropzone.defaultSettings
@ -238,7 +231,7 @@ type Msg
| SentMailsResp (Result Http.Error SentMails)
| AttachMetaClick String
| AttachMetaMsg String Comp.AttachmentMeta.Msg
| TogglePdfNativeView
| TogglePdfNativeView Bool
| RequestDeleteAttachment String
| DeleteAttachConfirm String Comp.YesNoDimmer.Msg
| DeleteAttachResp (Result Http.Error BasicResult)
@ -1034,9 +1027,17 @@ update key flags next msg model =
Nothing ->
noSub ( model, Cmd.none )
TogglePdfNativeView ->
TogglePdfNativeView default ->
noSub
( { model | pdfNativeView = not model.pdfNativeView }
( { model
| pdfNativeView =
case model.pdfNativeView of
Just flag ->
Just (not flag)
Nothing ->
Just (not default)
}
, Cmd.none
)
@ -1215,10 +1216,10 @@ actionInputDatePicker =
{ ds | containerClassList = [ ( "ui action input", True ) ] }
view : { prev : Maybe String, next : Maybe String } -> Model -> Html Msg
view inav model =
view : { prev : Maybe String, next : Maybe String } -> UiSettings -> Model -> Html Msg
view inav settings model =
div []
[ renderItemInfo model
[ renderItemInfo settings model
, div
[ classList
[ ( "ui ablue-comp menu", True )
@ -1307,7 +1308,7 @@ view inav model =
[ Icons.addFilesIcon
]
]
, renderMailForm model
, renderMailForm settings model
, renderAddFilesForm model
, renderNotes model
, div [ class "ui grid" ]
@ -1319,7 +1320,7 @@ view inav model =
]
]
(if model.menuOpen then
renderEditMenu model
renderEditMenu settings model
else
[]
@ -1335,7 +1336,7 @@ view inav model =
List.concat
[ [ renderAttachmentsTabMenu model
]
, renderAttachmentsTabBody model
, renderAttachmentsTabBody settings model
, renderIdInfo model
]
]
@ -1488,8 +1489,8 @@ renderAttachmentsTabMenu model =
)
renderAttachmentView : Model -> Int -> Attachment -> Html Msg
renderAttachmentView model pos attach =
renderAttachmentView : UiSettings -> Model -> Int -> Attachment -> Html Msg
renderAttachmentView settings model pos attach =
let
fileUrl =
"/api/v1/sec/attachment/" ++ attach.id
@ -1520,8 +1521,8 @@ renderAttachmentView model pos attach =
[ div [ class "ui slider checkbox" ]
[ input
[ type_ "checkbox"
, onCheck (\_ -> TogglePdfNativeView)
, checked model.pdfNativeView
, onCheck (\_ -> TogglePdfNativeView settings.nativePdfPreview)
, checked (Maybe.withDefault settings.nativePdfPreview model.pdfNativeView)
]
[]
, label [] [ text "Native view" ]
@ -1600,7 +1601,7 @@ renderAttachmentView model pos attach =
]
]
[ iframe
[ if model.pdfNativeView then
[ if Maybe.withDefault settings.nativePdfPreview model.pdfNativeView then
src fileUrl
else
@ -1630,8 +1631,8 @@ isAttachMetaOpen model id =
model.attachMetaOpen && (Dict.get id model.attachMeta /= Nothing)
renderAttachmentsTabBody : Model -> List (Html Msg)
renderAttachmentsTabBody model =
renderAttachmentsTabBody : UiSettings -> Model -> List (Html Msg)
renderAttachmentsTabBody settings model =
let
mailTab =
if Comp.SentMails.isEmpty model.sentMails then
@ -1651,12 +1652,12 @@ renderAttachmentsTabBody model =
]
]
in
List.indexedMap (renderAttachmentView model) model.item.attachments
List.indexedMap (renderAttachmentView settings model) model.item.attachments
++ mailTab
renderItemInfo : Model -> Html Msg
renderItemInfo model =
renderItemInfo : UiSettings -> Model -> Html Msg
renderItemInfo settings model =
let
date =
div
@ -1749,12 +1750,12 @@ renderItemInfo model =
]
]
]
:: renderTags model
:: renderTags settings model
)
renderTags : Model -> List (Html Msg)
renderTags model =
renderTags : UiSettings -> Model -> List (Html Msg)
renderTags settings model =
case model.item.tags of
[] ->
[]
@ -1766,7 +1767,7 @@ renderTags model =
div
[ classList
[ ( "ui tag label", True )
, ( "blue", Util.Maybe.nonEmpty t.category )
, ( Data.UiSettings.tagColorString t settings, True )
]
]
[ text t.name
@ -1776,10 +1777,10 @@ renderTags model =
]
renderEditMenu : Model -> List (Html Msg)
renderEditMenu model =
renderEditMenu : UiSettings -> Model -> List (Html Msg)
renderEditMenu settings model =
[ renderEditButtons model
, renderEditForm model
, renderEditForm settings model
]
@ -1813,8 +1814,8 @@ renderEditButtons model =
]
renderEditForm : Model -> Html Msg
renderEditForm model =
renderEditForm : UiSettings -> Model -> Html Msg
renderEditForm settings model =
div [ class "ui attached segment" ]
[ div [ class "ui form" ]
[ div [ class "field" ]
@ -1822,7 +1823,7 @@ renderEditForm model =
[ i [ class "tags icon" ] []
, text "Tags"
]
, Html.map TagDropdownMsg (Comp.Dropdown.view model.tagModel)
, Html.map TagDropdownMsg (Comp.Dropdown.view settings model.tagModel)
]
, div [ class " field" ]
[ label [] [ text "Name" ]
@ -1838,7 +1839,7 @@ renderEditForm model =
]
, div [ class "field" ]
[ label [] [ text "Direction" ]
, Html.map DirDropdownMsg (Comp.Dropdown.view model.directionModel)
, Html.map DirDropdownMsg (Comp.Dropdown.view settings model.directionModel)
]
, div [ class " field" ]
[ label [] [ text "Date" ]
@ -1875,12 +1876,12 @@ renderEditForm model =
]
, div [ class "field" ]
[ label [] [ text "Organization" ]
, Html.map OrgDropdownMsg (Comp.Dropdown.view model.corrOrgModel)
, Html.map OrgDropdownMsg (Comp.Dropdown.view settings model.corrOrgModel)
, renderOrgSuggestions model
]
, div [ class "field" ]
[ label [] [ text "Person" ]
, Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel)
, Html.map CorrPersonMsg (Comp.Dropdown.view settings model.corrPersonModel)
, renderCorrPersonSuggestions model
]
, h4 [ class "ui dividing header" ]
@ -1889,12 +1890,12 @@ renderEditForm model =
]
, div [ class "field" ]
[ label [] [ text "Person" ]
, Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel)
, Html.map ConcPersonMsg (Comp.Dropdown.view settings model.concPersonModel)
, renderConcPersonSuggestions model
]
, div [ class "field" ]
[ label [] [ text "Equipment" ]
, Html.map ConcEquipMsg (Comp.Dropdown.view model.concEquipModel)
, Html.map ConcEquipMsg (Comp.Dropdown.view settings model.concEquipModel)
, renderConcEquipSuggestions model
]
]
@ -1970,8 +1971,8 @@ renderDueDateSuggestions model =
SetDueDateSuggestion
renderMailForm : Model -> Html Msg
renderMailForm model =
renderMailForm : UiSettings -> Model -> Html Msg
renderMailForm settings model =
div
[ classList
[ ( "ui bottom attached segment", True )
@ -1991,7 +1992,7 @@ renderMailForm model =
[ text "Sending …"
]
]
, Html.map ItemMailMsg (Comp.ItemMail.view model.itemMail)
, Html.map ItemMailMsg (Comp.ItemMail.view settings model.itemMail)
, div
[ classList
[ ( "ui message", True )

7
modules/webapp/src/main/elm/Comp/ItemMail.elm
View File

@ -15,6 +15,7 @@ import Api.Model.SimpleMail exposing (SimpleMail)
import Comp.Dropdown
import Comp.EmailInput
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick, onInput)
@ -173,8 +174,8 @@ isValid model =
== Nothing
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div
[ classList
[ ( "ui form", True )
@ -183,7 +184,7 @@ view model =
]
[ div [ class "field" ]
[ label [] [ text "Send via" ]
, Html.map ConnMsg (Comp.Dropdown.view model.connectionModel)
, Html.map ConnMsg (Comp.Dropdown.view settings model.connectionModel)
]
, div [ class "ui error message" ]
[ Maybe.withDefault "" model.formError |> text

181
modules/webapp/src/main/elm/Comp/MappingForm.elm Normal file
View File

@ -0,0 +1,181 @@
module Comp.MappingForm exposing
( FormData
, Model
, Msg
, ViewOpts
, init
, update
, view
)
import Comp.FixedDropdown
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Util.Maybe
type alias FormData =
Dict String String
type alias Model =
{ leftDropdown : Comp.FixedDropdown.Model String
, rightDropdown : Comp.FixedDropdown.Model String
, leftSelect : Maybe String
, rightSelect : Maybe String
}
type Msg
= AddPair FormData
| DeleteItem FormData String
| EditItem String String
| LeftMsg (Comp.FixedDropdown.Msg String)
| RightMsg (Comp.FixedDropdown.Msg String)
init : List String -> List String -> Model
init leftSel rightSel =
{ leftDropdown = Comp.FixedDropdown.initString leftSel
, rightDropdown = Comp.FixedDropdown.initString rightSel
, leftSelect = Nothing
, rightSelect = Nothing
}
--- Update
update : Msg -> Model -> ( Model, Maybe FormData )
update msg model =
case msg of
AddPair data ->
case ( model.leftSelect, model.rightSelect ) of
( Just l, Just r ) ->
( { model
| leftSelect = Nothing
, rightSelect = Nothing
}
, Just (Dict.insert l r data)
)
_ ->
( model, Nothing )
DeleteItem data k ->
( model, Just (Dict.remove k data) )
EditItem k v ->
( { model
| leftSelect = Just k
, rightSelect = Just v
}
, Nothing
)
LeftMsg lm ->
let
( m_, la ) =
Comp.FixedDropdown.update lm model.leftDropdown
in
( { model
| leftDropdown = m_
, leftSelect = Util.Maybe.withDefault model.leftSelect la
}
, Nothing
)
RightMsg lm ->
let
( m_, la ) =
Comp.FixedDropdown.update lm model.rightDropdown
in
( { model
| rightDropdown = m_
, rightSelect = Util.Maybe.withDefault model.rightSelect la
}
, Nothing
)
--- View
type alias ViewOpts =
{ renderItem : ( String, String ) -> Html Msg
, label : String
, description : Maybe String
}
view : FormData -> ViewOpts -> Model -> Html Msg
view data opts model =
div [ class "field" ]
[ label [] [ text opts.label ]
, div [ class "fields" ]
[ div [ class "inline field" ]
[ Html.map LeftMsg
(Comp.FixedDropdown.viewString
model.leftSelect
model.leftDropdown
)
]
, div [ class "inline field" ]
[ Html.map RightMsg
(Comp.FixedDropdown.viewString
model.rightSelect
model.rightDropdown
)
]
, button
[ class "ui icon button"
, onClick (AddPair data)
, href "#"
]
[ i [ class "add icon" ] []
]
]
, renderFormData opts data
, span
[ classList
[ ( "small-info", True )
, ( "invisible hidden", opts.description == Nothing )
]
]
[ Maybe.withDefault "" opts.description
|> text
]
]
renderFormData : ViewOpts -> FormData -> Html Msg
renderFormData opts data =
let
values =
Dict.toList data
renderItem ( k, v ) =
div [ class "item" ]
[ a
[ class "link icon"
, href "#"
, onClick (DeleteItem data k)
]
[ i [ class "trash icon" ] []
]
, a
[ class "link icon"
, href "#"
, onClick (EditItem k v)
]
[ i [ class "edit icon" ] []
]
, opts.renderItem ( k, v )
]
in
div [ class "ui list" ]
(List.map renderItem values)

15
modules/webapp/src/main/elm/Comp/NotificationForm.elm
View File

@ -18,6 +18,7 @@ import Comp.EmailInput
import Comp.IntField
import Data.CalEvent exposing (CalEvent)
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Data.Validated exposing (Validated(..))
import Html exposing (..)
import Html.Attributes exposing (..)
@ -73,8 +74,8 @@ initCmd flags =
]
init : Flags -> ( Model, Cmd Msg )
init flags =
init : Flags -> UiSettings -> ( Model, Cmd Msg )
init flags settings =
let
initialSchedule =
Data.Validated.Unknown Data.CalEvent.everyMonth
@ -415,8 +416,8 @@ isFormSuccess model =
|> Maybe.withDefault False
view : String -> Model -> Html Msg
view extraClasses model =
view : String -> UiSettings -> Model -> Html Msg
view extraClasses settings model =
div
[ classList
[ ( "ui form", True )
@ -451,7 +452,7 @@ view extraClasses model =
]
, div [ class "required field" ]
[ label [] [ text "Send via" ]
, Html.map ConnMsg (Comp.Dropdown.view model.connectionModel)
, Html.map ConnMsg (Comp.Dropdown.view settings model.connectionModel)
, span [ class "small-info" ]
[ text "The SMTP connection to use when sending notification mails."
]
@ -468,14 +469,14 @@ view extraClasses model =
]
, div [ class "field" ]
[ label [] [ text "Tags Include (and)" ]
, Html.map TagIncMsg (Comp.Dropdown.view model.tagInclModel)
, Html.map TagIncMsg (Comp.Dropdown.view settings model.tagInclModel)
, span [ class "small-info" ]
[ text "Items must have all the tags specified here."
]
]
, div [ class "field" ]
[ label [] [ text "Tags Exclude (or)" ]
, Html.map TagExcMsg (Comp.Dropdown.view model.tagExclModel)
, Html.map TagExcMsg (Comp.Dropdown.view settings model.tagExclModel)
, span [ class "small-info" ]
[ text "Items must not have any tag specified here."
]

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

@ -12,6 +12,7 @@ import Api.Model.Organization exposing (Organization)
import Comp.AddressForm
import Comp.ContactField
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
@ -106,8 +107,8 @@ update flags msg model =
)
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "ui form" ]
[ div
[ classList
@ -127,11 +128,11 @@ view model =
, h3 [ class "ui dividing header" ]
[ text "Address"
]
, Html.map AddressMsg (Comp.AddressForm.view model.addressModel)
, Html.map AddressMsg (Comp.AddressForm.view settings model.addressModel)
, h3 [ class "ui dividing header" ]
[ text "Contacts"
]
, Html.map ContactMsg (Comp.ContactField.view model.contactModel)
, Html.map ContactMsg (Comp.ContactField.view settings model.contactModel)
, h3 [ class "ui dividing header" ]
[ text "Notes"
]

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

@ -14,6 +14,7 @@ import Comp.OrgForm
import Comp.OrgTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
@ -197,13 +198,13 @@ update flags msg model =
( m, Api.getOrganizations flags str OrgResp )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
if model.viewMode == Table then
viewTable model
else
viewForm model
viewForm settings model
viewTable : Model -> Html Msg
@ -248,8 +249,8 @@ viewTable model =
]
viewForm : Model -> Html Msg
viewForm model =
viewForm : UiSettings -> Model -> Html Msg
viewForm settings model =
let
newOrg =
model.formModel.org.id == ""
@ -269,7 +270,7 @@ viewForm model =
, text model.formModel.org.id
]
]
, Html.map FormMsg (Comp.OrgForm.view model.formModel)
, Html.map FormMsg (Comp.OrgForm.view settings model.formModel)
, div
[ classList
[ ( "ui error message", True )

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

@ -12,6 +12,7 @@ import Api.Model.Person exposing (Person)
import Comp.AddressForm
import Comp.ContactField
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onInput)
@ -120,8 +121,8 @@ update flags msg model =
( { model | concerning = not model.concerning }, Cmd.none )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "ui form" ]
[ div
[ classList
@ -152,11 +153,11 @@ view model =
, h3 [ class "ui dividing header" ]
[ text "Address"
]
, Html.map AddressMsg (Comp.AddressForm.view model.addressModel)
, Html.map AddressMsg (Comp.AddressForm.view settings model.addressModel)
, h3 [ class "ui dividing header" ]
[ text "Contacts"
]
, Html.map ContactMsg (Comp.ContactField.view model.contactModel)
, Html.map ContactMsg (Comp.ContactField.view settings model.contactModel)
, h3 [ class "ui dividing header" ]
[ text "Notes"
]

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

@ -14,6 +14,7 @@ import Comp.PersonForm
import Comp.PersonTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
@ -197,13 +198,13 @@ update flags msg model =
( m, Api.getPersons flags str PersonResp )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
if model.viewMode == Table then
viewTable model
else
viewForm model
viewForm settings model
viewTable : Model -> Html Msg
@ -248,8 +249,8 @@ viewTable model =
]
viewForm : Model -> Html Msg
viewForm model =
viewForm : UiSettings -> Model -> Html Msg
viewForm settings model =
let
newPerson =
model.formModel.org.id == ""
@ -263,13 +264,13 @@ viewForm model =
else
h3 [ class "ui dividing header" ]
[ text ("Edit org: " ++ model.formModel.org.name)
[ text ("Edit person: " ++ model.formModel.org.name)
, div [ class "sub header" ]
[ text "Id: "
, text model.formModel.org.id
]
]
, Html.map FormMsg (Comp.PersonForm.view model.formModel)
, Html.map FormMsg (Comp.PersonForm.view settings model.formModel)
, div
[ classList
[ ( "ui error message", True )

7
modules/webapp/src/main/elm/Comp/ScanMailboxForm.elm
View File

@ -20,6 +20,7 @@ import Comp.YesNoDimmer
import Data.CalEvent exposing (CalEvent)
import Data.Direction exposing (Direction(..))
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Data.Validated exposing (Validated(..))
import Html exposing (..)
import Html.Attributes exposing (..)
@ -419,8 +420,8 @@ isFormSuccess model =
|> Maybe.withDefault False
view : String -> Model -> Html Msg
view extraClasses model =
view : String -> UiSettings -> Model -> Html Msg
view extraClasses settings model =
div
[ classList
[ ( "ui form", True )
@ -456,7 +457,7 @@ view extraClasses model =
]
, div [ class "required field" ]
[ label [] [ text "Mailbox" ]
, Html.map ConnMsg (Comp.Dropdown.view model.connectionModel)
, Html.map ConnMsg (Comp.Dropdown.view settings model.connectionModel)
, span [ class "small-info" ]
[ text "The IMAP connection to use when sending notification mails."
]

15
modules/webapp/src/main/elm/Comp/ScanMailboxManage.elm
View File

@ -13,6 +13,7 @@ import Api.Model.ScanMailboxSettingsList exposing (ScanMailboxSettingsList)
import Comp.ScanMailboxForm
import Comp.ScanMailboxList
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
@ -198,8 +199,8 @@ update flags msg model =
--- View
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div []
[ div [ class "ui menu" ]
[ a
@ -224,17 +225,17 @@ view model =
|> text
]
, case model.detailModel of
Just settings ->
viewForm settings
Just msett ->
viewForm settings msett
Nothing ->
viewList model
]
viewForm : Comp.ScanMailboxForm.Model -> Html Msg
viewForm model =
Html.map DetailMsg (Comp.ScanMailboxForm.view "segment" model)
viewForm : UiSettings -> Comp.ScanMailboxForm.Model -> Html Msg
viewForm settings model =
Html.map DetailMsg (Comp.ScanMailboxForm.view "segment" settings model)
viewList : Model -> Html Msg

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

@ -2,8 +2,8 @@ module Comp.SearchMenu exposing
( Model
, Msg(..)
, NextState
, emptyModel
, getItemSearch
, init
, update
, view
)
@ -20,6 +20,7 @@ import Comp.DatePicker
import Comp.Dropdown exposing (isDropdownChangeMsg)
import Data.Direction exposing (Direction)
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import DatePicker exposing (DatePicker)
import Html exposing (..)
import Html.Attributes exposing (..)
@ -55,8 +56,8 @@ type alias Model =
}
emptyModel : Model
emptyModel =
init : Model
init =
{ tagInclModel = Util.Tag.makeDropdownModel
, tagExclModel = Util.Tag.makeDropdownModel
, directionModel =
@ -75,7 +76,7 @@ emptyModel =
{ multiple = False
, searchable = \n -> n > 5
, makeOption = \e -> { value = e.id, text = e.name }
, labelColor = \_ -> ""
, labelColor = \_ -> \_ -> ""
, placeholder = "Choose an organization"
}
, corrPersonModel =
@ -93,7 +94,7 @@ emptyModel =
{ multiple = False
, searchable = \n -> n > 5
, makeOption = \e -> { value = e.id, text = e.name }
, labelColor = \_ -> ""
, labelColor = \_ -> \_ -> ""
, placeholder = "Choose an equipment"
}
, inboxCheckbox = False
@ -184,8 +185,8 @@ noChange p =
NextState p False
update : Flags -> Msg -> Model -> NextState
update flags msg model =
update : Flags -> UiSettings -> Msg -> Model -> NextState
update flags settings msg model =
case msg of
Init ->
let
@ -193,25 +194,24 @@ update flags msg model =
Comp.DatePicker.init
( mdp, cdp ) =
case model.datePickerInitialized of
True ->
( model, Cmd.none )
if model.datePickerInitialized then
( model, Cmd.none )
False ->
( { model
| untilDateModel = dp
, fromDateModel = dp
, untilDueDateModel = dp
, fromDueDateModel = dp
, datePickerInitialized = True
}
, Cmd.batch
[ Cmd.map UntilDateMsg dpc
, Cmd.map FromDateMsg dpc
, Cmd.map UntilDueDateMsg dpc
, Cmd.map FromDueDateMsg dpc
]
)
else
( { model
| untilDateModel = dp
, fromDateModel = dp
, untilDueDateModel = dp
, fromDueDateModel = dp
, datePickerInitialized = True
}
, Cmd.batch
[ Cmd.map UntilDateMsg dpc
, Cmd.map FromDateMsg dpc
, Cmd.map UntilDueDateMsg dpc
, Cmd.map FromDueDateMsg dpc
]
)
in
noChange
( mdp
@ -227,7 +227,7 @@ update flags msg model =
ResetForm ->
let
next =
update flags Init emptyModel
update flags settings Init init
in
{ next | stateChange = True }
@ -238,8 +238,8 @@ update flags msg model =
in
noChange <|
Util.Update.andThen1
[ update flags (TagIncMsg tagList) >> .modelCmd
, update flags (TagExcMsg tagList) >> .modelCmd
[ update flags settings (TagIncMsg tagList) >> .modelCmd
, update flags settings (TagExcMsg tagList) >> .modelCmd
]
model
@ -251,7 +251,7 @@ update flags msg model =
opts =
Comp.Dropdown.SetOptions equips.items
in
update flags (ConcEquipmentMsg opts) model
update flags settings (ConcEquipmentMsg opts) model
GetEquipResp (Err _) ->
noChange ( model, Cmd.none )
@ -261,7 +261,7 @@ update flags msg model =
opts =
Comp.Dropdown.SetOptions orgs.items
in
update flags (OrgMsg opts) model
update flags settings (OrgMsg opts) model
GetOrgResp (Err _) ->
noChange ( model, Cmd.none )
@ -273,8 +273,8 @@ update flags msg model =
in
noChange <|
Util.Update.andThen1
[ update flags (CorrPersonMsg opts) >> .modelCmd
, update flags (ConcPersonMsg opts) >> .modelCmd
[ update flags settings (CorrPersonMsg opts) >> .modelCmd
, update flags settings (ConcPersonMsg opts) >> .modelCmd
]
model
@ -461,8 +461,8 @@ update flags msg model =
-- View
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "ui form" ]
[ div [ class "inline field" ]
[ div [ class "ui checkbox" ]
@ -493,18 +493,18 @@ view model =
]
, div [ class "field" ]
[ label [] [ text "Direction" ]
, Html.map DirectionMsg (Comp.Dropdown.view model.directionModel)
, Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel)
]
, h3 [ class "ui header" ]
[ text "Tags"
]
, div [ class "field" ]
[ label [] [ text "Include (and)" ]
, Html.map TagIncMsg (Comp.Dropdown.view model.tagInclModel)
, Html.map TagIncMsg (Comp.Dropdown.view settings model.tagInclModel)
]
, div [ class "field" ]
[ label [] [ text "Exclude (or)" ]
, Html.map TagExcMsg (Comp.Dropdown.view model.tagExclModel)
, Html.map TagExcMsg (Comp.Dropdown.view settings model.tagExclModel)
]
, h3 [ class "ui header" ]
[ case getDirection model of
@ -519,22 +519,22 @@ view model =
]
, div [ class "field" ]
[ label [] [ text "Organization" ]
, Html.map OrgMsg (Comp.Dropdown.view model.orgModel)
, Html.map OrgMsg (Comp.Dropdown.view settings model.orgModel)
]
, div [ class "field" ]
[ label [] [ text "Person" ]
, Html.map CorrPersonMsg (Comp.Dropdown.view model.corrPersonModel)
, Html.map CorrPersonMsg (Comp.Dropdown.view settings model.corrPersonModel)
]
, h3 [ class "ui header" ]
[ text "Concerned"
]
, div [ class "field" ]
[ label [] [ text "Person" ]
, Html.map ConcPersonMsg (Comp.Dropdown.view model.concPersonModel)
, Html.map ConcPersonMsg (Comp.Dropdown.view settings model.concPersonModel)
]
, div [ class "field" ]
[ label [] [ text "Equipment" ]
, Html.map ConcEquipmentMsg (Comp.Dropdown.view model.concEquipmentModel)
, Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel)
]
, h3 [ class "ui header" ]
[ text "Date"

167
modules/webapp/src/main/elm/Comp/UiSettingsForm.elm
View File

@ -2,92 +2,179 @@ module Comp.UiSettingsForm exposing
( Model
, Msg
, init
, initWith
, update
, view
)
import Api
import Api.Model.TagList exposing (TagList)
import Comp.ColorTagger
import Comp.IntField
import Data.Color exposing (Color)
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (StoredUiSettings, UiSettings)
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck)
import Http
import Util.List
type alias Model =
{ defaults : UiSettings
, input : StoredUiSettings
{ itemSearchPageSize : Maybe Int
, searchPageSizeModel : Comp.IntField.Model
, tagColors : Dict String Color
, tagColorModel : Comp.ColorTagger.Model
, nativePdfPreview : Bool
}
initWith : UiSettings -> Model
initWith defaults =
{ defaults = defaults
, input = Data.UiSettings.toStoredUiSettings defaults
, searchPageSizeModel =
Comp.IntField.init
(Just 10)
(Just 500)
False
"Item search page"
}
init : Model
init =
initWith Data.UiSettings.defaults
changeInput : (StoredUiSettings -> StoredUiSettings) -> Model -> StoredUiSettings
changeInput change model =
change model.input
init : Flags -> UiSettings -> ( Model, Cmd Msg )
init flags settings =
( { itemSearchPageSize = Just settings.itemSearchPageSize
, searchPageSizeModel =
Comp.IntField.init
(Just 10)
(Just 500)
False
"Page size"
, tagColors = settings.tagCategoryColors
, tagColorModel =
Comp.ColorTagger.init
[]
Data.Color.all
, nativePdfPreview = settings.nativePdfPreview
}
, Api.getTags flags "" GetTagsResp
)
type Msg
= SearchPageSizeMsg Comp.IntField.Msg
getSettings : Model -> UiSettings
getSettings model =
Data.UiSettings.merge model.input model.defaults
| TagColorMsg Comp.ColorTagger.Msg
| GetTagsResp (Result Http.Error TagList)
| TogglePdfPreview
--- Update
update : Msg -> Model -> ( Model, Maybe UiSettings )
update msg model =
update : UiSettings -> Msg -> Model -> ( Model, Maybe UiSettings )
update sett msg model =
case msg of
SearchPageSizeMsg lm ->
let
( m, n ) =
Comp.IntField.update lm model.searchPageSizeModel
nextSettings =
Maybe.map (\sz -> { sett | itemSearchPageSize = sz }) n
model_ =
{ model
| searchPageSizeModel = m
, input = changeInput (\s -> { s | itemSearchPageSize = n }) model
, itemSearchPageSize = n
}
nextSettings =
Maybe.map (\_ -> getSettings model_) n
in
( model_, nextSettings )
TagColorMsg lm ->
let
( m_, d_ ) =
Comp.ColorTagger.update lm model.tagColorModel
nextSettings =
Maybe.map (\tc -> { sett | tagCategoryColors = tc }) d_
model_ =
{ model
| tagColorModel = m_
, tagColors = Maybe.withDefault model.tagColors d_
}
in
( model_, nextSettings )
TogglePdfPreview ->
let
flag =
not model.nativePdfPreview
in
( { model | nativePdfPreview = flag }
, Just { sett | nativePdfPreview = flag }
)
GetTagsResp (Ok tl) ->
let
categories =
List.filterMap .category tl.items
|> Util.List.distinct
in
( { model
| tagColorModel =
Comp.ColorTagger.init
categories
Data.Color.all
}
, Nothing
)
GetTagsResp (Err _) ->
( model, Nothing )
--- View
view : Model -> Html Msg
view model =
tagColorViewOpts : Comp.ColorTagger.ViewOpts
tagColorViewOpts =
{ renderItem =
\( k, v ) ->
span [ class ("ui label " ++ Data.Color.toString v) ]
[ text k ]
, label = "Choose color for tag categories"
, description = Just "Tags can be represented differently based on their category."
}
view : UiSettings -> Model -> Html Msg
view _ model =
div [ class "ui form" ]
[ Html.map SearchPageSizeMsg
[ div [ class "ui dividing header" ]
[ text "Item Search"
]
, Html.map SearchPageSizeMsg
(Comp.IntField.viewWithInfo
"Maximum results in one page when searching items."
model.input.itemSearchPageSize
""
model.itemSearchPageSize
"field"
model.searchPageSizeModel
)
, div [ class "ui dividing header" ]
[ text "Item Detail"
]
, div [ class "field" ]
[ div [ class "ui checkbox" ]
[ input
[ type_ "checkbox"
, onCheck (\_ -> TogglePdfPreview)
, checked model.nativePdfPreview
]
[]
, label []
[ text "Browser-native PDF preview"
]
]
]
, div [ class "ui dividing header" ]
[ text "Tag Category Colors"
]
, Html.map TagColorMsg
(Comp.ColorTagger.view
model.tagColors
tagColorViewOpts
model.tagColorModel
)
]

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

@ -1,6 +1,6 @@
module Comp.UiSettingsManage exposing
( Model
, Msg
, Msg(..)
, init
, update
, view
@ -27,32 +27,44 @@ type Msg
= UiSettingsFormMsg Comp.UiSettingsForm.Msg
| Submit
| SettingsSaved
| UpdateSettings
init : UiSettings -> Model
init defaults =
{ formModel = Comp.UiSettingsForm.initWith defaults
, settings = Nothing
, message = Nothing
}
init : Flags -> UiSettings -> ( Model, Cmd Msg )
init flags settings =
let
( fm, fc ) =
Comp.UiSettingsForm.init flags settings
in
( { formModel = fm
, settings = Nothing
, message = Nothing
}
, Cmd.map UiSettingsFormMsg fc
)
--- update
update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
update flags msg model =
update : Flags -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
update flags settings msg model =
case msg of
UiSettingsFormMsg lm ->
let
( m_, sett ) =
Comp.UiSettingsForm.update lm model.formModel
Comp.UiSettingsForm.update settings lm model.formModel
in
( { model
| formModel = m_
, settings = sett
, message = Nothing
, message =
if sett /= Nothing then
Nothing
else
model.message
}
, Cmd.none
, Sub.none
@ -78,6 +90,16 @@ update flags msg model =
, Sub.none
)
UpdateSettings ->
let
( fm, fc ) =
Comp.UiSettingsForm.init flags settings
in
( { model | formModel = fm }
, Cmd.map UiSettingsFormMsg fc
, Sub.none
)
--- View
@ -93,10 +115,10 @@ isSuccess model =
Maybe.map .success model.message == Just True
view : String -> Model -> Html Msg
view classes model =
view : UiSettings -> String -> Model -> Html Msg
view settings classes model =
div [ class classes ]
[ Html.map UiSettingsFormMsg (Comp.UiSettingsForm.view model.formModel)
[ Html.map UiSettingsFormMsg (Comp.UiSettingsForm.view settings model.formModel)
, div [ class "ui divider" ] []
, button
[ class "ui primary button"

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

@ -12,6 +12,7 @@ module Comp.UserForm exposing
import Api.Model.User exposing (User)
import Comp.Dropdown
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Data.UserState exposing (UserState)
import Html exposing (..)
import Html.Attributes exposing (..)
@ -152,8 +153,8 @@ update _ msg model =
)
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "ui form" ]
[ div
[ classList
@ -182,7 +183,7 @@ view model =
]
, div [ class "field" ]
[ label [] [ text "State" ]
, Html.map StateMsg (Comp.Dropdown.view model.state)
, Html.map StateMsg (Comp.Dropdown.view settings model.state)
]
, div
[ classList

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

@ -14,6 +14,7 @@ import Comp.UserForm
import Comp.UserTable
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onSubmit)
@ -194,13 +195,13 @@ update flags msg model =
( { model | deleteConfirm = cm }, cmd )
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
if model.viewMode == Table then
viewTable model
else
viewForm model
viewForm settings model
viewTable : Model -> Html Msg
@ -222,8 +223,8 @@ viewTable model =
]
viewForm : Model -> Html Msg
viewForm model =
viewForm : UiSettings -> Model -> Html Msg
viewForm settings model =
let
newUser =
Comp.UserForm.isNewUser model.formModel
@ -239,7 +240,7 @@ viewForm model =
h3 [ class "ui dividing header" ]
[ text ("Edit user: " ++ model.formModel.user.login)
]
, Html.map FormMsg (Comp.UserForm.view model.formModel)
, Html.map FormMsg (Comp.UserForm.view settings model.formModel)
, div
[ classList
[ ( "ui error message", True )

135
modules/webapp/src/main/elm/Data/Color.elm Normal file
View File

@ -0,0 +1,135 @@
module Data.Color exposing
( Color(..)
, all
, allString
, fromString
, toString
)
type Color
= Red
| Orange
| Yellow
| Olive
| Green
| Teal
| Blue
| Violet
| Purple
| Pink
| Brown
| Grey
| Black
all : List Color
all =
[ Red
, Orange
, Yellow
, Olive
, Green
, Teal
, Blue
, Violet
, Purple
, Pink
, Brown
, Grey
, Black
]
allString : List String
allString =
List.map toString all
fromString : String -> Maybe Color
fromString str =
case String.toLower str of
"red" ->
Just Red
"orange" ->
Just Orange
"yellow" ->
Just Yellow
"olive" ->
Just Olive
"green" ->
Just Green
"teal" ->
Just Teal
"blue" ->
Just Blue
"violet" ->
Just Violet
"purple" ->
Just Purple
"pink" ->
Just Pink
"brown" ->
Just Brown
"grey" ->
Just Grey
"black" ->
Just Black
_ ->
Nothing
toString : Color -> String
toString color =
case color of
Red ->
"red"
Orange ->
"orange"
Yellow ->
"yellow"
Olive ->
"olive"
Green ->
"green"
Teal ->
"teal"
Blue ->
"blue"
Violet ->
"violet"
Purple ->
"purple"
Pink ->
"pink"
Brown ->
"brown"
Grey ->
"grey"
Black ->
"black"

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

@ -4,9 +4,16 @@ module Data.UiSettings exposing
, defaults
, merge
, mergeDefaults
, tagColor
, tagColorString
, toStoredUiSettings
)
import Api.Model.Tag exposing (Tag)
import Data.Color exposing (Color)
import Dict exposing (Dict)
{-| Settings for the web ui. All fields should be optional, since it
is loaded from local storage.
@ -15,10 +22,10 @@ versions. Also if a user is logged out, an empty object is send to
force default settings.
-}
type alias StoredUiSettings =
{ itemSearchPageSize : Maybe Int
, tagCategoryColors : List ( String, String )
, nativePdfPreview : Bool
}
@ -31,12 +38,16 @@ default value, converting the StoredUiSettings into a UiSettings.
-}
type alias UiSettings =
{ itemSearchPageSize : Int
, tagCategoryColors : Dict String Color
, nativePdfPreview : Bool
}
defaults : UiSettings
defaults =
{ itemSearchPageSize = 60
, tagCategoryColors = Dict.empty
, nativePdfPreview = False
}
@ -44,6 +55,15 @@ merge : StoredUiSettings -> UiSettings -> UiSettings
merge given fallback =
{ itemSearchPageSize =
choose given.itemSearchPageSize fallback.itemSearchPageSize
, tagCategoryColors =
Dict.union
(Dict.fromList given.tagCategoryColors
|> Dict.map (\_ -> Data.Color.fromString)
|> Dict.filter (\_ -> \mc -> mc /= Nothing)
|> Dict.map (\_ -> Maybe.withDefault Data.Color.Grey)
)
fallback.tagCategoryColors
, nativePdfPreview = given.nativePdfPreview
}
@ -55,9 +75,33 @@ mergeDefaults given =
toStoredUiSettings : UiSettings -> StoredUiSettings
toStoredUiSettings settings =
{ itemSearchPageSize = Just settings.itemSearchPageSize
, tagCategoryColors =
Dict.map (\_ -> Data.Color.toString) settings.tagCategoryColors
|> Dict.toList
, nativePdfPreview = settings.nativePdfPreview
}
tagColor : Tag -> UiSettings -> Maybe Color
tagColor tag settings =
let
readColor c =
Dict.get c settings.tagCategoryColors
in
Maybe.andThen readColor tag.category
tagColorString : Tag -> UiSettings -> String
tagColorString tag settings =
tagColor tag settings
|> Maybe.map Data.Color.toString
|> Maybe.withDefault ""
--- Helpers
choose : Maybe a -> a -> a
choose m1 m2 =
Maybe.withDefault m2 m1

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

@ -7,6 +7,7 @@ import App.View exposing (..)
import Browser exposing (Document)
import Browser.Navigation exposing (Key)
import Data.Flags exposing (Flags)
import Data.UiSettings
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
@ -38,8 +39,8 @@ main =
init : Flags -> Url -> Key -> ( Model, Cmd Msg )
init flags url key =
let
im =
App.Data.init key url flags
( im, ic ) =
App.Data.init key url flags Data.UiSettings.defaults
page =
checkPage flags im.page
@ -62,6 +63,7 @@ init flags url key =
( m
, Cmd.batch
[ cmd
, ic
, Api.versionInfo flags VersionResp
, sessionCheck
, Ports.getUiSettings flags

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

@ -5,6 +5,7 @@ import Comp.CollectiveSettingsForm
import Comp.SourceManage
import Comp.UserManage
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
@ -14,8 +15,8 @@ import Util.Maybe
import Util.Size
view : Flags -> Model -> Html Msg
view flags model =
view : Flags -> UiSettings -> Model -> Html Msg
view flags settings model =
div [ class "collectivesetting-page ui padded grid" ]
[ div [ class "sixteen wide mobile four wide tablet four wide computer column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
@ -61,13 +62,13 @@ view flags model =
viewSources flags model
Just UserTab ->
viewUsers model
viewUsers settings model
Just InsightsTab ->
viewInsights model
Just SettingsTab ->
viewSettings flags model
viewSettings flags settings model
Nothing ->
[]
@ -164,26 +165,26 @@ viewSources flags model =
]
viewUsers : Model -> List (Html Msg)
viewUsers model =
viewUsers : UiSettings -> Model -> List (Html Msg)
viewUsers settings model =
[ h2 [ class "ui header" ]
[ i [ class "ui user icon" ] []
, div [ class "content" ]
[ text "Users"
]
]
, Html.map UserMsg (Comp.UserManage.view model.userModel)
, Html.map UserMsg (Comp.UserManage.view settings model.userModel)
]
viewSettings : Flags -> Model -> List (Html Msg)
viewSettings flags model =
viewSettings : Flags -> UiSettings -> Model -> List (Html Msg)
viewSettings flags settings model =
[ h2 [ class "ui header" ]
[ i [ class "cog icon" ] []
, text "Settings"
]
, div [ class "ui segment" ]
[ Html.map SettingsFormMsg (Comp.CollectiveSettingsForm.view flags model.settingsModel)
[ Html.map SettingsFormMsg (Comp.CollectiveSettingsForm.view flags settings model.settingsModel)
]
, div
[ classList

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

@ -27,13 +27,12 @@ type alias Model =
, searchOffset : Int
, moreAvailable : Bool
, moreInProgress : Bool
, uiSettings : UiSettings
}
init : Flags -> Model
init _ =
{ searchMenuModel = Comp.SearchMenu.emptyModel
{ searchMenuModel = Comp.SearchMenu.init
, itemListModel = Comp.ItemCardList.init
, searchInProgress = False
, viewMode = Listing
@ -41,7 +40,6 @@ init _ =
, searchOffset = 0
, moreAvailable = True
, moreInProgress = False
, uiSettings = Data.UiSettings.defaults
}
@ -55,7 +53,6 @@ type Msg
| DoSearch
| ToggleSearchMenu
| LoadMore
| GetUiSettings UiSettings
type ViewMode
@ -77,15 +74,15 @@ itemNav id model =
}
doSearchCmd : Flags -> Int -> Model -> Cmd Msg
doSearchCmd flags offset model =
doSearchCmd : Flags -> UiSettings -> Int -> Model -> Cmd Msg
doSearchCmd flags settings offset model =
let
smask =
Comp.SearchMenu.getItemSearch model.searchMenuModel
mask =
{ smask
| limit = model.uiSettings.itemSearchPageSize
| limit = settings.itemSearchPageSize
, offset = offset
}
in
@ -96,10 +93,10 @@ doSearchCmd flags offset model =
Api.itemSearch flags mask ItemSearchAddResp
resultsBelowLimit : Model -> Bool
resultsBelowLimit model =
resultsBelowLimit : UiSettings -> Model -> Bool
resultsBelowLimit settings model =
let
len =
Data.Items.length model.itemListModel.results
in
len < model.uiSettings.itemSearchPageSize
len < settings.itemSearchPageSize

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

@ -4,17 +4,18 @@ import Browser.Navigation as Nav
import Comp.ItemCardList
import Comp.SearchMenu
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Page exposing (Page(..))
import Page.Home.Data exposing (..)
import Util.Update
update : Nav.Key -> Flags -> Msg -> Model -> ( Model, Cmd Msg )
update key flags msg model =
update : Nav.Key -> Flags -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg )
update key flags settings msg model =
case msg of
Init ->
Util.Update.andThen1
[ update key flags (SearchMenuMsg Comp.SearchMenu.Init)
[ update key flags settings (SearchMenuMsg Comp.SearchMenu.Init)
]
model
@ -23,19 +24,19 @@ update key flags msg model =
nm =
{ model | searchOffset = 0 }
in
update key flags (SearchMenuMsg Comp.SearchMenu.ResetForm) nm
update key flags settings (SearchMenuMsg Comp.SearchMenu.ResetForm) nm
SearchMenuMsg m ->
let
nextState =
Comp.SearchMenu.update flags m model.searchMenuModel
Comp.SearchMenu.update flags settings m model.searchMenuModel
newModel =
{ model | searchMenuModel = Tuple.first nextState.modelCmd }
( m2, c2 ) =
if nextState.stateChange then
doSearch flags newModel
doSearch flags settings newModel
else
( newModel, Cmd.none )
@ -62,7 +63,7 @@ update key flags msg model =
ItemSearchResp (Ok list) ->
let
noff =
model.uiSettings.itemSearchPageSize
settings.itemSearchPageSize
m =
{ model
@ -72,12 +73,12 @@ update key flags msg model =
, moreAvailable = list.groups /= []
}
in
update key flags (ItemCardListMsg (Comp.ItemCardList.SetResults list)) m
update key flags settings (ItemCardListMsg (Comp.ItemCardList.SetResults list)) m
ItemSearchAddResp (Ok list) ->
let
noff =
model.searchOffset + model.uiSettings.itemSearchPageSize
model.searchOffset + settings.itemSearchPageSize
m =
{ model
@ -88,7 +89,7 @@ update key flags msg model =
, moreAvailable = list.groups /= []
}
in
update key flags (ItemCardListMsg (Comp.ItemCardList.AddResults list)) m
update key flags settings (ItemCardListMsg (Comp.ItemCardList.AddResults list)) m
ItemSearchAddResp (Err _) ->
( { model
@ -109,7 +110,7 @@ update key flags msg model =
nm =
{ model | searchOffset = 0 }
in
doSearch flags nm
doSearch flags settings nm
ToggleSearchMenu ->
( { model | menuCollapsed = not model.menuCollapsed }
@ -118,24 +119,17 @@ update key flags msg model =
LoadMore ->
if model.moreAvailable then
doSearchMore flags model
doSearchMore flags settings model
else
( model, Cmd.none )
GetUiSettings settings ->
let
m_ =
{ model | uiSettings = settings }
in
doSearch flags m_
doSearch : Flags -> Model -> ( Model, Cmd Msg )
doSearch flags model =
doSearch : Flags -> UiSettings -> Model -> ( Model, Cmd Msg )
doSearch flags settings model =
let
cmd =
doSearchCmd flags 0 model
doSearchCmd flags settings 0 model
in
( { model
| searchInProgress = True
@ -146,11 +140,11 @@ doSearch flags model =
)
doSearchMore : Flags -> Model -> ( Model, Cmd Msg )
doSearchMore flags model =
doSearchMore : Flags -> UiSettings -> Model -> ( Model, Cmd Msg )
doSearchMore flags settings model =
let
cmd =
doSearchCmd flags model.searchOffset model
doSearchCmd flags settings model.searchOffset model
in
( { model | moreInProgress = True, viewMode = Listing }
, cmd

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

@ -2,6 +2,7 @@ module Page.Home.View exposing (view)
import Comp.ItemCardList
import Comp.SearchMenu
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
@ -9,8 +10,8 @@ import Page exposing (Page(..))
import Page.Home.Data exposing (..)
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "home-page ui padded grid" ]
[ div
[ classList
@ -52,7 +53,7 @@ view model =
]
]
, div [ class "ui attached fluid segment" ]
[ Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel)
[ Html.map SearchMenuMsg (Comp.SearchMenu.view settings model.searchMenuModel)
]
]
, div
@ -86,7 +87,7 @@ view model =
else
Html.map ItemCardListMsg
(Comp.ItemCardList.view model.itemListModel)
(Comp.ItemCardList.view settings model.itemListModel)
Detail ->
div [] []
@ -101,7 +102,7 @@ view model =
[ classList
[ ( "ui basic tiny button", True )
, ( "disabled", not model.moreAvailable )
, ( "hidden invisible", resultsBelowLimit model )
, ( "hidden invisible", resultsBelowLimit settings model )
]
, disabled (not model.moreAvailable || model.moreInProgress || model.searchInProgress)
, title "Load more items"

7
modules/webapp/src/main/elm/Page/ItemDetail/View.elm
View File

@ -1,6 +1,7 @@
module Page.ItemDetail.View exposing (view)
import Comp.ItemDetail
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Page.ItemDetail.Data exposing (Model, Msg(..))
@ -12,8 +13,8 @@ type alias ItemNav =
}
view : ItemNav -> Model -> Html Msg
view inav model =
view : ItemNav -> UiSettings -> Model -> Html Msg
view inav settings model =
div [ class "ui fluid container item-detail-page" ]
[ Html.map ItemDetailMsg (Comp.ItemDetail.view inav model.detail)
[ Html.map ItemDetailMsg (Comp.ItemDetail.view inav settings model.detail)
]

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

@ -4,6 +4,7 @@ import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
@ -11,8 +12,8 @@ import Page.ManageData.Data exposing (..)
import Util.Html exposing (classActive)
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "managedata-page ui padded grid" ]
[ div [ class "sixteen wide mobile four wide tablet four wide computer column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
@ -61,10 +62,10 @@ view model =
viewEquip model
Just OrgTab ->
viewOrg model
viewOrg settings model
Just PersonTab ->
viewPerson model
viewPerson settings model
Nothing ->
[]
@ -97,25 +98,25 @@ viewEquip model =
]
viewOrg : Model -> List (Html Msg)
viewOrg model =
viewOrg : UiSettings -> Model -> List (Html Msg)
viewOrg settings model =
[ h2 [ class "ui header" ]
[ i [ class "ui factory icon" ] []
, div [ class "content" ]
[ text "Organizations"
]
]
, Html.map OrgManageMsg (Comp.OrgManage.view model.orgManageModel)
, Html.map OrgManageMsg (Comp.OrgManage.view settings model.orgManageModel)
]
viewPerson : Model -> List (Html Msg)
viewPerson model =
viewPerson : UiSettings -> Model -> List (Html Msg)
viewPerson settings model =
[ h2 [ class "ui header" ]
[ i [ class "ui user icon" ] []
, div [ class "content" ]
[ text "Person"
]
]
, Html.map PersonManageMsg (Comp.PersonManage.view model.personManageModel)
, Html.map PersonManageMsg (Comp.PersonManage.view settings model.personManageModel)
]

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

@ -2,7 +2,7 @@ module Page.UserSettings.Data exposing
( Model
, Msg(..)
, Tab(..)
, emptyModel
, init
)
import Comp.ChangePasswordForm
@ -26,16 +26,22 @@ type alias Model =
}
emptyModel : Flags -> Model
emptyModel flags =
{ currentTab = Nothing
, changePassModel = Comp.ChangePasswordForm.emptyModel
, emailSettingsModel = Comp.EmailSettingsManage.emptyModel
, imapSettingsModel = Comp.ImapSettingsManage.emptyModel
, notificationModel = Tuple.first (Comp.NotificationForm.init flags)
, scanMailboxModel = Tuple.first (Comp.ScanMailboxManage.init flags)
, uiSettingsModel = Comp.UiSettingsManage.init Data.UiSettings.defaults
}
init : Flags -> UiSettings -> ( Model, Cmd Msg )
init flags settings =
let
( um, uc ) =
Comp.UiSettingsManage.init flags settings
in
( { currentTab = Nothing
, changePassModel = Comp.ChangePasswordForm.emptyModel
, emailSettingsModel = Comp.EmailSettingsManage.emptyModel
, imapSettingsModel = Comp.ImapSettingsManage.emptyModel
, notificationModel = Tuple.first (Comp.NotificationForm.init flags settings)
, scanMailboxModel = Tuple.first (Comp.ScanMailboxManage.init flags)
, uiSettingsModel = um
}
, Cmd.map UiSettingsMsg uc
)
type Tab
@ -54,5 +60,5 @@ type Msg
| NotificationMsg Comp.NotificationForm.Msg
| ImapSettingsMsg Comp.ImapSettingsManage.Msg
| ScanMailboxMsg Comp.ScanMailboxManage.Msg
| GetUiSettings UiSettings
| UiSettingsMsg Comp.UiSettingsManage.Msg
| UpdateSettings

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

@ -7,11 +7,12 @@ import Comp.NotificationForm
import Comp.ScanMailboxManage
import Comp.UiSettingsManage
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Page.UserSettings.Data exposing (..)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
update flags msg model =
update : Flags -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
update flags settings msg model =
case msg of
SetTab t ->
let
@ -40,7 +41,7 @@ update flags msg model =
let
initCmd =
Cmd.map NotificationMsg
(Tuple.second (Comp.NotificationForm.init flags))
(Tuple.second (Comp.NotificationForm.init flags settings))
in
( m, initCmd, Sub.none )
@ -96,18 +97,18 @@ update flags msg model =
, Sub.none
)
GetUiSettings settings ->
( { model | uiSettingsModel = Comp.UiSettingsManage.init settings }
, Cmd.none
, Sub.none
)
UiSettingsMsg lm ->
let
( m2, c2, s2 ) =
Comp.UiSettingsManage.update flags lm model.uiSettingsModel
Comp.UiSettingsManage.update flags settings lm model.uiSettingsModel
in
( { model | uiSettingsModel = m2 }
, Cmd.map UiSettingsMsg c2
, Sub.map UiSettingsMsg s2
)
UpdateSettings ->
update flags
settings
(UiSettingsMsg Comp.UiSettingsManage.UpdateSettings)
model

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

@ -6,6 +6,7 @@ import Comp.ImapSettingsManage
import Comp.NotificationForm
import Comp.ScanMailboxManage
import Comp.UiSettingsManage
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
@ -13,8 +14,8 @@ import Page.UserSettings.Data exposing (..)
import Util.Html exposing (classActive)
view : Model -> Html Msg
view model =
view : UiSettings -> Model -> Html Msg
view settings model =
div [ class "usersetting-page ui padded grid" ]
[ div [ class "sixteen wide mobile four wide tablet four wide computer column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
@ -38,19 +39,19 @@ view model =
viewChangePassword model
Just EmailSettingsTab ->
viewEmailSettings model
viewEmailSettings settings model
Just NotificationTab ->
viewNotificationForm model
viewNotificationForm settings model
Just ImapSettingsTab ->
viewImapSettings model
viewImapSettings settings model
Just ScanMailboxTab ->
viewScanMailboxManage model
viewScanMailboxManage settings model
Just UiSettingsTab ->
viewUiSettings model
viewUiSettings settings model
Nothing ->
[]
@ -71,8 +72,8 @@ makeTab model tab header icon =
]
viewUiSettings : Model -> List (Html Msg)
viewUiSettings model =
viewUiSettings : UiSettings -> Model -> List (Html Msg)
viewUiSettings settings model =
[ h2 [ class "ui header" ]
[ i [ class "cog icon" ] []
, text "UI Settings"
@ -81,31 +82,36 @@ viewUiSettings model =
[ text "These settings only affect the web ui. They are stored in the browser, "
, text "so they are separated between browsers and devices."
]
, Html.map UiSettingsMsg (Comp.UiSettingsManage.view "ui segment" model.uiSettingsModel)
, Html.map UiSettingsMsg
(Comp.UiSettingsManage.view
settings
"ui segment"
model.uiSettingsModel
)
]
viewEmailSettings : Model -> List (Html Msg)
viewEmailSettings model =
viewEmailSettings : UiSettings -> Model -> List (Html Msg)
viewEmailSettings settings model =
[ h2 [ class "ui header" ]
[ i [ class "mail icon" ] []
, div [ class "content" ]
[ text "E-Mail Settings (Smtp)"
]
]
, Html.map EmailSettingsMsg (Comp.EmailSettingsManage.view model.emailSettingsModel)
, Html.map EmailSettingsMsg (Comp.EmailSettingsManage.view settings model.emailSettingsModel)
]
viewImapSettings : Model -> List (Html Msg)
viewImapSettings model =
viewImapSettings : UiSettings -> Model -> List (Html Msg)
viewImapSettings settings model =
[ h2 [ class "ui header" ]
[ i [ class "mail icon" ] []
, div [ class "content" ]
[ text "E-Mail Settings (Imap)"
]
]
, Html.map ImapSettingsMsg (Comp.ImapSettingsManage.view model.imapSettingsModel)
, Html.map ImapSettingsMsg (Comp.ImapSettingsManage.view settings model.imapSettingsModel)
]
@ -121,8 +127,8 @@ viewChangePassword model =
]
viewNotificationForm : Model -> List (Html Msg)
viewNotificationForm model =
viewNotificationForm : UiSettings -> Model -> List (Html Msg)
viewNotificationForm settings model =
[ h2 [ class "ui header" ]
[ i [ class "ui bullhorn icon" ] []
, div [ class "content" ]
@ -141,12 +147,12 @@ viewNotificationForm model =
, text " days and sends this list via e-mail."
]
, Html.map NotificationMsg
(Comp.NotificationForm.view "segment" model.notificationModel)
(Comp.NotificationForm.view "segment" settings model.notificationModel)
]
viewScanMailboxManage : Model -> List (Html Msg)
viewScanMailboxManage model =
viewScanMailboxManage : UiSettings -> Model -> List (Html Msg)
viewScanMailboxManage settings model =
[ h2 [ class "ui header" ]
[ i [ class "ui envelope open outline icon" ] []
, div [ class "content" ]
@ -171,6 +177,7 @@ viewScanMailboxManage model =
]
, Html.map ScanMailboxMsg
(Comp.ScanMailboxManage.view
settings
model.scanMailboxModel
)
]

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

@ -32,13 +32,13 @@ port setAllProgress : ( String, Int ) -> Cmd msg
port scrollToElem : String -> Cmd msg
port saveUiSettings : ( AuthResult, UiSettings ) -> Cmd msg
port saveUiSettings : ( AuthResult, StoredUiSettings ) -> Cmd msg
port receiveUiSettings : (StoredUiSettings -> msg) -> Sub msg
port requestUiSettings : ( AuthResult, UiSettings ) -> Cmd msg
port requestUiSettings : ( AuthResult, StoredUiSettings ) -> Cmd msg
port uiSettingsSaved : (() -> msg) -> Sub msg
@ -53,7 +53,10 @@ storeUiSettings : Flags -> UiSettings -> Cmd msg
storeUiSettings flags settings =
case flags.account of
Just ar ->
saveUiSettings ( ar, settings )
saveUiSettings
( ar
, Data.UiSettings.toStoredUiSettings settings
)
Nothing ->
Cmd.none
@ -68,7 +71,10 @@ getUiSettings : Flags -> Cmd msg
getUiSettings flags =
case flags.account of
Just ar ->
requestUiSettings ( ar, Data.UiSettings.defaults )
requestUiSettings
( ar
, Data.UiSettings.toStoredUiSettings Data.UiSettings.defaults
)
Nothing ->
Cmd.none

9
modules/webapp/src/main/elm/Util/Tag.elm
View File

@ -2,7 +2,7 @@ module Util.Tag exposing (makeDropdownModel)
import Api.Model.Tag exposing (Tag)
import Comp.Dropdown
import Util.Maybe
import Data.UiSettings
makeDropdownModel : Comp.Dropdown.Model Tag
@ -13,10 +13,7 @@ makeDropdownModel =
, makeOption = \tag -> { value = tag.id, text = tag.name }
, labelColor =
\tag ->
if Util.Maybe.nonEmpty tag.category then
"basic blue"
else
""
\settings ->
"basic " ++ Data.UiSettings.tagColorString tag settings
, placeholder = "Choose a tag…"
}

2
modules/webapp/src/main/webjar/docspell.css
View File

@ -153,7 +153,7 @@ label span.muted {
margin-left: 0.5em;
}
.ui.search.dropdown.open {
.ui.search.dropdown.open, .ui.selection.dropdown.open {
z-index: 20;
}