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