{-# LANGUAGE UndecidableInstances #-}

module Conduit.DB.Init where

import Conduit.DB.Core (DBPool(..))
import Conduit.Features.Account.DB (migrateAccountTables)
import Conduit.Features.Articles.DB (createArticleFunctions, migrateArticleTables)
import Database.Esqueleto.Experimental (SqlPersistT, createPoolConfig, rawExecute, runMigration, runSqlPool)
import Database.Persist.Postgresql (PostgresConf(..))
import UnliftIO (MonadUnliftIO)

data PGConnOps = PGConnOps
  { PGConnOps -> Text
connStr     :: !Text
  , PGConnOps -> Int
connSize    :: !Int
  , PGConnOps -> Int
connTimeout :: !Int
  , PGConnOps -> Int
connStripes :: !Int
  , PGConnOps -> Bool
truncTables :: !Bool
  } deriving (ReadPrec [PGConnOps]
ReadPrec PGConnOps
Int -> ReadS PGConnOps
ReadS [PGConnOps]
(Int -> ReadS PGConnOps)
-> ReadS [PGConnOps]
-> ReadPrec PGConnOps
-> ReadPrec [PGConnOps]
-> Read PGConnOps
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PGConnOps
readsPrec :: Int -> ReadS PGConnOps
$creadList :: ReadS [PGConnOps]
readList :: ReadS [PGConnOps]
$creadPrec :: ReadPrec PGConnOps
readPrec :: ReadPrec PGConnOps
$creadListPrec :: ReadPrec [PGConnOps]
readListPrec :: ReadPrec [PGConnOps]
Read)

mkPoolConfig :: PGConnOps -> PostgresConf
mkPoolConfig :: PGConnOps -> PostgresConf
mkPoolConfig PGConnOps
ops = PostgresConf
  { pgConnStr :: ConnectionString
pgConnStr         = String -> ConnectionString
forall a. IsString a => String -> a
fromString (String -> ConnectionString) -> String -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString PGConnOps
ops.connStr
  , pgPoolSize :: Int
pgPoolSize        = PGConnOps
ops.connSize
  , pgPoolIdleTimeout :: Integer
pgPoolIdleTimeout = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral PGConnOps
ops.connTimeout
  , pgPoolStripes :: Int
pgPoolStripes     = PGConnOps
ops.connStripes
  }

mkDBPool :: (MonadIO m) => PGConnOps -> m DBPool
mkDBPool :: forall (m :: * -> *). MonadIO m => PGConnOps -> m DBPool
mkDBPool = IO DBPool -> m DBPool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBPool -> m DBPool)
-> (PGConnOps -> IO DBPool) -> PGConnOps -> m DBPool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConnectionPool -> DBPool) -> IO ConnectionPool -> IO DBPool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConnectionPool -> DBPool
DBPool (IO ConnectionPool -> IO DBPool)
-> (PGConnOps -> IO ConnectionPool) -> PGConnOps -> IO DBPool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostgresConf -> IO (PersistConfigPool PostgresConf)
PostgresConf -> IO ConnectionPool
forall c. PersistConfig c => c -> IO (PersistConfigPool c)
createPoolConfig (PostgresConf -> IO ConnectionPool)
-> (PGConnOps -> PostgresConf) -> PGConnOps -> IO ConnectionPool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGConnOps -> PostgresConf
mkPoolConfig

initDB :: (MonadUnliftIO m) => DBPool -> PGConnOps -> m ()
initDB :: forall (m :: * -> *).
MonadUnliftIO m =>
DBPool -> PGConnOps -> m ()
initDB (DBPool ConnectionPool
pool) PGConnOps
ops = (ReaderT SqlBackend m () -> ConnectionPool -> m ())
-> ConnectionPool -> ReaderT SqlBackend m () -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT SqlBackend m () -> ConnectionPool -> m ()
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool ConnectionPool
pool do
  Bool -> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when PGConnOps
ops.truncTables ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => SqlPersistT m ()
resetTables
  ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => SqlPersistT m ()
runMigrations
  ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => SqlPersistT m ()
runDBFunctions

tables :: [Text]
tables :: [Text]
tables = [Text
"user", Text
"follow", Text
"article", Text
"favorite", Text
"comment"]

dropTables :: (MonadIO m) => SqlPersistT m ()
dropTables :: forall (m :: * -> *). MonadIO m => SqlPersistT m ()
dropTables = (Text -> [PersistValue] -> SqlPersistT m ())
-> [PersistValue] -> Text -> SqlPersistT m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [PersistValue] -> SqlPersistT m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute [] (Text -> SqlPersistT m ()) -> Text -> SqlPersistT m ()
forall a b. (a -> b) -> a -> b
$
  (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
t -> Text
"drop table if exists  \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" cascade;") [Text]
tables

resetTables :: (MonadIO m) => SqlPersistT m ()
resetTables :: forall (m :: * -> *). MonadIO m => SqlPersistT m ()
resetTables = (Text -> [PersistValue] -> SqlPersistT m ())
-> [PersistValue] -> Text -> SqlPersistT m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [PersistValue] -> SqlPersistT m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute [] (Text -> SqlPersistT m ()) -> Text -> SqlPersistT m ()
forall a b. (a -> b) -> a -> b
$
  (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
t -> Text
"truncate \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" cascade;") [Text]
tables

runMigrations :: (MonadIO m) => SqlPersistT m ()
runMigrations :: forall (m :: * -> *). MonadIO m => SqlPersistT m ()
runMigrations = do
  Migration -> SqlPersistT m ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migrateAccountTables
  Migration -> SqlPersistT m ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migrateArticleTables

runDBFunctions :: (MonadIO m) => SqlPersistT m ()
runDBFunctions :: forall (m :: * -> *). MonadIO m => SqlPersistT m ()
runDBFunctions = do
  SqlPersistT m ()
forall (m :: * -> *). MonadIO m => SqlPersistT m ()
createArticleFunctions