module Hasql.Private.Session
where

import Hasql.Private.Prelude
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.Private.Decoders.Results as Decoders.Results
import qualified Hasql.Private.Decoders.Result as Decoders.Result
import qualified Hasql.Private.Settings as Settings
import qualified Hasql.Private.IO as IO
import qualified Hasql.Private.Query as Query
import qualified Hasql.Private.Connection as Connection


-- |
-- A batch of actions to be executed in the context of a database connection.
newtype Session a =
  Session (ReaderT Connection.Connection (EitherT Error IO) a)
  deriving (Functor, Applicative, Monad, MonadError Error, MonadIO)

-- |
-- Executes a bunch of commands on the provided connection.
run :: Session a -> Connection.Connection -> IO (Either Error a)
run (Session impl) connection =
  runEitherT $
  runReaderT impl connection

-- |
-- Possibly a multi-statement query,
-- which however cannot be parameterized or prepared,
-- nor can any results of it be collected.
sql :: ByteString -> Session ()
sql sql =
  Session $ ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->
    EitherT $ fmap (mapLeft unsafeCoerce) $ withMVar pqConnectionRef $ \pqConnection -> do
      r1 <- IO.sendNonparametricQuery pqConnection sql
      r2 <- IO.getResults pqConnection integerDatetimes decoder
      return $ r1 *> r2
  where
    decoder =
      Decoders.Results.single $
      Decoders.Result.unit

-- |
-- Parameters and a specification of the parametric query to apply them to.
query :: a -> Query.Query a b -> Session b
query input (Query.Query (Kleisli impl)) =
  Session $ unsafeCoerce $ impl input


-- * Error
-------------------------

-- |
-- An error of some command in the session.
data Error =
  -- |
  -- An error on the client-side,
  -- with a message generated by the \"libpq\" library.
  -- Usually indicates problems with connection.
  ClientError !(Maybe ByteString) |
  -- |
  -- Some error with a command result.
  ResultError !ResultError
  deriving (Show, Eq)

-- |
-- An error with a command result.
data ResultError =
  -- | 
  -- An error reported by the DB.
  -- Consists of the following: Code, message, details, hint.
  -- 
  -- * __Code__.
  -- The SQLSTATE code for the error.
  -- It's recommended to use
  -- <http://hackage.haskell.org/package/postgresql-error-codes the "postgresql-error-codes" package>
  -- to work with those.
  -- 
  -- * __Message__.
  -- The primary human-readable error message (typically one line). Always present.
  -- 
  -- * __Details__.
  -- An optional secondary error message carrying more detail about the problem. 
  -- Might run to multiple lines.
  -- 
  -- * __Hint__.
  -- An optional suggestion on what to do about the problem. 
  -- This is intended to differ from detail in that it offers advice (potentially inappropriate) 
  -- rather than hard facts.
  -- Might run to multiple lines.
  ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) |
  -- |
  -- The database returned an unexpected result.
  -- Indicates an improper statement or a schema mismatch.
  UnexpectedResult !Text |
  -- |
  -- An error of the row reader, preceded by the index of the row.
  RowError !Int !RowError |
  -- |
  -- An unexpected amount of rows.
  UnexpectedAmountOfRows !Int
  deriving (Show, Eq)

-- |
-- An error during the decoding of a specific row.
data RowError =
  -- |
  -- Appears on the attempt to parse more columns than there are in the result.
  EndOfInput |
  -- |
  -- Appears on the attempt to parse a @NULL@ as some value.
  UnexpectedNull |
  -- |
  -- Appears when a wrong value parser is used.
  -- Comes with the error details.
  ValueError !Text
  deriving (Show, Eq)