add "session"

a session is a series of points which we assume (or the
rider confirms) comprise a complete and continuous ride
This commit is contained in:
Daniel Barlow 2024-11-10 13:11:13 +00:00
parent b21eda22ad
commit 6c3eb694f0
3 changed files with 38 additions and 1 deletions

View File

@ -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}

View File

@ -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]

View File

@ -108,6 +108,7 @@ library souplesse-lib
, time
, containers
, text
, raw-strings-qq
, transformers
, persistent
, persistent-postgresql