94 lines
3.2 KiB
Haskell
94 lines
3.2 KiB
Haskell
{-# 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)
|
|
|
|
preamble = [r|
|
|
<?xml version="1.0" encoding="UTF-8"?>
|
|
<gpx
|
|
version="1.1"
|
|
creator="OpenTracks"
|
|
xmlns="http://www.topografix.com/GPX/1/1"
|
|
xmlns:topografix="http://www.topografix.com/GPX/Private/TopoGrafix/0/1"
|
|
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
|
|
xmlns:opentracks="http://opentracksapp.com/xmlschemas/v1"
|
|
xmlns:gpxtpx="http://www.garmin.com/xmlschemas/TrackPointExtension/v2"
|
|
xmlns:gpxtrkx="http://www.garmin.com/xmlschemas/TrackStatsExtension/v1"
|
|
xmlns:cluetrust="http://www.cluetrust.com/Schemas/"
|
|
xmlns:pwr="http://www.garmin.com/xmlschemas/PowerExtension/v1"
|
|
xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd http://www.topografix.com/GPX/Private/TopoGrafix/0/1 http://www.topografix.com/GPX/Private/TopoGrafix/0/1/topografix.xsd http://www.garmin.com/xmlschemas/TrackPointExtension/v2 https://www8.garmin.com/xmlschemas/TrackPointExtensionv2.xsd http://www.garmin.com/xmlschemas/PowerExtension/v1 https://www8.garmin.com/xmlschemas/PowerExtensionv1.xsd http://www.garmin.com/xmlschemas/TrackStatsExtension/v1 http://www.cluetrust.com/Schemas http://www.cluetrust.com/Schemas/gpxdata10.xsd http://opentracksapp.com/xmlschemas/v1 http://opentracksapp.com/xmlschemas/OpenTracks_v1.xsd">
|
|
|]
|
|
wrap x = preamble ++ x ++ "</gpx>"
|
|
|
|
|
|
onepoint = wrap $
|
|
"<trk> <trkseg> \n\
|
|
\<trkpt lat=\"51\" lon=\"-0.1\"> </trkpt> \n\
|
|
\</trkseg> </trk>"
|
|
onepointWithAttrs = wrap $
|
|
"<trk> <trkseg> \n\
|
|
\<trkpt lat=\"51\" lon=\"-0.1\"> \n\
|
|
\ <ele>25.2</ele>\n\
|
|
\</trkpt> \n\
|
|
\</trkseg> </trk>"
|
|
|
|
test1 = TestCase $
|
|
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 (wrap "<dgdsfg>>") of
|
|
Left err -> assertBool "syntax error" True
|
|
Right _ -> assertFailure "no error message parsing bad xml"
|
|
|
|
test2 = TestCase $
|
|
case Track.parse onepoint
|
|
of
|
|
Left err -> assertFailure (displayException err)
|
|
Right (p:ps) ->
|
|
assertEqual "matches lat/lon"
|
|
(Track.Pos 51.0 (-0.1))
|
|
(Track.pos p)
|
|
Right [] -> assertFailure "no points"
|
|
|
|
test3 = TestCase $
|
|
case Track.parse onepoint
|
|
of
|
|
Left err -> assertFailure (displayException err)
|
|
Right (p:ps) ->
|
|
assertEqual "matches elevation"
|
|
Nothing (Track.elevation p)
|
|
Right [] -> assertFailure "no points"
|
|
|
|
test4 = TestCase $
|
|
case Track.parse onepointWithAttrs
|
|
of
|
|
Left err -> assertFailure (displayException err)
|
|
Right (p:ps) ->
|
|
assertEqual "matches elevation"
|
|
(Just 25.2) (Track.elevation p)
|
|
Right [] -> assertFailure "no points"
|
|
|
|
tests :: Test
|
|
tests = TestList [
|
|
test1,
|
|
testMalformed,
|
|
test2,
|
|
test3,
|
|
test4
|
|
]
|
|
|
|
main :: IO ()
|
|
main = do
|
|
result <- runTestTT tests
|
|
if failures result > 0 then Exit.exitFailure else Exit.exitSuccess
|