commit 5ec4e6be9acea5ac1ba401e23fb50b28290be0bf
parent 3278c7962c992511bd0182ce5ef10e3546990e87
Author: Daniel Barlow <dan@telent.net>
Date: Wed, 30 Oct 2024 17:17:48 +0000
parse cadence and power
Diffstat:
3 files changed, 67 insertions(+), 27 deletions(-)
diff --git a/README.md b/README.md
@@ -43,6 +43,12 @@ arbitrary functions of properties (e.g. to look at power/cadence
ratio, or ... some other weirdness)
+# Tech notes
+
+Run tests with `cabal test --test-show-details=always`: if you don't
+ask for details it won't tell you about incomplete pattern matches
+
+
----
_Do not look below this line_
@@ -53,3 +59,4 @@ _Do not look below this line_
* do we even need Track? will it ever be anything more than a collection
of Points?
* need a real gpx file with namespace decls before we can parse power and stuff
+* tests seem to pass without <gpx> element?
diff --git a/lib/Track.hs b/lib/Track.hs
@@ -5,6 +5,8 @@ module Track (
Pos(..),
pos,
elevation,
+ cadence,
+ power,
parse,
Track.length
) where
@@ -28,24 +30,28 @@ data Point = Point {
pos :: Pos,
elevation :: Maybe Float,
time :: UTCTime,
- power :: Power,
cadence :: Cadence,
+ power :: Power,
heartRate :: HeartRate
} deriving (Show)
-- TODO do we even need this type?
type Track = [Point]
-gpxNS = "http://www.topografix.com/GPX/1/1"
+gpxNS localName =
+ Name localName (Just "http://www.topografix.com/GPX/1/1") Nothing
+
+tpxNS localName =
+ Name localName (Just "http://www.garmin.com/xmlschemas/TrackPointExtension/v2") Nothing
mkPoint pos =
Point
pos
Nothing
(UTCTime (toEnum 60631) 43200)
- (Just 0)
- (Just 0)
- (Just 0)
+ Nothing
+ Nothing
+ Nothing
elToPoint :: Cursor -> Point
elToPoint c =
@@ -54,17 +60,31 @@ elToPoint c =
let
lat = getAttr "lat"
lon = getAttr "lon"
- ele = child c >>= element (Name "ele" (Just gpxNS) Nothing) >>= child >>= content
+ ele = child c >>= element (gpxNS "ele") >>= child >>= content
+ gpxtpx = child c >>=
+ element (gpxNS "extensions")
+ >>= child
+ >>= element (tpxNS "TrackPointExtension") >>= child
+ cadence = gpxtpx >>= element (tpxNS "cad")
+ >>= child >>= content
+ power = gpxtpx >>= element (Name "PowerInWatts" (Just "http://www.garmin.com/xmlschemas/PowerExtension/v1") Nothing)
+ >>= child >>= content
in Point (Pos lat lon)
(case ele of
[e] -> Just $ asFloat e
_ -> Nothing)
(UTCTime (toEnum 60631) 43200)
- (Just 0)
- (Just 0)
- (Just 0)
+ (case cadence of
+ [e] -> Just (asInt e)
+ _ -> Nothing)
+ (case power of
+ [e] -> Just (asInt e)
+ _ -> Nothing)
+ Nothing
+
where
asFloat v = (read (Data.Text.unpack v) :: Float)
+ asInt v = (read (Data.Text.unpack v) :: Int)
getAttr name =
case Map.lookup name attrs of
Just v -> asFloat v
@@ -74,11 +94,10 @@ elToPoint c =
getPoints :: Cursor -> [Point]
getPoints c =
let
- ns n = Name n (Just gpxNS) Nothing
trkpts =
- element (ns "gpx") c >>= child >>=
- element (ns "trk") >>= descendant >>=
- element (ns "trkpt")
+ element (gpxNS "gpx") c >>= child >>=
+ element (gpxNS "trk") >>= descendant >>=
+ element (gpxNS "trkpt")
in
List.map elToPoint trkpts
diff --git a/tests/UnitTest.hs b/tests/UnitTest.hs
@@ -28,16 +28,29 @@ xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/
wrap x = preamble ++ x ++ "</gpx>"
-onepoint = wrap
- "<trk> <trkseg> \n\
- \<trkpt lat=\"51\" lon=\"-0.1\"> </trkpt> \n\
- \</trkseg> </trk>"
-onepointWithAttrs = wrap
- "<trk> <trkseg> \n\
- \<trkpt lat=\"51\" lon=\"-0.1\"> \n\
- \ <ele>25.2</ele>\n\
- \</trkpt> \n\
- \</trkseg> </trk>"
+onepoint = wrap [r|
+<trk> <trkseg>
+<trkpt lat="51" lon="-0.1"> </trkpt>
+</trkseg> </trk>
+|]
+
+onepointWithAttrs = wrap [r|
+<trk>
+ <trkseg>
+ <trkpt lat="51" lon="-0.1">
+ <ele>25.2</ele>
+ <extensions><gpxtpx:TrackPointExtension>
+ <gpxtpx:speed>2.4</gpxtpx:speed>
+ <gpxtpx:cad>128</gpxtpx:cad>
+ <pwr:PowerInWatts>55</pwr:PowerInWatts>
+ <opentracks:accuracy_horizontal>3.216</opentracks:accuracy_horizontal><opentracks:distance>10.675</opentracks:distance>
+ <cluetrust:distance>32.025</cluetrust:distance>
+ </gpxtpx:TrackPointExtension>
+ </extensions>
+ </trkpt>
+ </trkseg>
+</trk>
+|]
test1 = TestCase $
case Track.parse (wrap "") of
@@ -65,8 +78,8 @@ test3 = TestCase $
of
Left err -> assertFailure (displayException err)
Right (p:ps) ->
- assertEqual "matches elevation"
- Nothing (Track.elevation p)
+ assertEqual "matches attributes"
+ (Nothing, Nothing) (Track.elevation p, Track.cadence p)
Right [] -> assertFailure "no points"
test4 = TestCase $
@@ -74,8 +87,9 @@ test4 = TestCase $
of
Left err -> assertFailure (displayException err)
Right (p:ps) ->
- assertEqual "matches elevation"
- (Just 25.2) (Track.elevation p)
+ assertEqual "matches attributes"
+ (Just 25.2, Just 128, Just 55)
+ (Track.elevation p, Track.cadence p, Track.power p)
Right [] -> assertFailure "no points"
tests :: Test
