beginning of xml parsing

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
+mkPoint pos =
-parse str = [
+  Point
-  -- Point (Pos 516 0) (UTCTime (toEnum  60631) 43200)
+    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

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

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 :: Test
-test1 = TestCase $
+-- test1 = TestCase $
-        let
+--         let
-          trk = Track.parse "<gpx></gpx>"
+--           trk = Track.parse "<gpx></gpx>"
-        in
+--         in
-          assertEqual "empty track has no elements"
+--           assertEqual "empty track has no elements"
-          0 (Track.length trk)
+--           0 (Track.length trk)
+
+test3 = TestCase $  assertEqual "empty track has no elements" 1 2
+
+test2 = TestCase $
+        case Track.parse
+            "<gpx> <trk> <trkseg> \n\
+            \<trkpt lat=\"51\" lon=\"-0.1\"> </trkpt> \n\
+            \</trkseg> </trk> </gpx>"
+        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