{-# language DeriveFunctor #-}
{-# language DerivingVia #-}
{-# language FlexibleContexts #-}
{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}
{-# language RankNTypes #-}
{-# language RecordWildCards #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}

module Rel8.Statement
  ( Statement
  , statementReturning
  , statementNoReturning
  , ppDecodeStatement
  )
where

-- base
import Control.Applicative (liftA2)
import Control.Monad (ap, liftM2)
import Data.Foldable (fold, toList)
import Data.Int (Int64)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty, intersperse)
import Data.Monoid (Endo (Endo))
import Data.String (fromString)
import Prelude

-- hasql
import qualified Hasql.Decoders as Hasql

-- opaleye
import qualified Opaleye.Internal.Tag as Opaleye

-- pretty
import Text.PrettyPrint
  ( Doc
  , (<+>)
  , ($$)
  , comma
  , hcat
  , parens
  , punctuate
  , text
  , vcat
  )

-- rel8
import Rel8.Expr (Expr)
import Rel8.Expr.Bool (false)
import Rel8.Query (Query)
import Rel8.Query.Aggregate (countRows)
import Rel8.Query.Each (each)
import Rel8.Schema.Escape (escape)
import Rel8.Schema.Table (TableSchema (..))
import Rel8.Statement.Rows (Rows (..))
import Rel8.Table (Table)
import Rel8.Table.Cols (fromCols)
import Rel8.Table.Name (namesFromLabelsWithA, showNames)
import Rel8.Table.Serialize (parse)

-- semigroupoids
import Data.Functor.Apply (Apply, WrappedApplicative (..))
import Data.Functor.Bind (Bind, (>>-))

-- transformers
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict (State, evalState)
import Control.Monad.Trans.Writer.CPS (WriterT, runWriterT, tell)


type Binding :: Type
data Binding = Binding
  { Binding -> String
relation :: !String
  , Binding -> Maybe (NonEmpty String)
columns :: !(Maybe (NonEmpty String))
  , Binding -> Doc
doc :: !Doc
  , Binding -> Returning
returning :: !Returning
  }


type Result :: Type -> Type
data Result a = Unmodified !a | Modified !a


instance Functor Result where
  fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f = \case
    Unmodified a
a -> b -> Result b
forall a. a -> Result a
Modified (a -> b
f a
a)
    Modified a
a -> b -> Result b
forall a. a -> Result a
Modified (a -> b
f a
a)


getResult :: Result a -> a
getResult :: forall a. Result a -> a
getResult = \case
  Unmodified a
a -> a
a
  Modified a
a -> a
a


type Returning :: Type
data Returning where
  NoReturning :: Returning
  Returning :: Query (Expr Int64) -> Returning 


-- | 'Statement' represents a single PostgreSQL statement. Most commonly,
-- this is constructed using 'Rel8.select', 'Rel8.insert', 'Rel8.update'
-- or 'Rel8.delete'.
--
-- However, in addition to @SELECT@, @INSERT@, @UPDATE@ and @DELETE@,
-- PostgreSQL also supports compositions thereof via its statement-level
-- @WITH@ syntax (with some caveats). Each such \"sub-statement\" can
-- reference the results of previous sub-statements. 'Statement' provides a
-- 'Monad' instance that captures this \"binding\" pattern.
--
-- The caveat with this is that the [side-effects of these sub-statements
-- are not visible to other sub-statements](https://www.postgresql.org/docs/current/queries-with.html#QUERIES-WITH-MODIFYING);
-- only the explicit results of previous sub-statements (from @SELECT@s or
-- @RETURNING@ clauses) are visible. So, for example, an @INSERT@ into a table
-- followed immediately by a @SELECT@ therefrom will not return the inserted
-- rows. However, it is possible to return the inserted rows using
-- @RETURNING@, 'Rel8.unionAll'ing this with the result of a @SELECT@
-- from the same table will produce the desired result.
--
-- An example of where this can be useful is if you want to delete rows from
-- a table and simultaneously log their deletion in a log table.
--
-- @
-- deleteFoo :: (Foo Expr -> Expr Bool) -> Statement ()
-- deleteFoo predicate = do
--   foos <-
--     delete Delete
--       { from = fooSchema
--       , using = pure ()
--       , deleteWhere = \_ -> predicate
--       , returning = Returning id
--       }
--   insert Insert
--     { into = deletedFooSchema
--     , rows = do
--         Foo {..} <- foos
--         let
--           deletedAt = 'Rel8.Expr.Time.now'
--         pure DeletedFoo {..}
--     , onConflict = Abort
--     , returning = NoReturning
--     }
-- @
newtype Statement a =
  Statement (WriterT (Endo [Binding]) (State Opaleye.Tag) (Result a))
  deriving stock ((forall a b. (a -> b) -> Statement a -> Statement b)
-> (forall a b. a -> Statement b -> Statement a)
-> Functor Statement
forall a b. a -> Statement b -> Statement a
forall a b. (a -> b) -> Statement a -> Statement b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Statement a -> Statement b
fmap :: forall a b. (a -> b) -> Statement a -> Statement b
$c<$ :: forall a b. a -> Statement b -> Statement a
<$ :: forall a b. a -> Statement b -> Statement a
Functor)
  deriving (Functor Statement
Functor Statement =>
(forall a b. Statement (a -> b) -> Statement a -> Statement b)
-> (forall a b. Statement a -> Statement b -> Statement b)
-> (forall a b. Statement a -> Statement b -> Statement a)
-> (forall a b c.
    (a -> b -> c) -> Statement a -> Statement b -> Statement c)
-> Apply Statement
forall a b. Statement a -> Statement b -> Statement a
forall a b. Statement a -> Statement b -> Statement b
forall a b. Statement (a -> b) -> Statement a -> Statement b
forall a b c.
(a -> b -> c) -> Statement a -> Statement b -> Statement c
forall (f :: * -> *).
Functor f =>
(forall a b. f (a -> b) -> f a -> f b)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> Apply f
$c<.> :: forall a b. Statement (a -> b) -> Statement a -> Statement b
<.> :: forall a b. Statement (a -> b) -> Statement a -> Statement b
$c.> :: forall a b. Statement a -> Statement b -> Statement b
.> :: forall a b. Statement a -> Statement b -> Statement b
$c<. :: forall a b. Statement a -> Statement b -> Statement a
<. :: forall a b. Statement a -> Statement b -> Statement a
$cliftF2 :: forall a b c.
(a -> b -> c) -> Statement a -> Statement b -> Statement c
liftF2 :: forall a b c.
(a -> b -> c) -> Statement a -> Statement b -> Statement c
Apply) via WrappedApplicative Statement


instance Applicative Statement where
  pure :: forall a. a -> Statement a
pure = WriterT (Endo [Binding]) (State Tag) (Result a) -> Statement a
forall a.
WriterT (Endo [Binding]) (State Tag) (Result a) -> Statement a
Statement (WriterT (Endo [Binding]) (State Tag) (Result a) -> Statement a)
-> (a -> WriterT (Endo [Binding]) (State Tag) (Result a))
-> a
-> Statement a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a -> WriterT (Endo [Binding]) (State Tag) (Result a)
forall a. a -> WriterT (Endo [Binding]) (State Tag) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result a -> WriterT (Endo [Binding]) (State Tag) (Result a))
-> (a -> Result a)
-> a
-> WriterT (Endo [Binding]) (State Tag) (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result a
forall a. a -> Result a
Modified
  <*> :: forall a b. Statement (a -> b) -> Statement a -> Statement b
(<*>) = Statement (a -> b) -> Statement a -> Statement b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  liftA2 :: forall a b c.
(a -> b -> c) -> Statement a -> Statement b -> Statement c
liftA2 = (a -> b -> c) -> Statement a -> Statement b -> Statement c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2


instance Bind Statement where
  Statement WriterT (Endo [Binding]) (State Tag) (Result a)
m >>- :: forall a b. Statement a -> (a -> Statement b) -> Statement b
>>- a -> Statement b
f = WriterT (Endo [Binding]) (State Tag) (Result b) -> Statement b
forall a.
WriterT (Endo [Binding]) (State Tag) (Result a) -> Statement a
Statement (WriterT (Endo [Binding]) (State Tag) (Result b) -> Statement b)
-> WriterT (Endo [Binding]) (State Tag) (Result b) -> Statement b
forall a b. (a -> b) -> a -> b
$ do
    Result a
result <- WriterT (Endo [Binding]) (State Tag) (Result a)
m
    case a -> Statement b
f (Result a -> a
forall a. Result a -> a
getResult Result a
result) of
      Statement WriterT (Endo [Binding]) (State Tag) (Result b)
m' -> WriterT (Endo [Binding]) (State Tag) (Result b)
m'


instance Monad Statement where
  >>= :: forall a b. Statement a -> (a -> Statement b) -> Statement b
(>>=) = Statement a -> (a -> Statement b) -> Statement b
forall a b. Statement a -> (a -> Statement b) -> Statement b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)


statementNoReturning :: State Opaleye.Tag Doc -> Statement ()
statementNoReturning :: State Tag Doc -> Statement ()
statementNoReturning State Tag Doc
pp = WriterT (Endo [Binding]) (State Tag) (Result ()) -> Statement ()
forall a.
WriterT (Endo [Binding]) (State Tag) (Result a) -> Statement a
Statement (WriterT (Endo [Binding]) (State Tag) (Result ()) -> Statement ())
-> WriterT (Endo [Binding]) (State Tag) (Result ()) -> Statement ()
forall a b. (a -> b) -> a -> b
$ do
  Binding
binding <- State Tag Binding -> WriterT (Endo [Binding]) (State Tag) Binding
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (Endo [Binding]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State Tag Binding -> WriterT (Endo [Binding]) (State Tag) Binding)
-> State Tag Binding
-> WriterT (Endo [Binding]) (State Tag) Binding
forall a b. (a -> b) -> a -> b
$ do
    Doc
doc <- State Tag Doc
pp
    Tag
tag <- State Tag Tag
Opaleye.fresh
    let
      relation :: String
relation = Tag -> String -> String
Opaleye.tagWith Tag
tag String
"statement"
      columns :: Maybe a
columns = Maybe a
forall a. Maybe a
Nothing
      returning :: Returning
returning = Returning
NoReturning
      binding :: Binding
binding = Binding {String
Maybe (NonEmpty String)
Doc
Returning
forall a. Maybe a
relation :: String
columns :: Maybe (NonEmpty String)
doc :: Doc
returning :: Returning
doc :: Doc
relation :: String
columns :: forall a. Maybe a
returning :: Returning
..}
    Binding -> State Tag Binding
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Binding
binding
  Endo [Binding] -> WriterT (Endo [Binding]) (State Tag) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (([Binding] -> [Binding]) -> Endo [Binding]
forall a. (a -> a) -> Endo a
Endo (Binding
binding Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
:))
  Result () -> WriterT (Endo [Binding]) (State Tag) (Result ())
forall a. a -> WriterT (Endo [Binding]) (State Tag) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result () -> WriterT (Endo [Binding]) (State Tag) (Result ()))
-> Result () -> WriterT (Endo [Binding]) (State Tag) (Result ())
forall a b. (a -> b) -> a -> b
$ () -> Result ()
forall a. a -> Result a
Unmodified ()


statementReturning :: Table Expr a 
  => State Opaleye.Tag Doc -> Statement (Query a)
statementReturning :: forall a. Table Expr a => State Tag Doc -> Statement (Query a)
statementReturning State Tag Doc
pp = WriterT (Endo [Binding]) (State Tag) (Result (Query a))
-> Statement (Query a)
forall a.
WriterT (Endo [Binding]) (State Tag) (Result a) -> Statement a
Statement (WriterT (Endo [Binding]) (State Tag) (Result (Query a))
 -> Statement (Query a))
-> WriterT (Endo [Binding]) (State Tag) (Result (Query a))
-> Statement (Query a)
forall a b. (a -> b) -> a -> b
$ do
  (Binding
binding, Query a
query) <- State Tag (Binding, Query a)
-> WriterT (Endo [Binding]) (State Tag) (Binding, Query a)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (Endo [Binding]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State Tag (Binding, Query a)
 -> WriterT (Endo [Binding]) (State Tag) (Binding, Query a))
-> State Tag (Binding, Query a)
-> WriterT (Endo [Binding]) (State Tag) (Binding, Query a)
forall a b. (a -> b) -> a -> b
$ do
    Doc
doc <- State Tag Doc
pp
    Tag
tag <- State Tag Tag
Opaleye.fresh
    let
      relation :: String
relation = Tag -> String -> String
Opaleye.tagWith Tag
tag String
"statement"
      symbol :: NonEmpty String -> StateT Tag Identity String
symbol NonEmpty String
labels = do
        Tag
subtag <- State Tag Tag
Opaleye.fresh
        let
          suffix :: String
suffix = Tag -> String -> String
Opaleye.tagWith Tag
tag (Tag -> String -> String
Opaleye.tagWith Tag
subtag String
"")
        String -> StateT Tag Identity String
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> StateT Tag Identity String)
-> String -> StateT Tag Identity String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
suffix) String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
        where
          label :: String
label = NonEmpty String -> String
forall m. Monoid m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (String -> NonEmpty String -> NonEmpty String
forall a. a -> NonEmpty a -> NonEmpty a
intersperse String
"/" NonEmpty String
labels)
      names :: Cols Name (Columns a)
names = (NonEmpty String -> StateT Tag Identity String)
-> StateT Tag Identity (Cols Name (Columns a))
forall (f :: * -> *) a.
(Apply f, Table Name a) =>
(NonEmpty String -> f String) -> f a
namesFromLabelsWithA NonEmpty String -> StateT Tag Identity String
symbol StateT Tag Identity (Cols Name (Columns a))
-> Tag -> Cols Name (Columns a)
forall s a. State s a -> s -> a
`evalState` Tag
Opaleye.start
      columns :: Maybe (NonEmpty String)
columns = NonEmpty String -> Maybe (NonEmpty String)
forall a. a -> Maybe a
Just (NonEmpty String -> Maybe (NonEmpty String))
-> NonEmpty String -> Maybe (NonEmpty String)
forall a b. (a -> b) -> a -> b
$ Cols Name (Columns a) -> NonEmpty String
forall a. Table Name a => a -> NonEmpty String
showNames Cols Name (Columns a)
names
      query :: Query a
query =
        Cols Expr (Columns a) -> a
forall (context :: * -> *) a.
Table context a =>
Cols context (Columns a) -> a
fromCols (Cols Expr (Columns a) -> a)
-> Query (Cols Expr (Columns a)) -> Query a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableSchema (Cols Name (Columns a))
-> Query (Cols Expr (Columns a))
forall names exprs.
Selects names exprs =>
TableSchema names -> Query exprs
each
          TableSchema
            { $sel:name:TableSchema :: QualifiedName
name = String -> QualifiedName
forall a. IsString a => String -> a
fromString String
relation
            , $sel:columns:TableSchema :: Cols Name (Columns a)
columns = Cols Name (Columns a)
names
            }
      returning :: Returning
returning = Query (Expr Int64) -> Returning
Returning (Query a -> Query (Expr Int64)
forall a. Query a -> Query (Expr Int64)
countRows Query a
query)
      binding :: Binding
binding = Binding {String
Maybe (NonEmpty String)
Doc
Returning
relation :: String
columns :: Maybe (NonEmpty String)
doc :: Doc
returning :: Returning
doc :: Doc
relation :: String
columns :: Maybe (NonEmpty String)
returning :: Returning
..}
    (Binding, Query a) -> State Tag (Binding, Query a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Binding
binding, Query a
query)
  Endo [Binding] -> WriterT (Endo [Binding]) (State Tag) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (([Binding] -> [Binding]) -> Endo [Binding]
forall a. (a -> a) -> Endo a
Endo (Binding
binding Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
:))
  Result (Query a)
-> WriterT (Endo [Binding]) (State Tag) (Result (Query a))
forall a. a -> WriterT (Endo [Binding]) (State Tag) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (Query a)
 -> WriterT (Endo [Binding]) (State Tag) (Result (Query a)))
-> Result (Query a)
-> WriterT (Endo [Binding]) (State Tag) (Result (Query a))
forall a b. (a -> b) -> a -> b
$ Query a -> Result (Query a)
forall a. a -> Result a
Unmodified Query a
query


ppDecodeStatement :: ()
  => (forall x. Table Expr x => Query x -> State Opaleye.Tag Doc)
  -> Rows exprs a -> Statement exprs -> (Doc, Hasql.Result a)
ppDecodeStatement :: forall exprs a.
(forall x. Table Expr x => Query x -> State Tag Doc)
-> Rows exprs a -> Statement exprs -> (Doc, Result a)
ppDecodeStatement forall x. Table Expr x => Query x -> State Tag Doc
ppSelect Rows exprs a
rows (Statement WriterT (Endo [Binding]) (State Tag) (Result exprs)
m) = State Tag (Doc, Result a) -> Tag -> (Doc, Result a)
forall s a. State s a -> s -> a
evalState State Tag (Doc, Result a)
go Tag
Opaleye.start
  where
    go :: State Tag (Doc, Result a)
go = do
      (Result exprs
result, Endo [Binding] -> [Binding]
dlist) <- WriterT (Endo [Binding]) (State Tag) (Result exprs)
-> State Tag (Result exprs, Endo [Binding])
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT WriterT (Endo [Binding]) (State Tag) (Result exprs)
m
      let
        bindings' :: [Binding]
bindings' = [Binding] -> [Binding]
dlist []
      case [Binding] -> Maybe ([Binding], Binding)
forall a. [a] -> Maybe ([a], a)
unsnoc [Binding]
bindings' of
        Maybe ([Binding], Binding)
Nothing -> case Rows exprs a
rows of
          Rows exprs a
Void -> do
            Doc
doc <- Query (Expr Bool) -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect (Expr Bool -> Query (Expr Bool)
forall a. a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Bool
false)
            (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Result ()
Hasql.noResult)
          Rows exprs a
RowsAffected -> do
            Doc
doc <- Query (Expr Bool) -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect (Expr Bool -> Query (Expr Bool)
forall a. a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Bool
false)
            (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Int64
0 Int64 -> Result () -> Result Int64
forall a b. a -> Result b -> Result a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Result ()
Hasql.noResult)
          Single @exprs @a -> do
            Doc
doc <- Query exprs -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect (Result (Query exprs) -> Query exprs
forall a. Result a -> a
getResult Result exprs
Result (Query exprs)
result)
            (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result a
forall a. Row a -> Result a
Hasql.singleRow (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
          Maybe @exprs @a -> do
            Doc
doc <- Query exprs -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect (Result (Query exprs) -> Query exprs
forall a. Result a -> a
getResult Result exprs
Result (Query exprs)
result)
            (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result (Maybe a)
forall a. Row a -> Result (Maybe a)
Hasql.rowMaybe (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
          List @exprs @a -> do
            Doc
doc <- Query exprs -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect (Result (Query exprs) -> Query exprs
forall a. Result a -> a
getResult Result exprs
Result (Query exprs)
result)
            (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result [a]
forall a. Row a -> Result [a]
Hasql.rowList (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
          Vector @exprs @a -> do
            Doc
doc <- Query exprs -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect (Result (Query exprs) -> Query exprs
forall a. Result a -> a
getResult Result exprs
Result (Query exprs)
result)
            (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result (Vector a)
forall a. Row a -> Result (Vector a)
Hasql.rowVector (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
        Just ([Binding]
bindings, binding :: Binding
binding@Binding {doc :: Binding -> Doc
doc = Doc
after}) -> case Rows exprs a
rows of
          Rows exprs a
Void -> (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Result ()
Hasql.noResult)
            where
              doc :: Doc
doc = [Binding] -> Doc -> Doc
ppWith [Binding]
bindings Doc
after
          Rows exprs a
RowsAffected -> do
            case Result exprs
result of
              Unmodified exprs
_ -> (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Result Int64
Hasql.rowsAffected)
                where
                  doc :: Doc
doc = [Binding] -> Doc -> Doc
ppWith [Binding]
bindings Doc
after
              Modified exprs
_ -> case Binding -> Returning
returning Binding
binding of
                Returning
NoReturning -> (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Result Int64
Hasql.rowsAffected)
                  where
                    doc :: Doc
doc = [Binding] -> Doc -> Doc
ppWith [Binding]
bindings Doc
after 
                Returning Query (Expr Int64)
query -> do
                  Doc
doc <- [Binding] -> Doc -> Doc
ppWith [Binding]
bindings' (Doc -> Doc) -> State Tag Doc -> State Tag Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query (Expr Int64) -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect Query (Expr Int64)
query
                  (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row Int64 -> Result Int64
forall a. Row a -> Result a
Hasql.singleRow Row Int64
forall exprs a. Serializable exprs a => Row a
parse)
          Single @exprs @a -> do
            case Result exprs
result of
              Unmodified exprs
_ -> (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result a
forall a. Row a -> Result a
Hasql.singleRow (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
                where
                  doc :: Doc
doc = [Binding] -> Doc -> Doc
ppWith [Binding]
bindings Doc
after
              Modified exprs
query -> do
                Doc
doc <- [Binding] -> Doc -> Doc
ppWith [Binding]
bindings' (Doc -> Doc) -> State Tag Doc -> State Tag Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query exprs -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect exprs
Query exprs
query
                (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result a
forall a. Row a -> Result a
Hasql.singleRow (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
          Maybe @exprs @a -> do
            case Result exprs
result of
              Unmodified exprs
_ -> (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result (Maybe a)
forall a. Row a -> Result (Maybe a)
Hasql.rowMaybe (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
                where
                  doc :: Doc
doc = [Binding] -> Doc -> Doc
ppWith [Binding]
bindings Doc
after
              Modified exprs
query -> do
                Doc
doc <- [Binding] -> Doc -> Doc
ppWith [Binding]
bindings' (Doc -> Doc) -> State Tag Doc -> State Tag Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query exprs -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect exprs
Query exprs
query
                (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result (Maybe a)
forall a. Row a -> Result (Maybe a)
Hasql.rowMaybe (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
          List @exprs @a -> do
            case Result exprs
result of
              Unmodified exprs
_ -> (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result [a]
forall a. Row a -> Result [a]
Hasql.rowList (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
                where
                  doc :: Doc
doc = [Binding] -> Doc -> Doc
ppWith [Binding]
bindings Doc
after
              Modified exprs
query -> do
                Doc
doc <- [Binding] -> Doc -> Doc
ppWith [Binding]
bindings' (Doc -> Doc) -> State Tag Doc -> State Tag Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query exprs -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect exprs
Query exprs
query
                (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result [a]
forall a. Row a -> Result [a]
Hasql.rowList (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
          Vector @exprs @a -> do
            case Result exprs
result of
              Unmodified exprs
_ -> (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result (Vector a)
forall a. Row a -> Result (Vector a)
Hasql.rowVector (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))
                where
                  doc :: Doc
doc = [Binding] -> Doc -> Doc
ppWith [Binding]
bindings Doc
after
              Modified exprs
query -> do
                Doc
doc <- [Binding] -> Doc -> Doc
ppWith [Binding]
bindings' (Doc -> Doc) -> State Tag Doc -> State Tag Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query exprs -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect exprs
Query exprs
query
                (Doc, Result a) -> State Tag (Doc, Result a)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
doc, Row a -> Result (Vector a)
forall a. Row a -> Result (Vector a)
Hasql.rowVector (forall exprs a. Serializable exprs a => Row a
parse @exprs @a))


ppWith :: [Binding] -> Doc -> Doc
ppWith :: [Binding] -> Doc -> Doc
ppWith [Binding]
bindings Doc
after = Doc
pre Doc -> Doc -> Doc
$$ Doc
after
  where
    pre :: Doc
pre = case [Binding]
bindings of
      [] -> Doc
forall a. Monoid a => a
mempty
      [Binding]
_ ->
        String -> Doc
text String
"WITH" Doc -> Doc -> Doc
<+>
        [Doc] -> Doc
vcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Binding -> Doc) -> [Binding] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Binding -> Doc
go [Binding]
bindings))
    go :: Binding -> Doc
go binding :: Binding
binding@Binding {doc :: Binding -> Doc
doc = Doc
before} =
      Binding -> Doc
ppAlias Binding
binding Doc -> Doc -> Doc
$$
      String -> Doc
text String
"AS" Doc -> Doc -> Doc
<+>
      Doc -> Doc
parens Doc
before


ppAlias :: Binding -> Doc
ppAlias :: Binding -> Doc
ppAlias Binding {String
relation :: Binding -> String
relation :: String
relation, columns :: Binding -> Maybe (NonEmpty String)
columns = Maybe (NonEmpty String)
mcolumns} = case Maybe (NonEmpty String)
mcolumns of
  Maybe (NonEmpty String)
Nothing -> String -> Doc
escape String
relation
  Just NonEmpty String
columns -> 
    String -> Doc
escape String
relation Doc -> Doc -> Doc
<+>
    Doc -> Doc
parens ([Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (String -> Doc
escape (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty String
columns)))


unsnoc :: [a] -> Maybe ([a], a)
unsnoc :: forall a. [a] -> Maybe ([a], a)
unsnoc = (a -> Maybe ([a], a) -> Maybe ([a], a))
-> Maybe ([a], a) -> [a] -> Maybe ([a], a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a], a) -> Maybe ([a], a))
-> (Maybe ([a], a) -> ([a], a)) -> Maybe ([a], a) -> Maybe ([a], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], a) -> (([a], a) -> ([a], a)) -> Maybe ([a], a) -> ([a], a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([], a
x) (\(~([a]
a, a
b)) -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a, a
b))) Maybe ([a], a)
forall a. Maybe a
Nothing