A whole lot of filtering. URL now reflects filters.

schedule/src/Decoders.elm

@@ -15,6 +15,7 @@ import Date exposing (Date, Month(..))
 -- External modules
 
 import Date.Extra
+import Navigation exposing (Location)
 
 
 -- DECODERS
@@ -107,7 +108,7 @@ eventTypeDecoder =
         |> required "light_text" bool
 
 
-initDataDecoder : Decoder (Flags -> Filter -> Route -> Model)
+initDataDecoder : Decoder (Flags -> Filter -> Location -> Route -> Model)
 initDataDecoder =
     decode Model
         |> required "days" (list dayDecoder)

schedule/src/Main.elm

@@ -32,15 +32,15 @@ init : Flags -> Location -> ( Model, Cmd Msg )
 init flags location =
     let
         currentRoute =
-            parseLocation location
+            parseLocation (Debug.log "location" location)
 
         emptyFilter =
             Filter [] [] []
 
-        initModel =
+        model =
-            Model [] [] [] [] [] flags emptyFilter currentRoute
+            Model [] [] [] [] [] flags emptyFilter location currentRoute
     in
-        initModel ! [ sendInitMessage flags.camp_slug flags.websocket_server ]
+        model ! [ sendInitMessage flags.camp_slug flags.websocket_server ]
 
 
 

schedule/src/Messages.elm

@@ -15,6 +15,6 @@ type Msg
     | WebSocketPayload String
     | ToggleEventTypeFilter EventType
     | ToggleEventLocationFilter EventLocation
-    | ToggleVideoRecordingFilter { name : String, filter : EventInstance -> Bool }
+    | ToggleVideoRecordingFilter { name : String, slug : String, filter : EventInstance -> Bool }
     | OnLocationChange Location
     | BackInHistory

schedule/src/Models.elm

@@ -1,10 +1,18 @@
 module Models exposing (..)
 
+-- Core modules
+
 import Date exposing (Date, now)
 
 
+-- External modules
+
+import Navigation exposing (Location)
+
+
 type Route
     = OverviewRoute
+    | OverviewFilteredRoute String
     | DayRoute String
     | EventRoute EventSlug
     | NotFoundRoute
@@ -18,6 +26,7 @@ type alias Model =
     , eventTypes : List EventType
     , flags : Flags
     , filter : Filter
+    , location : Location
     , route : Route
     }
 
@@ -25,7 +34,7 @@ type alias Model =
 type alias Filter =
     { eventTypes : List EventType
     , eventLocations : List EventLocation
-    , videoRecording : List { name : String, filter : EventInstance -> Bool }
+    , videoRecording : List { name : String, slug : String, filter : EventInstance -> Bool }
     }
 
 

schedule/src/Routing.elm

@@ -11,10 +11,29 @@ import Navigation exposing (Location)
 import UrlParser exposing (Parser, (</>), oneOf, map, top, s, string, parseHash)
 
 
+{--
+URLs to support:
+
+- #
+    This show the overview of the schedule
+
+- #?type={types},location={locations},video={no,yes,link}
+    This is the overview, just with filters enable
+
+- #day/{year}-{month}-{day}
+    Show a particular day
+
+- #event/{slug}
+    Show a particular event
+
+--}
+
+
 matchers : Parser (Route -> a) a
 matchers =
     oneOf
         [ map OverviewRoute top
+        , map OverviewFilteredRoute (top </> string)
         , map DayRoute (s "day" </> string)
         , map EventRoute (s "event" </> string)
         ]

schedule/src/Update.elm

@@ -2,10 +2,11 @@ module Update exposing (update)
 
 -- Local modules
 
-import Models exposing (Model, Route(OverviewRoute, EventRoute), Filter)
+import Models exposing (Model, Route(..), Filter)
 import Messages exposing (Msg(..))
 import Decoders exposing (webSocketActionDecoder, initDataDecoder, eventDecoder)
 import Routing exposing (parseLocation)
+import Views.FilterView exposing (parseFilterFromQuery, filterToQuery)
 
 
 -- Core modules
@@ -33,7 +34,7 @@ update msg model =
                                 "init" ->
                                     case Json.Decode.decodeString initDataDecoder str of
                                         Ok m ->
-                                            m model.flags (Filter [] [] []) model.route
+                                            m model.flags model.filter model.location model.route
 
                                         Err error ->
                                             model
@@ -43,8 +44,11 @@ update msg model =
 
                         Err error ->
                             model
+
+                ( newModel_, _ ) =
+                    update (OnLocationChange model.location) newModel
             in
-                newModel ! []
+                newModel_ ! []
 
         ToggleEventTypeFilter eventType ->
             let
@@ -59,8 +63,14 @@ update msg model =
 
                 newFilter =
                     { currentFilter | eventTypes = eventTypesFilter }
+
+                query =
+                    filterToQuery newFilter
+
+                cmd =
+                    Navigation.newUrl query
             in
-                { model | filter = newFilter } ! []
+                { model | filter = newFilter } ! [ cmd ]
 
         ToggleEventLocationFilter eventLocation ->
             let
@@ -75,8 +85,14 @@ update msg model =
 
                 newFilter =
                     { currentFilter | eventLocations = eventLocationsFilter }
+
+                query =
+                    filterToQuery newFilter
+
+                cmd =
+                    Navigation.newUrl query
             in
-                { model | filter = newFilter } ! []
+                { model | filter = newFilter } ! [ cmd ]
 
         ToggleVideoRecordingFilter videoRecording ->
             let
@@ -91,15 +107,29 @@ update msg model =
 
                 newFilter =
                     { currentFilter | videoRecording = videoRecordingFilter }
+
+                query =
+                    filterToQuery newFilter
+
+                cmd =
+                    Navigation.newUrl query
             in
-                { model | filter = newFilter } ! []
+                { model | filter = newFilter } ! [ cmd ]
 
         OnLocationChange location ->
             let
                 newRoute =
                     parseLocation location
+
+                newFilter =
+                    case newRoute of
+                        OverviewFilteredRoute query ->
+                            parseFilterFromQuery query model
+
+                        _ ->
+                            model.filter
             in
-                { model | route = newRoute } ! []
+                { model | filter = newFilter, route = newRoute, location = location } ! []
 
         BackInHistory ->
             model ! [ Navigation.back 1 ]

schedule/src/Views.elm

@@ -30,6 +30,9 @@ view model =
             OverviewRoute ->
                 scheduleOverviewView model
 
+            OverviewFilteredRoute _ ->
+                scheduleOverviewView model
+
             DayRoute dayIso ->
                 let
                     day =

schedule/src/Views/FilterView.elm

@@ -1,9 +1,14 @@
-module Views.FilterView exposing (filterSidebar, applyFilters)
+module Views.FilterView exposing (filterSidebar, applyFilters, parseFilterFromQuery, filterToQuery)
 
 -- Local modules
 
 import Messages exposing (Msg(..))
-import Models exposing (Model, EventInstance)
+import Models exposing (Model, EventInstance, Filter, Day)
+
+
+-- Core modules
+
+import Regex
 
 
 -- External modules
@@ -14,6 +19,7 @@ import Html.Events exposing (onClick)
 import Date.Extra exposing (Interval(..), equalBy)
 
 
+applyFilters : Day -> Model -> List EventInstance
 applyFilters day model =
     let
         types =
@@ -89,11 +95,11 @@ hasRecordingFilter eventInstance =
     eventInstance.videoUrl /= ""
 
 
-videoRecordingFilters : List { name : String, filter : EventInstance -> Bool }
+videoRecordingFilters : List { name : String, slug : String, filter : EventInstance -> Bool }
 videoRecordingFilters =
-    [ { name = "Will not be recorded", filter = notRecordedFilter }
+    [ { name = "Will not be recorded", slug = "not-to-be-recorded", filter = notRecordedFilter }
-    , { name = "Will recorded", filter = recordedFilter }
+    , { name = "Will recorded", slug = "to-be-recorded", filter = recordedFilter }
-    , { name = "Has recording", filter = hasRecordingFilter }
+    , { name = "Has recording", slug = "has-recording", filter = hasRecordingFilter }
     ]
 
 
@@ -147,3 +153,76 @@ filterChoiceView filter currentFilters action =
                     ]
                 ]
             ]
+
+
+findFilter : List { a | slug : String } -> String -> Maybe { a | slug : String }
+findFilter modelItems filterSlug =
+    List.head (List.filter (\x -> x.slug == filterSlug) modelItems)
+
+
+getFilter : String -> List { a | slug : String } -> String -> List { a | slug : String }
+getFilter filterType modelItems query =
+    let
+        filterMatch =
+            query
+                |> Regex.find (Regex.AtMost 1) (Regex.regex (filterType ++ "=([\\w,_-]+)&*"))
+                |> List.concatMap .submatches
+                |> List.head
+                |> Maybe.withDefault Nothing
+                |> Maybe.withDefault ""
+
+        filterSlugs =
+            String.split "," filterMatch
+    in
+        List.filterMap (\x -> findFilter modelItems x) filterSlugs
+
+
+parseFilterFromQuery : String -> Model -> Filter
+parseFilterFromQuery query model =
+    let
+        types =
+            getFilter "type" model.eventTypes query
+
+        locations =
+            getFilter "location" model.eventLocations query
+
+        videoFilters =
+            getFilter "video" videoRecordingFilters query
+    in
+        { eventTypes = types
+        , eventLocations = locations
+        , videoRecording = videoFilters
+        }
+
+
+filterToQuery : Filter -> String
+filterToQuery filter =
+    let
+        typePart =
+            case String.join "," (List.map .slug filter.eventTypes) of
+                "" ->
+                    ""
+
+                types ->
+                    "type=" ++ types
+
+        locationPart =
+            case String.join "," (List.map .slug filter.eventLocations) of
+                "" ->
+                    ""
+
+                locations ->
+                    "location=" ++ locations
+
+        videoPart =
+            case String.join "," (List.map .slug filter.videoRecording) of
+                "" ->
+                    ""
+
+                video ->
+                    "video=" ++ video
+
+        result =
+            String.join "&" (List.filter (\x -> x /= "") [ typePart, locationPart, videoPart ])
+    in
+        "#" ++ result

schedule/src/Views/ScheduleOverview.elm

@@ -3,8 +3,8 @@ module Views.ScheduleOverview exposing (scheduleOverviewView)
 -- Local modules
 
 import Messages exposing (Msg(..))
-import Models exposing (Model, Day, EventInstance)
+import Models exposing (Model, Day, EventInstance, Filter)
-import Views.FilterView exposing (filterSidebar, applyFilters)
+import Views.FilterView exposing (filterSidebar, applyFilters, parseFilterFromQuery)
 
 
 -- External modules