parse trkpt timestamp

tests were passing despite incomplete pattern matches, oops

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_
@@ -52,4 +58,6 @@ _Do not look below this line_
 * [done] Pos can't include elevation if it's sometimes unknown
 * 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
+* [done] need a real gpx file with namespace decls before we can parse power and stuff
+* tests seem to pass without <gpx> element?
+* stop returning bogus data when missing required elements (e.g. time)

default.nix

@@ -6,6 +6,7 @@ let
       pkgs.haskell.lib.addBuildTools drv (with pkgs.haskellPackages;
         [
           cabal-install
+          hlint
         ]);
   };
 in haskellEnv.overrideAttrs(o: {

lib/Track.hs

@@ -5,10 +5,14 @@ module Track (
   Pos(..),
   pos,
   elevation,
+  cadence,
+  power,
+  time,
   parse,
   Track.length
              ) where
 import Data.Time
+import qualified Data.Time.ISO8601
 import qualified Data.List
 import Text.XML
 import Text.XML.Cursor as Cursor
@@ -28,22 +32,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 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)
+    Nothing
-    (Just 0)
+    Nothing
-    (Just 0)
+    Nothing
 
 elToPoint :: Cursor -> Point
 elToPoint c =
@@ -52,19 +62,38 @@ elToPoint c =
       let
         lat = getAttr "lat"
         lon = getAttr "lon"
-        ele = child c >>= element "ele" >>= child >>= content
+        ele = child c >>= element (gpxNS "ele") >>= child >>= content
+        ts = child c >>= element (gpxNS "time") >>= 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
+             [e] -> Just $ asFloat e
              _ -> Nothing)
-         (UTCTime (toEnum  60631) 43200)
+         (case ts of
-         (Just 0)
+             [e] -> case Data.Time.ISO8601.parseISO8601 (Data.Text.unpack e) of
-         (Just 0)
+                      Just utime -> utime
-         (Just 0)
+                      _ -> UTCTime (toEnum 0) 0
+             _ -> UTCTime (toEnum 0) 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
+          case Map.lookup name attrs of
             Just v -> asFloat v
             _ -> 0
     _ -> mkPoint (Pos 0 0)
@@ -73,9 +102,9 @@ getPoints :: Cursor -> [Point]
 getPoints c =
   let
     trkpts =
-      child c >>=
+      element (gpxNS "gpx") c >>= child >>=
-      element "trk" >>= descendant >>=
+      element (gpxNS "trk") >>= descendant >>=
-      element "trkpt"
+      element (gpxNS "trkpt")
   in
     List.map elToPoint trkpts
 
@@ -85,4 +114,4 @@ parse str = do
   return (getPoints (fromDocument gpx))
 
 length :: Track -> Int
-length trk = Data.List.length trk
+length = Data.List.length

souplesse.cabal

@@ -90,7 +90,7 @@ library souplesse-lib
       , time
       , containers
       , text
-      -- , text-iso8601
+      , iso8601-time
     default-language: GHC2021
 
 test-suite tests
@@ -101,5 +101,7 @@ test-suite tests
     build-depends:
         base >=4.7 && <5
       , souplesse-lib
+      , raw-strings-qq
+      , time
       , HUnit
     default-language: GHC2021

tests/UnitTest.hs

@@ -1,32 +1,69 @@
+{-# LANGUAGE QuasiQuotes #-}
+
 module Main where
 
 import qualified Track
+
+import Text.RawString.QQ(r)
 import Test.HUnit
 import qualified System.Exit as Exit
 import Control.Exception
 import Debug.Trace (trace, traceShow)
+import qualified Data.Time
 
-onepoint =
+preamble = [r|
-  "<gpx> <trk> <trkseg> \n\
+<?xml version="1.0" encoding="UTF-8"?>
-  \<trkpt lat=\"51\" lon=\"-0.1\"> </trkpt> \n\
+<gpx
-  \</trkseg> </trk> </gpx>"
+version="1.1"
-onepointEle =
+creator="OpenTracks"
-  "<gpx> <trk> <trkseg> \n\
+xmlns="http://www.topografix.com/GPX/1/1"
-  \<trkpt lat=\"51\" lon=\"-0.1\"> \n\
+xmlns:topografix="http://www.topografix.com/GPX/Private/TopoGrafix/0/1"
-  \ <ele>25.2</ele>\n\
+xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
-  \</trkpt> \n\
+xmlns:opentracks="http://opentracksapp.com/xmlschemas/v1"
-  \</trkseg> </trk> </gpx>"
+xmlns:gpxtpx="http://www.garmin.com/xmlschemas/TrackPointExtension/v2"
+xmlns:gpxtrkx="http://www.garmin.com/xmlschemas/TrackStatsExtension/v1"
+xmlns:cluetrust="http://www.cluetrust.com/Schemas/"
+xmlns:pwr="http://www.garmin.com/xmlschemas/PowerExtension/v1"
+xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd http://www.topografix.com/GPX/Private/TopoGrafix/0/1 http://www.topografix.com/GPX/Private/TopoGrafix/0/1/topografix.xsd http://www.garmin.com/xmlschemas/TrackPointExtension/v2 https://www8.garmin.com/xmlschemas/TrackPointExtensionv2.xsd http://www.garmin.com/xmlschemas/PowerExtension/v1 https://www8.garmin.com/xmlschemas/PowerExtensionv1.xsd http://www.garmin.com/xmlschemas/TrackStatsExtension/v1 http://www.cluetrust.com/Schemas http://www.cluetrust.com/Schemas/gpxdata10.xsd http://opentracksapp.com/xmlschemas/v1 http://opentracksapp.com/xmlschemas/OpenTracks_v1.xsd">
+|]
+wrap x = preamble ++ x ++ "</gpx>"
+
+
+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>
+   <time>2024-10-23T08:34:59.779+01:00</time>
+   <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 "<gpx></gpx>" of
+        case Track.parse (wrap "") of
           Left err -> assertFailure (displayException err)
           Right t -> assertEqual "empty track has no elements"
                      0 (Track.length t)
 
 testMalformed = TestCase $
-        case Track.parse "<gpx><dgdsfg>></gpx>" of
+        case Track.parse (wrap "<dgdsfg>>") of
           Left err -> assertBool "syntax error" True
-          Right t -> assertFailure "no error message parsing bad xml"
+          Right _ -> assertFailure "no error message parsing bad xml"
 
 test2 = TestCase $
         case Track.parse onepoint
@@ -36,22 +73,26 @@ test2 = TestCase $
             assertEqual "matches lat/lon"
              (Track.Pos 51.0 (-0.1))
              (Track.pos p)
+          Right [] -> assertFailure "no points"
 
 test3 = TestCase $
         case Track.parse onepoint
         of
           Left err -> assertFailure (displayException err)
           Right (p:ps) ->
-            assertEqual "matches elevation"
+            assertEqual "matches attributes"
-             Nothing (Track.elevation p)
+             (Nothing, Nothing) (Track.elevation p, Track.cadence p)
+          Right [] -> assertFailure "no points"
 
 test4 = TestCase $
-        case Track.parse onepointEle
+        case Track.parse onepointWithAttrs
         of
           Left err -> assertFailure (displayException err)
           Right (p:ps) ->
-            assertEqual "matches elevation"
+            assertEqual "matches attributes"
-             (Just 25.2) (Track.elevation p)
+             (Just 25.2, Just 128, Just 55, Data.Time.UTCTime (toEnum 60606) 27299.779)
+             (Track.elevation p, Track.cadence p, Track.power p, Track.time p)
+          Right [] -> assertFailure "no points"
 
 tests :: Test
 tests = TestList [