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)
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
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
, activeEventInstance : Maybe EventInstance
}
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
allDaysDay =
Day "All Days" "" ""
init : Flags -> ( Model, Cmd Msg )
init flags =
( Model [] [] [] [] flags allDaysDay (Filter [] []) Nothing, 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
| OpenEventInstanceDetail EventInstance
| CloseEventInstanceDetail
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 [] []) Nothing
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 } ! []
OpenEventInstanceDetail eventInstance ->
{ model | activeEventInstance = Just eventInstance } ! []
CloseEventInstanceDetail ->
{ model | activeEventInstance = Nothing } ! []
-- 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 -> Maybe EventInstance -> 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.activeEventInstance of
Just eventInstance ->
eventInstanceDetailView eventInstance
Nothing ->
scheduleOverviewView model
]
eventInstanceDetailView : EventInstance -> Html Msg
eventInstanceDetailView eventInstance =
div [ class "row" ]
[ div [ class "col-sm-9" ]
[ div [ onClick CloseEventInstanceDetail ]
[ 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"
, onClick (OpenEventInstanceDetail eventInstance)
, 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)
]
]
]