Merge pull request #476 from eikek/tag-category-chooser

Allow to choose from existing tag categories

modules/webapp/src/main/elm/App/Data.elm

@@ -43,6 +43,7 @@ type alias Model =
     , newInviteModel : Page.NewInvite.Data.Model
     , itemDetailModel : Page.ItemDetail.Data.Model
     , navMenuOpen : Bool
+    , userMenuOpen : Bool
     , subs : Sub Msg
     , uiSettings : UiSettings
     }
@@ -89,6 +90,7 @@ init key url flags_ settings =
       , newInviteModel = Page.NewInvite.Data.emptyModel
       , itemDetailModel = Page.ItemDetail.Data.emptyModel
       , navMenuOpen = False
+      , userMenuOpen = False
       , subs = Sub.none
       , uiSettings = settings
       }
@@ -142,6 +144,7 @@ type Msg
     | LogoutResp (Result Http.Error ())
     | SessionCheckResp (Result Http.Error AuthResult)
     | ToggleNavMenu
+    | ToggleUserMenu
     | GetUiSettings UiSettings
 
 

modules/webapp/src/main/elm/App/Update.elm

@@ -174,7 +174,29 @@ updateWithSub msg model =
                 ( model, Page.goto check, Sub.none )
 
         ToggleNavMenu ->
-            ( { model | navMenuOpen = not model.navMenuOpen }
+            ( { model
+                | navMenuOpen = not model.navMenuOpen
+                , userMenuOpen =
+                    if not model.navMenuOpen then
+                        False
+
+                    else
+                        model.userMenuOpen
+              }
+            , Cmd.none
+            , Sub.none
+            )
+
+        ToggleUserMenu ->
+            ( { model
+                | userMenuOpen = not model.userMenuOpen
+                , navMenuOpen =
+                    if not model.userMenuOpen then
+                        False
+
+                    else
+                        model.navMenuOpen
+              }
             , Cmd.none
             , Sub.none
             )

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

@@ -1,6 +1,7 @@
 module App.View exposing (view)
 
 import App.Data exposing (..)
+import Data.Flags
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (onClick)
@@ -16,7 +17,6 @@ import Page.Queue.View
 import Page.Register.View
 import Page.Upload.View
 import Page.UserSettings.View
-import Util.Maybe
 
 
 view : Model -> Html Msg
@@ -197,10 +197,51 @@ loginInfo : Model -> Html Msg
 loginInfo model =
     div [ class "right menu" ]
         (case model.flags.account of
-            Just _ ->
+            Just acc ->
-                [ div
+                [ a
+                    [ class "ui dropdown icon link item"
+                    , href "#"
+                    , onClick ToggleUserMenu
+                    , title ("Logged in as " ++ Data.Flags.accountString acc)
+                    ]
+                    [ i [ class "user alternate icon" ] []
+                    , div
+                        [ classList
+                            [ ( "left menu", True )
+                            , ( "transition visible", model.userMenuOpen )
+                            , ( "transition hidden", not model.userMenuOpen )
+                            ]
+                        ]
+                        [ div [ class "header" ]
+                            [ i [ class "user outline icon" ] []
+                            , Data.Flags.accountString acc |> text
+                            ]
+                        , div [ class "ui divider" ] []
+                        , menuEntry model
+                            CollectiveSettingPage
+                            [ i [ class "users circle icon" ] []
+                            , text "Collective Profile"
+                            ]
+                        , menuEntry model
+                            UserSettingPage
+                            [ i [ class "user circle icon" ] []
+                            , text "User Profile"
+                            ]
+                        , div [ class "divider" ] []
+                        , a
+                            [ class "icon item"
+                            , href ""
+                            , onClick Logout
+                            ]
+                            [ i [ class "sign out icon" ] []
+                            , text "Logout"
+                            ]
+                        ]
+                    ]
+                , a
                     [ class "ui dropdown icon link item"
                     , onClick ToggleNavMenu
+                    , href "#"
                     ]
                     [ i [ class "ui bars icon" ] []
                     , div
@@ -220,17 +261,6 @@ loginInfo model =
                             , text "Items"
                             ]
                         , div [ class "divider" ] []
-                        , menuEntry model
-                            CollectiveSettingPage
-                            [ i [ class "users circle icon" ] []
-                            , text "Collective Profile"
-                            ]
-                        , menuEntry model
-                            UserSettingPage
-                            [ i [ class "user circle icon" ] []
-                            , text "User Profile"
-                            ]
-                        , div [ class "divider" ] []
                         , menuEntry model
                             ManageDataPage
                             [ i [ class "cubes icon" ] []
@@ -277,15 +307,6 @@ loginInfo model =
                                 [ i [ class "external link icon" ] []
                                 ]
                             ]
-                        , div [ class "divider" ] []
-                        , a
-                            [ class "icon item"
-                            , href ""
-                            , onClick Logout
-                            ]
-                            [ i [ class "sign-out icon" ] []
-                            , text "Logout"
-                            ]
                         ]
                     ]
                 ]

modules/webapp/src/main/elm/Comp/DetailEdit.elm

@@ -165,11 +165,11 @@ initTag itemId tm =
     init itemId (TM tm)
 
 
-initTagByName : String -> String -> Model
+initTagByName : String -> String -> List String -> Model
-initTagByName itemId name =
+initTagByName itemId name categories =
     let
         tm =
-            Comp.TagForm.emptyModel
+            Comp.TagForm.emptyModel categories
 
         tm_ =
             { tm | name = name }

modules/webapp/src/main/elm/Comp/Dropdown.elm

@@ -13,6 +13,7 @@ module Comp.Dropdown exposing
     , setMkOption
     , update
     , view
+    , viewSingle
     )
 
 {-| This needs to be rewritten from scratch!
@@ -252,7 +253,15 @@ filterOptions str list =
 
 applyFilter : String -> Model a -> Model a
 applyFilter str model =
-    { model | filterString = str, available = filterOptions str model.available }
+    let
+        selected =
+            if str /= "" && not model.multiple then
+                []
+
+            else
+                model.selected
+    in
+    { model | filterString = str, available = filterOptions str model.available, selected = selected }
 
 
 makeNextActive : (Int -> Int) -> Model a -> Model a

modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm

@@ -98,6 +98,7 @@ type alias Model =
     , customFieldsModel : Comp.CustomFieldMultiInput.Model
     , customFieldSavingIcon : Dict String String
     , customFieldThrottle : Throttle Msg
+    , allTags : List Tag
     }
 
 
@@ -202,6 +203,7 @@ emptyModel =
     , customFieldsModel = Comp.CustomFieldMultiInput.initWith []
     , customFieldSavingIcon = Dict.empty
     , customFieldThrottle = Throttle.create 1
+    , allTags = []
     }
 
 

modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm

@@ -65,6 +65,7 @@ import Util.Http
 import Util.List
 import Util.Maybe
 import Util.String
+import Util.Tag
 
 
 update : Nav.Key -> Flags -> ItemNav -> UiSettings -> Msg -> Model -> UpdateResult
@@ -588,7 +589,7 @@ update key flags inav settings msg model =
                 tagList =
                     Comp.Dropdown.SetOptions tags.items
             in
-            update key flags inav settings (TagDropdownMsg tagList) model
+            update key flags inav settings (TagDropdownMsg tagList) { model | allTags = tags.items }
 
         GetTagsResp (Err _) ->
             resultModel model
@@ -1039,9 +1040,13 @@ update key flags inav settings msg model =
                     resultModel model
 
         StartTagModal ->
+            let
+                cats =
+                    Util.Tag.getCategories model.allTags
+            in
             resultModel
                 { model
-                    | modalEdit = Just (Comp.DetailEdit.initTagByName model.item.id "")
+                    | modalEdit = Just (Comp.DetailEdit.initTagByName model.item.id "" cats)
                 }
 
         StartCorrOrgModal ->

modules/webapp/src/main/elm/Comp/TagForm.elm

@@ -9,24 +9,38 @@ module Comp.TagForm exposing
     )
 
 import Api.Model.Tag exposing (Tag)
+import Comp.Dropdown
 import Data.Flags exposing (Flags)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (onInput)
+import Util.Maybe
 
 
 type alias Model =
     { tag : Tag
     , name : String
-    , category : Maybe String
+    , allCategories : List String
+    , catDropdown : Comp.Dropdown.Model String
     }
 
 
-emptyModel : Model
+emptyModel : List String -> Model
-emptyModel =
+emptyModel categories =
     { tag = Api.Model.Tag.empty
     , name = ""
-    , category = Nothing
+    , allCategories = categories
+    , catDropdown =
+        let
+            cm =
+                Comp.Dropdown.makeSingleList
+                    { makeOption = \s -> Comp.Dropdown.mkOption s s
+                    , placeholder = "Select or define category..."
+                    , options = categories
+                    , selected = Nothing
+                    }
+        in
+        { cm | searchable = \_ -> True }
     }
 
 
@@ -37,26 +51,66 @@ isValid model =
 
 getTag : Model -> Tag
 getTag model =
-    Tag model.tag.id model.name model.category 0
+    let
+        cat =
+            Comp.Dropdown.getSelected model.catDropdown
+                |> List.head
+                |> Maybe.withDefault model.catDropdown.filterString
+    in
+    Tag model.tag.id model.name (Util.Maybe.fromString cat) 0
 
 
 type Msg
     = SetName String
     | SetCategory String
+    | SetCategoryOptions (List String)
     | SetTag Tag
+    | CatMsg (Comp.Dropdown.Msg String)
 
 
 update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
 update _ msg model =
     case msg of
         SetTag t ->
-            ( { model | tag = t, name = t.name, category = t.category }, Cmd.none )
+            let
+                ( dm_, cmd_ ) =
+                    Comp.Dropdown.update
+                        (Comp.Dropdown.SetSelection
+                            (List.filterMap identity [ t.category ])
+                        )
+                        model.catDropdown
+            in
+            ( { model | tag = t, name = t.name, catDropdown = dm_ }
+            , Cmd.map CatMsg cmd_
+            )
 
         SetName n ->
             ( { model | name = n }, Cmd.none )
 
         SetCategory n ->
-            ( { model | category = Just n }, Cmd.none )
+            let
+                ( dm_, cmd_ ) =
+                    Comp.Dropdown.update (Comp.Dropdown.SetSelection [ n ]) model.catDropdown
+            in
+            ( { model | catDropdown = dm_ }, Cmd.map CatMsg cmd_ )
+
+        SetCategoryOptions list ->
+            let
+                ( dm_, cmd_ ) =
+                    Comp.Dropdown.update
+                        (Comp.Dropdown.SetOptions list)
+                        model.catDropdown
+            in
+            ( { model | catDropdown = dm_ }
+            , Cmd.map CatMsg cmd_
+            )
+
+        CatMsg lm ->
+            let
+                ( dm_, cmd_ ) =
+                    Comp.Dropdown.update lm model.catDropdown
+            in
+            ( { model | catDropdown = dm_ }, Cmd.map CatMsg cmd_ )
 
 
 view : Model -> Html Msg
@@ -78,13 +132,8 @@ view model =
                 []
             ]
         , div [ class "field" ]
-            [ label [] [ text "Category" ]
+            [ label []
-            , input
+                [ text "Category" ]
-                [ type_ "text"
+            , Html.map CatMsg (Comp.Dropdown.viewSingle model.catDropdown)
-                , onInput SetCategory
-                , placeholder "Category (optional)"
-                , value (Maybe.withDefault "" model.category)
-                ]
-                []
             ]
         ]

modules/webapp/src/main/elm/Comp/TagManage.elm

@@ -20,6 +20,8 @@ import Html.Events exposing (onClick, onInput, onSubmit)
 import Http
 import Util.Http
 import Util.Maybe
+import Util.Tag
+import Util.Update
 
 
 type alias Model =
@@ -41,7 +43,7 @@ type ViewMode
 emptyModel : Model
 emptyModel =
     { tagTableModel = Comp.TagTable.emptyModel
-    , tagFormModel = Comp.TagForm.emptyModel
+    , tagFormModel = Comp.TagForm.emptyModel []
     , viewMode = Table
     , formError = Nothing
     , loading = False
@@ -110,8 +112,15 @@ update flags msg model =
             let
                 m2 =
                     { model | viewMode = Table, loading = False }
+
+                cats =
+                    Util.Tag.getCategories tags.items
             in
-            update flags (TableMsg (Comp.TagTable.SetTags tags.items)) m2
+            Util.Update.andThen1
+                [ update flags (TableMsg (Comp.TagTable.SetTags tags.items))
+                , update flags (FormMsg (Comp.TagForm.SetCategoryOptions cats))
+                ]
+                m2
 
         TagResp (Err _) ->
             ( { model | loading = False }, Cmd.none )

modules/webapp/src/main/elm/Data/Flags.elm

@@ -1,6 +1,7 @@
 module Data.Flags exposing
     ( Config
     , Flags
+    , accountString
     , getToken
     , withAccount
     , withoutAccount
@@ -42,3 +43,12 @@ withAccount flags acc =
 withoutAccount : Flags -> Flags
 withoutAccount flags =
     { flags | account = Nothing }
+
+
+accountString : AuthResult -> String
+accountString auth =
+    if auth.collective == auth.user then
+        auth.collective
+
+    else
+        auth.collective ++ "/" ++ auth.user

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

@@ -65,7 +65,7 @@ view flags settings model =
                         viewUsers settings model
 
                     Just InsightsTab ->
-                        viewInsights model
+                        viewInsights flags model
 
                     Just SettingsTab ->
                         viewSettings flags settings model
@@ -77,14 +77,37 @@ view flags settings model =
         ]
 
 
-viewInsights : Model -> List (Html Msg)
+viewInsights : Flags -> Model -> List (Html Msg)
-viewInsights model =
+viewInsights flags model =
+    let
+        ( coll, user ) =
+            Maybe.map (\a -> ( a.collective, a.user )) flags.account
+                |> Maybe.withDefault ( "", "" )
+    in
     [ h1 [ class "ui header" ]
         [ i [ class "chart bar outline icon" ] []
         , div [ class "content" ]
             [ text "Insights"
             ]
         ]
+    , h2 [ class "ui sub header" ]
+        [ div [ class "ui horizontal list" ]
+            [ div
+                [ class "item"
+                , title "Collective"
+                ]
+                [ i [ class "users circle icon" ] []
+                , text coll
+                ]
+            , div
+                [ class "item"
+                , title "User"
+                ]
+                [ i [ class "user outline icon" ] []
+                , text user
+                ]
+            ]
+        ]
     , div [ class "ui basic blue segment" ]
         [ h4 [ class "ui header" ]
             [ text "Items"

modules/webapp/src/main/webjar/docspell.css

@@ -252,7 +252,12 @@ textarea.markdown-editor {
 .ui.modal.keep-small {
     width: 95%;
 }
-
+.ui.modal.keep-small .scrolling.content {
+    min-height: 23rem;
+}
+.ui.modal.keep-small .scrolling.content .menu.transition.visible {
+    max-height: 11rem;
+}
 
 label span.muted {
     font-size: smaller;