{-# LANGUAGE OverloadedStrings #-}
{-|
Copyright   : (c) 2020-2021 Tim Emiola
SPDX-License-Identifier: BSD3
Maintainer  : Tim Emiola <adetokunbo@users.noreply.github.com>

Defines data access combinators used by the demo service

-}
module TmpProc.Example1.Database
  ( -- * Contact Database access
    create
  , fetch
  , remove
  , migrateDB

    -- * Database location
  , 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

{-| Specifies the database to connect to .-}
type Locator = ConnectionString


{-| A default for local development .-}
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