filtering by tags works

assets/src/Data/TierListing.elm

@@ -4,6 +4,7 @@ module Data.TierListing exposing
   )
 
 import Dict exposing (Dict)
+import Set exposing (Set)
 
 import Json.Decode as D exposing (Decoder)
 
@@ -17,15 +18,16 @@ import Data.Key as Key exposing (Key)
 -}
 type alias TierListing =
   {  prefix : List String
-  , listing : Dict String Key
+  , listing : Dict String ( Key, Set String )
   }
 
 
-item : Decoder ( String, Key )
+item : Decoder ( String, ( Key, Set String ) )
 item =
-  D.map2 Tuple.pair
+  D.map3 (\uuid key tags -> ( uuid, ( key, tags ) ))
     (D.field "uuid" D.string)
     (D.field "key" Key.stringFormatDecoder)
+    (D.field "tags" (D.map Set.fromList (D.list D.string)))
 
 decoder : List String -> Decoder TierListing
 decoder key =

assets/src/Page/Tiers.elm

@@ -5,8 +5,8 @@ import Set exposing (Set)
 
 import Browser exposing (Document)
 import File exposing (File)
-import Html exposing (Html, a, button, div, h1, header, input, main_, p, span, strong, text)
-import Html.Attributes exposing (class, disabled, href, placeholder, type_)
+import Html exposing (Html, a, button, div, h1, header, input, label, main_, p, span, strong, text)
+import Html.Attributes exposing (class, disabled, for, href, id, placeholder, type_)
 import Html.Events exposing (onCheck, onClick, onInput)
 import Json.Decode as JD
 
@@ -37,6 +37,8 @@ type alias ShowingTiersState =
   ,    expanded : Dict String (Dict String Version)
   ,      search : Maybe String
   ,    selected : Dict ( String, String ) Key -- ( uuid, version -> key )
+  ,     allTags : Set String
+  , selectedTags : Set String
   }
 
 type State
@@ -62,6 +64,7 @@ type Msg
   |   GotBranches  Uuid (Result Error (Dict String Version))
   | PrepareCheckout
   | GotStoredSelection (Result JD.Error CheckoutRequest.CheckoutStorage)
+  | ToggleTagFilter String Bool
 
 
 
@@ -76,8 +79,8 @@ init flags path =
 
 -- VIEW -----------------------------------------------------------------------
 
-viewHeader : List String -> Dict ( String, String ) Key -> Html Msg
-viewHeader path selectedTiers =
+viewHeader : List String -> Dict ( String, String ) Key -> Set String -> Set String -> Html Msg
+viewHeader path selectedTiers allTags selectedTags =
   let
     name =
       case List.reverse path |> List.head of
@@ -94,6 +97,28 @@ viewHeader path selectedTiers =
         , placeholder "search for a tier"
         ]
         []
+
+    tagCheckbox tag =
+      let
+        isSelected =
+          Set.intersect allTags selectedTags
+          |> \set -> Set.size set > 0
+      in
+      div [ class "tag-filter-option" ]
+        [ input
+            [ type_ "checkbox"
+            , onCheck <| ToggleTagFilter tag
+            , id ("tag-" ++ tag)
+            ]
+            []
+        , label [ for ("tag-" ++ tag) ]
+            [ text tag ]
+        ]
+
+    tagFilter =
+      div [ class "container" ] <|
+        List.map tagCheckbox (Set.toList allTags)
+        
   in
   header []
     [ div [ class "box" ]
@@ -113,12 +138,13 @@ viewHeader path selectedTiers =
             ]
         ]
     , search_
+    , tagFilter
     ]
 
 viewTierListing
   :  Dict ( String, String ) Key -> Dict String (Dict String Version) -> TierListing
-  -> Maybe String -> Document Msg
-viewTierListing selected expanded tierListing search =
+  -> Maybe String -> Set String -> Set String -> Document Msg
+viewTierListing selected expanded tierListing search allTags selectedTags =
   let
     version uuid key versionId info =
       span [ class "version" ]
@@ -144,14 +170,16 @@ viewTierListing selected expanded tierListing search =
         parts
       |> List.intersperse (span [ class "sep" ] [ text "/" ])
 
-    tier ( uuid, key_, matchResult ) =
+    tier uuid key_ tags matchResult =
       let
         data =
           Dict.get (Uuid.toString uuid) expanded
 
         identifiers =
           div [ class "identifiers" ]
-            [ div [ class "uuid" ] [ text <| Uuid.toString uuid ]
+            [ div [ class "tags" ] <|
+                List.map (\tag -> span [ class "tag" ] [ text tag ])
+                  (Set.toList tags)
             , a [ class "key", href <| Route.routeToString (Route.Tier uuid "latest") ]
                 (viewKey <| Key.parts key_)
             ]
@@ -186,33 +214,34 @@ viewTierListing selected expanded tierListing search =
     tiers =
       case search of
         Just term ->
-          let
-            matches =
-              Dict.toList tierListing.listing
-              |> List.map (\( uuid, key ) ->
-                  ( Uuid.fromString uuid
-                  , key
-                  , Key.toString key
-                    |> String.toLower
-                    |> Fuzzy.match [] [ "/" ] (String.toLower term)
-                  ))
-              |> List.sortBy (\( _, _, result ) -> result.score)
-              |> List.filter (\( _, _, result ) -> result.score < 1000)
-              |> List.map (\(uuid, key, result) -> ( uuid, key, Just result ))
-          in
-          matches
+          Dict.toList tierListing.listing
+          |> List.map (\( uuid, ( key, tags ) ) ->
+              ( Uuid.fromString uuid
+              , ( key, tags )
+              , Key.toString key
+                |> String.toLower
+                |> Fuzzy.match [] [ "/" ] (String.toLower term)
+              ))
+          |> List.sortBy (\( _, _, result ) -> result.score)
+          |> List.filter (\( _, _, result ) -> result.score < 1000)
+          |> List.filter (\( _, ( _, tags ), _ ) ->
+                Set.isEmpty selectedTags
+             || (Set.size (Set.intersect tags selectedTags)) > 0)
+          |> List.map (\(uuid, ( key, tags ), result) -> tier uuid key tags (Just result))
 
         Nothing ->
           Dict.toList tierListing.listing
-          |> List.map (\( uuid, key ) ->
-              ( Uuid.fromString uuid, key, Nothing ))
+          |> List.filter (\( _, ( _, tags ) ) ->
+               Set.isEmpty selectedTags
+            || (Set.size (Set.intersect tags selectedTags) > 0))
+          |> List.map (\( uuid, ( key, tags ) ) ->
+              tier (Uuid.fromString uuid) key tags Nothing )
 
     header_ =
-      viewHeader tierListing.prefix selected
+      viewHeader tierListing.prefix selected allTags selectedTags
 
     content =
-      main_ [ class "no-border" ] <|
-        List.map tier tiers
+      main_ [ class "no-border" ] tiers
   in
   { title = "tier listing"
   ,  body = [ header_, content ]
@@ -223,7 +252,7 @@ view model =
   case model.state of
     Empty path ->
       { title = "loading"
-      ,  body = [ viewHeader path Dict.empty, viewSpinner ]
+      ,  body = [ viewHeader path Dict.empty Set.empty Set.empty, viewSpinner ]
       }
 
     Error e ->
@@ -231,8 +260,8 @@ view model =
       ,  body = [ div [] [ text <| Error.errorToString e ] ]
       }
 
-    ShowingTiers { tierListing, expanded, selected, search } ->
-      viewTierListing selected expanded tierListing search
+    ShowingTiers { tierListing, expanded, selected, search, allTags, selectedTags } ->
+      viewTierListing selected expanded tierListing search allTags selectedTags
 
 
 
@@ -250,6 +279,12 @@ update msg model =
                 ,    expanded = Dict.empty
                 ,      search = Nothing
                 ,    selected = Dict.empty
+                , allTags =
+                    tierListing.listing
+                    |> Dict.values
+                    |> List.concatMap (Tuple.second >> Set.toList)
+                    |> Set.fromList
+                , selectedTags = Set.empty
                 }
             }
           , LocalStorage.get "checkout-tiers"
@@ -364,6 +399,20 @@ update msg model =
           , LocalStorage.set "checkout-tiers" [] CheckoutRequest.encodeCheckoutStorage
           )
 
+    ( ToggleTagFilter tag state, ShowingTiers showingTiersState ) ->
+      let
+        showingTiersState_ =
+          if state then
+            { showingTiersState
+            | selectedTags = Debug.log "toggle tag filter (true)" <| Set.insert tag showingTiersState.selectedTags }
+          else
+            { showingTiersState
+            | selectedTags = Debug.log "toggle tag filter (false)" <| Set.remove tag showingTiersState.selectedTags }
+      in
+      ( { model | state = ShowingTiers showingTiersState_ }
+      , Cmd.none
+      )
+
     {- ignore everything else -}
     ( msg_, state ) ->
       let

assets/style.scss

@@ -352,7 +352,7 @@ svg.spinner {
 .identifiers {
   flex-grow: 1;
 
-  & > .uuid {
+  & .uuid {
     font-family: $code-font-stack;
     font-weight: $code-font-weight;
     font-size: 0.75rem;
@@ -704,3 +704,25 @@ a.key {
 
   width: 100%;
 }
+
+.tags {
+  & > .tag {
+    font-family: $code-font-stack;
+    font-size: 0.75rem;
+
+    &:not(:last-child)::after {
+      content: ', ';
+      color: #666;
+    }
+  }
+}
+
+.tag-filter-option {
+  display: inline-flex;
+  align-items: center;
+
+  & > label {
+    font-family: $code-font-stack;
+    font-size: 0.75rem;
+  }
+}