souplesse/lib/Track.hs

{-# LANGUAGE OverloadedStrings #-}

module Track
  ( Track,
    Pos (..),
    BadFile,
    pos,
    cadence,
    power,
    heartRate,
    time,
    parse,
    Track.length,
  )
where

import Control.Exception
import Data.Functor ((<&>))
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 Text.Read (readMaybe)
data Pos = Pos Float Float (Maybe Float) deriving (Show, Eq)

type Power = Maybe Int

type Cadence = Maybe Int

type HeartRate = Maybe Int

data Point = Point
  { pos :: Pos,
    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 String deriving (Show)

instance Exception BadFile

elToPoint :: Cursor -> Either SomeException Point
elToPoint c =
  case node c of
    NodeElement (Element _ attrs _) ->
      let lat = (listToMaybe $ attribute "lat" c ) >>= asFloat
          lon = (listToMaybe $ attribute "lon" c ) >>= asFloat
          ele = listToMaybe $ child c >>= element (gpxNS "ele") >>= child >>= content
          ts =
            listToMaybe (child c >>= element (gpxNS "time") >>= child >>= content)
              >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
          gpxtpx =
            child c
              >>= element (gpxNS "extensions")
              >>= child
              >>= element (tpxNS "TrackPointExtension")
              >>= child
          extn n =
            gpxtpx >>= element n >>= child >>= content

          cadence = extn (tpxNS "cad")
          hr = extn (tpxNS "hr")
          power = extn "{http://www.garmin.com/xmlschemas/PowerExtension/v1}PowerInWatts"
       in if isJust lat && isJust lon && isJust ts
            then
              Right $
                Point
                  (Pos (fromJust lat) (fromJust lon) (ele >>= asFloat))
                  (fromJust ts)
                  (listToMaybe cadence >>= asInt)
                  (listToMaybe power >>= asInt)
                  (listToMaybe hr >>= asInt)
            else Left (toException (BadFile "missing a required attribute"))
      where
        asFloat v = return (Data.Text.unpack v) >>= (readMaybe :: String -> Maybe Float)
        asInt v = return (Data.Text.unpack v) >>= (readMaybe :: String -> Maybe Int)
    _ -> Left (toException (BadFile "did not find trkpt"))

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