frontend: get start/duration from query params

This commit is contained in:
Daniel Barlow 2024-11-12 00:15:19 +00:00
parent 3427f500b3
commit cbe8bf4d4d
2 changed files with 45 additions and 11 deletions

View File

@ -13,6 +13,7 @@
"elm/json": "1.1.3", "elm/json": "1.1.3",
"elm/svg": "1.0.1", "elm/svg": "1.0.1",
"elm/time": "1.0.0", "elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm-explorations/test": "2.2.0", "elm-explorations/test": "2.2.0",
"mpizenberg/elm-pointer-events": "5.0.0", "mpizenberg/elm-pointer-events": "5.0.0",
"rtfeldman/elm-iso8601-date-strings": "1.1.4", "rtfeldman/elm-iso8601-date-strings": "1.1.4",
@ -23,7 +24,6 @@
"elm/file": "1.0.5", "elm/file": "1.0.5",
"elm/parser": "1.1.0", "elm/parser": "1.1.0",
"elm/random": "1.0.0", "elm/random": "1.0.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.3", "elm/virtual-dom": "1.0.3",
"miniBill/elm-xml-parser": "1.0.1", "miniBill/elm-xml-parser": "1.0.1",
"rtfeldman/elm-hex": "1.0.0" "rtfeldman/elm-hex": "1.0.0"

View File

@ -1,6 +1,7 @@
module Main exposing (view) module Main exposing (view)
import Browser import Browser
import Browser.Navigation as Nav
import Html exposing (Html, button, div, span, text, img, pre) import Html exposing (Html, button, div, span, text, img, pre)
import Html.Attributes as H exposing (src, style, width, height) import Html.Attributes as H exposing (src, style, width, height)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
@ -17,15 +18,28 @@ import Svg.Attributes as S exposing
, fill , fill
, points , points
, stroke, strokeWidth, strokeOpacity) , stroke, strokeWidth, strokeOpacity)
import Url.Parser exposing (Parser, (</>), (<?>), int, map, oneOf, s, string)
import Url.Parser.Query as Query
import Url exposing (Url)
type Route = Timeline (Maybe Int) (Maybe Int)
routeParser : Parser (Route -> a) a
routeParser =
map Timeline (s "timeline" <?> Query.int "start" <?> Query.int "duration")
-- MAIN -- MAIN
main = main =
Browser.element { init = init Browser.application
{ init = init
, update = update , update = update
, subscriptions = subscriptions , subscriptions = subscriptions
, onUrlRequest = (\ ur -> NewUrlRequest)
, onUrlChange = (\ u -> UrlChanged)
, view = view } , view = view }
@ -114,10 +128,19 @@ type alias Model =
{ centre: Coord { centre: Coord
, zoom: Zoom , zoom: Zoom
, drag: Drag , drag: Drag
, startTime : Int
, duration : Int
, track: TrackState } , track: TrackState }
init : () -> (Model, Cmd Msg) init : () -> Url -> Nav.Key -> (Model, Cmd Msg)
init _ = ((Model (toCoord 51.60 -0.01) 13 None Empty), fetchTrack) init _ url navKey =
let (start, duration) =
case Url.Parser.parse routeParser url of
Just (Timeline (Just s) (Just d)) -> (s, d)
_ -> (10,10)
in
((Model (toCoord 51.60 -0.01) 13 None start duration Empty),
(fetchTrack start duration))
-- SUBSCRIPTIONS -- SUBSCRIPTIONS
@ -125,8 +148,11 @@ subscriptions : Model -> Sub Msg
subscriptions model = Sub.none subscriptions model = Sub.none
fetchTrack = Http.get fetchTrack start duration = Http.get
{ url = "http://localhost:3000/points?start=1729668899&duration=2842" { url = ("http://localhost:3000/points?start=" ++
String.fromInt start ++
"&duration=" ++
String.fromInt duration)
, expect = Http.expectJson Loaded trackDecoder , expect = Http.expectJson Loaded trackDecoder
} }
@ -175,6 +201,8 @@ type Msg
| PointerMove (Int, Int) | PointerMove (Int, Int)
| PointerUp (Int, Int) | PointerUp (Int, Int)
| Loaded (Result Http.Error (List Point)) | Loaded (Result Http.Error (List Point))
| NewUrlRequest
| UrlChanged
update : Msg -> Model -> (Model, Cmd Msg) update : Msg -> Model -> (Model, Cmd Msg)
@ -207,6 +235,8 @@ newModel msg model =
Ok trk -> { model | track = Present trk } Ok trk -> { model | track = Present trk }
Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") } Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") }
Err e -> { model | track = Debug.log "unknown error" (Failure "e") } Err e -> { model | track = Debug.log "unknown error" (Failure "e") }
NewUrlRequest -> model
UrlChanged -> model
-- VIEW -- VIEW
@ -293,8 +323,8 @@ canvas centre zoom width height track =
portalWidth = 600 portalWidth = 600
portalHeight = 600 portalHeight = 600
view : Model -> Html Msg viewDiv : Model -> Html Msg
view model = viewDiv model =
let coord = translate model.centre (pixelsToCoord model.zoom (dragDelta model.drag)) let coord = translate model.centre (pixelsToCoord model.zoom (dragDelta model.drag))
canvasV = canvas coord model.zoom portalWidth portalHeight model.track canvasV = canvas coord model.zoom portalWidth portalHeight model.track
in div [] in div []
@ -317,3 +347,7 @@ view model =
, button [ onClick (Scroll 10 0) ] [ text ">" ] , button [ onClick (Scroll 10 0) ] [ text ">" ]
-- , div [] [ text (Debug.toString (List.length model.track)) ] -- , div [] [ text (Debug.toString (List.length model.track)) ]
] ]
view : Model -> Browser.Document Msg
view model =
Browser.Document "Souplesse elm" [ (viewDiv model) ]