|
|
|
port module Main exposing (main)
|
|
|
|
|
|
|
|
import Browser
|
|
|
|
import Browser.Navigation as Nav
|
|
|
|
import Html exposing (..)
|
|
|
|
import Html.Attributes exposing (..)
|
|
|
|
import Html.Events exposing (onClick, onInput)
|
|
|
|
import Model exposing (Model)
|
|
|
|
import Navigation
|
|
|
|
import Random
|
|
|
|
import Url
|
|
|
|
import Url.Parser
|
|
|
|
import WsMessage exposing (createSession)
|
|
|
|
|
|
|
|
|
|
|
|
main =
|
|
|
|
Browser.application
|
|
|
|
{ init = init
|
|
|
|
, onUrlChange = UrlChanged
|
|
|
|
, onUrlRequest = LinkClicked
|
|
|
|
, subscriptions = subscriptions
|
|
|
|
, update = update
|
|
|
|
, view = view
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
port wsout : String -> Cmd msg
|
|
|
|
|
|
|
|
|
|
|
|
port wsin : (String -> msg) -> Sub msg
|
|
|
|
|
|
|
|
|
|
|
|
{-| currently no flags are needed
|
|
|
|
that's the reason for the generic type and \_ as param name
|
|
|
|
-}
|
|
|
|
init : { userUuid : String } -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
|
|
|
|
init flags url key =
|
|
|
|
let
|
|
|
|
route : Navigation.Route
|
|
|
|
route =
|
|
|
|
Url.Parser.parse Navigation.routeParser url
|
|
|
|
|> Maybe.withDefault Navigation.Home
|
|
|
|
|
|
|
|
initInfo : Model.InitInfo
|
|
|
|
initInfo =
|
|
|
|
Model.InitInfo key route url flags.userUuid
|
|
|
|
|
|
|
|
model : Model
|
|
|
|
model =
|
|
|
|
Model.initialModel initInfo
|
|
|
|
in
|
|
|
|
routeChanged route model
|
|
|
|
|
|
|
|
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
|
|
subscriptions _ =
|
|
|
|
wsin WsIn
|
|
|
|
|
|
|
|
|
|
|
|
type Msg
|
|
|
|
= UrlChanged Url.Url
|
|
|
|
| LinkClicked Browser.UrlRequest
|
|
|
|
| WsIn String
|
|
|
|
| WsOut String
|
|
|
|
| CreateRetro
|
|
|
|
| CreatePoker
|
|
|
|
| NameChanged String
|
|
|
|
| NameGenerated ScrambledName
|
|
|
|
| RandomizeName
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- BOOT TIME
|
|
|
|
|
|
|
|
|
|
|
|
type alias ScrambledName =
|
|
|
|
{ prefix : String
|
|
|
|
, suffix : String
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
randomUserName : Cmd Msg
|
|
|
|
randomUserName =
|
|
|
|
let
|
|
|
|
prefixes =
|
|
|
|
[ "Joyful"
|
|
|
|
, "Squiddly"
|
|
|
|
, "Fast"
|
|
|
|
, "Tinkering"
|
|
|
|
, "Freezy"
|
|
|
|
, "Warm-To-The-Touch"
|
|
|
|
, "Red"
|
|
|
|
, "Pale"
|
|
|
|
, "Hardy"
|
|
|
|
, "Hardened"
|
|
|
|
, "Rocky"
|
|
|
|
, "Pokey"
|
|
|
|
, "Screeching"
|
|
|
|
, "Sweet"
|
|
|
|
, "Grumpy"
|
|
|
|
, "Tempered"
|
|
|
|
, "Bendy"
|
|
|
|
]
|
|
|
|
|
|
|
|
suffixes =
|
|
|
|
[ "Rock"
|
|
|
|
, "Impala"
|
|
|
|
, "Liliac"
|
|
|
|
, "Bike"
|
|
|
|
, "Tinker"
|
|
|
|
, "Red"
|
|
|
|
, "Green"
|
|
|
|
, "Squid"
|
|
|
|
, "Sponge"
|
|
|
|
, "Star"
|
|
|
|
, "Fish"
|
|
|
|
, "Tandem"
|
|
|
|
, "Ground dweller"
|
|
|
|
, "Bird"
|
|
|
|
, "Ice cream"
|
|
|
|
, "Brush"
|
|
|
|
, "Highborn"
|
|
|
|
]
|
|
|
|
in
|
|
|
|
Random.generate NameGenerated
|
|
|
|
(Random.map2 ScrambledName
|
|
|
|
(Random.uniform "Chuck" prefixes)
|
|
|
|
(Random.uniform "Norris" suffixes)
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- UPDATE PART
|
|
|
|
|
|
|
|
|
|
|
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
|
|
|
update msg model =
|
|
|
|
case msg of
|
|
|
|
-- Navigation based messages
|
|
|
|
LinkClicked urlRequest ->
|
|
|
|
Navigation.linkClicked urlRequest model.key model
|
|
|
|
|
|
|
|
UrlChanged url ->
|
|
|
|
case Url.Parser.parse Navigation.routeParser url of
|
|
|
|
Just route ->
|
|
|
|
routeChanged route model
|
|
|
|
|
|
|
|
Nothing ->
|
|
|
|
-- TODO error reporting
|
|
|
|
( { model | route = Navigation.Home }, Cmd.none )
|
|
|
|
|
|
|
|
-- WEBSOCKETS
|
|
|
|
WsOut wsmsg ->
|
|
|
|
( model, wsout wsmsg )
|
|
|
|
|
|
|
|
WsIn strmsg ->
|
|
|
|
( model, Cmd.none )
|
|
|
|
|
|
|
|
-- INIT
|
|
|
|
NameChanged name ->
|
|
|
|
( { model | userName = name }, Cmd.none )
|
|
|
|
|
|
|
|
NameGenerated scrambled ->
|
|
|
|
( { model | userName = scrambled.prefix ++ " " ++ scrambled.suffix }, Cmd.none )
|
|
|
|
|
|
|
|
RandomizeName ->
|
|
|
|
( model, randomUserName )
|
|
|
|
|
|
|
|
-- RETRO
|
|
|
|
CreateRetro ->
|
|
|
|
Debug.todo "implement create retro"
|
|
|
|
|
|
|
|
-- POKER
|
|
|
|
CreatePoker ->
|
|
|
|
Debug.log (createSession model)
|
|
|
|
( model, wsout (createSession model) )
|
|
|
|
|
|
|
|
|
|
|
|
routeChanged : Navigation.Route -> Model -> ( Model, Cmd Msg )
|
|
|
|
routeChanged route model =
|
|
|
|
case route of
|
|
|
|
Navigation.Home ->
|
|
|
|
( { model | route = route }
|
|
|
|
, randomUserName
|
|
|
|
)
|
|
|
|
|
|
|
|
Navigation.Poker session ->
|
|
|
|
( { model | route = route, session = Just session }
|
|
|
|
, Cmd.none
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- HTML STUFF
|
|
|
|
|
|
|
|
|
|
|
|
view : Model -> Browser.Document Msg
|
|
|
|
view model =
|
|
|
|
{ title = "Open-Retro"
|
|
|
|
, body =
|
|
|
|
[ nav []
|
|
|
|
[ h1 [ class "app-title" ] [ text "Open-Retro" ]
|
|
|
|
, ul []
|
|
|
|
[ li []
|
|
|
|
[ input [ onInput NameChanged, value model.userName ]
|
|
|
|
[]
|
|
|
|
]
|
|
|
|
, li []
|
|
|
|
[ button
|
|
|
|
[ onClick RandomizeName ]
|
|
|
|
[ text "🎲" ]
|
|
|
|
]
|
|
|
|
, li []
|
|
|
|
[ button
|
|
|
|
[ onClick CreateRetro ]
|
|
|
|
[ text "🂿 New retro" ]
|
|
|
|
]
|
|
|
|
, li []
|
|
|
|
[ button
|
|
|
|
[ onClick CreatePoker ]
|
|
|
|
[ text "🃠 New poker" ]
|
|
|
|
]
|
|
|
|
]
|
|
|
|
]
|
|
|
|
, main_ [] (appContent model)
|
|
|
|
, node "link" [ rel "stylesheet", href "/compiled/css/style.css" ] []
|
|
|
|
]
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
appContent : Model -> List (Html Msg)
|
|
|
|
appContent model =
|
|
|
|
case model.route of
|
|
|
|
Navigation.Home ->
|
|
|
|
homePage model
|
|
|
|
|
|
|
|
Navigation.Poker _ ->
|
|
|
|
pokerPage model
|
|
|
|
|
|
|
|
|
|
|
|
homePage : Model -> List (Html Msg)
|
|
|
|
homePage _ =
|
|
|
|
[]
|
|
|
|
|
|
|
|
|
|
|
|
pokerPage : Model -> List (Html Msg)
|
|
|
|
pokerPage _ =
|
|
|
|
[]
|