{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Internal to the arbiter packages. Not covered by the PVP.
--
-- 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
  , RowEdit (..)
  , rowEdit
  , editJoin
  ) where

import Data.Text (Text)

import Arbiter.Core.Codec (Codec, cArray, cColumns, cScalar, joinColumns)
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
joinColumns ([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

-- | Columns a statement reads from a one-row source aliased @edit@ in place of its own.
data RowEdit = RowEdit
  { RowEdit -> [Text]
editColumns :: [Text]
  -- ^ The columns read from @edit@.
  , RowEdit -> Query ()
editSource :: Query ()
  -- ^ The one-row source, aliased @edit@.
  }

-- | A codec's written columns as a 'RowEdit': @(SELECT ?::t1 AS c1, ...) edit@.
rowEdit :: Codec s a -> s -> RowEdit
rowEdit :: forall s a. Codec s a -> s -> RowEdit
rowEdit Codec s a
codec s
value =
  let selected :: Query ()
selected = 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 ()
castAs (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]
cScalar Codec s a
codec s
value))
   in RowEdit {editColumns :: [Text]
editColumns = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Codec s a -> [(Text, Text)]
forall s a. Codec s a -> [(Text, Text)]
cColumns Codec s a
codec), editSource :: Query ()
editSource = [sql|(SELECT ${selected}) edit|]}
  where
    castAs :: (a, a) -> SomeParam -> Query ()
castAs (a
name, a
sqlType) SomeParam
columnValue =
      let hole :: Query ()
hole = SomeParam -> Query ()
param SomeParam
columnValue
       in [sql|${hole}::${sqlType} AS ${name}|]

-- | @CROSS JOIN@ an edit's source, or nothing without an edit.
editJoin :: Maybe RowEdit -> Query ()
editJoin :: Maybe RowEdit -> Query ()
editJoin = (RowEdit -> Query ()) -> Maybe RowEdit -> Query ()
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\RowEdit {editSource :: RowEdit -> Query ()
editSource = Query ()
source} -> [sql|CROSS JOIN ${source}|])