Prepared.hs

{-# language AllowAmbiguousTypes #-}
{-# language BlockArguments #-}
{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}

module Rel8.Statement.Prepared (
  input,
  prepared,
) where

-- base
import Data.Functor.Const (Const (Const), getConst)
import Data.Functor.Contravariant (contramap, (>$<))
import Data.Functor.Identity (runIdentity)
import Prelude

-- hasql
import qualified Hasql.Encoders as Hasql
import qualified Hasql.Statement as Hasql

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

-- rel8
import Rel8.Expr (Expr)
import Rel8.Expr.Opaleye (fromPrimExpr, scastExpr)
import Rel8.Schema.HTable (hfield, hspecs, htabulateA)
import Rel8.Schema.Null (Nullity (Null, NotNull))
import Rel8.Schema.Spec (Spec (..))
import Rel8.Statement (Statement)
import Rel8.Table (Table, fromColumns, toResult)
import Rel8.Table.Serialize (Serializable)
import Rel8.Type.Encoder (binary)
import Rel8.Type.Information (encode)

-- transformers
import Control.Monad.Trans.State.Strict (evalState, state)


{-| Given a 'Rel8.run' function that converts a 'Statement' to a
'Hasql.Statement', return a 'Rel8.run'-like function which instead takes a
/parameterized/ 'Statement' and converts it to a /preparable/
'Hasql.Statement'.

The parameters @i@ are sent to the database directly via PostgreSQL's binary
format. For large amounts of data this can be significantly more efficient
than embedding the values in the statement with 'Rel8.lit'.
-}
prepared :: forall a b i o.
  Serializable a i =>
  (Statement b -> Hasql.Statement () o) ->
  (a -> Statement b) ->
  Hasql.Statement i o
prepared run mkStatement = Hasql.Statement sql (encoder @a) decode True
  where
    Hasql.Statement sql _ decode _ = run $ mkStatement input


encoder :: forall a i. Serializable a i => Hasql.Params i
encoder =
  contramap (toResult @_ @a) $
    getConst $
      htabulateA \field ->
        case hfield hspecs field of
          Spec {nullity, info} -> Const $
            runIdentity . (`hfield` field) >$<
              case nullity of
                Null -> Hasql.param $ Hasql.nullable build
                NotNull -> Hasql.param $ Hasql.nonNullable build
              where
                build = binary (encode info)


input :: Table Expr a => a
input =
  fromColumns $
    flip (evalState @Word) 1 do
      htabulateA \field -> do
        n <- state (\n -> (n, n + 1))
        pure
          case hfield hspecs field of
            Spec {info} ->
              scastExpr info $ fromPrimExpr $
                Opaleye.ConstExpr $ Opaleye.OtherLit $ '$' : show n