module Hasql.DynamicStatements.Statement where

import Hasql.Decoders qualified as Decoders
import Hasql.DynamicStatements.Prelude
import Hasql.DynamicStatements.Snippet.Defs qualified as SnippetDefs
import Hasql.Statement
import Ptr.ByteString qualified as ByteString
import Ptr.Poking qualified as Poking

-- |
-- Construct a statement dynamically, specifying the parameters in-place
-- in the declaration of snippet and providing a result decoder and
-- specifying whether the statement should be prepared.
--
-- The injection of the parameters is handled automatically,
-- generating parametric statements with binary encoders under the hood.
--
-- This is useful when the SQL of your statement depends on the parameters.
-- Here's an example:
--
-- @
-- selectSubstring :: Text -> Maybe Int32 -> Maybe Int32 -> 'Statement' () Text
-- selectSubstring string from to = let
--   snippet =
--     "select substring(" <> Snippet.'SnippetDefs.param' string <>
--     foldMap (mappend " from " . Snippet.'SnippetDefs.param') from <>
--     foldMap (mappend " for " . Snippet.'SnippetDefs.param') to <>
--     ")"
--   decoder = Decoders.'Decoders.singleRow' (Decoders.'Decoders.column' (Decoders.'Decoders.nonNullable' Decoders.'Decoders.text'))
--   in 'dynamicallyParameterized' snippet decoder True
-- @
--
-- Without the Snippet API you would have had to implement the same functionality thus:
--
-- @
-- selectSubstring' :: Text -> Maybe Int32 -> Maybe Int32 -> 'Statement' () Text
-- selectSubstring' string from to = let
--   sql = case (from, to) of
--     (Just _, Just _) -> "select substring($1 from $2 to $3)"
--     (Just _, Nothing) -> "select substring($1 from $2)"
--     (Nothing, Just _) -> "select substring($1 to $2)"
--     (Nothing, Nothing) -> "select substring($1)"
--   encoder =
--     Encoders.'Encoders.param' (string '>$' Encoders.'Encoders.text') <>
--     foldMap (\\ x -> Encoders.'Encoders.param' (x '>$' Encoders.'Encoders.int8')) from <>
--     foldMap (\\ x -> Encoders.'Encoders.param' (x '>$' Encoders.'Encoders.int8')) to
--   decoder = Decoders.'Decoders.singleRow' (Decoders.'Decoders.column' (Decoders.'Decoders.nonNullable' Decoders.'Decoders.text'))
--   in Statement sql encoder decoder True
-- @
--
-- As you can see, the Snippet API abstracts over placeholders and
-- matching encoder generation, thus also protecting you from all sorts of related bugs.
dynamicallyParameterized :: SnippetDefs.Snippet -> Decoders.Result result -> Bool -> Statement () result
dynamicallyParameterized :: forall result.
Snippet -> Result result -> Bool -> Statement () result
dynamicallyParameterized (SnippetDefs.Snippet Seq SnippetChunk
chunks) Result result
decoder Bool
prepared =
  let step :: (a, Poking, Params ()) -> SnippetChunk -> (a, Poking, Params ())
step (!a
paramId, !Poking
poking, !Params ()
encoder) = \case
        SnippetDefs.StringSnippetChunk ByteString
sql -> (a
paramId, Poking
poking Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> ByteString -> Poking
Poking.bytes ByteString
sql, Params ()
encoder)
        SnippetDefs.ParamSnippetChunk Params ()
paramEncoder ->
          let newParamId :: a
newParamId = a
paramId a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
              newPoking :: Poking
newPoking = Poking
poking Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
Poking.word8 Word8
36 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> a -> Poking
forall a. Integral a => a -> Poking
Poking.asciiIntegral a
paramId
              newEncoder :: Params ()
newEncoder = Params ()
encoder Params () -> Params () -> Params ()
forall a. Semigroup a => a -> a -> a
<> Params ()
paramEncoder
           in (a
newParamId, Poking
newPoking, Params ()
newEncoder)
   in case ((Integer, Poking, Params ())
 -> SnippetChunk -> (Integer, Poking, Params ()))
-> (Integer, Poking, Params ())
-> Seq SnippetChunk
-> (Integer, Poking, Params ())
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Integer, Poking, Params ())
-> SnippetChunk -> (Integer, Poking, Params ())
forall {a}.
Integral a =>
(a, Poking, Params ()) -> SnippetChunk -> (a, Poking, Params ())
step (Integer
1, Poking
forall a. Monoid a => a
mempty, Params ()
forall a. Monoid a => a
mempty) Seq SnippetChunk
chunks of
        (Integer
_, Poking
poking, Params ()
encoder) -> ByteString
-> Params () -> Result result -> Bool -> Statement () result
forall params result.
ByteString
-> Params params
-> Result result
-> Bool
-> Statement params result
Statement (Poking -> ByteString
ByteString.poking Poking
poking) Params ()
encoder Result result
decoder Bool
prepared