module Foundation.Yesod.Persist
  ( runDB, getDBRunner
  , module Foundation.DB
  ) where

import Import.NoFoundation hiding (runDB, getDBRunner)

import Foundation.Type
import Foundation.DB
import Foundation.Authorization

import Database.Persist.Sql (transactionUndo)


runDB :: ( YesodPersistBackend UniWorX ~ SqlBackend
         , BearerAuthSite UniWorX
         )
      => YesodDB UniWorX a -> HandlerFor UniWorX a
runDB action = do
  -- stack <- liftIO currentCallStack
  -- $logDebugS "YesodPersist" . unlines $ "runDB" : map pack stack
  $logDebugS "YesodPersist" "runDB"
  dryRun <- isDryRun
  let action'
        | dryRun = action <* transactionUndo
        | otherwise = action

  runSqlPoolRetry action' . appConnPool =<< getYesod

getDBRunner :: ( YesodPersistBackend UniWorX ~ SqlBackend
               , BearerAuthSite UniWorX
               )
            => HandlerFor UniWorX (DBRunner UniWorX, HandlerFor UniWorX ())
getDBRunner = do
  (DBRunner{..}, cleanup) <- defaultGetDBRunner appConnPool
  return . (, cleanup) $ DBRunner
    (\action -> do
        dryRun <- isDryRun
        let action'
              | dryRun = action <* transactionUndo
              | otherwise = action
        $logDebugS "YesodPersist" "runDBRunner"
        runDBRunner action'
    )
