Daniel Barlow
e15c42ff4a
where by "handle" we mean that Track.parse now returns an Either instead of making up data points that lie on the equator
122 lines
3.1 KiB
Haskell
122 lines
3.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Track
|
|
( Track,
|
|
Pos (..),
|
|
pos,
|
|
elevation,
|
|
cadence,
|
|
power,
|
|
time,
|
|
parse,
|
|
Track.length,
|
|
)
|
|
where
|
|
|
|
import Control.Exception
|
|
import Data.List as List
|
|
import Data.List qualified
|
|
import Data.Map as Map
|
|
import Data.Maybe
|
|
import Data.Text qualified
|
|
import Data.Text.Lazy as T
|
|
import Data.Time
|
|
import Data.Time.ISO8601 qualified
|
|
import Debug.Trace (trace, traceShow)
|
|
import Text.XML
|
|
import Text.XML.Cursor as Cursor
|
|
|
|
data Pos = Pos Float Float deriving (Show, Eq)
|
|
|
|
type Power = Maybe Int
|
|
|
|
type Cadence = Maybe Int
|
|
|
|
type HeartRate = Maybe Int
|
|
|
|
data Point = Point
|
|
{ pos :: Pos,
|
|
elevation :: Maybe Float,
|
|
time :: UTCTime,
|
|
cadence :: Cadence,
|
|
power :: Power,
|
|
heartRate :: HeartRate
|
|
}
|
|
deriving (Show)
|
|
|
|
-- TODO do we even need this type?
|
|
type Track = [Point]
|
|
|
|
gpxNS localName =
|
|
Name localName (Just "http://www.topografix.com/GPX/1/1") Nothing
|
|
|
|
tpxNS localName =
|
|
Name localName (Just "http://www.garmin.com/xmlschemas/TrackPointExtension/v2") Nothing
|
|
|
|
|
|
data BadFile = BadFile deriving (Show)
|
|
|
|
instance Exception BadFile
|
|
|
|
elToPoint :: Cursor -> Either SomeException Point
|
|
elToPoint c =
|
|
case node c of
|
|
NodeElement (Element _ attrs _) ->
|
|
let lat = getAttr "lat"
|
|
lon = getAttr "lon"
|
|
ele = child c >>= element (gpxNS "ele") >>= child >>= content
|
|
ts = child c >>= element (gpxNS "time") >>= child >>= content
|
|
gpxtpx =
|
|
child c
|
|
>>= element (gpxNS "extensions")
|
|
>>= child
|
|
>>= element (tpxNS "TrackPointExtension")
|
|
>>= child
|
|
cadence =
|
|
gpxtpx
|
|
>>= element (tpxNS "cad")
|
|
>>= child
|
|
>>= content
|
|
power =
|
|
gpxtpx
|
|
>>= element (Name "PowerInWatts" (Just "http://www.garmin.com/xmlschemas/PowerExtension/v1") Nothing)
|
|
>>= child
|
|
>>= content
|
|
parsedTime =
|
|
listToMaybe ts
|
|
>>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
|
|
in case parsedTime of
|
|
Nothing -> Left (toException BadFile)
|
|
Just utime ->
|
|
Right $
|
|
Point
|
|
(Pos lat lon)
|
|
(listToMaybe ele >>= return . asFloat)
|
|
utime
|
|
(listToMaybe cadence >>= return . asInt)
|
|
(listToMaybe power >>= return . asInt)
|
|
Nothing
|
|
where
|
|
asFloat v = (read (Data.Text.unpack v) :: Float)
|
|
asInt v = (read (Data.Text.unpack v) :: Int)
|
|
getAttr name = maybe 0 asFloat (Map.lookup name attrs)
|
|
_ -> Left (toException BadFile)
|
|
|
|
getPoints :: Cursor -> Either SomeException [Point]
|
|
getPoints c =
|
|
let trkpts =
|
|
element (gpxNS "gpx") c
|
|
>>= child
|
|
>>= element (gpxNS "trk")
|
|
>>= descendant
|
|
>>= element (gpxNS "trkpt")
|
|
in traverse elToPoint trkpts
|
|
|
|
parse :: String -> Either SomeException [Point]
|
|
parse str = do
|
|
gpx <- parseText def (T.pack str)
|
|
getPoints (fromDocument gpx)
|
|
|
|
length :: Track -> Int
|
|
length = Data.List.length
|