parse cadence and power

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?

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
 

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