Commit 5d2fc8a8 authored by Vlad Dumitru's avatar Vlad Dumitru
Browse files

show tag population counts

parent d6d5399c
......@@ -5,7 +5,7 @@ import Set exposing (Set)
import Browser exposing (Document)
import File exposing (File)
import Html exposing (Html, a, button, div, h1, header, input, label, main_, p, span, strong, table, text, thead, th, td, tr)
import Html exposing (Html, a, button, div, h1, header, input, label, main_, p, span, strong, sup, table, text, thead, th, td, tr)
import Html.Attributes exposing (class, disabled, for, href, id, placeholder, type_)
import Html.Events exposing (onCheck, onClick, onInput)
import Json.Decode as JD
......@@ -37,7 +37,7 @@ type alias ShowingTiersState =
, expanded : Dict String (Dict String Version)
, search : Maybe String
, selected : Dict ( String, String ) Key -- ( uuid, version -> key )
, allTags : Set String
, allTags : Dict String Int
, selectedTags : Set String
}
......@@ -79,7 +79,7 @@ init flags path =
-- VIEW -----------------------------------------------------------------------
viewHeader : List String -> Dict ( String, String ) Key -> Set String -> Set String -> Html Msg
viewHeader : List String -> Dict ( String, String ) Key -> Dict String Int -> Set String -> Html Msg
viewHeader path selectedTiers allTags selectedTags =
let
name =
......@@ -98,10 +98,10 @@ viewHeader path selectedTiers allTags selectedTags =
]
[]
tagCheckbox tag =
tagCheckbox ( tag, count ) =
let
isSelected =
Set.intersect allTags selectedTags
Set.intersect (Set.fromList <| Dict.keys allTags) selectedTags
|> \set -> Set.size set > 0
in
div [ class "tag-filter-option" ]
......@@ -112,12 +112,12 @@ viewHeader path selectedTiers allTags selectedTags =
]
[]
, label [ for ("tag-" ++ tag) ]
[ text tag ]
[ text tag, sup [] [ text <| String.fromInt count ] ]
]
tagFilter =
div [ class "container" ] <|
List.map tagCheckbox (Set.toList allTags)
List.map tagCheckbox (Dict.toList allTags)
in
header []
......@@ -143,7 +143,7 @@ viewHeader path selectedTiers allTags selectedTags =
viewTierListing
: Dict ( String, String ) Key -> Dict String (Dict String Version) -> TierListing
-> Maybe String -> Set String -> Set String -> Document Msg
-> Maybe String -> Dict String Int -> Set String -> Document Msg
viewTierListing selected expanded tierListing search allTags selectedTags =
let
version : Uuid -> Key -> ( String, Version ) -> Html Msg
......@@ -259,7 +259,7 @@ view model =
case model.state of
Empty path ->
{ title = "loading"
, body = [ viewHeader path Dict.empty Set.empty Set.empty, viewSpinner ]
, body = [ viewHeader path Dict.empty Dict.empty Set.empty, viewSpinner ]
}
Error e ->
......@@ -274,6 +274,12 @@ view model =
-- UPDATE ---------------------------------------------------------------------
incrementTagCount : Maybe Int -> Maybe Int
incrementTagCount maybeInt =
case maybeInt of
Just int -> Just (int + 1)
Nothing -> Just 1
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case ( msg, model.state ) of
......@@ -289,8 +295,10 @@ update msg model =
, allTags =
tierListing.listing
|> Dict.values
|> List.concatMap (Tuple.second >> Set.toList)
|> Set.fromList
|> List.concatMap (Set.toList << Tuple.second)
|> List.foldl (\tag acc ->
Dict.update tag incrementTagCount acc)
Dict.empty
, selectedTags = Set.empty
}
}
......
......@@ -47,6 +47,9 @@ let encode_version (hash, (head, info, branch_head)) =
let encode_version_listing : (int64, (Speechcake.Storage.Bucket.value * Speechcake.Storage.Metadata.t * string option)) Hashtbl.t encoder =
fun versions ->
Hashtbl.to_alist versions
|> List.dedup_and_sort ~compare:(fun (_, (_, x, _)) (_, (_, y, _)) ->
Storage.Metadata.compare_date x y)
|> List.rev
|> List.map ~f:encode_version
|> fun versions -> `Assoc versions
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment