reynir
/
bornhack-website
1
0
Fork 0
Code Issues Pull Requests 1 Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
schedule/src/Decoders.elm
View File

@ -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

6
schedule/src/Messages.elm
View File

@ -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

97
schedule/src/Models.elm
View File

@ -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

90
schedule/src/Update.elm
View File

@ -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

10
schedule/src/Views/DayView.elm
View File

@ -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 ->

124
schedule/src/Views/FilterView.elm
View File

@ -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
"" ->
""