add postgres

README.md

@@ -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"
+```

app/Main.hs

@@ -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
+main = runStderrLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do
-  points <- Track.parseFile "track.gpx"
+  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'

lib/Store.hs

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

lib/Track.hs

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

souplesse.cabal

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