{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- | INSERT fragments derived from a profunctor 'Codec'. The column list, the
-- placeholders, and the parameters all come from one value.
module Arbiter.Core.Sql.Insert
  ( insertFrag
  , batchFrag
  ) where

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

import Arbiter.Core.Codec (Codec, cArray, cColumns, cScalar)
import Arbiter.Core.Sql.QQ (sql)
import Arbiter.Core.Sql.Query (Query, param, sepBy)

-- | A single row: @(c1, c2, ...) VALUES (?, ?, ...)@ with one scalar parameter
-- per column, from 'cScalar'.
insertFrag :: Codec s a -> s -> Query ()
insertFrag :: forall s a. Codec s a -> s -> Query ()
insertFrag Codec s a
codec s
value =
  let columns :: Text
columns = Codec s a -> Text
forall s a. Codec s a -> Text
columnList Codec s a
codec
      values :: Query ()
values = Text -> [Query ()] -> Query ()
sepBy Text
", " ((SomeParam -> Query ()) -> [SomeParam] -> [Query ()]
forall a b. (a -> b) -> [a] -> [b]
map SomeParam -> Query ()
param (Codec s a -> s -> [SomeParam]
forall s a. Codec s a -> s -> [SomeParam]
cScalar Codec s a
codec s
value))
   in [sql|(${columns}) VALUES (${values})|]

-- | A batch source: @(c1, ...) SELECT c1, ... FROM (SELECT unnest(?::t1[]) AS c1,
-- ...) src@ with one array parameter per column, from 'cArray'.
batchFrag :: Codec s a -> [s] -> Query ()
batchFrag :: forall s a. Codec s a -> [s] -> Query ()
batchFrag Codec s a
codec [s]
rows =
  let columns :: Text
columns = Codec s a -> Text
forall s a. Codec s a -> Text
columnList Codec s a
codec
      unnested :: Query ()
unnested = Text -> [Query ()] -> Query ()
sepBy Text
", " (((Text, Text) -> SomeParam -> Query ())
-> [(Text, Text)] -> [SomeParam] -> [Query ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text, Text) -> SomeParam -> Query ()
forall {a} {a}.
(ToFragment a, ToFragment a) =>
(a, a) -> SomeParam -> Query ()
unnestCol (Codec s a -> [(Text, Text)]
forall s a. Codec s a -> [(Text, Text)]
cColumns Codec s a
codec) (Codec s a -> [s] -> [SomeParam]
forall s a. Codec s a -> [s] -> [SomeParam]
cArray Codec s a
codec [s]
rows))
   in [sql|(${columns}) SELECT ${columns} FROM (SELECT ${unnested}) src|]
  where
    unnestCol :: (a, a) -> SomeParam -> Query ()
unnestCol (a
name, a
sqlType) SomeParam
value =
      let arrayParam :: Query ()
arrayParam = SomeParam -> Query ()
param SomeParam
value
       in [sql|unnest(${arrayParam}::${sqlType}[]) AS ${name}|]

columnList :: Codec s a -> Text
columnList :: forall s a. Codec s a -> Text
columnList = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> (Codec s a -> [Text]) -> Codec s a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst ([(Text, Text)] -> [Text])
-> (Codec s a -> [(Text, Text)]) -> Codec s a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codec s a -> [(Text, Text)]
forall s a. Codec s a -> [(Text, Text)]
cColumns