lib/Track.hs

@@ -3,11 +3,10 @@
 module Track
   ( Track,
     Pos (..),
-    BadFile,
     pos,
+    elevation,
     cadence,
     power,
-    heartRate,
     time,
     parse,
     Track.length,
@@ -15,7 +14,6 @@ module Track
 where
 
 import Control.Exception
-import Data.Functor ((<&>))
 import Data.List as List
 import Data.List qualified
 import Data.Map as Map
@@ -27,8 +25,9 @@ import Data.Time.ISO8601 qualified
 import Debug.Trace (trace, traceShow)
 import Text.XML
 import Text.XML.Cursor as Cursor
-import Text.Read (readMaybe)
-data Pos = Pos Float Float (Maybe Float) deriving (Show, Eq)
+import Data.Functor((<&>))
+
+data Pos = Pos Float Float deriving (Show, Eq)
 
 type Power = Maybe Int
 
@@ -38,6 +37,7 @@ type HeartRate = Maybe Int
 
 data Point = Point
   { pos :: Pos,
+    elevation :: Maybe Float,
     time :: UTCTime,
     cadence :: Cadence,
     power :: Power,
@@ -54,7 +54,8 @@ gpxNS localName =
 tpxNS localName =
   Name localName (Just "http://www.garmin.com/xmlschemas/TrackPointExtension/v2") Nothing
 
-data BadFile = BadFile String deriving (Show)
+
+data BadFile = BadFile deriving (Show)
 
 instance Exception BadFile
 
@@ -62,38 +63,45 @@ elToPoint :: Cursor -> Either SomeException Point
 elToPoint c =
   case node c of
     NodeElement (Element _ attrs _) ->
-      let lat = (listToMaybe $ attribute "lat" c ) >>= asFloat
-          lon = (listToMaybe $ attribute "lon" c ) >>= asFloat
-          ele = listToMaybe $ child c >>= element (gpxNS "ele") >>= child >>= content
-          ts =
-            listToMaybe (child c >>= element (gpxNS "time") >>= child >>= content)
-              >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
+      let lat = getAttr "lat"
+          lon = getAttr "lon"
+          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
-          extn n =
-            gpxtpx >>= element n >>= child >>= content
-
-          cadence = extn (tpxNS "cad")
-          hr = extn (tpxNS "hr")
-          power = extn "{http://www.garmin.com/xmlschemas/PowerExtension/v1}PowerInWatts"
-       in if isJust lat && isJust lon && isJust ts
-            then
+          cadence =
+            gpxtpx
+              >>= element (tpxNS "cad")
+              >>= child
+              >>= content
+          power =
+            gpxtpx
+              >>= element (Name "PowerInWatts" (Just "http://www.garmin.com/xmlschemas/PowerExtension/v1") Nothing)
+              >>= child
+              >>= content
+          parsedTime =
+            listToMaybe ts
+              >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
+       in case parsedTime of
+            Nothing -> Left (toException BadFile)
+            Just utime ->
               Right $
                 Point
-                  (Pos (fromJust lat) (fromJust lon) (ele >>= asFloat))
-                  (fromJust ts)
-                  (listToMaybe cadence >>= asInt)
-                  (listToMaybe power >>= asInt)
-                  (listToMaybe hr >>= asInt)
-            else Left (toException (BadFile "missing a required attribute"))
+                  (Pos lat lon)
+                  (listToMaybe ele <&> asFloat)
+                  utime
+                  (listToMaybe cadence <&> asInt)
+                  (listToMaybe power <&> asInt)
+                  Nothing
       where
-        asFloat v = return (Data.Text.unpack v) >>= (readMaybe :: String -> Maybe Float)
-        asInt v = return (Data.Text.unpack v) >>= (readMaybe :: String -> Maybe Int)
-    _ -> Left (toException (BadFile "did not find trkpt"))
+        asFloat v = (read (Data.Text.unpack v) :: Float)
+        asInt v = (read (Data.Text.unpack v) :: Int)
+        getAttr name = maybe 0 asFloat (Map.lookup name attrs)
+    _ -> Left (toException BadFile)
 
 getPoints :: Cursor -> Either SomeException [Point]
 getPoints c =

tests/UnitTest.hs

@@ -5,7 +5,6 @@ module Main where
 import Control.Exception
 import Data.Either
 import Data.Time qualified
-import Data.List as List
 import Debug.Trace (trace, traceShow)
 import System.Exit qualified as Exit
 import Test.HUnit
@@ -31,10 +30,6 @@ xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/
 
 wrap x = preamble ++ x ++ "</gpx>"
 
-wrapPoint x =
-  let trk = "<trk><trkseg>" ++ x ++ "</trkseg></trk>"
-  in wrap trk
-
 onepoint =
   wrap
     [r|
@@ -56,7 +51,6 @@ onepointWithAttrs =
    <extensions><gpxtpx:TrackPointExtension>
     <gpxtpx:speed>2.4</gpxtpx:speed>
     <gpxtpx:cad>128</gpxtpx:cad>
-    <gpxtpx:hr>160</gpxtpx:hr>
     <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>
@@ -83,57 +77,17 @@ testMalformed =
     let trk = Track.parse (wrap "<dgdsfg>>")
      in assertBool "catches syntax error" (isLeft trk)
 
-testMissingAttrs =
-  let els = [
-        [r|
-<trkpt lon="2" latsdf="51">
-   <time>2024-10-23T08:34:59.779+01:00</time>
-</trkpt>
-|],
-        [r|
-<trkpt lon="dsfgsdfg" lat="51">
-   <time>2024-10-23T08:34:59.779+01:00</time>
-</trkpt>
-|],
-        [r|
-<trkpt lon="2" lat="51">
-   <time>2024-10-23G87sdCfdfgsdfhg</time>
-</trkpt>
-|]
-        ]
-    in
-    TestCase $
-    assertBool
-    "failed to catch missing/malformed attribute"
-    (List.all isLeft
-     (List.map (\ text -> Track.parse (wrapPoint text))
-       els))
-
-
 test2 =
-  TestList [
   TestCase $
     either
       (assertFailure . displayException)
       ( \(p : _) ->
           assertEqual
             "matches lat/lon"
-            (Track.Pos 51.0 (-0.1) Nothing)
+            (Track.Pos 51.0 (-0.1))
             (Track.pos p)
       )
-      (Track.parse onepoint),
-  TestCase $
-    either
-      (assertFailure . displayException)
-      ( \(p : _) ->
-          assertEqual
-            "matches lat/lon"
-            (Track.Pos 51.0 (-0.1) (Just 25.2))
-            (Track.pos p)
-      )
-      (Track.parse onepointWithAttrs)
-  ]
-
+      (Track.parse onepoint)
 
 test3 =
   TestCase $
@@ -143,7 +97,7 @@ test3 =
           assertEqual
             "handles missing attributes"
             (Nothing, Nothing)
-            (Track.power p, Track.cadence p)
+            (Track.elevation p, Track.cadence p)
       )
       (Track.parse onepoint)
 
@@ -154,8 +108,8 @@ test4 =
       ( \(p : _) ->
           assertEqual
             "handles attributes"
-            (Just 128, Just 55, Data.Time.UTCTime (toEnum 60606) 27299.779, Just 160)
-            (Track.cadence p, Track.power p, Track.time p, Track.heartRate 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)
       )
       (Track.parse onepointWithAttrs)
 
@@ -164,7 +118,6 @@ tests =
   TestList
     [ test1,
       testMalformed,
-      testMissingAttrs,
       test2,
       test3,
       test4