module Database (getConnection, getPool, migrate) where

import Data.ByteString.Char8 (pack)
import Data.Functor
import qualified Hasql.Connection as Conn
import Hasql.Migration
import qualified Hasql.Pool as Pool
import qualified Hasql.Pool.Config as PoolConfig
import qualified Hasql.Session as Session
import Hasql.Transaction.Sessions
import System.Environment

migrate
    :: Conn.Connection -> IO (Either Session.SessionError [Maybe MigrationError])
migrate :: Connection -> IO (Either SessionError [Maybe MigrationError])
migrate Connection
conn = do
    String
path <- String -> IO String
getEnv String
"MIGRATIONS_DIR"
    [MigrationCommand]
migrations <- String -> IO [MigrationCommand]
loadMigrationsFromDirectory String
path
    let tx :: Transaction [Maybe MigrationError]
tx = (MigrationCommand -> Transaction (Maybe MigrationError))
-> [MigrationCommand] -> Transaction [Maybe MigrationError]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM MigrationCommand -> Transaction (Maybe MigrationError)
runMigration (MigrationCommand
MigrationInitialization MigrationCommand -> [MigrationCommand] -> [MigrationCommand]
forall a. a -> [a] -> [a]
: [MigrationCommand]
migrations)
    let session :: Session [Maybe MigrationError]
session = IsolationLevel
-> Mode
-> Transaction [Maybe MigrationError]
-> Session [Maybe MigrationError]
forall a. IsolationLevel -> Mode -> Transaction a -> Session a
transaction IsolationLevel
Serializable Mode
Write Transaction [Maybe MigrationError]
tx
    Session [Maybe MigrationError]
-> Connection -> IO (Either SessionError [Maybe MigrationError])
forall a. Session a -> Connection -> IO (Either SessionError a)
Session.run Session [Maybe MigrationError]
session Connection
conn

getPool :: IO Pool.Pool
getPool :: IO Pool
getPool = do
    Settings
s <- IO Settings
envSettings
    Config -> IO Pool
Pool.acquire (Config -> IO Pool) -> Config -> IO Pool
forall a b. (a -> b) -> a -> b
$ [Setting] -> Config
PoolConfig.settings [Settings -> Setting
PoolConfig.staticConnectionSettings Settings
s]

getConnection :: IO (Either Conn.ConnectionError Conn.Connection)
getConnection :: IO (Either ConnectionError Connection)
getConnection = IO Settings
envSettings IO Settings
-> (Settings -> IO (Either ConnectionError Connection))
-> IO (Either ConnectionError Connection)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Settings -> IO (Either ConnectionError Connection)
Conn.acquire

envSettings :: IO Conn.Settings
envSettings :: IO Settings
envSettings = do
    Settings
host <- String -> IO String
getEnv String
"POSTGRES_HOST" IO String -> (String -> Settings) -> IO Settings
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Settings
pack
    Word16
port <- String -> IO String
getEnv String
"POSTGRES_PORT" IO String -> (String -> Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Word16
forall a. Read a => String -> a
read
    Settings
user <- String -> IO String
getEnv String
"POSTGRES_USER" IO String -> (String -> Settings) -> IO Settings
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Settings
pack
    Settings
password <- String -> IO String
getEnv String
"POSTGRES_PASSWORD" IO String -> (String -> Settings) -> IO Settings
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Settings
pack
    Settings
database <- String -> IO String
getEnv String
"POSTGRES_DB" IO String -> (String -> Settings) -> IO Settings
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Settings
pack
    Settings -> IO Settings
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Settings -> IO Settings) -> Settings -> IO Settings
forall a b. (a -> b) -> a -> b
$ Settings -> Word16 -> Settings -> Settings -> Settings -> Settings
Conn.settings Settings
host Word16
port Settings
user Settings
password Settings
database