Daniel Barlow
31ba15f5a9
I claim that it's ok because if the match is non-exhaustive then the test will fail anyway
110 lines
3.6 KiB
Haskell
110 lines
3.6 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)
|
|
import qualified Data.Time
|
|
import Data.Either
|
|
|
|
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 [r|
|
|
<trk> <trkseg>
|
|
<trkpt lat="51" lon="-0.1"> </trkpt>
|
|
</trkseg> </trk>
|
|
|]
|
|
|
|
onepointWithAttrs = wrap [r|
|
|
<trk>
|
|
<trkseg>
|
|
<trkpt lat="51" lon="-0.1">
|
|
<ele>25.2</ele>
|
|
<time>2024-10-23T08:34:59.779+01:00</time>
|
|
<extensions><gpxtpx:TrackPointExtension>
|
|
<gpxtpx:speed>2.4</gpxtpx:speed>
|
|
<gpxtpx:cad>128</gpxtpx:cad>
|
|
<pwr:PowerInWatts>55</pwr:PowerInWatts>
|
|
<opentracks:accuracy_horizontal>3.216</opentracks:accuracy_horizontal><opentracks:distance>10.675</opentracks:distance>
|
|
<cluetrust:distance>32.025</cluetrust:distance>
|
|
</gpxtpx:TrackPointExtension>
|
|
</extensions>
|
|
</trkpt>
|
|
</trkseg>
|
|
</trk>
|
|
|]
|
|
|
|
test1 = TestCase $
|
|
either
|
|
(assertFailure . displayException)
|
|
(\ t -> assertEqual "empty track has no elements"
|
|
0 (Track.length t))
|
|
(Track.parse (wrap ""))
|
|
|
|
testMalformed = TestCase $
|
|
let trk = Track.parse (wrap "<dgdsfg>>")
|
|
in assertBool "catches syntax error" (isLeft trk)
|
|
|
|
test2 = TestCase $
|
|
either
|
|
(assertFailure . displayException)
|
|
(\ (p:_) ->
|
|
assertEqual "matches lat/lon"
|
|
(Track.Pos 51.0 (-0.1))
|
|
(Track.pos p))
|
|
(Track.parse onepoint)
|
|
|
|
test3 = TestCase $
|
|
either
|
|
(assertFailure . displayException)
|
|
(\ (p:_) ->
|
|
assertEqual "handles missing attributes"
|
|
(Nothing, Nothing) (Track.elevation p, Track.cadence p))
|
|
(Track.parse onepoint)
|
|
|
|
test4 = TestCase $
|
|
either
|
|
(assertFailure . displayException)
|
|
(\ (p:_) ->
|
|
assertEqual "handles attributes"
|
|
(Just 25.2, Just 128, Just 55, Data.Time.UTCTime (toEnum 60606) 27299.779)
|
|
(Track.elevation p, Track.cadence p, Track.power p, Track.time p))
|
|
(Track.parse onepointWithAttrs)
|
|
|
|
tests :: Test
|
|
tests = TestList [
|
|
test1,
|
|
testMalformed,
|
|
test2,
|
|
test3,
|
|
test4
|
|
]
|
|
|
|
main :: IO ()
|
|
main = do
|
|
result <- runTestTT tests
|
|
if (failures result > 0) || (errors result > 0)
|
|
then Exit.exitFailure
|
|
else Exit.exitSuccess
|