dan/souplesse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add Session.refreshDrafts

Browse Source 
hides some gnarly raw sql inside the module
This commit is contained in:
Daniel Barlow 2024-11-11 18:43:16 +00:00
parent e58b250024
commit 1bb2fe9218
2 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lib/Session.hs
View File

@ -16,7 +16,7 @@
module Session module Session
( Session (..), ( Session (..),
recents, recents,
updateSessions, refreshDrafts,
migrateSession, migrateSession,
) )
where where
@ -31,6 +31,7 @@ import Database.Persist
import Database.Persist.Postgresql import Database.Persist.Postgresql
( PgInterval, ( PgInterval,
SqlBackend, SqlBackend,
rawExecute
) )
import Database.Persist.TH import Database.Persist.TH
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
@ -45,8 +46,8 @@ Session
notes String Maybe notes String Maybe
|] |]
updateSessions :: Text updateSql :: Text
updateSessions = updateSql =
[r| [r|
-- delete existing drafts as new data may extend one of them -- delete existing drafts as new data may extend one of them
delete from session where draft; delete from session where draft;
@ -62,6 +63,10 @@ insert into session(start_time, duration, draft) (select time as start_time, mak
where draft; where draft;
|] |]
refreshDrafts :: (MonadIO m) => ReaderT SqlBackend m ()
refreshDrafts =
rawExecute updateSql []
recents :: (MonadIO m) => ReaderT SqlBackend m [Session] recents :: (MonadIO m) => ReaderT SqlBackend m [Session]
recents = do recents = do
s <- selectList [SessionDraft !=. True] [Desc SessionStartTime, LimitTo 10] s <- selectList [SessionDraft !=. True] [Desc SessionStartTime, LimitTo 10]

2
lib/Store.hs
View File

@ -89,7 +89,7 @@ save track = do
then return $ Left (OverlapExists "track overlaps with existing data") then return $ Left (OverlapExists "track overlaps with existing data")
else do else do
mapM_ (insert . fromPoint) track mapM_ (insert . fromPoint) track
rawExecute Session.updateSessions [] Session.refreshDrafts
return $ Right track return $ Right track
fetch :: (MonadIO m) => UTCTime -> NominalDiffTime -> ReaderT SqlBackend m [Point] fetch :: (MonadIO m) => UTCTime -> NominalDiffTime -> ReaderT SqlBackend m [Point]