{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeOperators         #-}

module Yam.Transaction(
    Transaction
  , TransactionPool(..)
  , DataSource(..)
  , MonadTransaction(..)
  , DataSourceConnector
  , DataSourceProvider
  , HasDataSource(..)
  , runTrans
  , selectValue
  , selectNow
  , now
  , initDataSource
  , runSecondaryTrans
  ) where

import           Yam.Import
import           Yam.Logger
import           Yam.Logger.MonadLogger

import           Control.Monad.Trans.Control (MonadBaseControl)
import           Data.Aeson
import           Data.Default
import qualified Data.Map                    as M
import           Data.Pool
import           Data.Proxy
import           Data.Reflection
import           Database.Persist.Sql
import           GHC.TypeLits

-- SqlPersistT ~ ReaderT SqlBackend
type Transaction  = SqlPersistT IO

type TransactionPool = Pool SqlBackend

data DataSource = DataSource
  { dbtype  :: Text
  , conn    :: Text
  , thread  :: Int
  , migrate :: Bool
  , extra   :: Maybe (M.Map Text Text)
  } deriving (Show, Generic, FromJSON)

instance Default DataSource where
  def = DataSource "sqlite" ":memory:" 10 True Nothing

class (MonadIO m, MonadBaseControl IO m, MonadLogger m) => MonadTransaction m where
  connectionPool :: m TransactionPool
  setConnectionPool :: TransactionPool -> Maybe TransactionPool -> m ()
  secondaryPool  :: m (Maybe TransactionPool)
  secondaryPool = return Nothing

type DataSourceConnector m a = LogFunc -> DataSource -> (TransactionPool -> m a) -> m a
type DataSourceProvider  m a = (Text, DataSourceConnector m a)

class HasDataSource ds where
  connector :: MonadTransaction m => Proxy ds -> DataSourceConnector m a

initDataSource :: MonadTransaction m => [DataSourceProvider m a] -> DataSource -> Maybe DataSource -> m a -> m a
initDataSource maps ds ds2nd action = let map = M.fromList maps in go map (Just ds) $ go map ds2nd action
  where go _    Nothing  action = action
        go map (Just ds) action = case M.lookup (dbtype ds) map of
            Nothing -> error $ "Datasource " <> cs (dbtype ds) <> " not supported"
            Just db -> do
              logger <- toMonadLogger
              db logger ds $ \p -> setConnectionPool p Nothing >> action

runTrans :: MonadTransaction m => Transaction a -> m a
runTrans trans = connectionPool >>= liftIO . runSqlPool trans

runSecondaryTrans :: MonadTransaction m => Transaction a -> m a
runSecondaryTrans trans = do
  pool <- secondaryPool
  case pool of
    Nothing -> error "Secondary Pool not exists"
    Just p  -> liftIO $ runSqlPool trans p

selectNow :: Transaction UTCTime
selectNow = head <$> (ask >>= dbNow . connRDBMS)
  where dbNow :: Text -> Transaction [UTCTime]
        dbNow "sqlite"     = selectValue "SELECT CURRENT_TIMESTAMP"
        dbNow "postgresql" = selectValue "SELECT CURRENT_TIMESTAMP"
        dbNow "oracle"     = selectValue "SELECT SYSDATE FROM DUAL"
        dbNow dbms         = error $ "Datasource " <> cs dbms <> " not supported"

selectValue :: (PersistField a) => Text -> Transaction [a]
selectValue sql = fmap unSingle <$> rawSql sql []

now :: MonadTransaction m => m UTCTime
now = runTrans selectNow