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:" ]