Commit 7974d78f authored by Bryan Richter's avatar Bryan Richter

Add runPersistConfig

parent 254471ee
......@@ -15,22 +15,22 @@
module ReadConfig (readYamlConfig, RunPersistConfig(..)) where
import Control.Lens
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.Aeson.Lens
import Data.Aeson.Types
import Data.Char
import Data.Text (Text)
import Data.Word
import Data.Yaml
import GHC.Generics hiding (from)
-- | All config necessary for connecting to a Postgres instance.
data RunPersistConfig = RunPersistConfig
{ runPersistUser :: Text
, runPersistName :: Text
, runPersistServer :: Text
, runPersistPort :: Int
, runPersistPass :: Text
{ runPersistServer :: String
, runPersistPort :: Word16
, runPersistUser :: String
, runPersistPass :: String
, runPersistName :: String
}
deriving (Show, Generic)
......
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-- | Make it possible to run SqlPersistT queries on a one-off basis. All
-- methods expect you to configure the database connection through the
......@@ -7,26 +8,58 @@
module RunPersist
( -- * Individual queries
runPersist
, runPersistConfig
, runPersistDebug
-- * Gobs of queries
, runPersistPool
, runPersistPoolDebug
) where
import Control.Exception (bracket)
import Control.Monad.Logger
( runStderrLoggingT
, LogLevel(..)
, LoggingT(..)
, filterLogger
)
import Database.Persist.Postgresql (SqlPersistT, openSimpleConn, withPostgresqlPool)
import Database.Persist.Sql (runSqlConn, runSqlPool)
import Database.PostgreSQL.Simple (connectPostgreSQL)
import Database.Persist.Postgresql
(SqlPersistT, openSimpleConn, withPostgresqlPool)
import Database.Persist.Sql (runSqlConn, runSqlPool, SqlBackend)
import Database.PostgreSQL.Simple
(connectPostgreSQL, ConnectInfo(..), connect, close, Connection)
import Data.Text (Text)
import qualified Data.Text as T
import ReadConfig
runPersist, runPersistDebug :: SqlPersistT IO a -> IO a
runPersist = runPersist' normalLogging
runPersistDebug = runPersist' id
-- | Connect to a database given a config file, then run the SqlPersist value
runPersistConfig :: FilePath -> Text -> SqlPersistT IO a -> IO a
runPersistConfig yml cfgName sql = do
mcfg <- readYamlConfig yml cfgName
maybe
(error
("run-persist: Could not find config group "
++ T.unpack cfgName
++ " within file "
++ yml))
(\cfg ->
bracket (connect (mkconn cfg)) close $ \conn ->
runSqlConn sql
=<< runStderrLoggingT (normalLogging (logSimpleConn conn)))
mcfg
where
mkconn RunPersistConfig{..} = ConnectInfo
{ connectHost = runPersistServer
, connectPort = runPersistPort
, connectUser = runPersistUser
, connectPassword = runPersistPass
, connectDatabase = runPersistName
}
runPersist'
:: (forall a. LoggingT IO a -> LoggingT IO a)
-> SqlPersistT IO b
......@@ -35,8 +68,9 @@ runPersist' filter' q = do
conn <- connectPostgreSQL "" -- Needs env vars
back <- runStderrLoggingT (filter' (logSimpleConn conn))
runSqlConn q back
where
logSimpleConn c = LoggingT (`openSimpleConn` c)
logSimpleConn :: Connection -> LoggingT IO SqlBackend
logSimpleConn c = LoggingT (`openSimpleConn` c)
normalLogging :: LoggingT IO a -> LoggingT IO a
normalLogging = filterLogger (const (> LevelDebug))
......
ConfigOption:
user: usernamestuff
name: databasenamestuff
server: localhost
port: 5432
pass: passwordlol
......@@ -2,7 +2,7 @@
-- documentation, see http://haskell.org/cabal/users-guide/
name: run-persist
version: 0.1.0.0
version: 0.2.0.0
-- synopsis:
-- description:
license: AGPL-3
......@@ -17,13 +17,19 @@ cabal-version: >=1.10
library
exposed-modules: RunPersist
-- other-modules:
other-modules: ReadConfig
other-extensions: OverloadedStrings
build-depends:
base >=4.8
, aeson >= 0.11.2
, lens >= 4.13
, lens-aeson >= 1.0.0.5
, monad-logger >= 0.3.19
, persistent-postgresql >= 2.2.2
, persistent >= 2.2.4.1
, persistent-postgresql >= 2.2.2
, postgresql-simple >= 0.5.2.1
, text >= 1.2.2.1
, transformers >= 0.4.2
, yaml >= 0.8.18
-- hs-source-dirs:
default-language: Haskell2010
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment