souplesse/tests/UnitTest.hs

{-# 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 =
  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