souplesse

commit 1007404a249843e9093766176ea1c4a92f4af222
parent 7cfe6b48921cdf075b5a1e37ad20a1fb8ed05296
Author: Daniel Barlow <dan@telent.net>
Date:   Tue, 29 Oct 2024 21:22:49 +0000

parse gpx elevation

Diffstat:
M
lib/Track.hs
 | 
26
++++++++++++++++++--------
M
tests/UnitTest.hs
 | 
37
+++++++++++++++++++++++++++++++------

2 files changed, 49 insertions(+), 14 deletions(-)
diff --git a/lib/Track.hs b/lib/Track.hs
@@ -39,24 +39,34 @@ type Track = [Point]
 mkPoint pos =
   Point
     pos
-    (Just 0)
+    Nothing
     (UTCTime (toEnum  60631) 43200)
     (Just 0)
     (Just 0)
     (Just 0)
 
 elToPoint :: Cursor -> Point
-elToPoint n =
-  case node n of
+elToPoint c =
+  case node c of
     NodeElement (Element _ attrs _) ->
       let
         lat = getAttr "lat"
         lon = getAttr "lon"
-      in mkPoint (Pos lat lon)
-      where getAttr name =
-              case (Map.lookup name attrs) of
-                Just v -> (read (Data.Text.unpack v) :: Float)
-                _ -> 0
+        ele = child c >>= element "ele" >>= child >>= content
+      in Point (Pos lat lon)
+         (case ele of
+             e:[] -> Just $ asFloat e
+             _ -> Nothing)
+         (UTCTime (toEnum  60631) 43200)
+         (Just 0)
+         (Just 0)
+         (Just 0)
+      where
+        asFloat v = (read (Data.Text.unpack v) :: Float)
+        getAttr name =
+          case (Map.lookup name attrs) of
+            Just v -> asFloat v
+            _ -> 0
     _ -> mkPoint (Pos 0 0)
 
 getPoints :: Cursor -> [Point]
diff --git a/tests/UnitTest.hs b/tests/UnitTest.hs
@@ -1,11 +1,21 @@
 module Main where
 
-import qualified Track (Track, Pos(..), pos, parse, length )
+import qualified Track
 import Test.HUnit
 import qualified System.Exit as Exit
 import Control.Exception
 import Debug.Trace (trace, traceShow)
 
+onepoint =
+  "<gpx> <trk> <trkseg> \n\
+  \<trkpt lat=\"51\" lon=\"-0.1\"> </trkpt> \n\
+  \</trkseg> </trk> </gpx>"
+onepointEle =
+  "<gpx> <trk> <trkseg> \n\
+  \<trkpt lat=\"51\" lon=\"-0.1\"> \n\
+  \ <ele>25.2</ele>\n\
+  \</trkpt> \n\
+  \</trkseg> </trk> </gpx>"
 
 test1 :: Test
 test1 = TestCase $
@@ -15,10 +25,7 @@ test1 = TestCase $
                      0 (Track.length t)
 
 test2 = TestCase $
-        case Track.parse
-            "<gpx> <trk> <trkseg> \n\
-            \<trkpt lat=\"51\" lon=\"-0.1\"> </trkpt> \n\
-            \</trkseg> </trk> </gpx>"
+        case Track.parse onepoint
         of
           Left err -> assertFailure (displayException err)
           Right (p:ps) ->
@@ -26,10 +33,28 @@ test2 = TestCase $
              (Track.Pos 51.0 (-0.1))
              (Track.pos p)
 
+test3 = TestCase $
+        case Track.parse onepoint
+        of
+          Left err -> assertFailure (displayException err)
+          Right (p:ps) ->
+            assertEqual "matches elevation"
+             Nothing (Track.elevation p)
+
+test4 = TestCase $
+        case Track.parse onepointEle
+        of
+          Left err -> assertFailure (displayException err)
+          Right (p:ps) ->
+            assertEqual "matches elevation"
+             (Just 25.2) (Track.elevation p)
+
 tests :: Test
 tests = TestList [
   TestLabel "test1" test1,
-  TestLabel "test2" test2
+  TestLabel "test2" test2,
+  TestLabel "test3" test3,
+  TestLabel "test4" test4
   ]
 
 main :: IO ()