souplesse/lib/Track.hs

{-# LANGUAGE OverloadedStrings #-}

module Track (
  Track,
  Pos(..),
  pos,
  elevation,
  parse,
  Track.length
             ) where
import Data.Time
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,
  power :: Power,
  cadence :: Cadence,
  heartRate :: HeartRate
} deriving (Show)

-- TODO do we even need this type?
type Track = [Point]

gpxNS = "http://www.topografix.com/GPX/1/1"

mkPoint pos =
  Point
    pos
    Nothing
    (UTCTime (toEnum  60631) 43200)
    (Just 0)
    (Just 0)
    (Just 0)

elToPoint :: Cursor -> Point
elToPoint c =
  case node c of
    NodeElement (Element _ attrs _) ->
      let
        lat = getAttr "lat"
        lon = getAttr "lon"
        ele = child c >>= element (Name "ele" (Just gpxNS) Nothing) >>= child >>= content
      in Point (Pos lat lon)
         (case ele of
             [e] -> Just $ asFloat e
             _ -> Nothing)
         (UTCTime (toEnum  60631) 43200)
         (Just 0)
         (Just 0)
         (Just 0)
      where
        asFloat v = (read (Data.Text.unpack v) :: Float)
        getAttr name =
          case Map.lookup name attrs of
            Just v -> asFloat v
            _ -> 0
    _ -> mkPoint (Pos 0 0)

getPoints :: Cursor -> [Point]
getPoints c =
  let
    ns n = Name n (Just gpxNS) Nothing
    trkpts =
      element (ns "gpx") c >>= child >>=
      element (ns "trk") >>= descendant >>=
      element (ns "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