souplesse

commit 9b4cb45c167052fa79a7c5b2452b509468a1b9ff
parent 8dda4c37bad7eabfbc11830a7139c6020affebe0
Author: Daniel Barlow <dan@telent.net>
Date:   Sun, 10 Nov 2024 18:53:56 +0000

fetch and parse json from frontend

Diffstat:
M
frontend/src/Main.elm
 | 
56
+++++++++++++++++++++++++++++++++++++++-----------------

1 file changed, 39 insertions(+), 17 deletions(-)
diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm
@@ -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 "-" ]