524 lines
13 KiB
Elm
524 lines
13 KiB
Elm
module Main exposing (..)
|
|
|
|
import Html exposing (Html, Attribute, div, input, text, li, ul, a, h4, label, i, span, hr, small, p)
|
|
import Html.Attributes exposing (class, classList, id, type_, for, style, href)
|
|
import Html.Events exposing (onClick)
|
|
import WebSocket exposing (listen)
|
|
import Json.Decode exposing (int, string, float, list, bool, Decoder)
|
|
import Json.Encode
|
|
import Json.Decode.Pipeline exposing (decode, required, optional, hardcoded)
|
|
import Markdown
|
|
import Navigation exposing (Location)
|
|
import UrlParser exposing ((</>))
|
|
|
|
|
|
main : Program Flags Model Msg
|
|
main =
|
|
Navigation.programWithFlags
|
|
OnLocationChange
|
|
{ init = init
|
|
, view = view
|
|
, update = update
|
|
, subscriptions = subscriptions
|
|
}
|
|
|
|
|
|
scheduleServer : String
|
|
scheduleServer =
|
|
"ws://localhost:8000/schedule/"
|
|
|
|
|
|
|
|
-- ROUTING
|
|
|
|
|
|
type Route
|
|
= OverviewRoute
|
|
| EventInstanceRoute EventInstanceSlug
|
|
| NotFoundRoute
|
|
|
|
|
|
matchers : UrlParser.Parser (Route -> a) a
|
|
matchers =
|
|
UrlParser.oneOf
|
|
[ UrlParser.map OverviewRoute UrlParser.top
|
|
, UrlParser.map EventInstanceRoute (UrlParser.s "event" </> UrlParser.string)
|
|
]
|
|
|
|
|
|
parseLocation : Location -> Route
|
|
parseLocation location =
|
|
case UrlParser.parseHash matchers location of
|
|
Just route ->
|
|
route
|
|
|
|
Nothing ->
|
|
NotFoundRoute
|
|
|
|
|
|
|
|
-- MODEL
|
|
|
|
|
|
type alias Model =
|
|
{ days : List Day
|
|
, eventInstances : List EventInstance
|
|
, eventLocations : List EventLocation
|
|
, eventTypes : List EventType
|
|
, flags : Flags
|
|
, activeDay : Day
|
|
, filter : Filter
|
|
, route : Route
|
|
}
|
|
|
|
|
|
type alias Filter =
|
|
{ eventTypes : List EventType
|
|
, eventLocations : List EventLocation
|
|
}
|
|
|
|
|
|
type alias Day =
|
|
{ day_name : String
|
|
, iso : String
|
|
, repr : String
|
|
}
|
|
|
|
|
|
type alias Speaker =
|
|
{ name : String
|
|
, url : String
|
|
}
|
|
|
|
|
|
type alias EventInstanceSlug =
|
|
String
|
|
|
|
|
|
type alias EventInstance =
|
|
{ title : String
|
|
, id : Int
|
|
, url : String
|
|
, abstract : String
|
|
, eventSlug : EventInstanceSlug
|
|
, eventType : String
|
|
, backgroundColor : String
|
|
, forgroundColor : String
|
|
, from : String
|
|
, to : String
|
|
, timeslots : Float
|
|
, location : String
|
|
, locationIcon : String
|
|
, speakers : List Speaker
|
|
, videoRecording : Bool
|
|
, videoUrl : String
|
|
}
|
|
|
|
|
|
emptyEventInstance : EventInstance
|
|
emptyEventInstance =
|
|
{ title = "This should not happen!"
|
|
, id = 0
|
|
, url = ""
|
|
, abstract = ""
|
|
, eventSlug = ""
|
|
, eventType = ""
|
|
, backgroundColor = ""
|
|
, forgroundColor = ""
|
|
, from = ""
|
|
, to = ""
|
|
, timeslots = 0.0
|
|
, location = ""
|
|
, locationIcon = ""
|
|
, speakers = []
|
|
, videoRecording = False
|
|
, videoUrl = ""
|
|
}
|
|
|
|
|
|
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
|
|
, ics_button_href : String
|
|
, camp_slug : String
|
|
}
|
|
|
|
|
|
allDaysDay : Day
|
|
allDaysDay =
|
|
Day "All Days" "" ""
|
|
|
|
|
|
init : Flags -> Location -> ( Model, Cmd Msg )
|
|
init flags location =
|
|
( Model [] [] [] [] flags allDaysDay (Filter [] []) (parseLocation location), sendInitMessage flags.camp_slug )
|
|
|
|
|
|
sendInitMessage : String -> Cmd Msg
|
|
sendInitMessage camp_slug =
|
|
WebSocket.send scheduleServer
|
|
(Json.Encode.encode 0
|
|
(Json.Encode.object
|
|
[ ( "action", Json.Encode.string "init" )
|
|
, ( "camp_slug", Json.Encode.string camp_slug )
|
|
]
|
|
)
|
|
)
|
|
|
|
|
|
|
|
-- UPDATE
|
|
|
|
|
|
type Msg
|
|
= NoOp
|
|
| WebSocketPayload String
|
|
| MakeActiveday Day
|
|
| ToggleEventTypeFilter EventType
|
|
| ToggleEventLocationFilter EventLocation
|
|
| OnLocationChange Location
|
|
|
|
|
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
|
update msg model =
|
|
case msg of
|
|
NoOp ->
|
|
( model, Cmd.none )
|
|
|
|
WebSocketPayload str ->
|
|
let
|
|
newModel =
|
|
case Json.Decode.decodeString initDataDecoder str of
|
|
Ok m ->
|
|
m model.flags allDaysDay (Filter [] []) model.route
|
|
|
|
Err error ->
|
|
model
|
|
in
|
|
newModel ! []
|
|
|
|
MakeActiveday day ->
|
|
{ model | activeDay = day } ! []
|
|
|
|
ToggleEventTypeFilter eventType ->
|
|
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 }
|
|
in
|
|
{ model | filter = newFilter } ! []
|
|
|
|
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 }
|
|
in
|
|
{ model | filter = newFilter } ! []
|
|
|
|
OnLocationChange location ->
|
|
let
|
|
newRoute =
|
|
parseLocation location
|
|
in
|
|
{ model | route = newRoute } ! []
|
|
|
|
|
|
|
|
-- SUBSCRIPTIONS
|
|
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions model =
|
|
WebSocket.listen scheduleServer WebSocketPayload
|
|
|
|
|
|
|
|
-- DECODERS
|
|
|
|
|
|
dayDecoder : Decoder Day
|
|
dayDecoder =
|
|
decode Day
|
|
|> required "day_name" string
|
|
|> required "iso" string
|
|
|> required "repr" string
|
|
|
|
|
|
speakerDecoder : Decoder Speaker
|
|
speakerDecoder =
|
|
decode Speaker
|
|
|> required "name" string
|
|
|> required "url" string
|
|
|
|
|
|
eventInstanceDecoder : Decoder EventInstance
|
|
eventInstanceDecoder =
|
|
decode EventInstance
|
|
|> required "title" string
|
|
|> required "id" int
|
|
|> required "url" string
|
|
|> required "abstract" string
|
|
|> required "event_slug" string
|
|
|> required "event_type" string
|
|
|> required "bg-color" string
|
|
|> required "fg-color" string
|
|
|> required "from" string
|
|
|> required "to" string
|
|
|> required "timeslots" float
|
|
|> required "location" string
|
|
|> required "location_icon" string
|
|
|> required "speakers" (list speakerDecoder)
|
|
|> required "video_recording" bool
|
|
|> optional "video_url" string ""
|
|
|
|
|
|
eventLocationDecoder : Decoder EventLocation
|
|
eventLocationDecoder =
|
|
decode EventLocation
|
|
|> required "name" string
|
|
|> required "slug" string
|
|
|> required "icon" string
|
|
|
|
|
|
eventTypeDecoder : Decoder EventType
|
|
eventTypeDecoder =
|
|
decode EventType
|
|
|> required "name" string
|
|
|> required "slug" string
|
|
|> required "color" string
|
|
|> required "light_text" bool
|
|
|
|
|
|
initDataDecoder : Decoder (Flags -> Day -> Filter -> Route -> Model)
|
|
initDataDecoder =
|
|
decode Model
|
|
|> required "days" (list dayDecoder)
|
|
|> required "event_instances" (list eventInstanceDecoder)
|
|
|> required "event_locations" (list eventLocationDecoder)
|
|
|> required "event_types" (list eventTypeDecoder)
|
|
|
|
|
|
|
|
-- VIEW
|
|
|
|
|
|
dayButton : Day -> Day -> Html Msg
|
|
dayButton day activeDay =
|
|
a
|
|
[ classList
|
|
[ ( "btn", True )
|
|
, ( "btn-default", day /= activeDay )
|
|
, ( "btn-primary", day == activeDay )
|
|
]
|
|
, onClick (MakeActiveday day)
|
|
]
|
|
[ text day.day_name
|
|
]
|
|
|
|
|
|
view : Model -> Html Msg
|
|
view model =
|
|
div []
|
|
[ div [ class "row" ]
|
|
[ div [ id "schedule-days", class "btn-group" ]
|
|
(List.map (\day -> dayButton day model.activeDay) (allDaysDay :: model.days))
|
|
]
|
|
, hr [] []
|
|
, case model.route of
|
|
OverviewRoute ->
|
|
scheduleOverviewView model
|
|
|
|
EventInstanceRoute eventInstanceId ->
|
|
eventInstanceDetailView eventInstanceId model.eventInstances
|
|
|
|
NotFoundRoute ->
|
|
div [] [ text "Not found!" ]
|
|
]
|
|
|
|
|
|
eventInstanceDetailView : EventInstanceSlug -> List EventInstance -> Html Msg
|
|
eventInstanceDetailView eventInstanceId eventInstances =
|
|
let
|
|
eventInstance =
|
|
case List.head (List.filter (\e -> e.eventSlug == eventInstanceId) eventInstances) of
|
|
Just eventInstance ->
|
|
eventInstance
|
|
|
|
Nothing ->
|
|
emptyEventInstance
|
|
in
|
|
div [ class "row" ]
|
|
[ div [ class "col-sm-9" ]
|
|
[ a [ href "#" ]
|
|
[ text "Back"
|
|
]
|
|
, h4 [] [ text eventInstance.title ]
|
|
, p [] [ Markdown.toHtml [] eventInstance.abstract ]
|
|
]
|
|
, div
|
|
[ classList
|
|
[ ( "col-sm-3", True )
|
|
, ( "schedule-sidebar", True )
|
|
]
|
|
]
|
|
[ h4 [] [ text "Speakers" ]
|
|
]
|
|
]
|
|
|
|
|
|
scheduleOverviewView : Model -> Html Msg
|
|
scheduleOverviewView model =
|
|
div [ class "row" ]
|
|
[ div
|
|
[ classList
|
|
[ ( "col-sm-3", True )
|
|
, ( "col-sm-push-9", True )
|
|
, ( "schedule-sidebar", True )
|
|
, ( "schedule-filter", True )
|
|
]
|
|
]
|
|
[ h4 [] [ text "Filter" ]
|
|
, div [ class "form-group" ]
|
|
[ filterView "Type" model.eventTypes model.filter.eventTypes ToggleEventTypeFilter
|
|
, filterView "Location" model.eventLocations model.filter.eventLocations ToggleEventLocationFilter
|
|
]
|
|
]
|
|
, div
|
|
[ classList
|
|
[ ( "col-sm-9", True )
|
|
, ( "col-sm-pull-3", True )
|
|
]
|
|
]
|
|
(List.map (\day -> dayRowView day model) model.days)
|
|
]
|
|
|
|
|
|
dayRowView : Day -> Model -> Html Msg
|
|
dayRowView day model =
|
|
let
|
|
types =
|
|
List.map (\eventType -> eventType.slug)
|
|
(if List.isEmpty model.filter.eventTypes then
|
|
model.eventTypes
|
|
else
|
|
model.filter.eventTypes
|
|
)
|
|
|
|
locations =
|
|
List.map (\eventLocation -> eventLocation.slug)
|
|
(if List.isEmpty model.filter.eventLocations then
|
|
model.eventLocations
|
|
else
|
|
model.filter.eventLocations
|
|
)
|
|
|
|
filteredEventInstances =
|
|
List.filter
|
|
(\eventInstance ->
|
|
((String.slice 0 10 eventInstance.from) == day.iso)
|
|
&& List.member eventInstance.location locations
|
|
&& List.member eventInstance.eventType types
|
|
)
|
|
model.eventInstances
|
|
in
|
|
div []
|
|
[ h4 []
|
|
[ text day.repr ]
|
|
, div [ class "schedule-day-row" ]
|
|
(List.map dayEventInstanceView filteredEventInstances)
|
|
]
|
|
|
|
|
|
dayEventInstanceView : EventInstance -> Html Msg
|
|
dayEventInstanceView eventInstance =
|
|
a
|
|
[ class "event"
|
|
, href ("#event/" ++ eventInstance.eventSlug)
|
|
, style
|
|
[ ( "background-color", eventInstance.backgroundColor )
|
|
, ( "color", eventInstance.forgroundColor )
|
|
]
|
|
]
|
|
[ small []
|
|
[ text ((String.slice 11 16 eventInstance.from) ++ " - " ++ (String.slice 11 16 eventInstance.to)) ]
|
|
, i [ classList [ ( "fa", True ), ( "fa-" ++ eventInstance.locationIcon, True ), ( "pull-right", True ) ] ] []
|
|
, p
|
|
[]
|
|
[ text eventInstance.title ]
|
|
]
|
|
|
|
|
|
filterView :
|
|
String
|
|
-> List { a | name : String }
|
|
-> List { a | name : String }
|
|
-> ({ a | name : String } -> Msg)
|
|
-> Html Msg
|
|
filterView name possibleFilters currentFilters action =
|
|
div []
|
|
[ text (name ++ ":")
|
|
, ul [] (List.map (\filter -> filterChoiceView filter currentFilters action) possibleFilters)
|
|
]
|
|
|
|
|
|
filterChoiceView :
|
|
{ a | name : String }
|
|
-> List { a | name : String }
|
|
-> ({ a | name : String } -> Msg)
|
|
-> Html Msg
|
|
filterChoiceView filter currentFilters action =
|
|
let
|
|
active =
|
|
List.member filter currentFilters
|
|
|
|
notActive =
|
|
not active
|
|
in
|
|
li []
|
|
[ div
|
|
[ classList
|
|
[ ( "btn", True )
|
|
, ( "btn-default", True )
|
|
, ( "filter-choice-active", active )
|
|
]
|
|
, onClick (action filter)
|
|
]
|
|
[ span []
|
|
[ i [ classList [ ( "fa", True ), ( "fa-minus", active ), ( "fa-plus", notActive ) ] ] []
|
|
, text (" " ++ filter.name)
|
|
]
|
|
]
|
|
]
|