module Hasql.DynamicStatements.Snippet.Defs where

import Hasql.DynamicStatements.Prelude
import qualified Hasql.Encoders as Encoders
import qualified Hasql.Implicits.Encoders as Encoders

-- |
-- Composable SQL snippet with parameters injected.
-- Abstracts over placeholders and matching of encoders.
--
-- It has an instance of `IsString`, so having the @OverloadedStrings@ extension enabled
-- you can construct it directly from string literals.
--
-- Here's an example:
--
-- @
-- selectSubstring :: Text -> Maybe Int32 -> Maybe Int32 -> 'Snippet'
-- selectSubstring string from to =
--   "select substring(" <> 'param' string <>
--   'foldMap' (\\ x -> " from " <> 'param' x) from <>
--   'foldMap' (\\ x -> " for " <> 'param' x) to <>
--   ")"
-- @
--
-- Having a decoder you can lift it into 'Hasql.Statement.Statement' using
-- 'Hasql.DynamicStatements.Statement.dynamicallyParameterized' or directly execute it in
-- 'Hasql.Session.Session' using
-- 'Hasql.DynamicStatements.Session.dynamicallyParameterizedStatement'.
newtype Snippet = Snippet (Seq SnippetChunk)

data SnippetChunk
  = StringSnippetChunk ByteString
  | ParamSnippetChunk (Encoders.Params ())

deriving instance Semigroup Snippet

deriving instance Monoid Snippet

instance IsString Snippet where
  fromString :: String -> Snippet
fromString String
x = Seq SnippetChunk -> Snippet
Snippet (SnippetChunk -> Seq SnippetChunk
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> SnippetChunk
StringSnippetChunk (String -> ByteString
forall a. IsString a => String -> a
fromString String
x)))

-- |
-- SQL chunk in ASCII.
sql :: ByteString -> Snippet
sql :: ByteString -> Snippet
sql ByteString
x = Seq SnippetChunk -> Snippet
Snippet (SnippetChunk -> Seq SnippetChunk
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> SnippetChunk
StringSnippetChunk ByteString
x))

-- |
-- Parameter encoded using an implicitly derived encoder from the type.
param :: (Encoders.DefaultParamEncoder param) => param -> Snippet
param :: forall param. DefaultParamEncoder param => param -> Snippet
param = NullableOrNot Value param -> param -> Snippet
forall param. NullableOrNot Value param -> param -> Snippet
encoderAndParam NullableOrNot Value param
forall a. DefaultParamEncoder a => NullableOrNot Value a
Encoders.defaultParam

-- |
-- Parameter with an explicitly defined encoder.
encoderAndParam :: Encoders.NullableOrNot Encoders.Value param -> param -> Snippet
encoderAndParam :: forall param. NullableOrNot Value param -> param -> Snippet
encoderAndParam NullableOrNot Value param
encoder param
param = Seq SnippetChunk -> Snippet
Snippet (SnippetChunk -> Seq SnippetChunk
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Params () -> SnippetChunk
ParamSnippetChunk (param
param param -> Params param -> Params ()
forall b a. b -> Params b -> Params a
forall (f :: * -> *) b a. Contravariant f => b -> f b -> f a
>$ NullableOrNot Value param -> Params param
forall a. NullableOrNot Value a -> Params a
Encoders.param NullableOrNot Value param
encoder)))