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

@@ -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
+            IT.render IT.dueDateShort item
-                |> Maybe.withDefault ""
     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
+                , IT.render IT.direction item |> title
-                    |> title
                 ]
                 [ dirIcon
-                , Util.String.underscoreToSpace item.name
+                , IT.render titlePattern item |> text
-                    |> 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

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

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