clear out [done] TODO items

that's right, this is no longer a hello world app

README.md

@@ -55,9 +55,8 @@ _Do not look below this line_
 
 ## WIP, Puzzles and TODO
 
-* [done] Pos can't include elevation if it's sometimes unknown
 * do we even need Track? will it ever be anything more than a collection
  of Points?
-* [done] need a real gpx file with namespace decls before we can parse power and stuff
+* can we lose this "if isJust lat && isJust lon && isJust ts" wart?
-* [done] tests seem to pass without <gpx> element?
+* probably we should store points in a more efficient form than
-* [done] stop returning bogus data when missing required elements (e.g. time)
+ a singly-linked list

app/Main.hs

@@ -1,4 +1,10 @@
 module Main where
 
+import Control.Exception
+import Track(parseFile)
+import Data.List as List
+
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+  points <- Track.parseFile "track.gpx"
+  putStrLn ("loaded " ++ (show (List.length points)))

lib/Track.hs

@@ -10,6 +10,7 @@ module Track
     heartRate,
     time,
     parse,
+    parseFile,
     Track.length,
   )
 where
@@ -20,14 +21,16 @@ import Data.List as List
 import Data.List qualified
 import Data.Map as Map
 import Data.Maybe
+import Data.Either
 import Data.Text qualified
 import Data.Text.Lazy as T
 import Data.Time
 import Data.Time.ISO8601 qualified
 import Debug.Trace (trace, traceShow)
+import Text.Read (readMaybe)
 import Text.XML
 import Text.XML.Cursor as Cursor
-import Text.Read (readMaybe)
+
 data Pos = Pos Float Float (Maybe Float) deriving (Show, Eq)
 
 type Power = Maybe Int
@@ -60,40 +63,37 @@ instance Exception BadFile
 
 elToPoint :: Cursor -> Either SomeException Point
 elToPoint c =
-  case node c of
+  let lat = listToMaybe (attribute "lat" c) >>= asFloat
-    NodeElement (Element _ attrs _) ->
+      lon = listToMaybe (attribute "lon" c) >>= asFloat
-      let lat = (listToMaybe $ attribute "lat" c ) >>= asFloat
+      ts =
-          lon = (listToMaybe $ attribute "lon" c ) >>= asFloat
+        listToMaybe (child c >>= element (gpxNS "time") >>= child >>= content)
-          ele = listToMaybe $ child c >>= element (gpxNS "ele") >>= child >>= content
+          >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
-          ts =
+      ele = listToMaybe (child c >>= element (gpxNS "ele") >>= child >>= content) >>= asFloat
-            listToMaybe (child c >>= element (gpxNS "time") >>= child >>= content)
+      gpxtpx =
-              >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
+        child c
-          gpxtpx =
+          >>= element (gpxNS "extensions")
-            child c
+          >>= child
-              >>= element (gpxNS "extensions")
+          >>= element (tpxNS "TrackPointExtension")
-              >>= child
+          >>= child
-              >>= element (tpxNS "TrackPointExtension")
+      extn n =
-              >>= child
+        gpxtpx >>= element n >>= child >>= content
-          extn n =
-            gpxtpx >>= element n >>= child >>= content
 
-          cadence = extn (tpxNS "cad")
+      cadence = extn (tpxNS "cad")
-          hr = extn (tpxNS "hr")
+      hr = extn (tpxNS "hr")
-          power = extn "{http://www.garmin.com/xmlschemas/PowerExtension/v1}PowerInWatts"
+      power = extn "{http://www.garmin.com/xmlschemas/PowerExtension/v1}PowerInWatts"
-       in if isJust lat && isJust lon && isJust ts
+   in if isJust lat && isJust lon && isJust ts
-            then
+        then
-              Right $
+          Right $
-                Point
+            Point
-                  (Pos (fromJust lat) (fromJust lon) (ele >>= asFloat))
+              (Pos (fromJust lat) (fromJust lon) ele)
-                  (fromJust ts)
+              (fromJust ts)
-                  (listToMaybe cadence >>= asInt)
+              (listToMaybe cadence >>= asInt)
-                  (listToMaybe power >>= asInt)
+              (listToMaybe power >>= asInt)
-                  (listToMaybe hr >>= asInt)
+              (listToMaybe hr >>= asInt)
-            else Left (toException (BadFile "missing a required attribute"))
+        else Left (toException (BadFile "missing a required attribute"))
-      where
+  where
-        asFloat v = return (Data.Text.unpack v) >>= (readMaybe :: String -> Maybe Float)
+    asFloat v = (readMaybe :: String -> Maybe Float) (Data.Text.unpack v)
-        asInt v = return (Data.Text.unpack v) >>= (readMaybe :: String -> Maybe Int)
+    asInt v = (readMaybe :: String -> Maybe Int) (Data.Text.unpack v)
-    _ -> Left (toException (BadFile "did not find trkpt"))
 
 getPoints :: Cursor -> Either SomeException [Point]
 getPoints c =
@@ -112,3 +112,10 @@ parse str = do
 
 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

souplesse.cabal

@@ -68,7 +68,9 @@ executable souplesse
     -- other-extensions:
 
     -- Other library packages from which modules are imported.
-    build-depends:    base ^>=4.18.2.1
+    build-depends:
+        base ^>=4.18.2.1
+      , souplesse-lib
 
     -- Directories containing source files.
     hs-source-dirs:   app

tests/UnitTest.hs

@@ -4,8 +4,8 @@ module Main where
 
 import Control.Exception
 import Data.Either
-import Data.Time qualified
 import Data.List as List
+import Data.Time qualified
 import Debug.Trace (trace, traceShow)
 import System.Exit qualified as Exit
 import Test.HUnit
@@ -33,7 +33,7 @@ wrap x = preamble ++ x ++ "</gpx>"
 
 wrapPoint x =
   let trk = "<trk><trkseg>" ++ x ++ "</trkseg></trk>"
-  in wrap trk
+   in wrap trk
 
 onepoint =
   wrap
@@ -84,56 +84,51 @@ testMalformed =
      in assertBool "catches syntax error" (isLeft trk)
 
 testMissingAttrs =
-  let els = [
+  let els =
-        [r|
+        [ [r|
 <trkpt lon="2" latsdf="51">
    <time>2024-10-23T08:34:59.779+01:00</time>
 </trkpt>
 |],
-        [r|
+          [r|
 <trkpt lon="dsfgsdfg" lat="51">
    <time>2024-10-23T08:34:59.779+01:00</time>
 </trkpt>
 |],
-        [r|
+          [r|
 <trkpt lon="2" lat="51">
    <time>2024-10-23G87sdCfdfgsdfhg</time>
 </trkpt>
 |]
         ]
-    in
+   in TestCase $
-    TestCase $
+        assertBool
-    assertBool
+          "failed to catch missing/malformed attribute"
-    "failed to catch missing/malformed attribute"
+          (List.all (isLeft . Track.parse . wrapPoint) els)
-    (List.all isLeft
-     (List.map (\ text -> Track.parse (wrapPoint text))
-       els))
-
 
 test2 =
-  TestList [
+  TestList
-  TestCase $
+    [ TestCase $
-    either
+        either
-      (assertFailure . displayException)
+          (assertFailure . displayException)
-      ( \(p : _) ->
+          ( \(p : _) ->
-          assertEqual
+              assertEqual
-            "matches lat/lon"
+                "matches lat/lon"
-            (Track.Pos 51.0 (-0.1) Nothing)
+                (Track.Pos 51.0 (-0.1) Nothing)
-            (Track.pos p)
+                (Track.pos p)
-      )
+          )
-      (Track.parse onepoint),
+          (Track.parse onepoint),
-  TestCase $
+      TestCase $
-    either
+        either
-      (assertFailure . displayException)
+          (assertFailure . displayException)
-      ( \(p : _) ->
+          ( \(p : _) ->
-          assertEqual
+              assertEqual
-            "matches lat/lon"
+                "matches lat/lon"
-            (Track.Pos 51.0 (-0.1) (Just 25.2))
+                (Track.Pos 51.0 (-0.1) (Just 25.2))
-            (Track.pos p)
+                (Track.pos p)
-      )
+          )
-      (Track.parse onepointWithAttrs)
+          (Track.parse onepointWithAttrs)
-  ]
+    ]
-
 
 test3 =
   TestCase $