fetch and parse json from frontend

This commit is contained in:
Daniel Barlow 2024-11-10 18:53:56 +00:00
parent 8dda4c37ba
commit 9b4cb45c16

View File

@ -17,9 +17,6 @@ import Svg.Attributes as S exposing
, fill
, stroke, strokeWidth, strokeOpacity)
import Track exposing (Track)
-- import ExampleTrack
-- MAIN
@ -111,7 +108,7 @@ dragDelta d =
None -> (0,0)
Dragging (fx,fy) (tx,ty) -> (fx-tx, fy-ty)
type TrackState = Empty | Loading | Failure String | Present Track
type TrackState = Empty | Loading | Failure String | Present (List Point)
type alias Model =
{ centre: Coord
, zoom: Zoom
@ -119,7 +116,7 @@ type alias Model =
, track: TrackState }
init : () -> (Model, Cmd Msg)
init _ = ((Model (toCoord 51.60 -0.01) 16 None Empty), fetchTrack)
init _ = ((Model (toCoord 51.60 -0.01) 13 None Empty), fetchTrack)
-- SUBSCRIPTIONS
@ -128,10 +125,38 @@ subscriptions model = Sub.none
fetchTrack = Http.get
{ url = "/track.gpx.xml"
, expect = Http.expectString Loaded
{ url = "http://localhost:3000/points?start=1729668899&duration=2842"
, expect = Http.expectJson Loaded trackDecoder
}
type alias Pos =
{ lat : Float
, lon : Float
, ele : Maybe Float
}
type alias Point =
{ time : Float
, pos : Pos
}
posDecoder : D.Decoder Pos
posDecoder = D.map3 Pos
(D.field "lat" D.float)
(D.field "lon" D.float)
(D.field "ele" (D.maybe D.float))
pointDecoder : D.Decoder Point
pointDecoder = D.map2 Point
(D.field "time" D.float)
(D.field "pos" posDecoder)
trackDecoder : D.Decoder (List Point)
trackDecoder = D.list pointDecoder
-- UPDATE
@ -142,7 +167,7 @@ type Msg
| PointerDown (Int, Int)
| PointerMove (Int, Int)
| PointerUp (Int, Int)
| Loaded (Result Http.Error String)
| Loaded (Result Http.Error (List Point))
update : Msg -> Model -> (Model, Cmd Msg)
@ -172,12 +197,9 @@ newModel msg model =
Loaded result ->
case result of
Ok trk -> { model
| track = case Track.parse trk of
Ok track -> Present track
Err _ -> Failure "parse failed"
}
Err e -> { model | track = Failure "e" }
Ok trk -> { model | track = Debug.log "LOADED" (Present trk) }
Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") }
Err e -> { model | track = Debug.log "unknown error" (Failure "e") }
-- VIEW
@ -193,7 +215,7 @@ tileImg zoom tilenumber = img [ width 256,
height 256,
src (tileUrl tilenumber zoom) ] []
trackView : Track -> Svg Msg
trackView : List Point -> Svg Msg
trackView track =
@ -249,7 +271,7 @@ canvas centre zoom width height track =
epos e = Tuple.mapBoth floor floor e.pointer.clientPos
tv = case track of
Present t -> trackView t
Failure f -> div [] [ text "failure", text f]
Failure f -> Debug.log f (div [] [ text "failure", text f])
Loading -> div [] [text "loading"]
Empty -> div [] [text "no points"]
in div [style "position" "absolute"
@ -279,7 +301,7 @@ view model =
[canvasV])
, div [] [ text (String.fromInt model.zoom ) ]
, div [] [ case model.track of
Present tk -> text (String.fromInt (List.length tk))
-- Present tk -> text (String.fromInt (List.length tk))
_ -> text "dgdfg"
]
, button [ onClick ZoomOut ] [ text "-" ]