{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}

module Persistence.DatabaseConnection (getConnection) where

import Persistence.DBConfig

import qualified Persistence.SQLite as SQLite
#ifdef MYSQL
-- NOTE: MySQL support requires users to install MySQL even if they want to use
-- SQLite or PostgreSQL.
import qualified Persistence.MySQL as MySQL
#endif
#ifndef UNI_PACKAGE
import qualified Persistence.PostgreSQL as PSQL
#endif

import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import Control.Monad.Logger
import Control.Monad.IO.Unlift
import qualified Control.Monad.Fail as Fail

import Data.Maybe (fromMaybe)
import Data.Pool (Pool)

import Database.Persist.Sql

defaultPoolSize :: Int
defaultPoolSize :: Int
defaultPoolSize = 4

getConnection :: ( MonadIO m
                 , MonadBaseControl IO m
                 , MonadLogger m
                 , MonadLoggerIO m
                 , MonadUnliftIO m
                 )
              => DBConfig -> IO ((Pool SqlBackend -> m a) -> m a)
getConnection :: DBConfig -> IO ((Pool SqlBackend -> m a) -> m a)
getConnection dbConfig :: DBConfig
dbConfig = case DBConfig -> Maybe String
adapter DBConfig
dbConfig of
#ifdef MYSQL
  Just "mysql" -> return $ MySQL.connection dbConfig $
                    fromMaybe defaultPoolSize $ pool dbConfig
  Just "mysql2" -> return $ MySQL.connection dbConfig $
                    fromMaybe defaultPoolSize $ pool dbConfig
#else
  Just "mysql" -> String -> IO ((Pool SqlBackend -> m a) -> m a)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
mySQLErrorMessage
  Just "mysql2" -> String -> IO ((Pool SqlBackend -> m a) -> m a)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
mySQLErrorMessage
#endif
#ifdef UNI_PACKAGE
  Just "postgresql" -> String -> IO ((Pool SqlBackend -> m a) -> m a)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
postgreSQLErrorMessage
#else
  Just "postgresql" -> return $ PSQL.connection dbConfig $
                         fromMaybe defaultPoolSize $ pool dbConfig
#endif
  Just "sqlite" -> ((Pool SqlBackend -> m a) -> m a)
-> IO ((Pool SqlBackend -> m a) -> m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (((Pool SqlBackend -> m a) -> m a)
 -> IO ((Pool SqlBackend -> m a) -> m a))
-> ((Pool SqlBackend -> m a) -> m a)
-> IO ((Pool SqlBackend -> m a) -> m a)
forall a b. (a -> b) -> a -> b
$ DBConfig -> Int -> (Pool SqlBackend -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadLogger m, MonadLoggerIO m,
 MonadUnliftIO m) =>
DBConfig -> Int -> (Pool SqlBackend -> m a) -> m a
SQLite.connection DBConfig
dbConfig (Int -> (Pool SqlBackend -> m a) -> m a)
-> Int -> (Pool SqlBackend -> m a) -> m a
forall a b. (a -> b) -> a -> b
$
                     Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultPoolSize (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ DBConfig -> Maybe Int
pool DBConfig
dbConfig
  Just "sqlite3" -> ((Pool SqlBackend -> m a) -> m a)
-> IO ((Pool SqlBackend -> m a) -> m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (((Pool SqlBackend -> m a) -> m a)
 -> IO ((Pool SqlBackend -> m a) -> m a))
-> ((Pool SqlBackend -> m a) -> m a)
-> IO ((Pool SqlBackend -> m a) -> m a)
forall a b. (a -> b) -> a -> b
$ DBConfig -> Int -> (Pool SqlBackend -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadLogger m, MonadLoggerIO m,
 MonadUnliftIO m) =>
DBConfig -> Int -> (Pool SqlBackend -> m a) -> m a
SQLite.connection DBConfig
dbConfig (Int -> (Pool SqlBackend -> m a) -> m a)
-> Int -> (Pool SqlBackend -> m a) -> m a
forall a b. (a -> b) -> a -> b
$
                      Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultPoolSize (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ DBConfig -> Maybe Int
pool DBConfig
dbConfig
  _ -> String -> IO ((Pool SqlBackend -> m a) -> m a)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail ("Persistence.Database: No database adapter specified "
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ "or adapter unsupported.")
  where
#ifndef MYSQL
    mySQLErrorMessage :: String
mySQLErrorMessage = "MySQL support is deactivated. If you need it, please use a hets-server package compiled with the mysql flag instead of hets-desktop."
#endif
#ifdef UNI_PACKAGE
    postgreSQLErrorMessage :: String
postgreSQLErrorMessage = "PostgreSQL support is deactivated. If you need it, please use the package hets-server instead of hets-desktop."
#endif