{-# LANGUAGE OverloadedStrings #-}
module TmpProc.Example1.Database
(
create
, fetch
, remove
, migrateDB
, Locator
, defaultLoc
)
where
import Control.Monad.Logger (LogLevel (..), LoggingT,
filterLogger, runStdoutLoggingT, LogSource)
import Control.Monad.Reader (runReaderT)
import Database.Persist
import Database.Persist.Postgresql (ConnectionString, SqlPersistT,
fromSqlKey, runMigration,
toSqlKey, withPostgresqlConn)
import TmpProc.Example1.Schema
type Locator = ConnectionString
defaultLoc :: Locator
defaultLoc :: Locator
defaultLoc = Locator
"host=127.0.0.1 port=5432 contact=postgres dbname=postgres password=postgres"
migrateDB :: Locator -> IO ()
migrateDB :: Locator -> IO ()
migrateDB Locator
loc = forall a. Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb Locator
loc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migrateAll
fetch :: Locator -> ContactID -> IO (Maybe Contact)
fetch :: Locator -> ContactID -> IO (Maybe Contact)
fetch Locator
loc ContactID
cid = forall a. Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb Locator
loc forall a b. (a -> b) -> a -> b
$ forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get forall a b. (a -> b) -> a -> b
$ forall record.
ToBackendKey SqlBackend record =>
ContactID -> Key record
toSqlKey ContactID
cid
create :: Locator -> Contact -> IO ContactID
create :: Locator -> Contact -> IO ContactID
create Locator
loc Contact
contact = forall record.
ToBackendKey SqlBackend record =>
Key record -> ContactID
fromSqlKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb Locator
loc (forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert Contact
contact)
remove :: Locator -> ContactID -> IO ()
remove :: Locator -> ContactID -> IO ()
remove Locator
loc ContactID
cid = forall a. Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb Locator
loc forall a b. (a -> b) -> a -> b
$ forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key Contact
contactKey
where
contactKey :: Key Contact
contactKey :: Key Contact
contactKey = forall record.
ToBackendKey SqlBackend record =>
ContactID -> Key record
toSqlKey ContactID
cid
doDb :: Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb :: forall a. Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb = forall a.
(LogSource -> LogLevel -> Bool)
-> Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb' forall a. a -> LogLevel -> Bool
defaultFilter
doDb' :: (LogSource -> LogLevel -> Bool) -> Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb' :: forall a.
(LogSource -> LogLevel -> Bool)
-> Locator -> SqlPersistT (LoggingT IO) a -> IO a
doDb' LogSource -> LogLevel -> Bool
logFilter Locator
loc SqlPersistT (LoggingT IO) a
action =
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger LogSource -> LogLevel -> Bool
logFilter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
Locator -> (SqlBackend -> m a) -> m a
withPostgresqlConn Locator
loc forall a b. (a -> b) -> a -> b
$ \SqlBackend
backend ->
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT SqlPersistT (LoggingT IO) a
action SqlBackend
backend
defaultFilter :: a -> LogLevel -> Bool
defaultFilter :: forall a. a -> LogLevel -> Bool
defaultFilter a
_ LogLevel
level = LogLevel
level forall a. Ord a => a -> a -> Bool
> LogLevel
LevelDebug