souplesse

commit d81099075ac5e374f87fe4bd4ec5b3b1845bf115
parent 1007404a249843e9093766176ea1c4a92f4af222
Author: Daniel Barlow <dan@telent.net>
Date:   Tue, 29 Oct 2024 21:44:49 +0000

check we handle malformed gpx input

for some very obvious xml parse error

Diffstat:
M
lib/Track.hs
 | 
14
+++-----------
M
tests/UnitTest.hs
 | 
7
+++++++

2 files changed, 10 insertions(+), 11 deletions(-)
diff --git 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
@@ -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