Use more union types!

This commit is contained in:
Vidir Valberg Gudmundsson 2017-08-16 18:08:34 +02:00
parent bd1d139d2d
commit cf575d5b74
6 changed files with 208 additions and 129 deletions

View File

@ -2,7 +2,7 @@ module Decoders exposing (..)
-- Local modules -- 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 -- Core modules
@ -94,17 +94,17 @@ eventInstanceDecoder =
|> optional "is_favorited" (nullable bool) Nothing |> optional "is_favorited" (nullable bool) Nothing
eventLocationDecoder : Decoder EventLocation eventLocationDecoder : Decoder FilterType
eventLocationDecoder = eventLocationDecoder =
decode EventLocation decode LocationFilter
|> required "name" string |> required "name" string
|> required "slug" string |> required "slug" string
|> required "icon" string |> required "icon" string
eventTypeDecoder : Decoder EventType eventTypeDecoder : Decoder FilterType
eventTypeDecoder = eventTypeDecoder =
decode EventType decode TypeFilter
|> required "name" string |> required "name" string
|> required "slug" string |> required "slug" string
|> required "color" string |> required "color" string

View File

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

View File

@ -47,8 +47,8 @@ type alias Model =
{ days : List Day { days : List Day
, events : List Event , events : List Event
, eventInstances : List EventInstance , eventInstances : List EventInstance
, eventLocations : List EventLocation , eventLocations : List FilterType
, eventTypes : List EventType , eventTypes : List FilterType
, speakers : List Speaker , speakers : List Speaker
, flags : Flags , flags : Flags
, filter : Filter , 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 = type alias Day =
{ day_name : String { day_name : String
, date : Date , 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 = type alias Flags =
{ schedule_timeslot_length_minutes : Int { schedule_timeslot_length_minutes : Int
, schedule_midnight_offset_hours : Int , schedule_midnight_offset_hours : Int
@ -140,3 +112,68 @@ type alias Flags =
, camp_slug : String , camp_slug : String
, websocket_server : 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

View File

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

View File

@ -3,7 +3,7 @@ module Views.DayView exposing (dayView)
-- Local modules -- Local modules
import Messages exposing (Msg(..)) 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) 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 = locationColumns eventInstances eventLocations offset minutes =
let let
columnWidth = columnWidth =
@ -75,11 +75,11 @@ locationColumns eventInstances eventLocations offset minutes =
(List.map (\location -> locationColumn columnWidth eventInstances offset minutes location) eventLocations) (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 = locationColumn columnWidth eventInstances offset minutes location =
let let
locationInstances = locationInstances =
List.filter (\instance -> instance.location == location.slug) eventInstances List.filter (\instance -> instance.location == getSlugFromFilterType location) eventInstances
overlappingGroups = overlappingGroups =
List.Extra.groupWhile List.Extra.groupWhile
@ -101,7 +101,7 @@ locationColumn columnWidth eventInstances offset minutes location =
[ ( "location-column-header", True ) [ ( "location-column-header", True )
] ]
] ]
[ text location.name ] [ text <| getNameFromFilterType location ]
] ]
++ (List.map ++ (List.map
(\x -> (\x ->

View File

@ -3,7 +3,7 @@ module Views.FilterView exposing (filterSidebar, applyFilters, parseFilterFromQu
-- Local modules -- Local modules
import Messages exposing (Msg(..)) 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) import Routing exposing (routeToString)
@ -15,7 +15,7 @@ import Regex
-- External modules -- External modules
import Html exposing (Html, text, div, ul, li, span, i, h4, small) 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 Html.Events exposing (onClick)
import Date.Extra exposing (Interval(..), equalBy) import Date.Extra exposing (Interval(..), equalBy)
@ -24,7 +24,7 @@ applyFilters : Day -> Model -> List EventInstance
applyFilters day model = applyFilters day model =
let let
slugs default filters = slugs default filters =
List.map .slug List.map getSlugFromFilterType
(if List.isEmpty filters then (if List.isEmpty filters then
default default
else else
@ -71,44 +71,40 @@ filterSidebar model =
"Type" "Type"
model.eventTypes model.eventTypes
model.filter.eventTypes model.filter.eventTypes
ToggleEventTypeFilter
model.eventInstances model.eventInstances
.eventType .eventType
, filterView , filterView
"Location" "Location"
model.eventLocations model.eventLocations
model.filter.eventLocations model.filter.eventLocations
ToggleEventLocationFilter
model.eventInstances model.eventInstances
.location .location
, filterView , filterView
"Video" "Video"
videoRecordingFilters videoRecordingFilters
model.filter.videoRecording model.filter.videoRecording
ToggleVideoRecordingFilter
model.eventInstances model.eventInstances
.videoState .videoState
] ]
] ]
videoRecordingFilters : List VideoRecordingFilter videoRecordingFilters : List FilterType
videoRecordingFilters = 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 : filterView :
String 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 -> List EventInstance
-> (EventInstance -> String) -> (EventInstance -> String)
-> Html Msg -> Html Msg
filterView name possibleFilters currentFilters action eventInstances slugLike = filterView name possibleFilters currentFilters eventInstances slugLike =
div [] div []
[ text (name ++ ":") [ text (name ++ ":")
, ul [] , ul []
@ -118,7 +114,6 @@ filterView name possibleFilters currentFilters action eventInstances slugLike =
filterChoiceView filterChoiceView
filter filter
currentFilters currentFilters
action
eventInstances eventInstances
slugLike slugLike
) )
@ -127,13 +122,12 @@ filterView name possibleFilters currentFilters action eventInstances slugLike =
filterChoiceView : filterChoiceView :
{ a | name : String, slug : String } FilterType
-> List { a | name : String, slug : String } -> List FilterType
-> ({ a | name : String, slug : String } -> Msg)
-> List EventInstance -> List EventInstance
-> (EventInstance -> String) -> (EventInstance -> String)
-> Html Msg -> Html Msg
filterChoiceView filter currentFilters action eventInstances slugLike = filterChoiceView filter currentFilters eventInstances slugLike =
let let
active = active =
List.member filter currentFilters List.member filter currentFilters
@ -141,35 +135,97 @@ filterChoiceView filter currentFilters action eventInstances slugLike =
notActive = notActive =
not active not active
( name, slug ) =
unpackFilterType filter
eventInstanceCount = eventInstanceCount =
eventInstances eventInstances
|> List.filter (\eventInstance -> slugLike eventInstance == filter.slug) |> List.filter (\eventInstance -> slugLike eventInstance == slug)
|> List.length |> 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 in
li [] li
[]
[ div [ div
[ classList ([ classList
[ ( "btn", True ) [ ( "btn", True )
, ( "btn-default", True ) , ( "btn-default", True )
, ( "filter-choice-active", active ) , ( "filter-choice-active", active )
] ]
, onClick (action filter) , onClick (ToggleFilter filter)
] ]
++ buttonStyle
)
[ span [] [ span []
[ i [ classList [ ( "fa", True ), ( "fa-minus", active ), ( "fa-plus", notActive ) ] ] [] ([ span [ classList [ ( "pull-left", True ) ] ]
, text (" " ++ filter.name) [ i
, small [] [ text <| " (" ++ (toString eventInstanceCount) ++ ")" ] [ 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 = 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 = getFilter filterType modelItems query =
let let
filterMatch = filterMatch =
@ -208,7 +264,7 @@ filterToString : Filter -> String
filterToString filter = filterToString filter =
let let
typePart = 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 "type=" ++ types
locationPart = 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 "location=" ++ locations
videoPart = videoPart =
case String.join "," (List.map .slug filter.videoRecording) of case String.join "," (List.map getSlugFromFilterType filter.videoRecording) of
"" -> "" ->
"" ""