{-# LANGUAGE QuasiQuotes #-} module Main where import Control.Exception import Data.Either import Data.Time qualified import Data.List as List 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 (List.map (\ text -> Track.parse (wrapPoint text)) els)) 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, Just 160) (Track.elevation p, 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