Use more union types!

schedule/src/Decoders.elm

@@ -2,7 +2,7 @@ module Decoders exposing (..)
 
 -- Local modules
 
-import Models exposing (Day, Speaker, Event, EventInstance, EventLocation, EventType, Model, Flags, Filter, Route(..))
+import Models exposing (Day, Speaker, Event, EventInstance, Model, Flags, Filter, Route(..), FilterType(..))
 
 
 -- Core modules
@@ -94,17 +94,17 @@ eventInstanceDecoder =
         |> optional "is_favorited" (nullable bool) Nothing
 
 
-eventLocationDecoder : Decoder EventLocation
+eventLocationDecoder : Decoder FilterType
 eventLocationDecoder =
-    decode EventLocation
+    decode LocationFilter
         |> required "name" string
         |> required "slug" string
         |> required "icon" string
 
 
-eventTypeDecoder : Decoder EventType
+eventTypeDecoder : Decoder FilterType
 eventTypeDecoder =
-    decode EventType
+    decode TypeFilter
         |> required "name" string
         |> required "slug" string
         |> required "color" string

schedule/src/Messages.elm

@@ -2,7 +2,7 @@ module Messages exposing (Msg(..))
 
 -- Local modules
 
-import Models exposing (Day, EventType, EventLocation, EventInstance, VideoRecordingFilter)
+import Models exposing (Day, EventInstance, FilterType)
 
 
 -- External modules
@@ -13,8 +13,6 @@ import Navigation exposing (Location)
 type Msg
     = NoOp
     | WebSocketPayload String
-    | ToggleEventTypeFilter EventType
+    | ToggleFilter FilterType
-    | ToggleEventLocationFilter EventLocation
-    | ToggleVideoRecordingFilter VideoRecordingFilter
     | OnLocationChange Location
     | BackInHistory

schedule/src/Models.elm

@@ -47,8 +47,8 @@ type alias Model =
     { days : List Day
     , events : List Event
     , eventInstances : List EventInstance
-    , eventLocations : List EventLocation
+    , eventLocations : List FilterType
-    , eventTypes : List EventType
+    , eventTypes : List FilterType
     , speakers : List Speaker
     , flags : Flags
     , filter : Filter
@@ -58,19 +58,6 @@ type alias Model =
     }
 
 
-type alias Filter =
-    { eventTypes : List EventType
-    , eventLocations : List EventLocation
-    , videoRecording : List VideoRecordingFilter
-    }
-
-
-type alias VideoRecordingFilter =
-    { name : String
-    , slug : String
-    }
-
-
 type alias Day =
     { day_name : String
     , date : Date
@@ -118,21 +105,6 @@ type alias Event =
     }
 
 
-type alias EventLocation =
-    { name : String
-    , slug : String
-    , icon : String
-    }
-
-
-type alias EventType =
-    { name : String
-    , slug : String
-    , color : String
-    , lightText : Bool
-    }
-
-
 type alias Flags =
     { schedule_timeslot_length_minutes : Int
     , schedule_midnight_offset_hours : Int
@@ -140,3 +112,68 @@ type alias Flags =
     , camp_slug : String
     , websocket_server : String
     }
+
+
+
+-- FILTERS
+
+
+type alias FilterName =
+    String
+
+
+type alias FilterSlug =
+    String
+
+
+type alias LocationIcon =
+    String
+
+
+type alias TypeColor =
+    String
+
+
+type alias TypeLightText =
+    Bool
+
+
+type FilterType
+    = TypeFilter FilterName FilterSlug TypeColor TypeLightText
+    | LocationFilter FilterName FilterSlug LocationIcon
+    | VideoFilter FilterName FilterSlug
+
+
+type alias Filter =
+    { eventTypes : List FilterType
+    , eventLocations : List FilterType
+    , videoRecording : List FilterType
+    }
+
+
+unpackFilterType filter =
+    case filter of
+        TypeFilter name slug _ _ ->
+            ( name, slug )
+
+        LocationFilter name slug _ ->
+            ( name, slug )
+
+        VideoFilter name slug ->
+            ( name, slug )
+
+
+getSlugFromFilterType filter =
+    let
+        ( _, slug ) =
+            unpackFilterType filter
+    in
+        slug
+
+
+getNameFromFilterType filter =
+    let
+        ( name, slug ) =
+            unpackFilterType filter
+    in
+        name

schedule/src/Update.elm

@@ -2,7 +2,7 @@ module Update exposing (update)
 
 -- Local modules
 
-import Models exposing (Model, Route(..), Filter)
+import Models exposing (Model, Route(..), Filter, FilterType(..))
 import Messages exposing (Msg(..))
 import Decoders exposing (webSocketActionDecoder, initDataDecoder, eventDecoder)
 import Routing exposing (parseLocation)
@@ -50,63 +50,51 @@ update msg model =
             in
                 newModel_ ! []
 
-        ToggleEventTypeFilter eventType ->
+        ToggleFilter filter ->
             let
-                eventTypesFilter =
+                currentFilter =
+                    model.filter
+
+                newFilter =
+                    case filter of
+                        TypeFilter name slug color lightText ->
+                            let
+                                eventType =
+                                    TypeFilter name slug color lightText
+                            in
+                                { currentFilter
+                                    | eventTypes =
                                         if List.member eventType model.filter.eventTypes then
                                             List.filter (\x -> x /= eventType) model.filter.eventTypes
                                         else
                                             eventType :: model.filter.eventTypes
+                                }
 
-                currentFilter =
+                        LocationFilter name slug icon ->
-                    model.filter
-
-                newFilter =
-                    { currentFilter | eventTypes = eventTypesFilter }
-
-                query =
-                    filterToQuery newFilter
-
-                cmd =
-                    Navigation.newUrl query
-            in
-                { model | filter = newFilter } ! [ cmd ]
-
-        ToggleEventLocationFilter eventLocation ->
                             let
-                eventLocationsFilter =
+                                eventLocation =
+                                    LocationFilter name slug icon
+                            in
+                                { currentFilter
+                                    | eventLocations =
                                         if List.member eventLocation model.filter.eventLocations then
                                             List.filter (\x -> x /= eventLocation) model.filter.eventLocations
                                         else
                                             eventLocation :: model.filter.eventLocations
+                                }
 
-                currentFilter =
+                        VideoFilter name slug ->
-                    model.filter
-
-                newFilter =
-                    { currentFilter | eventLocations = eventLocationsFilter }
-
-                query =
-                    filterToQuery newFilter
-
-                cmd =
-                    Navigation.newUrl query
-            in
-                { model | filter = newFilter } ! [ cmd ]
-
-        ToggleVideoRecordingFilter videoRecording ->
                             let
-                videoRecordingFilter =
+                                videoRecording =
+                                    VideoFilter name slug
+                            in
+                                { currentFilter
+                                    | videoRecording =
                                         if List.member videoRecording model.filter.videoRecording then
                                             List.filter (\x -> x /= videoRecording) model.filter.videoRecording
                                         else
                                             videoRecording :: model.filter.videoRecording
-
+                                }
-                currentFilter =
-                    model.filter
-
-                newFilter =
-                    { currentFilter | videoRecording = videoRecordingFilter }
 
                 query =
                     filterToQuery newFilter

schedule/src/Views/DayView.elm

@@ -3,7 +3,7 @@ module Views.DayView exposing (dayView)
 -- Local modules
 
 import Messages exposing (Msg(..))
-import Models exposing (Model, Day, EventInstance, EventLocation, Route(EventRoute))
+import Models exposing (Model, Day, EventInstance, Route(EventRoute), FilterType(..), getSlugFromFilterType, getNameFromFilterType)
 import Routing exposing (routeToString)
 
 
@@ -57,7 +57,7 @@ dayView day model =
             ]
 
 
-locationColumns : List EventInstance -> List EventLocation -> Int -> List Date -> Html Msg
+locationColumns : List EventInstance -> List FilterType -> Int -> List Date -> Html Msg
 locationColumns eventInstances eventLocations offset minutes =
     let
         columnWidth =
@@ -75,11 +75,11 @@ locationColumns eventInstances eventLocations offset minutes =
             (List.map (\location -> locationColumn columnWidth eventInstances offset minutes location) eventLocations)
 
 
-locationColumn : Float -> List EventInstance -> Int -> List Date -> EventLocation -> Html Msg
+locationColumn : Float -> List EventInstance -> Int -> List Date -> FilterType -> Html Msg
 locationColumn columnWidth eventInstances offset minutes location =
     let
         locationInstances =
-            List.filter (\instance -> instance.location == location.slug) eventInstances
+            List.filter (\instance -> instance.location == getSlugFromFilterType location) eventInstances
 
         overlappingGroups =
             List.Extra.groupWhile
@@ -101,7 +101,7 @@ locationColumn columnWidth eventInstances offset minutes location =
                     [ ( "location-column-header", True )
                     ]
                 ]
-                [ text location.name ]
+                [ text <| getNameFromFilterType location ]
              ]
                 ++ (List.map
                         (\x ->

schedule/src/Views/FilterView.elm

@@ -3,7 +3,7 @@ module Views.FilterView exposing (filterSidebar, applyFilters, parseFilterFromQu
 -- Local modules
 
 import Messages exposing (Msg(..))
-import Models exposing (Model, EventInstance, Filter, Day, FilterQuery, Route(OverviewRoute, OverviewFilteredRoute), VideoRecordingFilter, EventType, EventLocation)
+import Models exposing (Model, EventInstance, Filter, Day, FilterQuery, Route(OverviewRoute, OverviewFilteredRoute), FilterType(..), unpackFilterType, getSlugFromFilterType)
 import Routing exposing (routeToString)
 
 
@@ -15,7 +15,7 @@ import Regex
 -- External modules
 
 import Html exposing (Html, text, div, ul, li, span, i, h4, small)
-import Html.Attributes exposing (class, classList)
+import Html.Attributes exposing (class, classList, style)
 import Html.Events exposing (onClick)
 import Date.Extra exposing (Interval(..), equalBy)
 
@@ -24,7 +24,7 @@ applyFilters : Day -> Model -> List EventInstance
 applyFilters day model =
     let
         slugs default filters =
-            List.map .slug
+            List.map getSlugFromFilterType
                 (if List.isEmpty filters then
                     default
                  else
@@ -71,44 +71,40 @@ filterSidebar model =
                 "Type"
                 model.eventTypes
                 model.filter.eventTypes
-                ToggleEventTypeFilter
                 model.eventInstances
                 .eventType
             , filterView
                 "Location"
                 model.eventLocations
                 model.filter.eventLocations
-                ToggleEventLocationFilter
                 model.eventInstances
                 .location
             , filterView
                 "Video"
                 videoRecordingFilters
                 model.filter.videoRecording
-                ToggleVideoRecordingFilter
                 model.eventInstances
                 .videoState
             ]
         ]
 
 
-videoRecordingFilters : List VideoRecordingFilter
+videoRecordingFilters : List FilterType
 videoRecordingFilters =
-    [ { name = "Will not be recorded", slug = "not-to-be-recorded" }
+    [ VideoFilter "Will not be recorded" "not-to-be-recorded"
-    , { name = "Will recorded", slug = "to-be-recorded" }
+    , VideoFilter "Will recorded" "to-be-recorded"
-    , { name = "Has recording", slug = "has-recording" }
+    , VideoFilter "Has recording" "has-recording"
     ]
 
 
 filterView :
     String
-    -> List { a | name : String, slug : String }
+    -> List FilterType
-    -> List { a | name : String, slug : String }
+    -> List FilterType
-    -> ({ a | name : String, slug : String } -> Msg)
     -> List EventInstance
     -> (EventInstance -> String)
     -> Html Msg
-filterView name possibleFilters currentFilters action eventInstances slugLike =
+filterView name possibleFilters currentFilters eventInstances slugLike =
     div []
         [ text (name ++ ":")
         , ul []
@@ -118,7 +114,6 @@ filterView name possibleFilters currentFilters action eventInstances slugLike =
                         filterChoiceView
                             filter
                             currentFilters
-                            action
                             eventInstances
                             slugLike
                     )
@@ -127,13 +122,12 @@ filterView name possibleFilters currentFilters action eventInstances slugLike =
 
 
 filterChoiceView :
-    { a | name : String, slug : String }
+    FilterType
-    -> List { a | name : String, slug : String }
+    -> List FilterType
-    -> ({ a | name : String, slug : String } -> Msg)
     -> List EventInstance
     -> (EventInstance -> String)
     -> Html Msg
-filterChoiceView filter currentFilters action eventInstances slugLike =
+filterChoiceView filter currentFilters eventInstances slugLike =
     let
         active =
             List.member filter currentFilters
@@ -141,35 +135,97 @@ filterChoiceView filter currentFilters action eventInstances slugLike =
         notActive =
             not active
 
+        ( name, slug ) =
+            unpackFilterType filter
+
         eventInstanceCount =
             eventInstances
-                |> List.filter (\eventInstance -> slugLike eventInstance == filter.slug)
+                |> List.filter (\eventInstance -> slugLike eventInstance == slug)
                 |> List.length
-    in
+
-        li []
+        buttonStyle =
-            [ div
+            case filter of
+                TypeFilter _ _ color lightText ->
+                    [ style
+                        [ ( "backgroundColor", color )
+                        , ( "color"
+                          , if lightText then
+                                "#fff"
+                            else
+                                "#000"
+                          )
+                        , ( "border", "1px solid black" )
+                        , ( "margin-bottom", "2px" )
+                        ]
+                    ]
+
+                _ ->
+                    []
+
+        locationIcon =
+            case filter of
+                LocationFilter _ _ icon ->
+                    [ i
                         [ classList
+                            [ ( "fa", True )
+                            , ( "fa-" ++ icon, True )
+                            , ( "pull-right", True )
+                            ]
+                        ]
+                        []
+                    ]
+
+                _ ->
+                    []
+    in
+        li
+            []
+            [ div
+                ([ classList
                     [ ( "btn", True )
                     , ( "btn-default", True )
                     , ( "filter-choice-active", active )
                     ]
-                , onClick (action filter)
+                 , onClick (ToggleFilter filter)
                  ]
+                    ++ buttonStyle
+                )
                 [ span []
-                    [ i [ classList [ ( "fa", True ), ( "fa-minus", active ), ( "fa-plus", notActive ) ] ] []
+                    ([ span [ classList [ ( "pull-left", True ) ] ]
-                    , text (" " ++ filter.name)
+                        [ i
+                            [ classList
+                                [ ( "fa", True )
+                                , ( "fa-minus", active )
+                                , ( "fa-plus", notActive )
+                                ]
+                            ]
+                            []
+                        , text (" " ++ name)
                         , small [] [ text <| " (" ++ (toString eventInstanceCount) ++ ")" ]
                         ]
                      ]
+                        ++ locationIcon
+                    )
+                ]
             ]
 
 
-findFilter : List { a | slug : String } -> String -> Maybe { a | slug : String }
+findFilter : List FilterType -> String -> Maybe FilterType
 findFilter modelItems filterSlug =
-    List.head (List.filter (\x -> x.slug == filterSlug) modelItems)
+    List.head
+        (List.filter
+            (\x ->
+                let
+                    ( _, slug ) =
+                        unpackFilterType x
+                in
+                    slug == filterSlug
+            )
+            modelItems
+        )
 
 
-getFilter : String -> List { a | slug : String } -> String -> List { a | slug : String }
+getFilter : String -> List FilterType -> String -> List FilterType
 getFilter filterType modelItems query =
     let
         filterMatch =
@@ -208,7 +264,7 @@ filterToString : Filter -> String
 filterToString filter =
     let
         typePart =
-            case String.join "," (List.map .slug filter.eventTypes) of
+            case String.join "," (List.map getSlugFromFilterType filter.eventTypes) of
                 "" ->
                     ""
 
@@ -216,7 +272,7 @@ filterToString filter =
                     "type=" ++ types
 
         locationPart =
-            case String.join "," (List.map .slug filter.eventLocations) of
+            case String.join "," (List.map getSlugFromFilterType filter.eventLocations) of
                 "" ->
                     ""
 
@@ -224,7 +280,7 @@ filterToString filter =
                     "location=" ++ locations
 
         videoPart =
-            case String.join "," (List.map .slug filter.videoRecording) of
+            case String.join "," (List.map getSlugFromFilterType filter.videoRecording) of
                 "" ->
                     ""