content: {-# language FlexibleContexts #-}
  {-# language FlexibleInstances #-}
  {-# language MultiParamTypeClasses #-}
  {-# language RecordWildCards #-}
  {-# language StandaloneKindSignatures #-}
  {-# language TypeFamilies #-}
  {-# language TypeOperators #-}
  {-# language UndecidableInstances #-}
  
  module Rel8.Expr.Function
    ( Arguments
    , function
    , primFunction
    , rawFunction
    , binaryOperator
    , rawBinaryOperator
    )
  where
  
  -- base
  import Data.Kind ( Constraint, Type )
  import Prelude
  
  -- opaleye
  import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
  
  -- rel8
  import {-# SOURCE #-} Rel8.Expr (Expr)
  import Rel8.Expr.Opaleye
    ( castExpr
    , fromPrimExpr, toPrimExpr, zipPrimExprsWith
    )
  import Rel8.Schema.HTable (hfoldMap)
  import Rel8.Schema.Null ( Sql )
  import Rel8.Schema.QualifiedName
    ( QualifiedName (..)
    , showQualifiedName
    , showQualifiedOperator
    
    )
  import Rel8.Table (Table, toColumns)
  import Rel8.Type ( DBType )
  
  
  -- | This type class is basically @'Table' 'Expr'@, where each column of the
  -- 'Table' is an argument to the function, but it also has an additional
  -- instance for @()@ for calling functions with no arguments.
  type Arguments :: Type -> Constraint
  class Arguments a where
    arguments :: a -> [Opaleye.PrimExpr]
  
  
  instance Table Expr a => Arguments a where
    arguments = hfoldMap (pure . toPrimExpr) . toColumns
  
  
  instance {-# OVERLAPS #-} Arguments () where
    arguments _ = []
  
  
  -- | @'function' name arguments@ runs the PostgreSQL function @name@ with
  -- the arguments @arguments@ returning an @'Expr' a@.
  function :: (Arguments arguments, Sql DBType a)
    => QualifiedName -> arguments -> Expr a
  function qualified = castExpr . rawFunction qualified
  
  
  -- | A less safe version of 'function' that does not wrap the return value in
  -- a cast.
  rawFunction :: Arguments arguments => QualifiedName -> arguments -> Expr a
  rawFunction qualified = fromPrimExpr . primFunction qualified
  
  
  primFunction :: Arguments arguments
    => QualifiedName -> arguments -> Opaleye.PrimExpr
  primFunction qualified = Opaleye.FunExpr name . arguments
    where
      name = showQualifiedName qualified
  
  
  -- | Construct an expression by applying an infix binary operator to two
  -- operands.
  binaryOperator :: Sql DBType c => QualifiedName -> Expr a -> Expr b -> Expr c
  binaryOperator operator a b = castExpr $ rawBinaryOperator operator a b
  
  
  -- | A less safe version of 'binaryOperator' that does not wrap the return
  -- value in a cast.
  rawBinaryOperator :: QualifiedName -> Expr a -> Expr b -> Expr c
  rawBinaryOperator operator a b =
    zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther name)) a b
    where
      name = showQualifiedOperator operator
  