reindent using ormolu
This commit is contained in:
parent
31ba15f5a9
commit
aa1f69f3d4
@ -7,6 +7,7 @@ let
|
|||||||
[
|
[
|
||||||
cabal-install
|
cabal-install
|
||||||
hlint
|
hlint
|
||||||
|
ormolu
|
||||||
]);
|
]);
|
||||||
};
|
};
|
||||||
in haskellEnv.overrideAttrs(o: {
|
in haskellEnv.overrideAttrs(o: {
|
||||||
|
147
lib/Track.hs
147
lib/Track.hs
@ -1,41 +1,47 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Track (
|
module Track
|
||||||
Track,
|
( Track,
|
||||||
Pos(..),
|
Pos (..),
|
||||||
pos,
|
pos,
|
||||||
elevation,
|
elevation,
|
||||||
cadence,
|
cadence,
|
||||||
power,
|
power,
|
||||||
time,
|
time,
|
||||||
parse,
|
parse,
|
||||||
Track.length
|
Track.length,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Exception
|
||||||
|
import Data.List as List
|
||||||
|
import Data.List qualified
|
||||||
|
import Data.Map as Map
|
||||||
|
import Data.Text qualified
|
||||||
|
import Data.Text.Lazy as T
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import qualified Data.Time.ISO8601
|
import Data.Time.ISO8601 qualified
|
||||||
import qualified Data.List
|
import Debug.Trace (trace, traceShow)
|
||||||
import Text.XML
|
import Text.XML
|
||||||
import Text.XML.Cursor as Cursor
|
import Text.XML.Cursor as Cursor
|
||||||
import qualified Data.Text
|
|
||||||
import Data.Text.Lazy as T
|
|
||||||
import Debug.Trace (trace, traceShow)
|
|
||||||
import Data.List as List
|
|
||||||
import Data.Map as Map
|
|
||||||
import Control.Exception
|
|
||||||
|
|
||||||
data Pos = Pos Float Float deriving (Show, Eq)
|
data Pos = Pos Float Float deriving (Show, Eq)
|
||||||
|
|
||||||
type Power = Maybe Int
|
type Power = Maybe Int
|
||||||
|
|
||||||
type Cadence = Maybe Int
|
type Cadence = Maybe Int
|
||||||
|
|
||||||
type HeartRate = Maybe Int
|
type HeartRate = Maybe Int
|
||||||
|
|
||||||
data Point = Point {
|
data Point = Point
|
||||||
pos :: Pos,
|
{ pos :: Pos,
|
||||||
elevation :: Maybe Float,
|
elevation :: Maybe Float,
|
||||||
time :: UTCTime,
|
time :: UTCTime,
|
||||||
cadence :: Cadence,
|
cadence :: Cadence,
|
||||||
power :: Power,
|
power :: Power,
|
||||||
heartRate :: HeartRate
|
heartRate :: HeartRate
|
||||||
} deriving (Show)
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
-- TODO do we even need this type?
|
-- TODO do we even need this type?
|
||||||
type Track = [Point]
|
type Track = [Point]
|
||||||
@ -50,7 +56,7 @@ mkPoint pos =
|
|||||||
Point
|
Point
|
||||||
pos
|
pos
|
||||||
Nothing
|
Nothing
|
||||||
(UTCTime (toEnum 60631) 43200)
|
(UTCTime (toEnum 60631) 43200)
|
||||||
Nothing
|
Nothing
|
||||||
Nothing
|
Nothing
|
||||||
Nothing
|
Nothing
|
||||||
@ -59,36 +65,47 @@ elToPoint :: Cursor -> Point
|
|||||||
elToPoint c =
|
elToPoint c =
|
||||||
case node c of
|
case node c of
|
||||||
NodeElement (Element _ attrs _) ->
|
NodeElement (Element _ attrs _) ->
|
||||||
let
|
let lat = getAttr "lat"
|
||||||
lat = getAttr "lat"
|
lon = getAttr "lon"
|
||||||
lon = getAttr "lon"
|
ele = child c >>= element (gpxNS "ele") >>= child >>= content
|
||||||
ele = child c >>= element (gpxNS "ele") >>= child >>= content
|
ts = child c >>= element (gpxNS "time") >>= child >>= content
|
||||||
ts = child c >>= element (gpxNS "time") >>= child >>= content
|
gpxtpx =
|
||||||
gpxtpx = child c >>=
|
child c
|
||||||
element (gpxNS "extensions")
|
>>= element (gpxNS "extensions")
|
||||||
>>= child
|
>>= child
|
||||||
>>= element (tpxNS "TrackPointExtension") >>= child
|
>>= element (tpxNS "TrackPointExtension")
|
||||||
cadence = gpxtpx >>= element (tpxNS "cad")
|
>>= child
|
||||||
>>= child >>= content
|
cadence =
|
||||||
power = gpxtpx >>= element (Name "PowerInWatts" (Just "http://www.garmin.com/xmlschemas/PowerExtension/v1") Nothing)
|
gpxtpx
|
||||||
>>= child >>= content
|
>>= element (tpxNS "cad")
|
||||||
in Point (Pos lat lon)
|
>>= child
|
||||||
(case ele of
|
>>= content
|
||||||
[e] -> Just $ asFloat e
|
power =
|
||||||
_ -> Nothing)
|
gpxtpx
|
||||||
(case ts of
|
>>= element (Name "PowerInWatts" (Just "http://www.garmin.com/xmlschemas/PowerExtension/v1") Nothing)
|
||||||
[e] -> case Data.Time.ISO8601.parseISO8601 (Data.Text.unpack e) of
|
>>= child
|
||||||
Just utime -> utime
|
>>= content
|
||||||
_ -> UTCTime (toEnum 0) 0
|
in Point
|
||||||
_ -> UTCTime (toEnum 0) 0)
|
(Pos lat lon)
|
||||||
(case cadence of
|
( case ele of
|
||||||
[e] -> Just (asInt e)
|
[e] -> Just $ asFloat e
|
||||||
_ -> Nothing)
|
_ -> Nothing
|
||||||
(case power of
|
)
|
||||||
[e] -> Just (asInt e)
|
( case ts of
|
||||||
_ -> Nothing)
|
[e] -> case Data.Time.ISO8601.parseISO8601 (Data.Text.unpack e) of
|
||||||
Nothing
|
Just utime -> utime
|
||||||
|
_ -> UTCTime (toEnum 0) 0
|
||||||
|
_ -> UTCTime (toEnum 0) 0
|
||||||
|
)
|
||||||
|
( case cadence of
|
||||||
|
[e] -> Just (asInt e)
|
||||||
|
_ -> Nothing
|
||||||
|
)
|
||||||
|
( case power of
|
||||||
|
[e] -> Just (asInt e)
|
||||||
|
_ -> Nothing
|
||||||
|
)
|
||||||
|
Nothing
|
||||||
where
|
where
|
||||||
asFloat v = (read (Data.Text.unpack v) :: Float)
|
asFloat v = (read (Data.Text.unpack v) :: Float)
|
||||||
asInt v = (read (Data.Text.unpack v) :: Int)
|
asInt v = (read (Data.Text.unpack v) :: Int)
|
||||||
@ -100,13 +117,13 @@ elToPoint c =
|
|||||||
|
|
||||||
getPoints :: Cursor -> [Point]
|
getPoints :: Cursor -> [Point]
|
||||||
getPoints c =
|
getPoints c =
|
||||||
let
|
let trkpts =
|
||||||
trkpts =
|
element (gpxNS "gpx") c
|
||||||
element (gpxNS "gpx") c >>= child >>=
|
>>= child
|
||||||
element (gpxNS "trk") >>= descendant >>=
|
>>= element (gpxNS "trk")
|
||||||
element (gpxNS "trkpt")
|
>>= descendant
|
||||||
in
|
>>= element (gpxNS "trkpt")
|
||||||
List.map elToPoint trkpts
|
in List.map elToPoint trkpts
|
||||||
|
|
||||||
parse :: String -> Either SomeException [Point]
|
parse :: String -> Either SomeException [Point]
|
||||||
parse str = do
|
parse str = do
|
||||||
|
@ -2,17 +2,17 @@
|
|||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import qualified Track
|
|
||||||
|
|
||||||
import Text.RawString.QQ(r)
|
|
||||||
import Test.HUnit
|
|
||||||
import qualified System.Exit as Exit
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Debug.Trace (trace, traceShow)
|
|
||||||
import qualified Data.Time
|
|
||||||
import Data.Either
|
import Data.Either
|
||||||
|
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|
|
preamble =
|
||||||
|
[r|
|
||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<gpx
|
<gpx
|
||||||
version="1.1"
|
version="1.1"
|
||||||
@ -27,16 +27,20 @@ xmlns:cluetrust="http://www.cluetrust.com/Schemas/"
|
|||||||
xmlns:pwr="http://www.garmin.com/xmlschemas/PowerExtension/v1"
|
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">
|
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>"
|
wrap x = preamble ++ x ++ "</gpx>"
|
||||||
|
|
||||||
|
onepoint =
|
||||||
onepoint = wrap [r|
|
wrap
|
||||||
|
[r|
|
||||||
<trk> <trkseg>
|
<trk> <trkseg>
|
||||||
<trkpt lat="51" lon="-0.1"> </trkpt>
|
<trkpt lat="51" lon="-0.1"> </trkpt>
|
||||||
</trkseg> </trk>
|
</trkseg> </trk>
|
||||||
|]
|
|]
|
||||||
|
|
||||||
onepointWithAttrs = wrap [r|
|
onepointWithAttrs =
|
||||||
|
wrap
|
||||||
|
[r|
|
||||||
<trk>
|
<trk>
|
||||||
<trkseg>
|
<trkseg>
|
||||||
<trkpt lat="51" lon="-0.1">
|
<trkpt lat="51" lon="-0.1">
|
||||||
@ -55,55 +59,72 @@ onepointWithAttrs = wrap [r|
|
|||||||
</trk>
|
</trk>
|
||||||
|]
|
|]
|
||||||
|
|
||||||
test1 = TestCase $
|
test1 =
|
||||||
either
|
TestCase $
|
||||||
(assertFailure . displayException)
|
either
|
||||||
(\ t -> assertEqual "empty track has no elements"
|
(assertFailure . displayException)
|
||||||
0 (Track.length t))
|
( \t ->
|
||||||
(Track.parse (wrap ""))
|
assertEqual
|
||||||
|
"empty track has no elements"
|
||||||
|
0
|
||||||
|
(Track.length t)
|
||||||
|
)
|
||||||
|
(Track.parse (wrap ""))
|
||||||
|
|
||||||
testMalformed = TestCase $
|
testMalformed =
|
||||||
let trk = Track.parse (wrap "<dgdsfg>>")
|
TestCase $
|
||||||
in assertBool "catches syntax error" (isLeft trk)
|
let trk = Track.parse (wrap "<dgdsfg>>")
|
||||||
|
in assertBool "catches syntax error" (isLeft trk)
|
||||||
|
|
||||||
test2 = TestCase $
|
test2 =
|
||||||
either
|
TestCase $
|
||||||
(assertFailure . displayException)
|
either
|
||||||
(\ (p:_) ->
|
(assertFailure . displayException)
|
||||||
assertEqual "matches lat/lon"
|
( \(p : _) ->
|
||||||
(Track.Pos 51.0 (-0.1))
|
assertEqual
|
||||||
(Track.pos p))
|
"matches lat/lon"
|
||||||
(Track.parse onepoint)
|
(Track.Pos 51.0 (-0.1))
|
||||||
|
(Track.pos p)
|
||||||
|
)
|
||||||
|
(Track.parse onepoint)
|
||||||
|
|
||||||
test3 = TestCase $
|
test3 =
|
||||||
either
|
TestCase $
|
||||||
(assertFailure . displayException)
|
either
|
||||||
(\ (p:_) ->
|
(assertFailure . displayException)
|
||||||
assertEqual "handles missing attributes"
|
( \(p : _) ->
|
||||||
(Nothing, Nothing) (Track.elevation p, Track.cadence p))
|
assertEqual
|
||||||
(Track.parse onepoint)
|
"handles missing attributes"
|
||||||
|
(Nothing, Nothing)
|
||||||
|
(Track.elevation p, Track.cadence p)
|
||||||
|
)
|
||||||
|
(Track.parse onepoint)
|
||||||
|
|
||||||
test4 = TestCase $
|
test4 =
|
||||||
either
|
TestCase $
|
||||||
(assertFailure . displayException)
|
either
|
||||||
(\ (p:_) ->
|
(assertFailure . displayException)
|
||||||
assertEqual "handles attributes"
|
( \(p : _) ->
|
||||||
(Just 25.2, Just 128, Just 55, Data.Time.UTCTime (toEnum 60606) 27299.779)
|
assertEqual
|
||||||
(Track.elevation p, Track.cadence p, Track.power p, Track.time p))
|
"handles attributes"
|
||||||
(Track.parse onepointWithAttrs)
|
(Just 25.2, Just 128, Just 55, Data.Time.UTCTime (toEnum 60606) 27299.779)
|
||||||
|
(Track.elevation p, Track.cadence p, Track.power p, Track.time p)
|
||||||
|
)
|
||||||
|
(Track.parse onepointWithAttrs)
|
||||||
|
|
||||||
tests :: Test
|
tests :: Test
|
||||||
tests = TestList [
|
tests =
|
||||||
test1,
|
TestList
|
||||||
testMalformed,
|
[ test1,
|
||||||
test2,
|
testMalformed,
|
||||||
test3,
|
test2,
|
||||||
test4
|
test3,
|
||||||
]
|
test4
|
||||||
|
]
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
result <- runTestTT tests
|
result <- runTestTT tests
|
||||||
if (failures result > 0) || (errors result > 0)
|
if (failures result > 0) || (errors result > 0)
|
||||||
then Exit.exitFailure
|
then Exit.exitFailure
|
||||||
else Exit.exitSuccess
|
else Exit.exitSuccess
|
||||||
|
Loading…
Reference in New Issue
Block a user