souplesse

UnitTest.hs (4766B)

---

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