add postgres

This commit is contained in:
Daniel Barlow 2024-11-04 23:37:48 +00:00
parent 0e7406f7aa
commit 2fae769bb9
5 changed files with 80 additions and 3 deletions

View File

@ -73,3 +73,7 @@ _Do not look below this line_
* frontend can get data from backend
* for DX, backend can serve the js files needed by frontend
* we only have yesod-core, may need other parts as well
```
docker run -p 5432:5432 --name souplesse-postgres -e POSTGRES_USER=souplesse -e POSTGRES_PASSWORD=secret -d postgres
nix-shell -p postgresql --run "psql -h localhost -U souplesse -p 5432"
```

View File

@ -6,9 +6,12 @@
module Main where
import Control.Monad.Logger (runStderrLoggingT)
import Data.ByteString.Lazy as BS
import Data.List as List
import Database.Persist.Postgresql (ConnectionString, runMigration, runSqlPersistMPool, withPostgresqlPool)
import Debug.Trace (traceShow)
import Store (migrateAll, save)
import Track (parseBS, parseFile)
import Yesod.Core
import Yesod.Form.Fields
@ -111,9 +114,16 @@ postUploadR = do
|]
connStr :: ConnectionString
connStr = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=secret"
main :: IO ()
main = do
points <- Track.parseFile "track.gpx"
main = runStderrLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do
flip runSqlPersistMPool pool $ do
runMigration migrateAll
p1 : _ <- liftIO $ Track.parseFile "track.gpx"
Store.save p1
static'@(Static settings) <- static "frontend"
putStrLn ("loaded " ++ show (List.length points) ++ " points from GPX")
-- putStrLn ("loaded " ++ show (List.length points) ++ " points from GPX")
warp 3000 $ Souplesse static'

55
lib/Store.hs Normal file
View File

@ -0,0 +1,55 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Store (save, migrateAll) where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader (ReaderT)
import Data.Time.Clock (UTCTime)
import Database.Persist
import Database.Persist.Postgresql
( ConnectionString,
SqlBackend,
createPostgresqlPool,
pgConnStr,
pgPoolSize,
runMigration,
runSqlPool,
)
import Database.Persist.TH
import Track as T
connString :: ConnectionString
connString = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=secret"
share
[mkPersist sqlSettings, mkMigrate "migrateAll"]
[persistLowerCase|
Trkpt
lat Double
lon Double
ele Double Maybe
time UTCTime
cadence Int Maybe
power Int Maybe
heartRate Int Maybe
|]
fromPoint :: Point -> Trkpt
fromPoint p =
let Pos lat lon ele = T.pos p
in Trkpt lat lon ele (T.time p) (T.cadence p) (T.power p) (T.heartRate p)
save p = do insert $ fromPoint p

View File

@ -4,6 +4,7 @@ module Track
( Track,
Pos (..),
BadFile,
Point,
pos,
cadence,
power,

View File

@ -73,6 +73,9 @@ executable souplesse
, souplesse-lib
, text
, bytestring
, persistent
, persistent-postgresql
, monad-logger
, yesod-core == 1.6.25.1
, yesod-static
, yesod-form
@ -89,6 +92,7 @@ executable souplesse
library souplesse-lib
exposed-modules:
Track
Store
hs-source-dirs:
lib
build-depends:
@ -97,6 +101,9 @@ library souplesse-lib
, time
, containers
, text
, transformers
, persistent
, persistent-postgresql
, iso8601-time
default-language: GHC2021