souplesse/lib/Track.hs

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