souplesse

commit 6c3eb694f0811c2c1b694f9fb08d55fc358811b7
parent b21eda22ada74849c6f39ddc4af410cfa8a15773
Author: Daniel Barlow <dan@telent.net>
Date:   Sun, 10 Nov 2024 13:11:13 +0000

add "session"

a session is a series of points which we assume (or the
rider confirms) comprise a complete and continuous ride

Diffstat:
M
app/Main.hs
 | 
5
+++++
M
lib/Store.hs
 | 
33
++++++++++++++++++++++++++++++++-
M
souplesse.cabal
 | 
1
+

3 files changed, 38 insertions(+), 1 deletion(-)
diff --git a/app/Main.hs b/app/Main.hs
@@ -56,11 +56,16 @@ instance YesodPersist Souplesse where
 getCalendarR :: Handler Html
 getCalendarR = do
   (formWidget, _) <- generateFormPost uploadForm
+  sessions' <- runDB Store.sessions
   defaultLayout
     [whamlet|
 <h1>Calendar
 
 <p>A calendar view goes here
+<ul>
+    $forall s <- sessions'
+        <li>#{show $ sessionStartTime s}  #{show $ sessionDuration s}
+
 
 <form action="/upload" method=post enctype="multipart/form-data">
     ^{formWidget}
diff --git a/lib/Store.hs b/lib/Store.hs
@@ -13,7 +13,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Store (save, fetch, migrateAll) where
+module Store (save, fetch, sessions, sessionStartTime, sessionDuration, migrateAll) where
 
 import Control.Exception
 import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -30,11 +30,14 @@ import Database.Persist.Postgresql
     pgPoolSize,
     runMigration,
     runSqlPool,
+    rawExecute,
+    PgInterval
   )
 import Database.Persist.TH
 import Text.Read (readMaybe)
 import Track (Point (..), Pos (..))
 import Track as T
+import Text.RawString.QQ (r)
 
 connString :: ConnectionString
 connString = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=secret"
@@ -50,6 +53,12 @@ Trkpt
     cadence Int Maybe
     power Int Maybe
     heartRate  Int Maybe
+
+Session
+    startTime UTCTime
+    duration PgInterval
+    draft Bool default=True
+    notes String Maybe
 |]
 
 fromPoint :: Point -> Trkpt
@@ -68,10 +77,31 @@ toPoint entity =
         (trkptPower tkp)
         (trkptHeartRate tkp)
 
+updateSessions = [r|
+-- delete existing drafts as new data may extend one of them
+delete from session where draft;
+-- find all potential start points in the new data
+insert into session(start_time, duration, draft) (select time as start_time, make_interval(0) as duration, true as draft from trkpt as p where not exists (select id from session where start_time <= p.time and (start_time + duration) > p.time) and not exists(select * from trkpt as p1 where time > p.time - '600 seconds'::interval and time < p.time));
+-- reset durations
+ update session s1
+ set duration =
+    coalesce(
+    (select max(time) from trkpt t1
+     where t1.time < coalesce((select min(start_time) from session s2 where s2.start_time > s1.start_time), now())) - s1.start_time
+     , make_interval())
+where draft;
+|]
+
 data OverlapExists = OverlapExists String deriving (Show)
 
 instance Exception OverlapExists
 
+sessions :: (MonadIO m) =>  ReaderT SqlBackend m [Session]
+sessions = do
+  s <- selectList [SessionDraft !=. True] [Desc SessionStartTime, LimitTo 10]
+  return $ map (\(Entity _ x) -> x) s
+
+
 save :: (MonadIO m) => Track -> ReaderT SqlBackend m (Either OverlapExists Track)
 save track = do
   let start = startTime track
@@ -81,6 +111,7 @@ save track = do
     then return $ Left (OverlapExists "track overlaps with existing data")
     else do
       mapM_ (insert . fromPoint) track
+      rawExecute updateSessions []
       return $ Right track
 
 fetch :: (MonadIO m) => UTCTime -> NominalDiffTime -> ReaderT SqlBackend m [Point]
diff --git a/souplesse.cabal b/souplesse.cabal
@@ -108,6 +108,7 @@ library souplesse-lib
       , time
       , containers
       , text
+      , raw-strings-qq
       , transformers
       , persistent
       , persistent-postgresql