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
import Data.Functor((<&>))

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


data BadFile = BadFile deriving (Show)

instance Exception BadFile

elToPoint :: Cursor -> Either SomeException 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
          parsedTime =
            listToMaybe ts
              >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
       in case parsedTime of
            Nothing -> Left (toException BadFile)
            Just utime ->
              Right $
                Point
                  (Pos lat lon)
                  (listToMaybe ele <&> asFloat)
                  utime
                  (listToMaybe cadence <&> asInt)
                  (listToMaybe power <&> 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)
    _ -> Left (toException BadFile)

getPoints :: Cursor -> Either SomeException [Point]
getPoints c =
  let trkpts =
        element (gpxNS "gpx") c
          >>= child
          >>= element (gpxNS "trk")
          >>= descendant
          >>= element (gpxNS "trkpt")
   in traverse elToPoint trkpts

parse :: String -> Either SomeException [Point]
parse str = do
  gpx <- parseText def (T.pack str)
  getPoints (fromDocument gpx)

length :: Track -> Int
length = Data.List.length