{-# 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
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
import qualified Hasql.Decoders as Hasql
import qualified Opaleye.Internal.Tag as Opaleye
import Text.PrettyPrint
( Doc
, (<+>)
, ($$)
, comma
, hcat
, parens
, punctuate
, text
, vcat
)
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)
import Data.Functor.Apply (Apply, WrappedApplicative (..))
import Data.Functor.Bind (Bind, (>>-))
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
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