Daniel Barlow
e15c42ff4a
where by "handle" we mean that Track.parse now returns an Either instead of making up data points that lie on the equator
132 lines
3.7 KiB
Haskell
132 lines
3.7 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
module Main where
|
|
|
|
import Control.Exception
|
|
import Data.Either
|
|
import Data.Time qualified
|
|
import Debug.Trace (trace, traceShow)
|
|
import System.Exit qualified as Exit
|
|
import Test.HUnit
|
|
import Text.RawString.QQ (r)
|
|
import Track qualified
|
|
|
|
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">
|
|
<time>2024-10-23T08:34:59.779+01:00</time>
|
|
</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)
|
|
( assertEqual
|
|
"empty track has no elements"
|
|
0
|
|
. Track.length
|
|
)
|
|
(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
|