135 lines
3.2 KiB
Haskell
135 lines
3.2 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.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
|
|
|
|
mkPoint pos =
|
|
Point
|
|
pos
|
|
Nothing
|
|
(UTCTime (toEnum 60631) 43200)
|
|
Nothing
|
|
Nothing
|
|
Nothing
|
|
|
|
elToPoint :: Cursor -> 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
|
|
in Point
|
|
(Pos lat lon)
|
|
( case ele of
|
|
[e] -> Just $ asFloat e
|
|
_ -> Nothing
|
|
)
|
|
( case ts of
|
|
[e] -> case Data.Time.ISO8601.parseISO8601 (Data.Text.unpack e) of
|
|
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
|
|
asFloat v = (read (Data.Text.unpack v) :: Float)
|
|
asInt v = (read (Data.Text.unpack v) :: Int)
|
|
getAttr name =
|
|
case Map.lookup name attrs of
|
|
Just v -> asFloat v
|
|
_ -> 0
|
|
_ -> mkPoint (Pos 0 0)
|
|
|
|
getPoints :: Cursor -> [Point]
|
|
getPoints c =
|
|
let trkpts =
|
|
element (gpxNS "gpx") c
|
|
>>= child
|
|
>>= element (gpxNS "trk")
|
|
>>= descendant
|
|
>>= element (gpxNS "trkpt")
|
|
in List.map elToPoint trkpts
|
|
|
|
parse :: String -> Either SomeException [Point]
|
|
parse str = do
|
|
gpx <- parseText def (T.pack str)
|
|
return (getPoints (fromDocument gpx))
|
|
|
|
length :: Track -> Int
|
|
length = Data.List.length
|