From 81a136d915e97bf1d1176fb3775b18900623a439 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sun, 29 Nov 2020 20:15:00 +0100 Subject: [PATCH 1/2] Use a template for rendering title and subtitle of the item card Introduces `ItemTemplate` to conveniently create strings given an item. --- modules/webapp/src/main/elm/Comp/ItemCard.elm | 24 +- .../webapp/src/main/elm/Data/ItemTemplate.elm | 386 ++++++++++++++++++ modules/webapp/src/main/elm/Util/List.elm | 15 + 3 files changed, 414 insertions(+), 11 deletions(-) create mode 100644 modules/webapp/src/main/elm/Data/ItemTemplate.elm diff --git a/modules/webapp/src/main/elm/Comp/ItemCard.elm b/modules/webapp/src/main/elm/Comp/ItemCard.elm index bed1dafe..23eaf3cd 100644 --- a/modules/webapp/src/main/elm/Comp/ItemCard.elm +++ b/modules/webapp/src/main/elm/Comp/ItemCard.elm @@ -11,13 +11,13 @@ module Comp.ItemCard exposing import Api import Api.Model.AttachmentLight exposing (AttachmentLight) import Api.Model.HighlightEntry exposing (HighlightEntry) -import Api.Model.IdName exposing (IdName) import Api.Model.ItemLight exposing (ItemLight) import Comp.LinkTarget exposing (LinkTarget(..)) import Data.Direction import Data.Fields import Data.Icons as Icons import Data.ItemSelection exposing (ItemSelection) +import Data.ItemTemplate as IT import Data.UiSettings exposing (UiSettings) import Html exposing (..) import Html.Attributes exposing (..) @@ -30,7 +30,6 @@ import Util.ItemDragDrop as DD import Util.List import Util.Maybe import Util.String -import Util.Time type alias Model = @@ -220,8 +219,7 @@ metaDataContent settings item = Data.UiSettings.fieldHidden settings f dueDate = - Maybe.map Util.Time.formatDateShort item.dueDate - |> Maybe.withDefault "" + IT.render IT.dueDateShort item in div [ class "content" ] [ div [ class "ui horizontal link list" ] @@ -268,7 +266,7 @@ metaDataContent settings item = [ class "item" , title "Source" ] - [ text item.source + [ IT.render IT.source item |> text ] , div [ classList @@ -321,6 +319,12 @@ mainContent cardAction cardColor isConfirmed settings _ item = fieldHidden f = Data.UiSettings.fieldHidden settings f + + titlePattern = + IT.name + + subtitlePattern = + IT.dateLong in a [ class "content" @@ -329,18 +333,16 @@ mainContent cardAction cardColor isConfirmed settings _ item = ] [ if fieldHidden Data.Fields.Direction then div [ class "header" ] - [ Util.String.underscoreToSpace item.name |> text + [ IT.render titlePattern item |> text ] else div [ class "header" - , Data.Direction.labelFromMaybe item.direction - |> title + , IT.render IT.direction item |> title ] [ dirIcon - , Util.String.underscoreToSpace item.name - |> text + , IT.render titlePattern item |> text ] , div [ classList @@ -358,7 +360,7 @@ mainContent cardAction cardColor isConfirmed settings _ item = , ( "invisible hidden", fieldHidden Data.Fields.Date ) ] ] - [ Util.Time.formatDate item.date |> text + [ IT.render subtitlePattern item |> text ] , div [ class "meta description" ] [ mainTagsAndFields settings item diff --git a/modules/webapp/src/main/elm/Data/ItemTemplate.elm b/modules/webapp/src/main/elm/Data/ItemTemplate.elm new file mode 100644 index 00000000..957e9949 --- /dev/null +++ b/modules/webapp/src/main/elm/Data/ItemTemplate.elm @@ -0,0 +1,386 @@ +module Data.ItemTemplate exposing + ( ItemTemplate + , concEquip + , concPerson + , concat + , concerning + , corrOrg + , corrPerson + , correspondent + , dateLong + , dateShort + , direction + , dueDateLong + , dueDateShort + , empty + , fileCount + , folder + , from + , fromMaybe + , helpMessage + , isEmpty + , literal + , map + , name + , nonEmpty + , readTemplate + , render + , source + , splitTokens + ) + +import Api.Model.IdName exposing (IdName) +import Api.Model.ItemLight exposing (ItemLight) +import Data.Direction +import Set +import Util.List +import Util.String +import Util.Time + + +type ItemTemplate + = ItemTemplate (ItemLight -> String) + + +readTemplate : String -> Maybe ItemTemplate +readTemplate str = + let + read tokens = + List.map patternToken tokens + |> concat + in + if str == "" then + Just empty + + else + Maybe.map read (splitTokens str) + + +render : ItemTemplate -> ItemLight -> String +render pattern item = + case pattern of + ItemTemplate f -> + f item + + +isEmpty : ItemTemplate -> ItemLight -> Bool +isEmpty pattern item = + render pattern item |> String.isEmpty + + +nonEmpty : ItemTemplate -> ItemLight -> Bool +nonEmpty pattern item = + isEmpty pattern item |> not + + + +--- Pattern Combinators + + +map : (String -> String) -> ItemTemplate -> ItemTemplate +map f pattern = + case pattern of + ItemTemplate p -> + from (p >> f) + + +map2 : (String -> String -> String) -> ItemTemplate -> ItemTemplate -> ItemTemplate +map2 f pattern1 pattern2 = + case ( pattern1, pattern2 ) of + ( ItemTemplate p1, ItemTemplate p2 ) -> + from (\i -> f (p1 i) (p2 i)) + + +combine : String -> ItemTemplate -> ItemTemplate -> ItemTemplate +combine sep p1 p2 = + map2 + (\s1 -> + \s2 -> + List.filter (String.isEmpty >> not) [ s1, s2 ] + |> String.join sep + ) + p1 + p2 + + +concat : List ItemTemplate -> ItemTemplate +concat patterns = + from + (\i -> + List.map (\p -> render p i) patterns + |> String.join "" + ) + + +firstNonEmpty : List ItemTemplate -> ItemTemplate +firstNonEmpty patterns = + from + (\i -> + List.map (\p -> render p i) patterns + |> List.filter (String.isEmpty >> not) + |> List.head + |> Maybe.withDefault "" + ) + + + +--- Patterns + + +from : (ItemLight -> String) -> ItemTemplate +from f = + ItemTemplate f + + +fromMaybe : (ItemLight -> Maybe String) -> ItemTemplate +fromMaybe f = + ItemTemplate (f >> Maybe.withDefault "") + + +literal : String -> ItemTemplate +literal str = + ItemTemplate (\_ -> str) + + +empty : ItemTemplate +empty = + literal "" + + +name : ItemTemplate +name = + ItemTemplate (.name >> Util.String.underscoreToSpace) + + +direction : ItemTemplate +direction = + let + dirStr ms = + Maybe.andThen Data.Direction.fromString ms + |> Maybe.map Data.Direction.toString + in + fromMaybe (.direction >> dirStr) + + +dateLong : ItemTemplate +dateLong = + ItemTemplate (.date >> Util.Time.formatDate) + + +dateShort : ItemTemplate +dateShort = + ItemTemplate (.date >> Util.Time.formatDateShort) + + +dueDateLong : ItemTemplate +dueDateLong = + fromMaybe (.dueDate >> Maybe.map Util.Time.formatDate) + + +dueDateShort : ItemTemplate +dueDateShort = + fromMaybe (.dueDate >> Maybe.map Util.Time.formatDateShort) + + +source : ItemTemplate +source = + ItemTemplate .source + + +folder : ItemTemplate +folder = + ItemTemplate (.folder >> getName) + + +corrOrg : ItemTemplate +corrOrg = + ItemTemplate (.corrOrg >> getName) + + +corrPerson : ItemTemplate +corrPerson = + ItemTemplate (.corrPerson >> getName) + + +correspondent : ItemTemplate +correspondent = + combine ", " corrOrg corrPerson + + +concPerson : ItemTemplate +concPerson = + ItemTemplate (.concPerson >> getName) + + +concEquip : ItemTemplate +concEquip = + ItemTemplate (.concEquipment >> getName) + + +concerning : ItemTemplate +concerning = + combine ", " concPerson concEquip + + +fileCount : ItemTemplate +fileCount = + ItemTemplate (.fileCount >> String.fromInt) + + + +--- Helpers + + +getName : Maybe IdName -> String +getName = + Maybe.map .name >> Maybe.withDefault "" + + + +--- Parse pattern + + +helpMessage : String +helpMessage = + """ +A pattern allows to customize the title and subtitle of each card. +Variables expressions are enclosed in `{{` and `}}`, other text is +used as-is. The following variables are available: + +- `{{name}}` the item name +- `{{source}}` the source the item was created from +- `{{folder}}` the items folder +- `{{corrOrg}}` the correspondent organization +- `{{corrPerson}}` the correspondent person +- `{{correspondent}}` both organization and person separated by a comma +- `{{concPerson}}` the concerning person +- `{{concEquip}}` the concerning equipment +- `{{concerning}}` both person and equipment separated by a comma +- `{{fileCount}}` the number of attachments of this item +- `{{dateLong}}` the item date as full formatted date +- `{{dateShort}}` the item date as short formatted date (yyyy/mm/dd) +- `{{dueDateLong}}` the item due date as full formatted date +- `{{dueDateShort}}` the item due date as short formatted date (yyyy/mm/dd) +- `{{direction}}` the items direction values as string + +If some variable is not present, an empty string is rendered. You can +combine multiple variables with `|` to use the first non-empty one, +for example `{{corrOrg|corrPerson|-}}` would render the organization +and if that is not present the person. If both are absent a dash `-` +is rendered. +""" + + +knownPattern : String -> Maybe ItemTemplate +knownPattern str = + case str of + "{{name}}" -> + Just name + + "{{source}}" -> + Just source + + "{{folder}}" -> + Just folder + + "{{corrOrg}}" -> + Just corrOrg + + "{{corrPerson}}" -> + Just corrPerson + + "{{correspondent}}" -> + Just correspondent + + "{{concPerson}}" -> + Just concPerson + + "{{concEquip}}" -> + Just concEquip + + "{{concerning}}" -> + Just concerning + + "{{fileCount}}" -> + Just fileCount + + "{{dateLong}}" -> + Just dateLong + + "{{dateShort}}" -> + Just dateShort + + "{{dueDateLong}}" -> + Just dueDateLong + + "{{dueDateShort}}" -> + Just dueDateShort + + "{{direction}}" -> + Just direction + + _ -> + Nothing + + +patternToken : String -> ItemTemplate +patternToken str = + knownPattern str + |> Maybe.withDefault + (alternativeToken str + |> Maybe.withDefault (literal str) + ) + + +alternativeToken : String -> Maybe ItemTemplate +alternativeToken str = + let + inner = + String.dropLeft 2 str + |> String.dropRight 2 + |> String.split "|" + |> List.filter (String.isEmpty >> not) + + pattern s = + knownPattern ("{{" ++ s ++ "}}") + |> Maybe.withDefault (literal s) + in + if String.startsWith "{{" str && String.endsWith "}}" str then + case inner of + [] -> + Nothing + + _ -> + List.map pattern inner + |> firstNonEmpty + |> Just + + else + Nothing + + +splitTokens : String -> Maybe (List String) +splitTokens str = + let + begins = + String.indexes "{{" str + + ends = + String.indexes "}}" str + |> List.map ((+) 2) + + indexes = + Set.union (Set.fromList begins) (Set.fromList ends) + |> Set.insert 0 + |> Set.insert (String.length str) + |> Set.toList + |> List.sort + + mkSubstring i1 i2 = + String.slice i1 i2 str + in + if List.length begins == List.length ends then + Util.List.sliding mkSubstring indexes |> Just + + else + Nothing diff --git a/modules/webapp/src/main/elm/Util/List.elm b/modules/webapp/src/main/elm/Util/List.elm index c7df91ca..57f03273 100644 --- a/modules/webapp/src/main/elm/Util/List.elm +++ b/modules/webapp/src/main/elm/Util/List.elm @@ -6,6 +6,7 @@ module Util.List exposing , findNext , findPrev , get + , sliding ) @@ -88,3 +89,17 @@ dropRight n list = List.reverse list |> List.drop n |> List.reverse + + +sliding : (a -> a -> b) -> List a -> List b +sliding f list = + let + windows = + case list of + _ :: xs -> + List.map2 Tuple.pair list xs + + _ -> + [] + in + List.map (\( e1, e2 ) -> f e1 e2) windows From bdc49aae98f8909de336e4cca41c283188db88d3 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sun, 29 Nov 2020 23:36:25 +0100 Subject: [PATCH 2/2] Let user change template for card title and subtitle --- modules/webapp/src/main/elm/Comp/ItemCard.elm | 4 +- .../src/main/elm/Comp/UiSettingsForm.elm | 145 +++++++++++++++++- .../webapp/src/main/elm/Data/UiSettings.elm | 36 ++++- 3 files changed, 180 insertions(+), 5 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/ItemCard.elm b/modules/webapp/src/main/elm/Comp/ItemCard.elm index 23eaf3cd..11213bf9 100644 --- a/modules/webapp/src/main/elm/Comp/ItemCard.elm +++ b/modules/webapp/src/main/elm/Comp/ItemCard.elm @@ -321,10 +321,10 @@ mainContent cardAction cardColor isConfirmed settings _ item = Data.UiSettings.fieldHidden settings f titlePattern = - IT.name + settings.cardTitleTemplate.template subtitlePattern = - IT.dateLong + settings.cardSubtitleTemplate.template in a [ class "content" diff --git a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm index 940de6e6..ec46fa32 100644 --- a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm +++ b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm @@ -16,12 +16,15 @@ import Data.BasicSize exposing (BasicSize) import Data.Color exposing (Color) import Data.Fields exposing (Field) import Data.Flags exposing (Flags) -import Data.UiSettings exposing (Pos(..), UiSettings) +import Data.ItemTemplate as IT exposing (ItemTemplate) +import Data.UiSettings exposing (ItemPattern, Pos(..), UiSettings) import Dict exposing (Dict) import Html exposing (..) import Html.Attributes exposing (..) -import Html.Events exposing (onCheck) +import Html.Events exposing (onCheck, onClick, onInput) import Http +import Markdown +import Util.Maybe import Util.Tag @@ -45,6 +48,44 @@ type alias Model = , searchMenuVisible : Bool , editMenuVisible : Bool , cardPreviewSize : BasicSize + , cardTitlePattern : PatternModel + , cardSubtitlePattern : PatternModel + , showPatternHelp : Bool + } + + +type alias PatternModel = + { pattern : Maybe String + , current : ItemTemplate + , result : Result String ItemTemplate + } + + +initPatternModel : ItemPattern -> PatternModel +initPatternModel ip = + { pattern = Just ip.pattern + , current = ip.template + , result = Ok ip.template + } + + +updatePatternModel : PatternModel -> String -> PatternModel +updatePatternModel pm str = + let + result = + case IT.readTemplate str of + Just t -> + Ok t + + Nothing -> + Err "Template invalid, check for unclosed variables." + + p = + Util.Maybe.fromString str + in + { pattern = p + , current = Result.withDefault pm.current result + , result = result } @@ -97,6 +138,9 @@ init flags settings = , searchMenuVisible = settings.searchMenuVisible , editMenuVisible = settings.editMenuVisible , cardPreviewSize = settings.cardPreviewSize + , cardTitlePattern = initPatternModel settings.cardTitleTemplate + , cardSubtitlePattern = initPatternModel settings.cardSubtitleTemplate + , showPatternHelp = False } , Api.getTags flags "" GetTagsResp ) @@ -117,6 +161,9 @@ type Msg | ToggleSearchMenuVisible | ToggleEditMenuVisible | CardPreviewSizeMsg Comp.BasicSizeField.Msg + | SetCardTitlePattern String + | SetCardSubtitlePattern String + | TogglePatternHelpMsg @@ -319,6 +366,55 @@ update sett msg model = , newSettings ) + SetCardTitlePattern str -> + let + pm = + model.cardTitlePattern + + pm_ = + updatePatternModel pm str + + newSettings = + if pm_.pattern /= Just sett.cardTitleTemplate.pattern then + Just + { sett + | cardTitleTemplate = + ItemPattern + (Maybe.withDefault "" pm_.pattern) + pm_.current + } + + else + Nothing + in + ( { model | cardTitlePattern = pm_ }, newSettings ) + + SetCardSubtitlePattern str -> + let + pm = + model.cardSubtitlePattern + + pm_ = + updatePatternModel pm str + + newSettings = + if pm_.pattern /= Just sett.cardSubtitleTemplate.pattern then + Just + { sett + | cardSubtitleTemplate = + ItemPattern + (Maybe.withDefault "" pm_.pattern) + pm_.current + } + + else + Nothing + in + ( { model | cardSubtitlePattern = pm_ }, newSettings ) + + TogglePatternHelpMsg -> + ( { model | showPatternHelp = not model.showPatternHelp }, Nothing ) + --- View @@ -369,6 +465,51 @@ view flags _ model = "Size of item preview" model.cardPreviewSize ) + , div [ class "field" ] + [ label [] + [ text "Card Title Pattern" + , a + [ class "right-float" + , title "Toggle pattern help text" + , href "#" + , onClick TogglePatternHelpMsg + ] + [ i [ class "help link icon" ] [] + ] + ] + , input + [ type_ "text" + , Maybe.withDefault "" model.cardTitlePattern.pattern |> value + , onInput SetCardTitlePattern + ] + [] + ] + , div [ class "field" ] + [ label [] + [ text "Card Subtitle Pattern" + , a + [ class "right-float" + , title "Toggle pattern help text" + , href "#" + , onClick TogglePatternHelpMsg + ] + [ i [ class "help link icon" ] [] + ] + ] + , input + [ type_ "text" + , Maybe.withDefault "" model.cardSubtitlePattern.pattern |> value + , onInput SetCardSubtitlePattern + ] + [] + ] + , Markdown.toHtml + [ classList + [ ( "ui message", True ) + , ( "hidden", not model.showPatternHelp ) + ] + ] + IT.helpMessage , div [ class "ui dividing header" ] [ text "Search Menu" ] , div [ class "field" ] diff --git a/modules/webapp/src/main/elm/Data/UiSettings.elm b/modules/webapp/src/main/elm/Data/UiSettings.elm index 5a0bc13f..2db6b41b 100644 --- a/modules/webapp/src/main/elm/Data/UiSettings.elm +++ b/modules/webapp/src/main/elm/Data/UiSettings.elm @@ -1,5 +1,6 @@ module Data.UiSettings exposing - ( Pos(..) + ( ItemPattern + , Pos(..) , StoredUiSettings , UiSettings , cardPreviewSize @@ -21,6 +22,7 @@ import Api.Model.Tag exposing (Tag) import Data.BasicSize exposing (BasicSize) import Data.Color exposing (Color) import Data.Fields exposing (Field) +import Data.ItemTemplate exposing (ItemTemplate) import Dict exposing (Dict) import Html exposing (Attribute) import Html.Attributes as HA @@ -48,6 +50,8 @@ type alias StoredUiSettings = , searchMenuVisible : Bool , editMenuVisible : Bool , cardPreviewSize : Maybe String + , cardTitleTemplate : Maybe String + , cardSubtitleTemplate : Maybe String } @@ -72,9 +76,23 @@ type alias UiSettings = , searchMenuVisible : Bool , editMenuVisible : Bool , cardPreviewSize : BasicSize + , cardTitleTemplate : ItemPattern + , cardSubtitleTemplate : ItemPattern } +type alias ItemPattern = + { pattern : String + , template : ItemTemplate + } + + +readPattern : String -> Maybe ItemPattern +readPattern str = + Data.ItemTemplate.readTemplate str + |> Maybe.map (ItemPattern str) + + type Pos = Top | Bottom @@ -118,6 +136,14 @@ defaults = , searchMenuVisible = False , editMenuVisible = False , cardPreviewSize = Data.BasicSize.Medium + , cardTitleTemplate = + { template = Data.ItemTemplate.name + , pattern = "{{name}}" + } + , cardSubtitleTemplate = + { template = Data.ItemTemplate.dateLong + , pattern = "{{dateLong}}" + } } @@ -157,6 +183,12 @@ merge given fallback = given.cardPreviewSize |> Maybe.andThen Data.BasicSize.fromString |> Maybe.withDefault fallback.cardPreviewSize + , cardTitleTemplate = + Maybe.andThen readPattern given.cardTitleTemplate + |> Maybe.withDefault fallback.cardTitleTemplate + , cardSubtitleTemplate = + Maybe.andThen readPattern given.cardSubtitleTemplate + |> Maybe.withDefault fallback.cardSubtitleTemplate } @@ -187,6 +219,8 @@ toStoredUiSettings settings = settings.cardPreviewSize |> Data.BasicSize.asString |> Just + , cardTitleTemplate = settings.cardTitleTemplate.pattern |> Just + , cardSubtitleTemplate = settings.cardSubtitleTemplate.pattern |> Just }