fetch and parse json from frontend
This commit is contained in:
parent
8dda4c37ba
commit
9b4cb45c16
@ -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 "-" ]
|
||||
|
Loading…
Reference in New Issue
Block a user