From 5b827ed6ed11bde4cfe561b212d9cc93b9106e8d Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Thu, 31 Oct 2024 16:18:40 +0000
Subject: [PATCH] handle missing lat/lon/time data

---
 lib/Track.hs      | 46 ++++++++++++++++++++++------------------------
 tests/UnitTest.hs | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+), 24 deletions(-)

diff --git a/lib/Track.hs b/lib/Track.hs
index 7452fda..869be9b 100644
--- a/lib/Track.hs
+++ b/lib/Track.hs
@@ -3,6 +3,7 @@
 module Track
   ( Track,
     Pos (..),
+    BadFile,
     pos,
     elevation,
     cadence,
@@ -15,6 +16,7 @@ module Track
 where
 
 import Control.Exception
+import Data.Functor ((<&>))
 import Data.List as List
 import Data.List qualified
 import Data.Map as Map
@@ -26,8 +28,7 @@ import Data.Time.ISO8601 qualified
 import Debug.Trace (trace, traceShow)
 import Text.XML
 import Text.XML.Cursor as Cursor
-import Data.Functor((<&>))
-
+import Text.Read (readMaybe)
 data Pos = Pos Float Float deriving (Show, Eq)
 
 type Power = Maybe Int
@@ -55,8 +56,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
 
@@ -64,10 +64,12 @@ 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")
@@ -80,25 +82,21 @@ elToPoint c =
           cadence = extn (tpxNS "cad")
           hr = extn (tpxNS "hr")
           power = extn "{http://www.garmin.com/xmlschemas/PowerExtension/v1}PowerInWatts"
-          parsedTime =
-            listToMaybe ts
-              >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
-       in case parsedTime of
-            Nothing -> Left (toException BadFile)
-            Just utime ->
+       in if isJust lat && isJust lon && isJust ts
+            then
               Right $
                 Point
-                  (Pos lat lon)
-                  (listToMaybe ele <&> asFloat)
-                  utime
-                  (listToMaybe cadence <&> asInt)
-                  (listToMaybe power <&> asInt)
-                  (listToMaybe hr <&> asInt)
+                  (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 =
diff --git a/tests/UnitTest.hs b/tests/UnitTest.hs
index b614689..7a9c292 100644
--- a/tests/UnitTest.hs
+++ b/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|
@@ -78,6 +83,33 @@ 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 =
   TestCase $
     either
@@ -119,6 +151,7 @@ tests =
   TestList
     [ test1,
       testMalformed,
+      testMissingAttrs,
       test2,
       test3,
       test4