diff --git a/lib/Track.hs b/lib/Track.hs
index 1ad6ce2..b7964d7 100644
--- a/lib/Track.hs
+++ b/lib/Track.hs
@@ -36,6 +36,8 @@ data Point = Point {
-- TODO do we even need this type?
type Track = [Point]
+gpxNS = "http://www.topografix.com/GPX/1/1"
+
mkPoint pos =
Point
pos
@@ -52,7 +54,7 @@ elToPoint c =
let
lat = getAttr "lat"
lon = getAttr "lon"
- ele = child c >>= element "ele" >>= child >>= content
+ ele = child c >>= element (Name "ele" (Just gpxNS) Nothing) >>= child >>= content
in Point (Pos lat lon)
(case ele of
e:[] -> Just $ asFloat e
@@ -72,12 +74,13 @@ elToPoint c =
getPoints :: Cursor -> [Point]
getPoints c =
let
+ ns n = Name n (Just gpxNS) Nothing
trkpts =
- child c >>=
- element "trk" >>= descendant >>=
- element "trkpt"
+ element (ns "gpx") c >>= child >>=
+ element (ns "trk") >>= descendant >>=
+ element (ns "trkpt")
in
- List.map elToPoint trkpts
+ (List.map elToPoint trkpts)
parse :: String -> Either SomeException [Point]
parse str = do
diff --git a/souplesse.cabal b/souplesse.cabal
index a786fd3..0d24a64 100644
--- a/souplesse.cabal
+++ b/souplesse.cabal
@@ -101,5 +101,6 @@ test-suite tests
build-depends:
base >=4.7 && <5
, souplesse-lib
+ , raw-strings-qq
, HUnit
default-language: GHC2021
diff --git a/tests/UnitTest.hs b/tests/UnitTest.hs
index 2d123ed..b0e5a0d 100644
--- a/tests/UnitTest.hs
+++ b/tests/UnitTest.hs
@@ -1,30 +1,52 @@
+{-# LANGUAGE QuasiQuotes #-}
+
module Main where
import qualified Track
+
+import Text.RawString.QQ(r)
import Test.HUnit
import qualified System.Exit as Exit
import Control.Exception
import Debug.Trace (trace, traceShow)
-onepoint =
- " \n\
+preamble = [r|
+
+
+|]
+wrap x = preamble ++ x ++ ""
+
+
+onepoint = wrap $
+ " \n\
\ \n\
- \ "
-onepointEle =
- " \n\
+ \ "
+onepointWithAttrs = wrap $
+ " \n\
\ \n\
\ 25.2\n\
\ \n\
- \ "
+ \ "
test1 = TestCase $
- case Track.parse "" of
+ case Track.parse (wrap "") of
Left err -> assertFailure (displayException err)
Right t -> assertEqual "empty track has no elements"
0 (Track.length t)
testMalformed = TestCase $
- case Track.parse ">" of
+ case Track.parse (wrap ">") of
Left err -> assertBool "syntax error" True
Right _ -> assertFailure "no error message parsing bad xml"
@@ -48,7 +70,7 @@ test3 = TestCase $
Right [] -> assertFailure "no points"
test4 = TestCase $
- case Track.parse onepointEle
+ case Track.parse onepointWithAttrs
of
Left err -> assertFailure (displayException err)
Right (p:ps) ->