142 lines
3.7 KiB
Haskell
142 lines
3.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
module Track
|
|
( Track,
|
|
Pos (..),
|
|
BadFile,
|
|
Point (..),
|
|
parse,
|
|
parseFile,
|
|
parseBS,
|
|
Track.length,
|
|
)
|
|
where
|
|
|
|
import Control.Exception
|
|
import Data.Aeson
|
|
import Data.ByteString.Lazy.Char8 qualified as L
|
|
import Data.Either
|
|
import Data.Functor ((<&>))
|
|
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.Read (readMaybe)
|
|
import Text.XML
|
|
import Text.XML.Cursor as Cursor
|
|
|
|
data Pos = Pos Double Double (Maybe Double) deriving (Show, Eq)
|
|
|
|
type Power = Maybe Int
|
|
|
|
type Cadence = Maybe Int
|
|
|
|
type HeartRate = Maybe Int
|
|
|
|
data Point = Point
|
|
{ pos :: Pos,
|
|
time :: UTCTime,
|
|
cadence :: Cadence,
|
|
power :: Power,
|
|
heartRate :: HeartRate
|
|
}
|
|
deriving (Show)
|
|
|
|
instance ToJSON Pos where
|
|
toJSON (Pos lat lon ele) =
|
|
case ele of
|
|
Just e -> object ["lat" .= lat, "lon" .= lon, "ele" .= e]
|
|
Nothing -> object ["lat" .= lat, "lon" .= lon, "ele" .= Null]
|
|
|
|
instance ToJSON Point where
|
|
toJSON Point {..} =
|
|
object
|
|
[ "pos" .= pos,
|
|
"time" .= time,
|
|
"cadence" .= cadence,
|
|
"power" .= power,
|
|
"heartRate" .= heartRate
|
|
]
|
|
|
|
-- 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 String deriving (Show)
|
|
|
|
instance Exception BadFile
|
|
|
|
elToPoint :: Cursor -> Either SomeException Point
|
|
elToPoint c =
|
|
let lat = listToMaybe (attribute "lat" c) >>= asDouble
|
|
lon = listToMaybe (attribute "lon" c) >>= asDouble
|
|
ts =
|
|
listToMaybe (child c >>= element (gpxNS "time") >>= child >>= content)
|
|
>>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
|
|
ele = listToMaybe (child c >>= element (gpxNS "ele") >>= child >>= content) >>= asDouble
|
|
gpxtpx =
|
|
child c
|
|
>>= element (gpxNS "extensions")
|
|
>>= child
|
|
>>= element (tpxNS "TrackPointExtension")
|
|
>>= child
|
|
extn n =
|
|
gpxtpx >>= element n >>= child >>= content
|
|
|
|
cadence = extn (tpxNS "cad")
|
|
hr = extn (tpxNS "hr")
|
|
power = extn "{http://www.garmin.com/xmlschemas/PowerExtension/v1}PowerInWatts"
|
|
in if isJust lat && isJust lon && isJust ts
|
|
then
|
|
Right $
|
|
Point
|
|
(Pos (fromJust lat) (fromJust lon) ele)
|
|
(fromJust ts)
|
|
(listToMaybe cadence >>= asInt)
|
|
(listToMaybe power >>= asInt)
|
|
(listToMaybe hr >>= asInt)
|
|
else Left (toException (BadFile "missing a required attribute"))
|
|
where
|
|
asDouble v = (readMaybe :: String -> Maybe Double) (Data.Text.unpack v)
|
|
asInt v = (readMaybe :: String -> Maybe Int) (Data.Text.unpack v)
|
|
|
|
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
|
|
|
|
-- parseFile :: FilePath -> IO [Point]
|
|
parseFile name = do
|
|
gpx <- Text.XML.readFile def name
|
|
return $ case getPoints (fromDocument gpx) of
|
|
Left err -> []
|
|
Right points -> points
|
|
|
|
parseBS bs = do
|
|
gpx <- parseLBS def bs
|
|
getPoints (fromDocument gpx)
|