bornhack-website/schedule/Main.elm

356 lines
8.6 KiB
Elm

module Main exposing (..)
import Html exposing (Html, Attribute, div, input, text, li, ul, a, h4, label, i, span)
import Html.Attributes exposing (class, classList, id, type_, for)
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)
main : Program Flags Model Msg
main =
Html.programWithFlags
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
scheduleServer : String
scheduleServer =
"ws://localhost:8000/schedule/"
-- MODEL
type alias Model =
{ days : List Day
, eventInstances : List EventInstance
, eventLocations : List EventLocation
, eventTypes : List EventType
, flags : Flags
, activeDay : Day
, filter : Filter
}
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 EventInstance =
{ title : String
, id : Int
, url : String
, abstract : String
, eventSlug : String
, eventType : String
, backgroundColor : String
, forgroundColor : String
, from : String
, to : String
, timeslots : Float
, location : String
, locationIcon : String
, speakers : List Speaker
, videoRecording : Bool
, videoUrl : String
}
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 "All Days" "" ""
init : Flags -> ( Model, Cmd Msg )
init flags =
( Model [] [] [] [] flags allDaysDay (Filter [] []), 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
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 [] [])
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 } ! []
-- 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 -> 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))
]
, div [ class "row" ]
[ div
[ classList
[ ( "col-sm-3", True )
, ( "col-sm-9", 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 [] []
]
]
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)
]
]
]
locationFilter : List EventLocation -> Html Msg
locationFilter eventLocations =
div [] [ text "Location:" ]