diff --git a/schedule/src/Decoders.elm b/schedule/src/Decoders.elm index 837ecdf6..b574794c 100644 --- a/schedule/src/Decoders.elm +++ b/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 diff --git a/schedule/src/Messages.elm b/schedule/src/Messages.elm index db48160e..414a6f79 100644 --- a/schedule/src/Messages.elm +++ b/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 - | ToggleEventLocationFilter EventLocation - | ToggleVideoRecordingFilter VideoRecordingFilter + | ToggleFilter FilterType | OnLocationChange Location | BackInHistory diff --git a/schedule/src/Models.elm b/schedule/src/Models.elm index 3c23cac1..9f60f394 100644 --- a/schedule/src/Models.elm +++ b/schedule/src/Models.elm @@ -47,8 +47,8 @@ type alias Model = { days : List Day , events : List Event , eventInstances : List EventInstance - , eventLocations : List EventLocation - , eventTypes : List EventType + , eventLocations : List FilterType + , 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 diff --git a/schedule/src/Update.elm b/schedule/src/Update.elm index d52293dc..8d2ad964 100644 --- a/schedule/src/Update.elm +++ b/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 = - if List.member eventType model.filter.eventTypes then - List.filter (\x -> x /= eventType) model.filter.eventTypes - else - eventType :: model.filter.eventTypes - currentFilter = model.filter newFilter = - { currentFilter | eventTypes = eventTypesFilter } + 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 + } - query = - filterToQuery newFilter + LocationFilter name slug icon -> + let + 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 + } - cmd = - Navigation.newUrl query - in - { model | filter = newFilter } ! [ cmd ] - - ToggleEventLocationFilter eventLocation -> - let - eventLocationsFilter = - if List.member eventLocation model.filter.eventLocations then - List.filter (\x -> x /= eventLocation) model.filter.eventLocations - else - eventLocation :: model.filter.eventLocations - - currentFilter = - model.filter - - newFilter = - { currentFilter | eventLocations = eventLocationsFilter } - - query = - filterToQuery newFilter - - cmd = - Navigation.newUrl query - in - { model | filter = newFilter } ! [ cmd ] - - ToggleVideoRecordingFilter videoRecording -> - let - videoRecordingFilter = - 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 } + VideoFilter name slug -> + let + 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 + } query = filterToQuery newFilter diff --git a/schedule/src/Views/DayView.elm b/schedule/src/Views/DayView.elm index 9745c40d..5721df37 100644 --- a/schedule/src/Views/DayView.elm +++ b/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 -> diff --git a/schedule/src/Views/FilterView.elm b/schedule/src/Views/FilterView.elm index e6cb5413..cc5698ee 100644 --- a/schedule/src/Views/FilterView.elm +++ b/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" } - , { name = "Will recorded", slug = "to-be-recorded" } - , { name = "Has recording", slug = "has-recording" } + [ VideoFilter "Will not be recorded" "not-to-be-recorded" + , VideoFilter "Will recorded" "to-be-recorded" + , VideoFilter "Has recording" "has-recording" ] filterView : String - -> List { a | name : String, slug : String } - -> List { a | name : String, slug : String } - -> ({ a | name : String, slug : String } -> Msg) + -> List FilterType + -> List FilterType -> 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 } - -> List { a | name : String, slug : String } - -> ({ a | name : String, slug : String } -> Msg) + FilterType + -> List FilterType -> 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 + + buttonStyle = + 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 [] + li + [] [ div - [ classList + ([ 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 ) ] ] [] - , text (" " ++ filter.name) - , small [] [ text <| " (" ++ (toString eventInstanceCount) ++ ")" ] - ] + ([ span [ classList [ ( "pull-left", True ) ] ] + [ 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 "" -> ""