{-# LANGUAGE TypeFamilies #-}

-- | The database primitives every backend implements.
module Arbiter.Core.MonadArbiter
  ( MonadArbiter (..)
  , JobHandler
  , HasRegistry
  , ResultOf

    -- * Instance kit
  , Query (..)
  , Piece (..)
  , mkQuery
  , Params
  , SomeParam (..)
  , ParamType (..)
  , RowCodec
  , Col (..)
  , NullCol (..)
  , runCodec
  , Stored (..)
  , storedBytes

    -- * Internal

    -- | Internal to the arbiter packages. Not covered by the PVP.
  , countOr0
  , countOr0Prepared
  , queryMaybe
  , queryAny
  ) where

import Data.Int (Int64)
import Data.Kind (Type)
import Data.Maybe (listToMaybe)
import GHC.TypeLits (ErrorMessage (..), TypeError)
import UnliftIO (MonadUnliftIO)

import Arbiter.Core.Codec (Col (..), NullCol (..), ParamType (..), Params, RowCodec, SomeParam (..), runCodec)
import Arbiter.Core.Job.Schema (SchemaName)
import Arbiter.Core.Job.Types (JobRead)
import Arbiter.Core.Job.Types.Internal (Stored (..), storedBytes)
import Arbiter.Core.Listen (Listener)
import Arbiter.Core.QueueRegistry (JobPayloadRegistry, ResultFor)
import Arbiter.Core.Sql.Query (Piece (..), Query (..), mkQuery)

-- | Database abstraction for job queue operations. Each backend (postgresql-simple,
-- hasql, Orville) provides an instance that maps queries to its native driver.
--
-- The instance also names the monad's schema and queue registry. The high-level
-- API resolves table names and result types from them at compile time.
class (MonadUnliftIO m) => MonadArbiter m where
  -- | This monad's registry. The default reports an instance that omits it.
  type RegistryOf m :: JobPayloadRegistry

  type
    RegistryOf m =
      TypeError
        ( 'Text "No registry declared for "
            ':<>: 'ShowType m
            ':$$: 'Text "Its MonadArbiter instance is missing the RegistryOf definition."
            ':$$: 'Text "Add to the instance:  type RegistryOf "
            ':<>: 'ShowType m
            ':<>: 'Text " = YourRegistry"
        )

  -- | Backend-specific handler shape (for example @Connection -> job -> m result@).
  -- 'JobHandler' instantiates it at one queue's job and result types.
  type Handler m job result :: Type

  -- | The schema name for this monad's arbiter tables.
  getSchema :: m SchemaName

  -- | Run a query and decode the result rows. The text, its parameters, and the
  -- decoder travel together in the 'Query'.
  executeQuery :: Query a -> m [a]

  -- | 'executeQuery' for a hot statement whose text is stable across calls. A
  -- backend may prepare it once per connection.
  executeQueryPrepared :: Query a -> m [a]
  executeQueryPrepared = Query a -> m [a]
forall a. Query a -> m [a]
forall (m :: * -> *) a. MonadArbiter m => Query a -> m [a]
executeQuery

  -- | Run a statement, returning the number of affected rows. The 'Query'
  -- decoder is ignored.
  executeStatement :: Query a -> m Int64

  -- | Run an action in a transaction. Nesting creates savepoints.
  withDbTransaction :: m a -> m a

  -- | Run a job handler in the backend's handler shape.
  runHandlerWithConnection
    :: JobHandler m payload (ResultOf m payload)
    -> JobRead payload
    -> m (ResultOf m payload)

  -- | The env's shared LISTEN\/NOTIFY listener, or 'Nothing' for poll-only.
  getListener :: m (Maybe Listener)

-- | A handler for @payload@'s queue. @result@ is what its registry entry declares.
type JobHandler m (payload :: Type) result = Handler m (JobRead payload) result

-- | 'MonadArbiter' with the registry named, for signatures that mention it.
type HasRegistry m (registry :: JobPayloadRegistry) =
  (MonadArbiter m, RegistryOf m ~ registry)

-- | The result type declared by @payload@'s registry entry. It is not injective.
-- A signature naming it needs another argument to determine @payload@.
type ResultOf m (payload :: Type) = ResultFor payload (RegistryOf m)

-- | Run a single-row count 'Query', returning 0 on an empty or unexpected result.
countOr0 :: (MonadArbiter m) => Query Int64 -> m Int64
countOr0 :: forall (m :: * -> *). MonadArbiter m => Query Int64 -> m Int64
countOr0 = ([Int64] -> Int64) -> m [Int64] -> m Int64
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int64] -> Int64
singleCount (m [Int64] -> m Int64)
-> (Query Int64 -> m [Int64]) -> Query Int64 -> m Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query Int64 -> m [Int64]
forall a. Query a -> m [a]
forall (m :: * -> *) a. MonadArbiter m => Query a -> m [a]
executeQuery

-- | 'countOr0' over a prepared statement.
countOr0Prepared :: (MonadArbiter m) => Query Int64 -> m Int64
countOr0Prepared :: forall (m :: * -> *). MonadArbiter m => Query Int64 -> m Int64
countOr0Prepared = ([Int64] -> Int64) -> m [Int64] -> m Int64
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int64] -> Int64
singleCount (m [Int64] -> m Int64)
-> (Query Int64 -> m [Int64]) -> Query Int64 -> m Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query Int64 -> m [Int64]
forall a. Query a -> m [a]
forall (m :: * -> *) a. MonadArbiter m => Query a -> m [a]
executeQueryPrepared

-- | Run a 'Query' and keep its first row.
queryMaybe :: (MonadArbiter m) => Query a -> m (Maybe a)
queryMaybe :: forall (m :: * -> *) a. MonadArbiter m => Query a -> m (Maybe a)
queryMaybe = ([a] -> Maybe a) -> m [a] -> m (Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe (m [a] -> m (Maybe a))
-> (Query a -> m [a]) -> Query a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query a -> m [a]
forall a. Query a -> m [a]
forall (m :: * -> *) a. MonadArbiter m => Query a -> m [a]
executeQuery

-- | Run a boolean 'Query'. The result is true when a row is true.
queryAny :: (MonadArbiter m) => Query Bool -> m Bool
queryAny :: forall (m :: * -> *). MonadArbiter m => Query Bool -> m Bool
queryAny = ([Bool] -> Bool) -> m [Bool] -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (m [Bool] -> m Bool)
-> (Query Bool -> m [Bool]) -> Query Bool -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query Bool -> m [Bool]
forall a. Query a -> m [a]
forall (m :: * -> *) a. MonadArbiter m => Query a -> m [a]
executeQuery

singleCount :: [Int64] -> Int64
singleCount :: [Int64] -> Int64
singleCount [Int64
count] = Int64
count
singleCount [Int64]
_ = Int64
0