{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Database.PostgreSQL.Opium
    -- * Queries
    --
    -- Functions for performing queries. @fetch@ retrieves rows, @execute@ doesn't.
    -- The 'Connection' parameter comes last to facilitate currying for implicitly passing in the connection, e.g. from some framework's connection pool.
    --
    -- | TODO: Add @newtype Query = Query Text@ with @IsString@ instance to make constructing query strings at run time harder.
  ( fetch
  , fetch_
  , execute
  , execute_
    -- * Classes to Implement
  , FromRow (..)
  , FromField (..)
  , ToParamList (..)
  , ToField (..)
    -- * Utility Stuff
  , Error (..)
  , ErrorPosition (..)
  , RawField (..)
  )
  where

import Control.Monad (unless, void)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE)
import Data.Functor.Identity (Identity (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Database.PostgreSQL.LibPQ
  ( Connection
  , Result
  )

import qualified Data.Text.Encoding as Encoding
import qualified Database.PostgreSQL.LibPQ as LibPQ

import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
import Database.PostgreSQL.Opium.FromField (FromField (..), RawField (..))
import Database.PostgreSQL.Opium.FromRow (FromRow (..), ColumnTable)
import Database.PostgreSQL.Opium.ToField (ToField (..))
import Database.PostgreSQL.Opium.ToParamList (ToParamList (..))

class RowContainer c where
  extract :: FromRow a => Result -> LibPQ.Row -> ColumnTable -> ExceptT Error IO (c a)

instance RowContainer [] where
  extract result nRows columnTable = do
    mapM (ExceptT . fromRow result columnTable) [0..nRows - 1]

instance RowContainer Maybe where
  extract result nRows columnTable
    | nRows == 0 = pure Nothing
    | nRows == 1 = Just <$> ExceptT (fromRow result columnTable 0)
    | otherwise = throwE ErrorMoreThanOneRow

instance RowContainer Identity where
  extract result nRows columnTable = do
    unless (nRows == 1) $ throwE ErrorNotExactlyOneRow
    Identity <$> ExceptT (fromRow result columnTable 0)

-- The order of the type parameters is important, because it is more common to use type applications for providing the row type and row container type.
fetch
  :: forall a b c. (ToParamList c, FromRow a, RowContainer b)
  => Text
  -> c
  -> Connection
  -> IO (Either Error (b a))
fetch query params conn = runExceptT $ do
  result <- execParams conn query params
  nRows <- liftIO $ LibPQ.ntuples result
  columnTable <- ExceptT $ getColumnTable @a Proxy result
  extract result nRows columnTable

fetch_ :: forall a c. (FromRow a, RowContainer c) => Text -> Connection -> IO (Either Error (c a))
fetch_ query = fetch query ()

execute
  :: forall a. ToParamList a
  => Text
  -> a
  -> Connection
  -> IO (Either Error ())
execute query params conn = runExceptT $ void $ execParams conn query params

execute_ :: Text -> Connection -> IO (Either Error ())
execute_ query = execute query ()

execParams
  :: ToParamList a
  => Connection
  -> Text
  -> a
  -> ExceptT Error IO Result
execParams conn query params = do
  let queryBytes = Encoding.encodeUtf8 query
  liftIO (LibPQ.execParams conn queryBytes (toParamList params) LibPQ.Binary) >>= \case
    Nothing ->
      except $ Left ErrorNoResult
    Just result -> do
      status <- liftIO $ LibPQ.resultStatus result
      mbMessage <- liftIO $ LibPQ.resultErrorMessage result
      case mbMessage of
        Just "" -> pure result
        Nothing -> pure result
        Just message -> except $ Left $ ErrorInvalidResult status $ Encoding.decodeUtf8 message