dan/souplesse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ormolu again (no other changes)

Browse Source
This commit is contained in:
Daniel Barlow 2024-10-31 17:13:50 +00:00
parent 7860a189b3
commit c3c31e52b4
2 changed files with 42 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lib/Track.hs
View File

@ -25,9 +25,10 @@ import Data.Text.Lazy as T
import Data.Time
import Data.Time.ISO8601 qualified
import Debug.Trace (trace, traceShow)
import Text.Read (readMaybe)
import Text.XML
import Text.XML.Cursor as Cursor
import Text.Read (readMaybe)
data Pos = Pos Float Float (Maybe Float) deriving (Show, Eq)
type Power = Maybe Int
@ -62,8 +63,8 @@ elToPoint :: Cursor -> Either SomeException Point
elToPoint c =
case node c of
NodeElement (Element _ attrs _) ->
let lat = (listToMaybe $ attribute "lat" c ) >>= asFloat
lon = (listToMaybe $ attribute "lon" c ) >>= asFloat
let lat = (listToMaybe $ attribute "lat" c) >>= asFloat
lon = (listToMaybe $ attribute "lon" c) >>= asFloat
ele = listToMaybe $ child c >>= element (gpxNS "ele") >>= child >>= content
ts =
listToMaybe (child c >>= element (gpxNS "time") >>= child >>= content)

75
tests/UnitTest.hs
View File

@ -4,8 +4,8 @@ module Main where
import Control.Exception
import Data.Either
import Data.Time qualified
import Data.List as List
import Data.Time qualified
import Debug.Trace (trace, traceShow)
import System.Exit qualified as Exit
import Test.HUnit
@ -33,7 +33,7 @@ wrap x = preamble ++ x ++ "</gpx>"
wrapPoint x =
let trk = "<trk><trkseg>" ++ x ++ "</trkseg></trk>"
in wrap trk
in wrap trk
onepoint =
wrap
@ -84,56 +84,57 @@ testMalformed =
in assertBool "catches syntax error" (isLeft trk)
testMissingAttrs =
let els = [
[r|
let els =
[ [r|
<trkpt lon="2" latsdf="51">
<time>2024-10-23T08:34:59.779+01:00</time>
</trkpt>
|],
[r|
[r|
<trkpt lon="dsfgsdfg" lat="51">
<time>2024-10-23T08:34:59.779+01:00</time>
</trkpt>
|],
[r|
[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))
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)
]
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 $