make elevation part of Position

this reverses the change made in 64470309 when it hadn't occured to
me that the members of a tuple can have different types

lib/Track.hs

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

tests/UnitTest.hs

@@ -5,6 +5,7 @@ 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
@@ -30,6 +31,10 @@ 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|
@@ -51,6 +56,7 @@ 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>
@@ -77,17 +83,57 @@ 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))
+            (Track.Pos 51.0 (-0.1) Nothing)
             (Track.pos p)
       )
-      (Track.parse onepoint)
+      (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)
+  ]
+
 
 test3 =
   TestCase $
@@ -97,7 +143,7 @@ test3 =
           assertEqual
             "handles missing attributes"
             (Nothing, Nothing)
-            (Track.elevation p, Track.cadence p)
+            (Track.power p, Track.cadence p)
       )
       (Track.parse onepoint)
 
@@ -108,8 +154,8 @@ test4 =
       ( \(p : _) ->
           assertEqual
             "handles attributes"
-            (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)
+            (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)
       )
       (Track.parse onepointWithAttrs)
 
@@ -118,6 +164,7 @@ tests =
   TestList
     [ test1,
       testMalformed,
+      testMissingAttrs,
       test2,
       test3,
       test4