Compare commits
9 Commits
5ec65cc49b
...
3192577d15
Author | SHA1 | Date | |
---|---|---|---|
3192577d15 | |||
a65c7fb8a9 | |||
d81099075a | |||
1007404a24 | |||
7cfe6b4892 | |||
6099753702 | |||
6447030949 | |||
1a1186fbff | |||
6b6c1d487e |
55
README.md
Normal file
55
README.md
Normal file
@ -0,0 +1,55 @@
|
||||
# Souplesse
|
||||
|
||||
_This readme describes what may someday be, not what is today_
|
||||
|
||||
Reads a GPX file which you generated by cycling around, and tells you
|
||||
interesting(sic) things about it.
|
||||
|
||||
The principle we aspire to is that the measurement is subsidary to the
|
||||
ride, not the purpose of the ride. The purpose of the ride is to enjoy
|
||||
cycling, or to see new places, or to get from A to B, and the purpose
|
||||
of Souplesse is to see if we can get any useful numbers out of the
|
||||
riding you were doing anyway without making you do more of it.
|
||||
|
||||
So, the general idea is that given some ride data it can tell you how
|
||||
long/how often you spent at a given level of effort (e.g. heart rate),
|
||||
or output (power, speed, cadence, rate of ascent).
|
||||
|
||||
## Canned views
|
||||
|
||||
### ride view
|
||||
|
||||
graph of (selected variables) / time, with buttons to select variables
|
||||
slider for threshold level
|
||||
all points above threshold are highlighted and interval times above
|
||||
threshold shown
|
||||
zoom in/out on time range
|
||||
show the selected points on a map
|
||||
|
||||
### calendar view
|
||||
|
||||
note this will need some kind of server-side storage so that the
|
||||
system remembers all your gpx files
|
||||
|
||||
shows dates that you rode
|
||||
for each ride, show time at effort
|
||||
some kind of slider for effort level
|
||||
|
||||
|
||||
## Query view
|
||||
|
||||
Not yet decided if this is useful, something that allows graphs of
|
||||
arbitrary functions of properties (e.g. to look at power/cadence
|
||||
ratio, or ... some other weirdness)
|
||||
|
||||
|
||||
----
|
||||
|
||||
_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?
|
||||
* need a real gpx file with namespace decls before we can parse power and stuff
|
71
lib/Track.hs
71
lib/Track.hs
@ -1,89 +1,88 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Track where
|
||||
module Track (
|
||||
Track,
|
||||
Pos(..),
|
||||
pos,
|
||||
elevation,
|
||||
parse,
|
||||
Track.length
|
||||
) where
|
||||
import Data.Time
|
||||
import qualified Data.List
|
||||
-- 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 Pos = Pos Float Float deriving (Show, Eq)
|
||||
type Power = Maybe Int
|
||||
type Cadence = Maybe Int
|
||||
type HeartRate = Maybe Int
|
||||
|
||||
data Point = Point {
|
||||
pos :: Pos,
|
||||
elevation :: Maybe Float,
|
||||
time :: UTCTime,
|
||||
power :: Power,
|
||||
cadence :: Cadence,
|
||||
heartRate :: HeartRate
|
||||
} deriving (Show)
|
||||
|
||||
-- TODO do we even need this type?
|
||||
type Track = [Point]
|
||||
|
||||
mkPoint pos =
|
||||
Point
|
||||
pos
|
||||
Nothing
|
||||
(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
|
||||
elToPoint c =
|
||||
case node c of
|
||||
NodeElement (Element _ attrs _) ->
|
||||
let
|
||||
lat = traceShow (getAttr "lat") (getAttr "lat")
|
||||
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)
|
||||
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]
|
||||
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
|
||||
parse :: String -> Either SomeException [Point]
|
||||
parse str = do
|
||||
gpx <- parseText def (T.pack str)
|
||||
return (getPoints (fromDocument gpx))
|
||||
|
||||
length :: Track -> Int
|
||||
length trk = Data.List.length trk
|
||||
|
@ -1,37 +1,65 @@
|
||||
module Main where
|
||||
|
||||
import qualified Track (Track, 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 $
|
||||
-- let
|
||||
-- trk = Track.parse "<gpx></gpx>"
|
||||
-- in
|
||||
-- assertEqual "empty track has no elements"
|
||||
-- 0 (Track.length trk)
|
||||
test1 = TestCase $
|
||||
case Track.parse "<gpx></gpx>" of
|
||||
Left err -> assertFailure (displayException err)
|
||||
Right t -> assertEqual "empty track has no elements"
|
||||
0 (Track.length t)
|
||||
|
||||
test3 = TestCase $ assertEqual "empty track has no elements" 1 2
|
||||
testMalformed = TestCase $
|
||||
case Track.parse "<gpx><dgdsfg>></gpx>" of
|
||||
Left err -> assertBool "syntax error" True
|
||||
Right t -> assertFailure "no error message parsing bad xml"
|
||||
|
||||
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 trk ->
|
||||
traceShow trk $
|
||||
assertEqual "one el" 1 (Track.length trk)
|
||||
Right (p:ps) ->
|
||||
assertEqual "matches lat/lon"
|
||||
(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
|
||||
test1,
|
||||
testMalformed,
|
||||
test2,
|
||||
test3,
|
||||
test4
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
|
Loading…
Reference in New Issue
Block a user