{-# LANGUAGE OverloadedStrings #-} module Track ( Track, Pos(..), pos, elevation, cadence, power, time, parse, Track.length ) where import Data.Time import qualified Data.Time.ISO8601 import qualified Data.List import Text.XML 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) 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