separate migrations for Point and Session

This commit is contained in:
Daniel Barlow 2024-11-10 15:36:10 +00:00
parent d6719447bb
commit 200c1019c4
2 changed files with 17 additions and 9 deletions

View File

@ -159,6 +159,7 @@ connStr = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=sec
main :: IO () main :: IO ()
main = runStderrLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do main = runStderrLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do
runResourceT $ flip runSqlPool pool $ do runResourceT $ flip runSqlPool pool $ do
runMigration migrateAll runMigration migrateSession
runMigration migrateTrkpt
static' <- static "frontend" static' <- static "frontend"
warp 3000 $ Souplesse pool static' warp 3000 $ Souplesse pool static'

View File

@ -13,7 +13,9 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
module Store (save, fetch, sessions, sessionStartTime, sessionDuration, migrateAll) where module Store (save, fetch, sessions, sessionStartTime,
sessionDuration, migrateSession, migrateTrkpt
) where
import Control.Exception import Control.Exception
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
@ -43,7 +45,17 @@ connString :: ConnectionString
connString = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=secret" connString = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=secret"
share share
[mkPersist sqlSettings, mkMigrate "migrateAll"] [mkPersist sqlSettings, mkMigrate "migrateSession"]
[persistLowerCase|
Session
startTime UTCTime
duration PgInterval
draft Bool default=True
notes String Maybe
|]
share
[mkPersist sqlSettings, mkMigrate "migrateTrkpt"]
[persistLowerCase| [persistLowerCase|
Trkpt Trkpt
lat Double lat Double
@ -53,14 +65,9 @@ Trkpt
cadence Int Maybe cadence Int Maybe
power Int Maybe power Int Maybe
heartRate Int Maybe heartRate Int Maybe
Session
startTime UTCTime
duration PgInterval
draft Bool default=True
notes String Maybe
|] |]
fromPoint :: Point -> Trkpt fromPoint :: Point -> Trkpt
fromPoint p = fromPoint p =
let Pos lat lon ele = T.pos p let Pos lat lon ele = T.pos p