{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

-- | A SQL query bundling its text, its positional parameters, and its row
-- decoder in one value. Built by the @sql@
-- quasiquoter in "Arbiter.Core.Sql.QQ". The parameters and decoder use the
-- same 'Arbiter.Core.Codec.Col'-driven vocabulary as the profunctor codec in
-- "Arbiter.Core.Codec".
module Arbiter.Core.Sql.Query
  ( Query (..)
  , raw
  , param
  , rows
  , rawRows
  , sepBy
  , mwhen
  , numberPlaceholders
  , ToFragment (..)
  ) where

import Data.Text (Text)
import Data.Text qualified as T

import Arbiter.Core.Codec (Params, RowCodec, SomeParam)

-- | A parameterized query paired with the decoder for its result rows.
data Query a = Query
  { forall a. Query a -> Text
qSql :: !Text
  -- ^ SQL text with @?@ placeholders, one per entry of 'qParams'.
  , forall a. Query a -> Params
qParams :: Params
  -- ^ Positional parameters, in placeholder order.
  , forall a. Query a -> RowCodec a
qDecode :: RowCodec a
  -- ^ Decoder for the result rows.
  }

instance Functor Query where
  fmap :: forall a b. (a -> b) -> Query a -> Query b
fmap a -> b
fn (Query Text
text Params
params RowCodec a
decoder) = Text -> Params -> RowCodec b -> Query b
forall a. Text -> Params -> RowCodec a -> Query a
Query Text
text Params
params ((a -> b) -> RowCodec a -> RowCodec b
forall a b. (a -> b) -> Ap NullCol a -> Ap NullCol b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn RowCodec a
decoder)

-- | Concatenation is defined for @Query ()@, a fragment with text and parameters and no output columns.
instance Semigroup (Query ()) where
  Query Text
text1 Params
params1 RowCodec ()
_ <> :: Query () -> Query () -> Query ()
<> Query Text
text2 Params
params2 RowCodec ()
_ = Text -> Params -> RowCodec () -> Query ()
forall a. Text -> Params -> RowCodec a -> Query a
Query (Text
text1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text2) (Params
params1 Params -> Params -> Params
forall a. Semigroup a => a -> a -> a
<> Params
params2) (() -> RowCodec ()
forall a. a -> Ap NullCol a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Monoid (Query ()) where
  mempty :: Query ()
mempty = Text -> Params -> RowCodec () -> Query ()
forall a. Text -> Params -> RowCodec a -> Query a
Query Text
"" [] (() -> RowCodec ()
forall a. a -> Ap NullCol a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  mconcat :: [Query ()] -> Query ()
mconcat [Query ()]
queries = Text -> Params -> RowCodec () -> Query ()
forall a. Text -> Params -> RowCodec a -> Query a
Query ([Text] -> Text
T.concat ((Query () -> Text) -> [Query ()] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Query () -> Text
forall a. Query a -> Text
qSql [Query ()]
queries)) ((Query () -> Params) -> [Query ()] -> Params
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Query () -> Params
forall a. Query a -> Params
qParams [Query ()]
queries) (() -> RowCodec ()
forall a. a -> Ap NullCol a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Literal SQL with no parameters (table names, static clauses).
raw :: Text -> Query ()
raw :: Text -> Query ()
raw Text
text = Text -> Params -> RowCodec () -> Query ()
forall a. Text -> Params -> RowCodec a -> Query a
Query Text
text [] (() -> RowCodec ()
forall a. a -> Ap NullCol a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | One @?@ placeholder bound to a single parameter.
param :: SomeParam -> Query ()
param :: SomeParam -> Query ()
param SomeParam
value = Text -> Params -> RowCodec () -> Query ()
forall a. Text -> Params -> RowCodec a -> Query a
Query Text
"?" [SomeParam
value] (() -> RowCodec ()
forall a. a -> Ap NullCol a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Rewrite the @?@ placeholders in a query's text to PostgreSQL positional
-- placeholders (@$1@, @$2@, ...) for libpq-based backends. The Nth @?@ maps to
-- the Nth entry of 'qParams'.
numberPlaceholders :: Text -> Text
numberPlaceholders :: Text -> Text
numberPlaceholders Text
text =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"?" Text
text of
    [] -> Text
""
    (Text
first : [Text]
rest) ->
      Text
first Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ((Int -> Text -> Text) -> [Int] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
index Text
part -> Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int
index :: Int)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
part) [Int
1 ..] [Text]
rest)

-- | Attach a handwritten row decoder to a parameterized fragment.
rows :: RowCodec a -> Query () -> Query a
rows :: forall a. RowCodec a -> Query () -> Query a
rows RowCodec a
decoder (Query Text
text Params
params RowCodec ()
_) = Text -> Params -> RowCodec a -> Query a
forall a. Text -> Params -> RowCodec a -> Query a
Query Text
text Params
params RowCodec a
decoder

-- | Attach a decoder to literal, parameter-free SQL rendered as plain 'Text'.
rawRows :: RowCodec a -> Text -> Query a
rawRows :: forall a. RowCodec a -> Text -> Query a
rawRows RowCodec a
decoder = RowCodec a -> Query () -> Query a
forall a. RowCodec a -> Query () -> Query a
rows RowCodec a
decoder (Query () -> Query a) -> (Text -> Query ()) -> Text -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Query ()
raw

-- | Join fragments with a separator, concatenating their text and parameters
-- in order. Used for @WHERE ... AND ...@ and runtime-sized @VALUES@ lists.
sepBy :: Text -> [Query ()] -> Query ()
sepBy :: Text -> [Query ()] -> Query ()
sepBy Text
sep [Query ()]
queries =
  Text -> Params -> RowCodec () -> Query ()
forall a. Text -> Params -> RowCodec a -> Query a
Query
    (Text -> [Text] -> Text
T.intercalate Text
sep ((Query () -> Text) -> [Query ()] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Query () -> Text
forall a. Query a -> Text
qSql [Query ()]
queries))
    ((Query () -> Params) -> [Query ()] -> Params
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Query () -> Params
forall a. Query a -> Params
qParams [Query ()]
queries)
    (() -> RowCodec ()
forall a. a -> Ap NullCol a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | The fragment under a true flag. @mempty@ under a false one.
mwhen :: (Monoid m) => Bool -> m -> m
mwhen :: forall m. Monoid m => Bool -> m -> m
mwhen Bool
True m
fragment = m
fragment
mwhen Bool
False m
_ = m
forall a. Monoid a => a
mempty

-- | Values a @${...}@ splice accepts: raw 'Text' (a bare clause or table name)
-- or a 'Query' fragment (whose parameters interleave at the splice site).
class ToFragment a where
  toFragment :: a -> Query ()

instance ToFragment Text where
  toFragment :: Text -> Query ()
toFragment = Text -> Query ()
raw

instance ToFragment (Query ()) where
  toFragment :: Query () -> Query ()
toFragment = Query () -> Query ()
forall a. a -> a
id