souplesse/tests/UnitTest.hs

{-# LANGUAGE QuasiQuotes #-}

module Main where

import qualified Track

import Text.RawString.QQ(r)
import Test.HUnit
import qualified System.Exit as Exit
import Control.Exception
import Debug.Trace (trace, traceShow)

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
  "<trk> <trkseg> \n\
  \<trkpt lat=\"51\" lon=\"-0.1\"> </trkpt> \n\
  \</trkseg> </trk>"
onepointWithAttrs = wrap
  "<trk> <trkseg> \n\
  \<trkpt lat=\"51\" lon=\"-0.1\"> \n\
  \ <ele>25.2</ele>\n\
  \</trkpt> \n\
  \</trkseg> </trk>"

test1 = TestCase $
        case Track.parse (wrap "") of
          Left err -> assertFailure (displayException err)
          Right t -> assertEqual "empty track has no elements"
                     0 (Track.length t)

testMalformed = TestCase $
        case Track.parse (wrap "<dgdsfg>>") of
          Left err -> assertBool "syntax error" True
          Right _ -> assertFailure "no error message parsing bad xml"

test2 = TestCase $
        case Track.parse onepoint
        of
          Left err -> assertFailure (displayException err)
          Right (p:ps) ->
            assertEqual "matches lat/lon"
             (Track.Pos 51.0 (-0.1))
             (Track.pos p)
          Right [] -> assertFailure "no points"

test3 = TestCase $
        case Track.parse onepoint
        of
          Left err -> assertFailure (displayException err)
          Right (p:ps) ->
            assertEqual "matches elevation"
             Nothing (Track.elevation p)
          Right [] -> assertFailure "no points"

test4 = TestCase $
        case Track.parse onepointWithAttrs
        of
          Left err -> assertFailure (displayException err)
          Right (p:ps) ->
            assertEqual "matches elevation"
             (Just 25.2) (Track.elevation p)
          Right [] -> assertFailure "no points"

tests :: Test
tests = TestList [
  test1,
  testMalformed,
  test2,
  test3,
  test4
  ]

main :: IO ()
main = do
    result <- runTestTT tests
    if failures result > 0 then Exit.exitFailure else Exit.exitSuccess