{-# 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 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) ( (listToMaybe ele) >>= return . asFloat ) ( 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 ) ( (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) _ -> 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