From 84b0919cd67bf47685e9e0b891098a740314d0b0 Mon Sep 17 00:00:00 2001 From: Vidir Valberg Gudmundsson Date: Sun, 23 Jul 2017 02:51:39 +0200 Subject: [PATCH] A whole lot of filtering. URL now reflects filters. --- schedule/src/Decoders.elm | 3 +- schedule/src/Main.elm | 8 +-- schedule/src/Messages.elm | 2 +- schedule/src/Models.elm | 11 ++- schedule/src/Routing.elm | 19 ++++++ schedule/src/Update.elm | 44 ++++++++++-- schedule/src/Views.elm | 3 + schedule/src/Views/FilterView.elm | 91 +++++++++++++++++++++++-- schedule/src/Views/ScheduleOverview.elm | 4 +- 9 files changed, 163 insertions(+), 22 deletions(-) diff --git a/schedule/src/Decoders.elm b/schedule/src/Decoders.elm index 6e68bff6..f0433b49 100644 --- a/schedule/src/Decoders.elm +++ b/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) diff --git a/schedule/src/Main.elm b/schedule/src/Main.elm index bea165e6..3a8ab0d5 100644 --- a/schedule/src/Main.elm +++ b/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 [] [] [] [] [] flags emptyFilter currentRoute + model = + Model [] [] [] [] [] flags emptyFilter location currentRoute in - initModel ! [ sendInitMessage flags.camp_slug flags.websocket_server ] + model ! [ sendInitMessage flags.camp_slug flags.websocket_server ] diff --git a/schedule/src/Messages.elm b/schedule/src/Messages.elm index 705ed40a..502f29cd 100644 --- a/schedule/src/Messages.elm +++ b/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 diff --git a/schedule/src/Models.elm b/schedule/src/Models.elm index 5e168516..233f96f4 100644 --- a/schedule/src/Models.elm +++ b/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 } } diff --git a/schedule/src/Routing.elm b/schedule/src/Routing.elm index 0530a036..17417bf3 100644 --- a/schedule/src/Routing.elm +++ b/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) ] diff --git a/schedule/src/Update.elm b/schedule/src/Update.elm index 6d839307..d9bea033 100644 --- a/schedule/src/Update.elm +++ b/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 ] diff --git a/schedule/src/Views.elm b/schedule/src/Views.elm index 4e5ce5d0..cff006a1 100644 --- a/schedule/src/Views.elm +++ b/schedule/src/Views.elm @@ -30,6 +30,9 @@ view model = OverviewRoute -> scheduleOverviewView model + OverviewFilteredRoute _ -> + scheduleOverviewView model + DayRoute dayIso -> let day = diff --git a/schedule/src/Views/FilterView.elm b/schedule/src/Views/FilterView.elm index e738bea4..2718b418 100644 --- a/schedule/src/Views/FilterView.elm +++ b/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 recorded", filter = recordedFilter } - , { name = "Has recording", filter = hasRecordingFilter } + [ { name = "Will not be recorded", slug = "not-to-be-recorded", filter = notRecordedFilter } + , { name = "Will recorded", slug = "to-be-recorded", filter = recordedFilter } + , { 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 diff --git a/schedule/src/Views/ScheduleOverview.elm b/schedule/src/Views/ScheduleOverview.elm index 32ce0e9a..04c4a332 100644 --- a/schedule/src/Views/ScheduleOverview.elm +++ b/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 Views.FilterView exposing (filterSidebar, applyFilters) +import Models exposing (Model, Day, EventInstance, Filter) +import Views.FilterView exposing (filterSidebar, applyFilters, parseFilterFromQuery) -- External modules