content: {-# LANGUAGE GeneralizedNewtypeDeriving, CPP, TypeFamilies #-}
  -- | Internal backend API.
  --   Using anything exported from this module may or may not invalidate any
  --   safety guarantees made by Selda; use at your own peril.
  module Database.Selda.Backend.Internal
    ( StmtID (..), BackendID (..)
    , QueryRunner, SeldaBackend (..), SeldaConnection (..), SeldaStmt (..)
    , MonadSelda (..), SeldaT (..), SeldaM
    , SeldaError (..)
    , Param (..), Lit (..), ColAttr (..), AutoIncType (..)
    , SqlType (..), SqlValue (..), SqlTypeRep (..)
    , PPConfig (..), defPPConfig
    , TableInfo (..), ColumnInfo (..), tableInfo, fromColInfo
    , isAutoPrimary, isPrimary, isUnique
    , sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat
    , freshStmtId
    , newConnection, allStmts
    , runSeldaT, withBackend
    ) where
  import Data.List (nub)
  import Database.Selda.SQL (Param (..))
  import Database.Selda.SqlType
      ( SqlValue(..),
        Lit(..),
        SqlType(..),
        SqlTypeRep(..),
        sqlDateTimeFormat,
        sqlDateFormat,
        sqlTimeFormat )
  import Database.Selda.Table.Type
      ( ColAttr(..),
        AutoIncType(..),
        Table(Table, tableAttrs, tableName, tableCols),
        isAutoPrimary,
        isPrimary,
        isUnique )
  import qualified Database.Selda.Table.Type as Table ( ColInfo(..) )
  import Database.Selda.SQL.Print.Config
      ( PPConfig(..), defPPConfig )
  import Database.Selda.Types (TableName, ColName)
  import Data.Int (Int64)
  import Control.Concurrent ( newMVar, putMVar, takeMVar, MVar )
  import Control.Monad.Catch
      ( Exception, bracket, MonadCatch, MonadMask, MonadThrow(..) )
  import Control.Monad.IO.Class ( MonadIO(..) )
  import Control.Monad.Reader
      ( MonadTrans(..), ReaderT(..), MonadReader(ask) )
  import Control.Monad (when)
  import Data.Dynamic ( Typeable, Dynamic )
  import qualified Data.IntMap as M
  import Data.IORef
      ( IORef, atomicModifyIORef', newIORef, readIORef )
  import Data.Text (Text)
  import System.IO.Unsafe (unsafePerformIO)
  
  
  
  
  -- | Uniquely identifies some particular backend.
  --
  --   When publishing a new backend, consider submitting a pull request with a
  --   constructor for your backend instead of using the @Other@ constructor.
  data BackendID = SQLite | PostgreSQL | Other Text
    deriving (Show, Eq, Ord)
  
  -- | Thrown by any function in 'SeldaT' if an error occurs.
  data SeldaError
    = DbError String     -- ^ Unable to open or connect to database.
    | SqlError String    -- ^ An error occurred while executing query.
    | UnsafeError String -- ^ An error occurred due to improper use of an unsafe
                         --   function.
    deriving (Show, Eq, Typeable)
  
  instance Exception SeldaError
  
  -- | A prepared statement identifier. Guaranteed to be unique per application.
  newtype StmtID = StmtID Int
    deriving (Show, Eq, Ord)
  
  -- | A connection identifier. Guaranteed to be unique per application.
  newtype ConnID = ConnID Int
    deriving (Show, Eq, Ord)
  
  {-# NOINLINE nextStmtId #-}
  nextStmtId :: IORef Int
  nextStmtId = unsafePerformIO $ newIORef 1
  
  -- | Generate a fresh statement identifier, guaranteed to be unique per process.
  freshStmtId :: MonadIO m => m StmtID
  freshStmtId = liftIO $ atomicModifyIORef' nextStmtId $ \n -> (n+1, StmtID n)
  
  -- | A function which executes a query and gives back a list of extensible
  --   tuples; one tuple per result row, and one tuple element per column.
  type QueryRunner a = Text -> [Param] -> IO a
  
  -- | A prepared statement.
  data SeldaStmt = SeldaStmt
   { -- | Backend-specific handle to the prepared statement.
     stmtHandle :: !Dynamic
  
     -- | The SQL code for the statement.
   , stmtText :: !Text
  
     -- | All parameters to be passed to the prepared statement.
     --   Parameters that are unique to each invocation are specified as indices
     --   starting at 0.
     --   Backends implementing @runPrepared@ should probably ignore this field.
   , stmtParams :: ![Either Int Param]
   }
  
  data SeldaConnection b = SeldaConnection
    { -- | The backend used by the current connection.
      connBackend :: !(SeldaBackend b)
  
      -- | A string uniquely identifying the database used by this connection.
      --   This could be, for instance, a PostgreSQL connection
      --   string or the absolute path to an SQLite file.
    , connDbId :: Text
  
      -- | All statements prepared for this connection.
    , connStmts :: !(IORef (M.IntMap SeldaStmt))
  
      -- | Is the connection closed?
    , connClosed :: !(IORef Bool)
  
      -- | Lock to prevent this connection from being used concurrently by
      --   multiple invocations of 'runSeldaT'.
    , connLock :: !(MVar ())
  }
  
  -- | Create a new Selda connection for the given backend and database
  --   identifier string.
  newConnection :: MonadIO m => SeldaBackend b -> Text -> m (SeldaConnection b)
  newConnection back dbid =
    liftIO $ SeldaConnection back dbid <$> newIORef M.empty
                                       <*> newIORef False
                                       <*> newMVar ()
  
  -- | Get all statements and their corresponding identifiers for the current
  --   connection.
  allStmts :: SeldaConnection b -> IO [(StmtID, Dynamic)]
  allStmts = fmap (map (\(k, v) -> (StmtID k, stmtHandle v)) . M.toList)
    . readIORef
    . connStmts
  
  -- | Comprehensive information about a table.
  data TableInfo = TableInfo
    { -- | Name of the table.
      tableInfoName :: TableName
      -- | Ordered information about each table column.
    , tableColumnInfos :: [ColumnInfo]
      -- | Unordered list of all (non-PK) uniqueness constraints on this table.
    , tableUniqueGroups :: [[ColName]]
      -- | Unordered list of all primary key constraints on this table.
    , tablePrimaryKey :: [ColName]
    } deriving (Show, Eq)
  
  -- | Comprehensive information about a column.
  data ColumnInfo = ColumnInfo
    { -- | Name of the column.
      colName :: ColName
      -- | Selda type of the column, or the type name given by the database
      --   if Selda couldn't make sense of the type.
    , colType :: Either Text SqlTypeRep
      -- | Is the given column auto-incrementing?
    , colIsAutoPrimary :: Bool
      -- | Can the column be NULL?
    , colIsNullable :: Bool
      -- | Is the column explicitly indexed (i.e. using 'indexed')?
    , colHasIndex :: Bool
      -- | Any foreign key (table, column) pairs referenced by this column.
    , colFKs :: [(TableName, ColName)]
    } deriving (Show, Eq)
  
  -- | Convert a 'Table.ColInfo' into a 'ColumnInfo'.
  fromColInfo :: Table.ColInfo -> ColumnInfo
  fromColInfo ci = ColumnInfo
      { colName = Table.colName ci
      , colType = Right $ Table.colType ci
      , colIsAutoPrimary = any isAutoPrimary (Table.colAttrs ci)
      , colIsNullable = Optional `elem` Table.colAttrs ci
      , colHasIndex = not $ null [() | Indexed _ <- Table.colAttrs ci]
      , colFKs = map fk (Table.colFKs ci)
      }
    where
      fk (Table tbl _ _ _, col, _) = (tbl, col)
  
  -- | Get the column information for each column in the given table.
  tableInfo :: Table a -> TableInfo
  tableInfo t = TableInfo
    { tableInfoName = tableName t
    , tableColumnInfos = map fromColInfo (tableCols t)
    , tableUniqueGroups = uniqueGroups
    , tablePrimaryKey = pkGroup
    }
    where
      uniqueGroups =
        [ map (Table.colName . ((tableCols t) !!)) ixs
        | (ixs, Unique) <- tableAttrs t
        ]
      pkGroup = nub $ concat
        [ concat
          [ map (Table.colName . ((tableCols t) !!)) ixs
          | (ixs, attr) <- tableAttrs t
          , isPrimary attr
          ]
        , [ Table.colName col
          | col <- tableCols t
          , attr <- Table.colAttrs col
          , isPrimary attr
          ]
        ]
  
  -- | A collection of functions making up a Selda backend.
  data SeldaBackend b = SeldaBackend
    { -- | Execute an SQL statement.
      runStmt :: Text -> [Param] -> IO (Int, [[SqlValue]])
  
      -- | Execute an SQL statement and return the last inserted primary key,
      --   where the primary key is auto-incrementing.
      --   Backends must take special care to make this thread-safe.
    , runStmtWithPK :: Text -> [Param] -> IO Int64
  
      -- | Prepare a statement using the given statement identifier.
    , prepareStmt :: StmtID -> [SqlTypeRep] -> Text -> IO Dynamic
  
      -- | Execute a prepared statement.
    , runPrepared :: Dynamic -> [Param] -> IO (Int, [[SqlValue]])
  
      -- | Get a list of all columns in the given table, with the type and any
      --   modifiers for each column.
      --   Return an empty list if the given table does not exist.
    , getTableInfo :: TableName -> IO TableInfo
  
      -- | SQL pretty-printer configuration.
    , ppConfig :: PPConfig
  
      -- | Close the currently open connection.
    , closeConnection :: SeldaConnection b -> IO ()
  
      -- | Unique identifier for this backend.
    , backendId :: BackendID
  
      -- | Turn on or off foreign key checking, and initiate/commit
      --   a transaction.
      --
      --   When implementing this function, it is safe to assume that
      --   @disableForeignKeys True@
      --   will always be called exactly once before each
      --   @disableForeignKeys False@.
    , disableForeignKeys :: Bool -> IO ()
    }
  
  -- | Some monad with Selda SQL capabilitites.
  class MonadIO m => MonadSelda m where
    {-# MINIMAL withConnection #-}
  
    -- | Type of database backend used by @m@.
    type Backend m
  
    -- | Pass a Selda connection to the given computation and execute it.
    --   After the computation finishes, @withConnection@ is free to do anything
    --   it likes to the connection, including closing it or giving it to another
    --   Selda computation.
    --   Thus, the computation must take care never to return or otherwise
    --   access the connection after returning.
    withConnection :: (SeldaConnection (Backend m) -> m a) -> m a
  
    -- | Perform the given computation as a transaction.
    --   Implementations must ensure that subsequent calls to 'withConnection'
    --   within the same transaction always passes the same connection
    --   to its argument.
    transact :: m a -> m a
    transact = id
  
  -- | Get the backend in use by the computation.
  withBackend :: MonadSelda m => (SeldaBackend (Backend m) -> m a) -> m a
  withBackend m = withConnection (m . connBackend)
  
  -- | Monad transformer adding Selda SQL capabilities.
  newtype SeldaT b m a = S {unS :: ReaderT (SeldaConnection b) m a}
    deriving ( Functor, Applicative, Monad, MonadIO
             , MonadThrow, MonadCatch, MonadMask , MonadFail
             )
  
  instance (MonadIO m, MonadMask m) => MonadSelda (SeldaT b m) where
    type Backend (SeldaT b m) = b
    withConnection m = S ask >>= m
  
  instance MonadTrans (SeldaT b) where
    lift = S . lift
  
  -- | The simplest form of Selda computation; 'SeldaT' specialized to 'IO'.
  type SeldaM b = SeldaT b IO
  
  -- | Run a Selda transformer. Backends should use this to implement their
  --   @withX@ functions.
  runSeldaT :: (MonadIO m, MonadMask m)
            => SeldaT b m a
            -> SeldaConnection b
            -> m a
  runSeldaT m c =
      bracket (liftIO $ takeMVar (connLock c))
              (const $ liftIO $ putMVar (connLock c) ())
              (const go)
    where
      go = do
        closed <- liftIO $ readIORef (connClosed c)
        when closed $ do
          liftIO $ throwM $ DbError "runSeldaT called with a closed connection"
        runReaderT (unS m) c
  