souplesse/lib/Track.hs

{-# 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