{-# LANGUAGE QuasiQuotes #-} module Main where import Control.Exception import Data.Either import Data.List as List 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>" wrapPoint x = let trk = "<trk><trkseg>" ++ x ++ "</trkseg></trk>" in wrap trk 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> <gpxtpx:hr>160</gpxtpx:hr> <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) testMissingAttrs = let els = [ [r| <trkpt lon="2" latsdf="51"> <time>2024-10-23T08:34:59.779+01:00</time> </trkpt> |], [r| <trkpt lon="dsfgsdfg" lat="51"> <time>2024-10-23T08:34:59.779+01:00</time> </trkpt> |], [r| <trkpt lon="2" lat="51"> <time>2024-10-23G87sdCfdfgsdfhg</time> </trkpt> |] ] in TestCase $ assertBool "failed to catch missing/malformed attribute" (List.all (isLeft . Track.parse . wrapPoint) els) test2 = TestList [ TestCase $ either (assertFailure . displayException) ( \(p : _) -> assertEqual "matches lat/lon" (Track.Pos 51.0 (-0.1) Nothing) (Track.pos p) ) (Track.parse onepoint), TestCase $ either (assertFailure . displayException) ( \(p : _) -> assertEqual "matches lat/lon" (Track.Pos 51.0 (-0.1) (Just 25.2)) (Track.pos p) ) (Track.parse onepointWithAttrs) ] test3 = TestCase $ either (assertFailure . displayException) ( \(p : _) -> assertEqual "handles missing attributes" (Nothing, Nothing) (Track.power p, Track.cadence p) ) (Track.parse onepoint) test4 = TestCase $ either (assertFailure . displayException) ( \(p : _) -> assertEqual "handles attributes" (Just 128, Just 55, Data.Time.UTCTime (toEnum 60606) 27299.779, Just 160) (Track.cadence p, Track.power p, Track.time p, Track.heartRate p) ) (Track.parse onepointWithAttrs) tests :: Test tests = TestList [ test1, testMalformed, testMissingAttrs, test2, test3, test4 ] main :: IO () main = do result <- runTestTT tests if (failures result > 0) || (errors result > 0) then Exit.exitFailure else Exit.exitSuccess