content: {-|
  Module: Squeal.PostgreSQL.Expression.Parameter
  Description: out-of-line parameters
  Copyright: (c) Eitan Chatav, 2019
  Maintainer: eitan@morphism.tech
  Stability: experimental
  
  out-of-line parameters
  -}
  
  {-# LANGUAGE
      AllowAmbiguousTypes
    , DataKinds
    , FlexibleContexts
    , FlexibleInstances
    , FunctionalDependencies
    , GADTs
    , KindSignatures
    , MultiParamTypeClasses
    , OverloadedStrings
    , RankNTypes
    , ScopedTypeVariables
    , TypeApplications
    , TypeFamilies
    , TypeOperators
    , UndecidableInstances
  #-}
  
  module Squeal.PostgreSQL.Expression.Parameter
    ( -- * Parameter
      HasParameter (parameter)
    , param
      -- * Parameter Internals
    , HasParameter'
    , ParamOutOfBoundsError
    , ParamTypeMismatchError
    ) where
  
  import Data.Kind (Constraint)
  import GHC.Exts (Any)
  import GHC.TypeLits
  
  import Squeal.PostgreSQL.Expression
  import Squeal.PostgreSQL.Expression.Type
  import Squeal.PostgreSQL.Render
  import Squeal.PostgreSQL.Type.Schema
  
  -- $setup
  -- >>> import Squeal.PostgreSQL
  
  {- | A `HasParameter` constraint is used to indicate a value that is
  supplied externally to a SQL statement.
  `Squeal.PostgreSQL.Session.manipulateParams`,
  `Squeal.PostgreSQL.Session.queryParams` and
  `Squeal.PostgreSQL.Session.traversePrepared` support specifying data values
  separately from the SQL command string, in which case `param`s are used to
  refer to the out-of-line data values.
  -}
  class KnownNat ix => HasParameter
    (ix :: Nat)
    (params :: [NullType])
    (ty :: NullType)
    | ix params -> ty where
      -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.
      --
      -- >>> printSQL (parameter @1 int4)
      -- ($1 :: int4)
      parameter
        :: TypeExpression db ty
        -> Expression grp lat with db params from ty
      parameter ty = UnsafeExpression $ parenthesized $
        "$" <> renderNat @ix <+> "::"
          <+> renderSQL ty
  
  -- we could do the check for 0 in @HasParameter'@, but this way forces checking 'ix' before delegating,
  -- which has the nice effect of ambiguous 'ix' errors mentioning 'HasParameter' instead of @HasParameter'@
  instance {-# OVERLAPS #-} (TypeError ('Text "Tried to get the param at index 0, but params are 1-indexed"), x ~ Any) => HasParameter 0 params x
  instance {-# OVERLAPS #-} (KnownNat ix, HasParameter' ix params ix params x) => HasParameter ix params x
  
  -- | @HasParameter'@ is an implementation detail of 'HasParameter' allowing us to
  -- include the full parameter list in our errors.
  class KnownNat ix => HasParameter'
    (originalIx :: Nat)
    (allParams :: [NullType])
    (ix :: Nat)
    (params :: [NullType])
    (ty :: NullType)
    | ix params -> ty where
  instance {-# OVERLAPS #-}
    ( params ~ (y ': xs)
    , y ~ x -- having a separate 'y' type variable is required for 'ParamTypeMismatchError'
    , ParamOutOfBoundsError originalIx allParams params
    , ParamTypeMismatchError originalIx allParams x y
    ) => HasParameter' originalIx allParams 1 params x
  instance {-# OVERLAPS #-}
    ( KnownNat ix
    , HasParameter' originalIx allParams (ix-1) xs x
    , params ~ (y ': xs)
    , ParamOutOfBoundsError originalIx allParams params
    )
    => HasParameter' originalIx allParams ix params x
  
  -- | @ParamOutOfBoundsError@ reports a nicer error with more context when we try to do an out-of-bounds lookup successfully do a lookup but
  -- find a different field than we expected, or when we find ourself out of bounds
  type family ParamOutOfBoundsError (originalIx :: Nat) (allParams :: [NullType]) (params :: [NullType]) :: Constraint where
    ParamOutOfBoundsError originalIx allParams '[] = TypeError
      ('Text "Index " ':<>: 'ShowType originalIx ':<>: 'Text " is out of bounds in 1-indexed parameter list:" ':$$: 'ShowType allParams)
    ParamOutOfBoundsError _ _ _ = ()
  
  -- | @ParamTypeMismatchError@ reports a nicer error with more context when we successfully do a lookup but
  -- find a different field than we expected, or when we find ourself out of bounds
  type family ParamTypeMismatchError  (originalIx :: Nat) (allParams :: [NullType]) (found :: NullType) (expected :: NullType) :: Constraint where
    ParamTypeMismatchError _ _ found found = ()
    ParamTypeMismatchError originalIx allParams found expected = TypeError
      (     'Text "Type mismatch when looking up param at index " ':<>: 'ShowType originalIx
      ':$$: 'Text "in 1-indexed parameter list:"
      ':$$: 'Text "  " ':<>: 'ShowType allParams
      ':$$: 'Text ""
      ':$$: 'Text "Expected: " ':<>: 'ShowType expected
      ':$$: 'Text "But found: " ':<>: 'ShowType found
      ':$$: 'Text ""
      )
  
  -- | `param` takes a `Nat` using type application and for basic types,
  -- infers a `TypeExpression`.
  --
  -- >>> printSQL (param @1 @('Null 'PGint4))
  -- ($1 :: int4)
  param
    :: forall n ty lat with db params from grp
     . (NullTyped db ty, HasParameter n params ty)
    => Expression grp lat with db params from ty -- ^ param
  param = parameter @n (nulltype @db)
  