diff --git a/lib/Track.hs b/lib/Track.hs
index 1480818..3c61c4b 100644
--- a/lib/Track.hs
+++ b/lib/Track.hs
@@ -1,17 +1,89 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module Track where
import Data.Time
import qualified Data.List
-data Pos = Pos Float Float
+-- import qualified Text.XML as X
+import Text.XML
+import Text.XML.Cursor as Cursor
+import qualified Data.Text
+-- import qualified Data.Text.Lazy
+import Data.Text.Lazy as T
+import Debug.Trace (trace, traceShow)
+import Data.List as List
+import Data.Map as Map
+import Control.Exception
+
+data Pos = Pos Float Float Float deriving (Show)
-data Point = Point Pos UTCTime
+type Power = Maybe Int
+type Cadence = Maybe Int
+type HeartRate = Maybe Int
+
+data Point = Point {
+ pos :: Pos,
+ time :: UTCTime,
+ power :: Power,
+ cadence :: Cadence,
+ heartRate :: HeartRate
+} deriving (Show)
type Track = [Point]
-parse :: String -> Track
-parse str = [
- -- Point (Pos 516 0) (UTCTime (toEnum 60631) 43200)
+mkPoint pos =
+ Point
+ pos
+ (UTCTime (toEnum 60631) 43200)
+ (Just 0)
+ (Just 0)
+ (Just 0)
+
+parse :: String -> Either SomeException [Point]
+parse' str = [
+ Point
+ (Pos 51.6 0 0)
+ (UTCTime (toEnum 60631) 43200)
+ (Just 0)
+ (Just 0)
+ (Just 0)
]
+elToPoint :: Cursor -> Point
+elToPoint n =
+ trace "el" $
+ case traceShow (node n) (node n) of
+ NodeElement (Element _ attrs _) ->
+ let
+ lat = traceShow (getAttr "lat") (getAttr "lat")
+ lon = getAttr "lon"
+ in mkPoint (Pos lat lon 0)
+ where getAttr name =
+ case (Map.lookup name attrs) of
+ Just v -> (read (Data.Text.unpack v) :: Float)
+ _ -> 0
+ _ -> mkPoint (Pos 1 2 3)
+
+getPoints :: Cursor -> [Point]
+getPoints c =
+ let
+ trkpts =
+ child c >>=
+ -- element "gpx" >>= child >>=
+ element "trk" >>= descendant >>=
+ element "trkpt"
+ in
+ List.map elToPoint trkpts
+
+
+parse str =
+ case parseText def (T.pack str) of
+ Right gpx ->
+ let
+ points = getPoints $ fromDocument gpx
+ in traceShow "(gpx)" (Right points)
+ Left err ->
+ Left err
+
length :: Track -> Int
length trk = Data.List.length trk
diff --git a/souplesse.cabal b/souplesse.cabal
index 61db521..a786fd3 100644
--- a/souplesse.cabal
+++ b/souplesse.cabal
@@ -86,8 +86,11 @@ library souplesse-lib
lib
build-depends:
base >=4.7 && <5
- , HaXml
+ , xml-conduit
, time
+ , containers
+ , text
+ -- , text-iso8601
default-language: GHC2021
test-suite tests
diff --git a/tests/UnitTest.hs b/tests/UnitTest.hs
index 8033537..6c0cd4c 100644
--- a/tests/UnitTest.hs
+++ b/tests/UnitTest.hs
@@ -3,18 +3,36 @@ module Main where
import qualified Track (Track, parse, length )
import Test.HUnit
import qualified System.Exit as Exit
+import Control.Exception
+import Debug.Trace (trace, traceShow)
-test1 :: Test
-test1 = TestCase $
- let
- trk = Track.parse ""
- in
- assertEqual "empty track has no elements"
- 0 (Track.length trk)
+-- test1 :: Test
+-- test1 = TestCase $
+-- let
+-- trk = Track.parse ""
+-- in
+-- assertEqual "empty track has no elements"
+-- 0 (Track.length trk)
+
+test3 = TestCase $ assertEqual "empty track has no elements" 1 2
+
+test2 = TestCase $
+ case Track.parse
+ " \n\
+ \ \n\
+ \ "
+ of
+ Left err -> assertFailure (displayException err)
+ Right trk ->
+ traceShow trk $
+ assertEqual "one el" 1 (Track.length trk)
tests :: Test
-tests = TestList [TestLabel "test1" test1]
+tests = TestList [
+-- TestLabel "test1" test1,
+ TestLabel "test2" test2
+ ]
main :: IO ()
main = do