souplesse/lib/Track.hs

{-# LANGUAGE OverloadedStrings #-}

module Track
  ( Track,
    module Point,
    BadFile,
    parse,
    parseFile,
    parseBS,
    Track.length,
  )
where

import Control.Exception
import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as L
import Data.Either
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 Point
import Text.Read (readMaybe)
import Text.XML
import Text.XML.Cursor as Cursor

-- 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 =
  let lat = listToMaybe (attribute "lat" c) >>= asDouble
      lon = listToMaybe (attribute "lon" c) >>= asDouble
      ts =
        listToMaybe (child c >>= element (gpxNS "time") >>= child >>= content)
          >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
      ele = listToMaybe (child c >>= element (gpxNS "ele") >>= child >>= content) >>= asDouble
      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)
              (fromJust ts)
              (listToMaybe cadence >>= asInt)
              (listToMaybe power >>= asInt)
              (listToMaybe hr >>= asInt)
        else Left (toException (BadFile "missing a required attribute"))
  where
    asDouble v = (readMaybe :: String -> Maybe Double) (Data.Text.unpack v)
    asInt v = (readMaybe :: String -> Maybe Int) (Data.Text.unpack v)

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

-- parseFile :: FilePath -> IO [Point]
parseFile name = do
  gpx <- Text.XML.readFile def name
  return $ case getPoints (fromDocument gpx) of
    Left err -> []
    Right points -> points

parseBS bs = do
  gpx <- parseLBS def bs
  getPoints (fromDocument gpx)