From d81099075ac5e374f87fe4bd4ec5b3b1845bf115 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Tue, 29 Oct 2024 21:44:49 +0000
Subject: [PATCH] check we handle malformed gpx input

for some very obvious xml parse error
---
 lib/Track.hs      | 14 +++-----------
 tests/UnitTest.hs |  7 +++++++
 2 files changed, 10 insertions(+), 11 deletions(-)

diff --git a/lib/Track.hs b/lib/Track.hs
index cfc1531..1ad6ce2 100644
--- a/lib/Track.hs
+++ b/lib/Track.hs
@@ -79,18 +79,10 @@ getPoints c =
   in
     List.map elToPoint trkpts
 
-
--- TODO am sure we could use some amazing monad thing to reduce
--- the amount of pattern matching here
 parse :: String -> Either SomeException [Point]
-parse str =
-  case parseText def (T.pack str) of
-    Right gpx ->
-      let
-        points = getPoints $ fromDocument gpx
-      in Right points
-    Left err ->
-      Left err
+parse str = do
+  gpx <- parseText def (T.pack str)
+  return (getPoints (fromDocument gpx))
 
 length :: Track -> Int
 length trk = Data.List.length trk
diff --git a/tests/UnitTest.hs b/tests/UnitTest.hs
index 8cefaee..18e6cd3 100644
--- a/tests/UnitTest.hs
+++ b/tests/UnitTest.hs
@@ -24,6 +24,12 @@ test1 = TestCase $
           Right t -> assertEqual "empty track has no elements"
                      0 (Track.length t)
 
+testMalformed :: Test
+testMalformed = TestCase $
+        case Track.parse "<gpx><dgdsfg>></gpx>" of
+          Left err -> assertBool "syntax error" True
+          Right t -> assertFailure "no error message parsing bad xml"
+
 test2 = TestCase $
         case Track.parse onepoint
         of
@@ -52,6 +58,7 @@ test4 = TestCase $
 tests :: Test
 tests = TestList [
   TestLabel "test1" test1,
+  testMalformed,
   TestLabel "test2" test2,
   TestLabel "test3" test3,
   TestLabel "test4" test4