{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DeriveLift            #-}
{-# LANGUAGE DuplicateRecordFields #-}

-- | Description: Syntax tree for SQL

module Preql.QuasiQuoter.Syntax.Syntax where

import Preql.QuasiQuoter.Syntax.Name

import Data.Data
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Word (Word)
import GHC.Generics
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift(..))
import qualified Data.Text as T

-- FIXME rename to Constant?
data Literal = I !Word | F !Double | T !Text | B !Bool | Null
    deriving (Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show, Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq, (forall x. Literal -> Rep Literal x)
-> (forall x. Rep Literal x -> Literal) -> Generic Literal
forall x. Rep Literal x -> Literal
forall x. Literal -> Rep Literal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Literal x -> Literal
$cfrom :: forall x. Literal -> Rep Literal x
Generic, Typeable, Typeable Literal
DataType
Constr
Typeable Literal
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Literal -> c Literal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Literal)
-> (Literal -> Constr)
-> (Literal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Literal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal))
-> ((forall b. Data b => b -> b) -> Literal -> Literal)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Literal -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Literal -> r)
-> (forall u. (forall d. Data d => d -> u) -> Literal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> Data Literal
Literal -> DataType
Literal -> Constr
(forall b. Data b => b -> b) -> Literal -> Literal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
forall u. (forall d. Data d => d -> u) -> Literal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cNull :: Constr
$cB :: Constr
$cT :: Constr
$cF :: Constr
$cI :: Constr
$tLiteral :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapMp :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapM :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapQi :: Int -> (forall d. Data d => d -> u) -> Literal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
gmapQ :: (forall d. Data d => d -> u) -> Literal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
$cgmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Literal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
dataTypeOf :: Literal -> DataType
$cdataTypeOf :: Literal -> DataType
toConstr :: Literal -> Constr
$ctoConstr :: Literal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cp1Data :: Typeable Literal
Data, Literal -> Q Exp
Literal -> Q (TExp Literal)
(Literal -> Q Exp) -> (Literal -> Q (TExp Literal)) -> Lift Literal
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Literal -> Q (TExp Literal)
$cliftTyped :: Literal -> Q (TExp Literal)
lift :: Literal -> Q Exp
$clift :: Literal -> Q Exp
Lift)

data Statement = QI !Insert | QD !Delete | QU !Update | QS !SelectStmt
    deriving (Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show, Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq, (forall x. Statement -> Rep Statement x)
-> (forall x. Rep Statement x -> Statement) -> Generic Statement
forall x. Rep Statement x -> Statement
forall x. Statement -> Rep Statement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Statement x -> Statement
$cfrom :: forall x. Statement -> Rep Statement x
Generic, Typeable, Typeable Statement
DataType
Constr
Typeable Statement
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Statement -> c Statement)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Statement)
-> (Statement -> Constr)
-> (Statement -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Statement))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Statement))
-> ((forall b. Data b => b -> b) -> Statement -> Statement)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Statement -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Statement -> r)
-> (forall u. (forall d. Data d => d -> u) -> Statement -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Statement -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Statement -> m Statement)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Statement -> m Statement)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Statement -> m Statement)
-> Data Statement
Statement -> DataType
Statement -> Constr
(forall b. Data b => b -> b) -> Statement -> Statement
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Statement -> c Statement
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Statement
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Statement -> u
forall u. (forall d. Data d => d -> u) -> Statement -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Statement -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Statement -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Statement -> m Statement
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Statement -> m Statement
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Statement
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Statement -> c Statement
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Statement)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Statement)
$cQS :: Constr
$cQU :: Constr
$cQD :: Constr
$cQI :: Constr
$tStatement :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Statement -> m Statement
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Statement -> m Statement
gmapMp :: (forall d. Data d => d -> m d) -> Statement -> m Statement
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Statement -> m Statement
gmapM :: (forall d. Data d => d -> m d) -> Statement -> m Statement
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Statement -> m Statement
gmapQi :: Int -> (forall d. Data d => d -> u) -> Statement -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Statement -> u
gmapQ :: (forall d. Data d => d -> u) -> Statement -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Statement -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Statement -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Statement -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Statement -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Statement -> r
gmapT :: (forall b. Data b => b -> b) -> Statement -> Statement
$cgmapT :: (forall b. Data b => b -> b) -> Statement -> Statement
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Statement)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Statement)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Statement)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Statement)
dataTypeOf :: Statement -> DataType
$cdataTypeOf :: Statement -> DataType
toConstr :: Statement -> Constr
$ctoConstr :: Statement -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Statement
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Statement
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Statement -> c Statement
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Statement -> c Statement
$cp1Data :: Typeable Statement
Data, Statement -> Q Exp
Statement -> Q (TExp Statement)
(Statement -> Q Exp)
-> (Statement -> Q (TExp Statement)) -> Lift Statement
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Statement -> Q (TExp Statement)
$cliftTyped :: Statement -> Q (TExp Statement)
lift :: Statement -> Q Exp
$clift :: Statement -> Q Exp
Lift)

-- | Queries of the form @INSERT INTO table (columns) VALUES (values);@
-- Limitations:
-- * single row
-- * no @ON CONFLICT@
data Insert = Insert
    { Insert -> Name
table   :: !Name
    , Insert -> NonEmpty Name
columns :: NonEmpty Name
    , Insert -> NonEmpty Expr
values  :: NonEmpty Expr -- TODO enforce matched lengths?
    } deriving (Int -> Insert -> ShowS
[Insert] -> ShowS
Insert -> String
(Int -> Insert -> ShowS)
-> (Insert -> String) -> ([Insert] -> ShowS) -> Show Insert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Insert] -> ShowS
$cshowList :: [Insert] -> ShowS
show :: Insert -> String
$cshow :: Insert -> String
showsPrec :: Int -> Insert -> ShowS
$cshowsPrec :: Int -> Insert -> ShowS
Show, Insert -> Insert -> Bool
(Insert -> Insert -> Bool)
-> (Insert -> Insert -> Bool) -> Eq Insert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Insert -> Insert -> Bool
$c/= :: Insert -> Insert -> Bool
== :: Insert -> Insert -> Bool
$c== :: Insert -> Insert -> Bool
Eq, (forall x. Insert -> Rep Insert x)
-> (forall x. Rep Insert x -> Insert) -> Generic Insert
forall x. Rep Insert x -> Insert
forall x. Insert -> Rep Insert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Insert x -> Insert
$cfrom :: forall x. Insert -> Rep Insert x
Generic, Typeable, Typeable Insert
DataType
Constr
Typeable Insert
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Insert -> c Insert)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Insert)
-> (Insert -> Constr)
-> (Insert -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Insert))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Insert))
-> ((forall b. Data b => b -> b) -> Insert -> Insert)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Insert -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Insert -> r)
-> (forall u. (forall d. Data d => d -> u) -> Insert -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Insert -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Insert -> m Insert)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Insert -> m Insert)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Insert -> m Insert)
-> Data Insert
Insert -> DataType
Insert -> Constr
(forall b. Data b => b -> b) -> Insert -> Insert
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Insert -> c Insert
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Insert
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Insert -> u
forall u. (forall d. Data d => d -> u) -> Insert -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Insert -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Insert -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Insert -> m Insert
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Insert -> m Insert
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Insert
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Insert -> c Insert
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Insert)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Insert)
$cInsert :: Constr
$tInsert :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Insert -> m Insert
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Insert -> m Insert
gmapMp :: (forall d. Data d => d -> m d) -> Insert -> m Insert
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Insert -> m Insert
gmapM :: (forall d. Data d => d -> m d) -> Insert -> m Insert
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Insert -> m Insert
gmapQi :: Int -> (forall d. Data d => d -> u) -> Insert -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Insert -> u
gmapQ :: (forall d. Data d => d -> u) -> Insert -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Insert -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Insert -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Insert -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Insert -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Insert -> r
gmapT :: (forall b. Data b => b -> b) -> Insert -> Insert
$cgmapT :: (forall b. Data b => b -> b) -> Insert -> Insert
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Insert)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Insert)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Insert)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Insert)
dataTypeOf :: Insert -> DataType
$cdataTypeOf :: Insert -> DataType
toConstr :: Insert -> Constr
$ctoConstr :: Insert -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Insert
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Insert
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Insert -> c Insert
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Insert -> c Insert
$cp1Data :: Typeable Insert
Data, Insert -> Q Exp
Insert -> Q (TExp Insert)
(Insert -> Q Exp) -> (Insert -> Q (TExp Insert)) -> Lift Insert
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Insert -> Q (TExp Insert)
$cliftTyped :: Insert -> Q (TExp Insert)
lift :: Insert -> Q Exp
$clift :: Insert -> Q Exp
Lift)

-- | Queries of the form @DELETE FROM table WHERE conditions@.
data Delete = Delete
    { Delete -> Name
table      :: !Name
    , Delete -> Maybe Expr
conditions :: Maybe Expr
    } deriving (Int -> Delete -> ShowS
[Delete] -> ShowS
Delete -> String
(Int -> Delete -> ShowS)
-> (Delete -> String) -> ([Delete] -> ShowS) -> Show Delete
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delete] -> ShowS
$cshowList :: [Delete] -> ShowS
show :: Delete -> String
$cshow :: Delete -> String
showsPrec :: Int -> Delete -> ShowS
$cshowsPrec :: Int -> Delete -> ShowS
Show, Delete -> Delete -> Bool
(Delete -> Delete -> Bool)
-> (Delete -> Delete -> Bool) -> Eq Delete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delete -> Delete -> Bool
$c/= :: Delete -> Delete -> Bool
== :: Delete -> Delete -> Bool
$c== :: Delete -> Delete -> Bool
Eq, (forall x. Delete -> Rep Delete x)
-> (forall x. Rep Delete x -> Delete) -> Generic Delete
forall x. Rep Delete x -> Delete
forall x. Delete -> Rep Delete x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Delete x -> Delete
$cfrom :: forall x. Delete -> Rep Delete x
Generic, Typeable, Typeable Delete
DataType
Constr
Typeable Delete
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Delete -> c Delete)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Delete)
-> (Delete -> Constr)
-> (Delete -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Delete))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delete))
-> ((forall b. Data b => b -> b) -> Delete -> Delete)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Delete -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Delete -> r)
-> (forall u. (forall d. Data d => d -> u) -> Delete -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Delete -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Delete -> m Delete)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Delete -> m Delete)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Delete -> m Delete)
-> Data Delete
Delete -> DataType
Delete -> Constr
(forall b. Data b => b -> b) -> Delete -> Delete
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delete -> c Delete
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delete
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Delete -> u
forall u. (forall d. Data d => d -> u) -> Delete -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Delete -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delete -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Delete -> m Delete
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delete -> m Delete
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delete
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delete -> c Delete
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Delete)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delete)
$cDelete :: Constr
$tDelete :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Delete -> m Delete
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delete -> m Delete
gmapMp :: (forall d. Data d => d -> m d) -> Delete -> m Delete
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Delete -> m Delete
gmapM :: (forall d. Data d => d -> m d) -> Delete -> m Delete
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Delete -> m Delete
gmapQi :: Int -> (forall d. Data d => d -> u) -> Delete -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Delete -> u
gmapQ :: (forall d. Data d => d -> u) -> Delete -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Delete -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delete -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delete -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Delete -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Delete -> r
gmapT :: (forall b. Data b => b -> b) -> Delete -> Delete
$cgmapT :: (forall b. Data b => b -> b) -> Delete -> Delete
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delete)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delete)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Delete)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Delete)
dataTypeOf :: Delete -> DataType
$cdataTypeOf :: Delete -> DataType
toConstr :: Delete -> Constr
$ctoConstr :: Delete -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delete
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Delete
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delete -> c Delete
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Delete -> c Delete
$cp1Data :: Typeable Delete
Data, Delete -> Q Exp
Delete -> Q (TExp Delete)
(Delete -> Q Exp) -> (Delete -> Q (TExp Delete)) -> Lift Delete
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Delete -> Q (TExp Delete)
$cliftTyped :: Delete -> Q (TExp Delete)
lift :: Delete -> Q Exp
$clift :: Delete -> Q Exp
Lift)

data Setting = Setting !Name !Expr
    deriving (Int -> Setting -> ShowS
[Setting] -> ShowS
Setting -> String
(Int -> Setting -> ShowS)
-> (Setting -> String) -> ([Setting] -> ShowS) -> Show Setting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Setting] -> ShowS
$cshowList :: [Setting] -> ShowS
show :: Setting -> String
$cshow :: Setting -> String
showsPrec :: Int -> Setting -> ShowS
$cshowsPrec :: Int -> Setting -> ShowS
Show, Setting -> Setting -> Bool
(Setting -> Setting -> Bool)
-> (Setting -> Setting -> Bool) -> Eq Setting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Setting -> Setting -> Bool
$c/= :: Setting -> Setting -> Bool
== :: Setting -> Setting -> Bool
$c== :: Setting -> Setting -> Bool
Eq, (forall x. Setting -> Rep Setting x)
-> (forall x. Rep Setting x -> Setting) -> Generic Setting
forall x. Rep Setting x -> Setting
forall x. Setting -> Rep Setting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Setting x -> Setting
$cfrom :: forall x. Setting -> Rep Setting x
Generic, Typeable, Typeable Setting
DataType
Constr
Typeable Setting
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Setting -> c Setting)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Setting)
-> (Setting -> Constr)
-> (Setting -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Setting))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Setting))
-> ((forall b. Data b => b -> b) -> Setting -> Setting)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Setting -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Setting -> r)
-> (forall u. (forall d. Data d => d -> u) -> Setting -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Setting -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Setting -> m Setting)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Setting -> m Setting)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Setting -> m Setting)
-> Data Setting
Setting -> DataType
Setting -> Constr
(forall b. Data b => b -> b) -> Setting -> Setting
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Setting -> c Setting
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Setting
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Setting -> u
forall u. (forall d. Data d => d -> u) -> Setting -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Setting -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Setting -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Setting -> m Setting
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Setting -> m Setting
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Setting
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Setting -> c Setting
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Setting)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Setting)
$cSetting :: Constr
$tSetting :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Setting -> m Setting
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Setting -> m Setting
gmapMp :: (forall d. Data d => d -> m d) -> Setting -> m Setting
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Setting -> m Setting
gmapM :: (forall d. Data d => d -> m d) -> Setting -> m Setting
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Setting -> m Setting
gmapQi :: Int -> (forall d. Data d => d -> u) -> Setting -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Setting -> u
gmapQ :: (forall d. Data d => d -> u) -> Setting -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Setting -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Setting -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Setting -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Setting -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Setting -> r
gmapT :: (forall b. Data b => b -> b) -> Setting -> Setting
$cgmapT :: (forall b. Data b => b -> b) -> Setting -> Setting
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Setting)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Setting)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Setting)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Setting)
dataTypeOf :: Setting -> DataType
$cdataTypeOf :: Setting -> DataType
toConstr :: Setting -> Constr
$ctoConstr :: Setting -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Setting
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Setting
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Setting -> c Setting
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Setting -> c Setting
$cp1Data :: Typeable Setting
Data, Setting -> Q Exp
Setting -> Q (TExp Setting)
(Setting -> Q Exp) -> (Setting -> Q (TExp Setting)) -> Lift Setting
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Setting -> Q (TExp Setting)
$cliftTyped :: Setting -> Q (TExp Setting)
lift :: Setting -> Q Exp
$clift :: Setting -> Q Exp
Lift)

-- | Queries of the form @UPDATE table SET settings WHERE conditions@.  Where each
-- @Setting name literal@ is like SQL @name = literal@.
data Update = Update
    { Update -> Name
table      :: !Name
    , Update -> NonEmpty Setting
settings   :: NonEmpty Setting
    , Update -> Maybe Expr
conditions :: Maybe Expr
    } deriving (Int -> Update -> ShowS
[Update] -> ShowS
Update -> String
(Int -> Update -> ShowS)
-> (Update -> String) -> ([Update] -> ShowS) -> Show Update
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Update] -> ShowS
$cshowList :: [Update] -> ShowS
show :: Update -> String
$cshow :: Update -> String
showsPrec :: Int -> Update -> ShowS
$cshowsPrec :: Int -> Update -> ShowS
Show, Update -> Update -> Bool
(Update -> Update -> Bool)
-> (Update -> Update -> Bool) -> Eq Update
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Update -> Update -> Bool
$c/= :: Update -> Update -> Bool
== :: Update -> Update -> Bool
$c== :: Update -> Update -> Bool
Eq, (forall x. Update -> Rep Update x)
-> (forall x. Rep Update x -> Update) -> Generic Update
forall x. Rep Update x -> Update
forall x. Update -> Rep Update x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Update x -> Update
$cfrom :: forall x. Update -> Rep Update x
Generic, Typeable, Typeable Update
DataType
Constr
Typeable Update
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Update -> c Update)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Update)
-> (Update -> Constr)
-> (Update -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Update))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Update))
-> ((forall b. Data b => b -> b) -> Update -> Update)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Update -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Update -> r)
-> (forall u. (forall d. Data d => d -> u) -> Update -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Update -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Update -> m Update)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Update -> m Update)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Update -> m Update)
-> Data Update
Update -> DataType
Update -> Constr
(forall b. Data b => b -> b) -> Update -> Update
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Update -> c Update
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Update
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Update -> u
forall u. (forall d. Data d => d -> u) -> Update -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Update -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Update -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Update -> m Update
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Update -> m Update
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Update
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Update -> c Update
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Update)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Update)
$cUpdate :: Constr
$tUpdate :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Update -> m Update
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Update -> m Update
gmapMp :: (forall d. Data d => d -> m d) -> Update -> m Update
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Update -> m Update
gmapM :: (forall d. Data d => d -> m d) -> Update -> m Update
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Update -> m Update
gmapQi :: Int -> (forall d. Data d => d -> u) -> Update -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Update -> u
gmapQ :: (forall d. Data d => d -> u) -> Update -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Update -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Update -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Update -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Update -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Update -> r
gmapT :: (forall b. Data b => b -> b) -> Update -> Update
$cgmapT :: (forall b. Data b => b -> b) -> Update -> Update
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Update)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Update)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Update)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Update)
dataTypeOf :: Update -> DataType
$cdataTypeOf :: Update -> DataType
toConstr :: Update -> Constr
$ctoConstr :: Update -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Update
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Update
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Update -> c Update
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Update -> c Update
$cp1Data :: Typeable Update
Data, Update -> Q Exp
Update -> Q (TExp Update)
(Update -> Q Exp) -> (Update -> Q (TExp Update)) -> Lift Update
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Update -> Q (TExp Update)
$cliftTyped :: Update -> Q (TExp Update)
lift :: Update -> Q Exp
$clift :: Update -> Q Exp
Lift)

-- TODO prevent multiple SelectOptions on the same query
-- If each constructor takes SelectOptions, we can ditch S and the empty SelectOptions becomes valid
data SelectStmt
    = SelectValues (NonEmpty (NonEmpty Expr))
    | Simple Select
    | S SelectStmt SelectOptions
    | Set SetOp AllOrDistinct SelectStmt SelectStmt
    deriving (Int -> SelectStmt -> ShowS
[SelectStmt] -> ShowS
SelectStmt -> String
(Int -> SelectStmt -> ShowS)
-> (SelectStmt -> String)
-> ([SelectStmt] -> ShowS)
-> Show SelectStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectStmt] -> ShowS
$cshowList :: [SelectStmt] -> ShowS
show :: SelectStmt -> String
$cshow :: SelectStmt -> String
showsPrec :: Int -> SelectStmt -> ShowS
$cshowsPrec :: Int -> SelectStmt -> ShowS
Show, SelectStmt -> SelectStmt -> Bool
(SelectStmt -> SelectStmt -> Bool)
-> (SelectStmt -> SelectStmt -> Bool) -> Eq SelectStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectStmt -> SelectStmt -> Bool
$c/= :: SelectStmt -> SelectStmt -> Bool
== :: SelectStmt -> SelectStmt -> Bool
$c== :: SelectStmt -> SelectStmt -> Bool
Eq, (forall x. SelectStmt -> Rep SelectStmt x)
-> (forall x. Rep SelectStmt x -> SelectStmt) -> Generic SelectStmt
forall x. Rep SelectStmt x -> SelectStmt
forall x. SelectStmt -> Rep SelectStmt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectStmt x -> SelectStmt
$cfrom :: forall x. SelectStmt -> Rep SelectStmt x
Generic, Typeable, Typeable SelectStmt
DataType
Constr
Typeable SelectStmt
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SelectStmt -> c SelectStmt)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectStmt)
-> (SelectStmt -> Constr)
-> (SelectStmt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SelectStmt))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelectStmt))
-> ((forall b. Data b => b -> b) -> SelectStmt -> SelectStmt)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SelectStmt -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SelectStmt -> r)
-> (forall u. (forall d. Data d => d -> u) -> SelectStmt -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectStmt -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt)
-> Data SelectStmt
SelectStmt -> DataType
SelectStmt -> Constr
(forall b. Data b => b -> b) -> SelectStmt -> SelectStmt
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectStmt -> c SelectStmt
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectStmt
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SelectStmt -> u
forall u. (forall d. Data d => d -> u) -> SelectStmt -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectStmt -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectStmt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectStmt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectStmt -> c SelectStmt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectStmt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SelectStmt)
$cSet :: Constr
$cS :: Constr
$cSimple :: Constr
$cSelectValues :: Constr
$tSelectStmt :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt
gmapMp :: (forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt
gmapM :: (forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectStmt -> m SelectStmt
gmapQi :: Int -> (forall d. Data d => d -> u) -> SelectStmt -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectStmt -> u
gmapQ :: (forall d. Data d => d -> u) -> SelectStmt -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectStmt -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectStmt -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectStmt -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectStmt -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectStmt -> r
gmapT :: (forall b. Data b => b -> b) -> SelectStmt -> SelectStmt
$cgmapT :: (forall b. Data b => b -> b) -> SelectStmt -> SelectStmt
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SelectStmt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SelectStmt)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SelectStmt)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectStmt)
dataTypeOf :: SelectStmt -> DataType
$cdataTypeOf :: SelectStmt -> DataType
toConstr :: SelectStmt -> Constr
$ctoConstr :: SelectStmt -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectStmt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectStmt
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectStmt -> c SelectStmt
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectStmt -> c SelectStmt
$cp1Data :: Typeable SelectStmt
Data, SelectStmt -> Q Exp
SelectStmt -> Q (TExp SelectStmt)
(SelectStmt -> Q Exp)
-> (SelectStmt -> Q (TExp SelectStmt)) -> Lift SelectStmt
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SelectStmt -> Q (TExp SelectStmt)
$cliftTyped :: SelectStmt -> Q (TExp SelectStmt)
lift :: SelectStmt -> Q Exp
$clift :: SelectStmt -> Q Exp
Lift)

data Select = Select
    { Select -> Maybe DistinctClause
distinct :: Maybe DistinctClause
    , Select -> [ResTarget]
targetList :: [ResTarget]
    , Select -> [TableRef]
from :: [TableRef]
    , Select -> Maybe Expr
whereClause :: Maybe Expr
    , Select -> [Expr]
groupBy :: [Expr] -- TODO more accurate type than Expr?
    , Select -> Maybe Expr
having :: Maybe Expr
    , Select -> [WindowDef]
window :: [WindowDef]
    -- TODO remaining fields
    } deriving (Int -> Select -> ShowS
[Select] -> ShowS
Select -> String
(Int -> Select -> ShowS)
-> (Select -> String) -> ([Select] -> ShowS) -> Show Select
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Select] -> ShowS
$cshowList :: [Select] -> ShowS
show :: Select -> String
$cshow :: Select -> String
showsPrec :: Int -> Select -> ShowS
$cshowsPrec :: Int -> Select -> ShowS
Show, Select -> Select -> Bool
(Select -> Select -> Bool)
-> (Select -> Select -> Bool) -> Eq Select
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Select -> Select -> Bool
$c/= :: Select -> Select -> Bool
== :: Select -> Select -> Bool
$c== :: Select -> Select -> Bool
Eq, (forall x. Select -> Rep Select x)
-> (forall x. Rep Select x -> Select) -> Generic Select
forall x. Rep Select x -> Select
forall x. Select -> Rep Select x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Select x -> Select
$cfrom :: forall x. Select -> Rep Select x
Generic, Typeable, Typeable Select
DataType
Constr
Typeable Select
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Select -> c Select)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Select)
-> (Select -> Constr)
-> (Select -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Select))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Select))
-> ((forall b. Data b => b -> b) -> Select -> Select)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Select -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Select -> r)
-> (forall u. (forall d. Data d => d -> u) -> Select -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Select -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Select -> m Select)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Select -> m Select)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Select -> m Select)
-> Data Select
Select -> DataType
Select -> Constr
(forall b. Data b => b -> b) -> Select -> Select
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Select -> c Select
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Select
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Select -> u
forall u. (forall d. Data d => d -> u) -> Select -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Select -> m Select
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Select -> m Select
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Select
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Select -> c Select
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Select)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Select)
$cSelect :: Constr
$tSelect :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Select -> m Select
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Select -> m Select
gmapMp :: (forall d. Data d => d -> m d) -> Select -> m Select
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Select -> m Select
gmapM :: (forall d. Data d => d -> m d) -> Select -> m Select
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Select -> m Select
gmapQi :: Int -> (forall d. Data d => d -> u) -> Select -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Select -> u
gmapQ :: (forall d. Data d => d -> u) -> Select -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Select -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
gmapT :: (forall b. Data b => b -> b) -> Select -> Select
$cgmapT :: (forall b. Data b => b -> b) -> Select -> Select
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Select)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Select)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Select)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Select)
dataTypeOf :: Select -> DataType
$cdataTypeOf :: Select -> DataType
toConstr :: Select -> Constr
$ctoConstr :: Select -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Select
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Select
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Select -> c Select
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Select -> c Select
$cp1Data :: Typeable Select
Data, Select -> Q Exp
Select -> Q (TExp Select)
(Select -> Q Exp) -> (Select -> Q (TExp Select)) -> Lift Select
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Select -> Q (TExp Select)
$cliftTyped :: Select -> Q (TExp Select)
lift :: Select -> Q Exp
$clift :: Select -> Q Exp
Lift)

data SelectOptions = SelectOptions
    { SelectOptions -> [SortBy]
sortBy :: [SortBy]
    , SelectOptions -> Maybe Expr
offset :: Maybe Expr
    , SelectOptions -> Maybe Expr
limit :: Maybe Expr
    , SelectOptions -> [Locking]
locking :: [Locking]
    , SelectOptions -> Maybe WithClause
withClause :: Maybe WithClause
    } deriving (Int -> SelectOptions -> ShowS
[SelectOptions] -> ShowS
SelectOptions -> String
(Int -> SelectOptions -> ShowS)
-> (SelectOptions -> String)
-> ([SelectOptions] -> ShowS)
-> Show SelectOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectOptions] -> ShowS
$cshowList :: [SelectOptions] -> ShowS
show :: SelectOptions -> String
$cshow :: SelectOptions -> String
showsPrec :: Int -> SelectOptions -> ShowS
$cshowsPrec :: Int -> SelectOptions -> ShowS
Show, SelectOptions -> SelectOptions -> Bool
(SelectOptions -> SelectOptions -> Bool)
-> (SelectOptions -> SelectOptions -> Bool) -> Eq SelectOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectOptions -> SelectOptions -> Bool
$c/= :: SelectOptions -> SelectOptions -> Bool
== :: SelectOptions -> SelectOptions -> Bool
$c== :: SelectOptions -> SelectOptions -> Bool
Eq, (forall x. SelectOptions -> Rep SelectOptions x)
-> (forall x. Rep SelectOptions x -> SelectOptions)
-> Generic SelectOptions
forall x. Rep SelectOptions x -> SelectOptions
forall x. SelectOptions -> Rep SelectOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectOptions x -> SelectOptions
$cfrom :: forall x. SelectOptions -> Rep SelectOptions x
Generic, Typeable, Typeable SelectOptions
DataType
Constr
Typeable SelectOptions
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SelectOptions -> c SelectOptions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectOptions)
-> (SelectOptions -> Constr)
-> (SelectOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SelectOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelectOptions))
-> ((forall b. Data b => b -> b) -> SelectOptions -> SelectOptions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SelectOptions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SelectOptions -> r)
-> (forall u. (forall d. Data d => d -> u) -> SelectOptions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectOptions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions)
-> Data SelectOptions
SelectOptions -> DataType
SelectOptions -> Constr
(forall b. Data b => b -> b) -> SelectOptions -> SelectOptions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectOptions -> c SelectOptions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectOptions
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SelectOptions -> u
forall u. (forall d. Data d => d -> u) -> SelectOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectOptions -> c SelectOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectOptions)
$cSelectOptions :: Constr
$tSelectOptions :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions
gmapMp :: (forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions
gmapM :: (forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectOptions -> m SelectOptions
gmapQi :: Int -> (forall d. Data d => d -> u) -> SelectOptions -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectOptions -> u
gmapQ :: (forall d. Data d => d -> u) -> SelectOptions -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectOptions -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectOptions -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectOptions -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectOptions -> r
gmapT :: (forall b. Data b => b -> b) -> SelectOptions -> SelectOptions
$cgmapT :: (forall b. Data b => b -> b) -> SelectOptions -> SelectOptions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectOptions)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SelectOptions)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectOptions)
dataTypeOf :: SelectOptions -> DataType
$cdataTypeOf :: SelectOptions -> DataType
toConstr :: SelectOptions -> Constr
$ctoConstr :: SelectOptions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectOptions
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectOptions -> c SelectOptions
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectOptions -> c SelectOptions
$cp1Data :: Typeable SelectOptions
Data, SelectOptions -> Q Exp
SelectOptions -> Q (TExp SelectOptions)
(SelectOptions -> Q Exp)
-> (SelectOptions -> Q (TExp SelectOptions)) -> Lift SelectOptions
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SelectOptions -> Q (TExp SelectOptions)
$cliftTyped :: SelectOptions -> Q (TExp SelectOptions)
lift :: SelectOptions -> Q Exp
$clift :: SelectOptions -> Q Exp
Lift)

-- This is really for writing tests, but put it here for faster type check errors
select :: Select
select :: Select
select = Select :: Maybe DistinctClause
-> [ResTarget]
-> [TableRef]
-> Maybe Expr
-> [Expr]
-> Maybe Expr
-> [WindowDef]
-> Select
Select
    { $sel:distinct:Select :: Maybe DistinctClause
distinct = Maybe DistinctClause
forall a. Maybe a
Nothing
    , $sel:targetList:Select :: [ResTarget]
targetList = []
    , $sel:from:Select :: [TableRef]
from = []
    , $sel:whereClause:Select :: Maybe Expr
whereClause = Maybe Expr
forall a. Maybe a
Nothing
    , $sel:groupBy:Select :: [Expr]
groupBy = []
    , $sel:having:Select :: Maybe Expr
having = Maybe Expr
forall a. Maybe a
Nothing
    , $sel:window:Select :: [WindowDef]
window = []
    }

selectOptions :: SelectOptions
selectOptions :: SelectOptions
selectOptions = SelectOptions :: [SortBy]
-> Maybe Expr
-> Maybe Expr
-> [Locking]
-> Maybe WithClause
-> SelectOptions
SelectOptions
    { $sel:sortBy:SelectOptions :: [SortBy]
sortBy = []
    , $sel:offset:SelectOptions :: Maybe Expr
offset = Maybe Expr
forall a. Maybe a
Nothing
    , $sel:limit:SelectOptions :: Maybe Expr
limit = Maybe Expr
forall a. Maybe a
Nothing
    , $sel:locking:SelectOptions :: [Locking]
locking = []
    , $sel:withClause:SelectOptions :: Maybe WithClause
withClause = Maybe WithClause
forall a. Maybe a
Nothing
    }

data TableRef
  = J JoinedTable
  | As JoinedTable Alias
  | SubSelect SelectStmt Alias
  deriving (Int -> TableRef -> ShowS
[TableRef] -> ShowS
TableRef -> String
(Int -> TableRef -> ShowS)
-> (TableRef -> String) -> ([TableRef] -> ShowS) -> Show TableRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableRef] -> ShowS
$cshowList :: [TableRef] -> ShowS
show :: TableRef -> String
$cshow :: TableRef -> String
showsPrec :: Int -> TableRef -> ShowS
$cshowsPrec :: Int -> TableRef -> ShowS
Show, TableRef -> TableRef -> Bool
(TableRef -> TableRef -> Bool)
-> (TableRef -> TableRef -> Bool) -> Eq TableRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableRef -> TableRef -> Bool
$c/= :: TableRef -> TableRef -> Bool
== :: TableRef -> TableRef -> Bool
$c== :: TableRef -> TableRef -> Bool
Eq, (forall x. TableRef -> Rep TableRef x)
-> (forall x. Rep TableRef x -> TableRef) -> Generic TableRef
forall x. Rep TableRef x -> TableRef
forall x. TableRef -> Rep TableRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableRef x -> TableRef
$cfrom :: forall x. TableRef -> Rep TableRef x
Generic, Typeable, Typeable TableRef
DataType
Constr
Typeable TableRef
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TableRef -> c TableRef)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TableRef)
-> (TableRef -> Constr)
-> (TableRef -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TableRef))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableRef))
-> ((forall b. Data b => b -> b) -> TableRef -> TableRef)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TableRef -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TableRef -> r)
-> (forall u. (forall d. Data d => d -> u) -> TableRef -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TableRef -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TableRef -> m TableRef)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TableRef -> m TableRef)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TableRef -> m TableRef)
-> Data TableRef
TableRef -> DataType
TableRef -> Constr
(forall b. Data b => b -> b) -> TableRef -> TableRef
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableRef -> c TableRef
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableRef
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TableRef -> u
forall u. (forall d. Data d => d -> u) -> TableRef -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableRef -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableRef -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableRef -> m TableRef
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableRef -> m TableRef
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableRef
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableRef -> c TableRef
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableRef)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableRef)
$cSubSelect :: Constr
$cAs :: Constr
$cJ :: Constr
$tTableRef :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TableRef -> m TableRef
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableRef -> m TableRef
gmapMp :: (forall d. Data d => d -> m d) -> TableRef -> m TableRef
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableRef -> m TableRef
gmapM :: (forall d. Data d => d -> m d) -> TableRef -> m TableRef
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableRef -> m TableRef
gmapQi :: Int -> (forall d. Data d => d -> u) -> TableRef -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableRef -> u
gmapQ :: (forall d. Data d => d -> u) -> TableRef -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableRef -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableRef -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableRef -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableRef -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableRef -> r
gmapT :: (forall b. Data b => b -> b) -> TableRef -> TableRef
$cgmapT :: (forall b. Data b => b -> b) -> TableRef -> TableRef
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableRef)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableRef)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TableRef)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableRef)
dataTypeOf :: TableRef -> DataType
$cdataTypeOf :: TableRef -> DataType
toConstr :: TableRef -> Constr
$ctoConstr :: TableRef -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableRef
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableRef
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableRef -> c TableRef
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableRef -> c TableRef
$cp1Data :: Typeable TableRef
Data, TableRef -> Q Exp
TableRef -> Q (TExp TableRef)
(TableRef -> Q Exp)
-> (TableRef -> Q (TExp TableRef)) -> Lift TableRef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: TableRef -> Q (TExp TableRef)
$cliftTyped :: TableRef -> Q (TExp TableRef)
lift :: TableRef -> Q Exp
$clift :: TableRef -> Q Exp
Lift)

data JoinedTable
  = Table Name
  | Join JoinType JoinQual TableRef TableRef
  | CrossJoin TableRef TableRef
  deriving (Int -> JoinedTable -> ShowS
[JoinedTable] -> ShowS
JoinedTable -> String
(Int -> JoinedTable -> ShowS)
-> (JoinedTable -> String)
-> ([JoinedTable] -> ShowS)
-> Show JoinedTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinedTable] -> ShowS
$cshowList :: [JoinedTable] -> ShowS
show :: JoinedTable -> String
$cshow :: JoinedTable -> String
showsPrec :: Int -> JoinedTable -> ShowS
$cshowsPrec :: Int -> JoinedTable -> ShowS
Show, JoinedTable -> JoinedTable -> Bool
(JoinedTable -> JoinedTable -> Bool)
-> (JoinedTable -> JoinedTable -> Bool) -> Eq JoinedTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoinedTable -> JoinedTable -> Bool
$c/= :: JoinedTable -> JoinedTable -> Bool
== :: JoinedTable -> JoinedTable -> Bool
$c== :: JoinedTable -> JoinedTable -> Bool
Eq, (forall x. JoinedTable -> Rep JoinedTable x)
-> (forall x. Rep JoinedTable x -> JoinedTable)
-> Generic JoinedTable
forall x. Rep JoinedTable x -> JoinedTable
forall x. JoinedTable -> Rep JoinedTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoinedTable x -> JoinedTable
$cfrom :: forall x. JoinedTable -> Rep JoinedTable x
Generic, Typeable, Typeable JoinedTable
DataType
Constr
Typeable JoinedTable
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JoinedTable -> c JoinedTable)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoinedTable)
-> (JoinedTable -> Constr)
-> (JoinedTable -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoinedTable))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoinedTable))
-> ((forall b. Data b => b -> b) -> JoinedTable -> JoinedTable)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinedTable -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinedTable -> r)
-> (forall u. (forall d. Data d => d -> u) -> JoinedTable -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoinedTable -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable)
-> Data JoinedTable
JoinedTable -> DataType
JoinedTable -> Constr
(forall b. Data b => b -> b) -> JoinedTable -> JoinedTable
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinedTable -> c JoinedTable
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinedTable
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JoinedTable -> u
forall u. (forall d. Data d => d -> u) -> JoinedTable -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinedTable -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinedTable -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinedTable
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinedTable -> c JoinedTable
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinedTable)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoinedTable)
$cCrossJoin :: Constr
$cJoin :: Constr
$cTable :: Constr
$tJoinedTable :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable
gmapMp :: (forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable
gmapM :: (forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinedTable -> m JoinedTable
gmapQi :: Int -> (forall d. Data d => d -> u) -> JoinedTable -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JoinedTable -> u
gmapQ :: (forall d. Data d => d -> u) -> JoinedTable -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoinedTable -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinedTable -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinedTable -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinedTable -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinedTable -> r
gmapT :: (forall b. Data b => b -> b) -> JoinedTable -> JoinedTable
$cgmapT :: (forall b. Data b => b -> b) -> JoinedTable -> JoinedTable
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoinedTable)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoinedTable)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JoinedTable)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinedTable)
dataTypeOf :: JoinedTable -> DataType
$cdataTypeOf :: JoinedTable -> DataType
toConstr :: JoinedTable -> Constr
$ctoConstr :: JoinedTable -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinedTable
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinedTable
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinedTable -> c JoinedTable
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinedTable -> c JoinedTable
$cp1Data :: Typeable JoinedTable
Data, JoinedTable -> Q Exp
JoinedTable -> Q (TExp JoinedTable)
(JoinedTable -> Q Exp)
-> (JoinedTable -> Q (TExp JoinedTable)) -> Lift JoinedTable
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: JoinedTable -> Q (TExp JoinedTable)
$cliftTyped :: JoinedTable -> Q (TExp JoinedTable)
lift :: JoinedTable -> Q Exp
$clift :: JoinedTable -> Q Exp
Lift)

data Alias = Alias
    { Alias -> Name
aliasName :: Name
    , Alias -> [Name]
columnNames :: [ Name ]
    } deriving (Int -> Alias -> ShowS
[Alias] -> ShowS
Alias -> String
(Int -> Alias -> ShowS)
-> (Alias -> String) -> ([Alias] -> ShowS) -> Show Alias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alias] -> ShowS
$cshowList :: [Alias] -> ShowS
show :: Alias -> String
$cshow :: Alias -> String
showsPrec :: Int -> Alias -> ShowS
$cshowsPrec :: Int -> Alias -> ShowS
Show, Alias -> Alias -> Bool
(Alias -> Alias -> Bool) -> (Alias -> Alias -> Bool) -> Eq Alias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alias -> Alias -> Bool
$c/= :: Alias -> Alias -> Bool
== :: Alias -> Alias -> Bool
$c== :: Alias -> Alias -> Bool
Eq, (forall x. Alias -> Rep Alias x)
-> (forall x. Rep Alias x -> Alias) -> Generic Alias
forall x. Rep Alias x -> Alias
forall x. Alias -> Rep Alias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Alias x -> Alias
$cfrom :: forall x. Alias -> Rep Alias x
Generic, Typeable, Typeable Alias
DataType
Constr
Typeable Alias
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Alias -> c Alias)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Alias)
-> (Alias -> Constr)
-> (Alias -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Alias))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Alias))
-> ((forall b. Data b => b -> b) -> Alias -> Alias)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Alias -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Alias -> r)
-> (forall u. (forall d. Data d => d -> u) -> Alias -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Alias -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Alias -> m Alias)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Alias -> m Alias)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Alias -> m Alias)
-> Data Alias
Alias -> DataType
Alias -> Constr
(forall b. Data b => b -> b) -> Alias -> Alias
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alias -> c Alias
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alias
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Alias -> u
forall u. (forall d. Data d => d -> u) -> Alias -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Alias -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Alias -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Alias -> m Alias
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alias -> m Alias
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alias
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alias -> c Alias
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Alias)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Alias)
$cAlias :: Constr
$tAlias :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Alias -> m Alias
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alias -> m Alias
gmapMp :: (forall d. Data d => d -> m d) -> Alias -> m Alias
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alias -> m Alias
gmapM :: (forall d. Data d => d -> m d) -> Alias -> m Alias
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Alias -> m Alias
gmapQi :: Int -> (forall d. Data d => d -> u) -> Alias -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Alias -> u
gmapQ :: (forall d. Data d => d -> u) -> Alias -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Alias -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Alias -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Alias -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Alias -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Alias -> r
gmapT :: (forall b. Data b => b -> b) -> Alias -> Alias
$cgmapT :: (forall b. Data b => b -> b) -> Alias -> Alias
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Alias)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Alias)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Alias)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Alias)
dataTypeOf :: Alias -> DataType
$cdataTypeOf :: Alias -> DataType
toConstr :: Alias -> Constr
$ctoConstr :: Alias -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alias
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Alias
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alias -> c Alias
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alias -> c Alias
$cp1Data :: Typeable Alias
Data, Alias -> Q Exp
Alias -> Q (TExp Alias)
(Alias -> Q Exp) -> (Alias -> Q (TExp Alias)) -> Lift Alias
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Alias -> Q (TExp Alias)
$cliftTyped :: Alias -> Q (TExp Alias)
lift :: Alias -> Q Exp
$clift :: Alias -> Q Exp
Lift)

data JoinType = Inner | LeftJoin | RightJoin | Full
    deriving (Int -> JoinType -> ShowS
[JoinType] -> ShowS
JoinType -> String
(Int -> JoinType -> ShowS)
-> (JoinType -> String) -> ([JoinType] -> ShowS) -> Show JoinType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinType] -> ShowS
$cshowList :: [JoinType] -> ShowS
show :: JoinType -> String
$cshow :: JoinType -> String
showsPrec :: Int -> JoinType -> ShowS
$cshowsPrec :: Int -> JoinType -> ShowS
Show, JoinType -> JoinType -> Bool
(JoinType -> JoinType -> Bool)
-> (JoinType -> JoinType -> Bool) -> Eq JoinType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoinType -> JoinType -> Bool
$c/= :: JoinType -> JoinType -> Bool
== :: JoinType -> JoinType -> Bool
$c== :: JoinType -> JoinType -> Bool
Eq, (forall x. JoinType -> Rep JoinType x)
-> (forall x. Rep JoinType x -> JoinType) -> Generic JoinType
forall x. Rep JoinType x -> JoinType
forall x. JoinType -> Rep JoinType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoinType x -> JoinType
$cfrom :: forall x. JoinType -> Rep JoinType x
Generic, Typeable, Typeable JoinType
DataType
Constr
Typeable JoinType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JoinType -> c JoinType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoinType)
-> (JoinType -> Constr)
-> (JoinType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoinType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinType))
-> ((forall b. Data b => b -> b) -> JoinType -> JoinType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinType -> r)
-> (forall u. (forall d. Data d => d -> u) -> JoinType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JoinType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JoinType -> m JoinType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinType -> m JoinType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinType -> m JoinType)
-> Data JoinType
JoinType -> DataType
JoinType -> Constr
(forall b. Data b => b -> b) -> JoinType -> JoinType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinType -> c JoinType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JoinType -> u
forall u. (forall d. Data d => d -> u) -> JoinType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinType -> c JoinType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinType)
$cFull :: Constr
$cRightJoin :: Constr
$cLeftJoin :: Constr
$cInner :: Constr
$tJoinType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JoinType -> m JoinType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
gmapMp :: (forall d. Data d => d -> m d) -> JoinType -> m JoinType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
gmapM :: (forall d. Data d => d -> m d) -> JoinType -> m JoinType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
gmapQi :: Int -> (forall d. Data d => d -> u) -> JoinType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JoinType -> u
gmapQ :: (forall d. Data d => d -> u) -> JoinType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoinType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
gmapT :: (forall b. Data b => b -> b) -> JoinType -> JoinType
$cgmapT :: (forall b. Data b => b -> b) -> JoinType -> JoinType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JoinType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinType)
dataTypeOf :: JoinType -> DataType
$cdataTypeOf :: JoinType -> DataType
toConstr :: JoinType -> Constr
$ctoConstr :: JoinType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinType -> c JoinType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinType -> c JoinType
$cp1Data :: Typeable JoinType
Data, JoinType -> Q Exp
JoinType -> Q (TExp JoinType)
(JoinType -> Q Exp)
-> (JoinType -> Q (TExp JoinType)) -> Lift JoinType
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: JoinType -> Q (TExp JoinType)
$cliftTyped :: JoinType -> Q (TExp JoinType)
lift :: JoinType -> Q Exp
$clift :: JoinType -> Q Exp
Lift, Int -> JoinType
JoinType -> Int
JoinType -> [JoinType]
JoinType -> JoinType
JoinType -> JoinType -> [JoinType]
JoinType -> JoinType -> JoinType -> [JoinType]
(JoinType -> JoinType)
-> (JoinType -> JoinType)
-> (Int -> JoinType)
-> (JoinType -> Int)
-> (JoinType -> [JoinType])
-> (JoinType -> JoinType -> [JoinType])
-> (JoinType -> JoinType -> [JoinType])
-> (JoinType -> JoinType -> JoinType -> [JoinType])
-> Enum JoinType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JoinType -> JoinType -> JoinType -> [JoinType]
$cenumFromThenTo :: JoinType -> JoinType -> JoinType -> [JoinType]
enumFromTo :: JoinType -> JoinType -> [JoinType]
$cenumFromTo :: JoinType -> JoinType -> [JoinType]
enumFromThen :: JoinType -> JoinType -> [JoinType]
$cenumFromThen :: JoinType -> JoinType -> [JoinType]
enumFrom :: JoinType -> [JoinType]
$cenumFrom :: JoinType -> [JoinType]
fromEnum :: JoinType -> Int
$cfromEnum :: JoinType -> Int
toEnum :: Int -> JoinType
$ctoEnum :: Int -> JoinType
pred :: JoinType -> JoinType
$cpred :: JoinType -> JoinType
succ :: JoinType -> JoinType
$csucc :: JoinType -> JoinType
Enum, JoinType
JoinType -> JoinType -> Bounded JoinType
forall a. a -> a -> Bounded a
maxBound :: JoinType
$cmaxBound :: JoinType
minBound :: JoinType
$cminBound :: JoinType
Bounded)

data JoinQual = Using [Name] | On Expr | Natural
    deriving (Int -> JoinQual -> ShowS
[JoinQual] -> ShowS
JoinQual -> String
(Int -> JoinQual -> ShowS)
-> (JoinQual -> String) -> ([JoinQual] -> ShowS) -> Show JoinQual
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinQual] -> ShowS
$cshowList :: [JoinQual] -> ShowS
show :: JoinQual -> String
$cshow :: JoinQual -> String
showsPrec :: Int -> JoinQual -> ShowS
$cshowsPrec :: Int -> JoinQual -> ShowS
Show, JoinQual -> JoinQual -> Bool
(JoinQual -> JoinQual -> Bool)
-> (JoinQual -> JoinQual -> Bool) -> Eq JoinQual
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoinQual -> JoinQual -> Bool
$c/= :: JoinQual -> JoinQual -> Bool
== :: JoinQual -> JoinQual -> Bool
$c== :: JoinQual -> JoinQual -> Bool
Eq, (forall x. JoinQual -> Rep JoinQual x)
-> (forall x. Rep JoinQual x -> JoinQual) -> Generic JoinQual
forall x. Rep JoinQual x -> JoinQual
forall x. JoinQual -> Rep JoinQual x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoinQual x -> JoinQual
$cfrom :: forall x. JoinQual -> Rep JoinQual x
Generic, Typeable, Typeable JoinQual
DataType
Constr
Typeable JoinQual
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JoinQual -> c JoinQual)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoinQual)
-> (JoinQual -> Constr)
-> (JoinQual -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoinQual))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinQual))
-> ((forall b. Data b => b -> b) -> JoinQual -> JoinQual)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinQual -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinQual -> r)
-> (forall u. (forall d. Data d => d -> u) -> JoinQual -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JoinQual -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JoinQual -> m JoinQual)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinQual -> m JoinQual)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinQual -> m JoinQual)
-> Data JoinQual
JoinQual -> DataType
JoinQual -> Constr
(forall b. Data b => b -> b) -> JoinQual -> JoinQual
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinQual -> c JoinQual
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinQual
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JoinQual -> u
forall u. (forall d. Data d => d -> u) -> JoinQual -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinQual -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinQual -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinQual -> m JoinQual
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinQual -> m JoinQual
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinQual
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinQual -> c JoinQual
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinQual)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinQual)
$cNatural :: Constr
$cOn :: Constr
$cUsing :: Constr
$tJoinQual :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JoinQual -> m JoinQual
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinQual -> m JoinQual
gmapMp :: (forall d. Data d => d -> m d) -> JoinQual -> m JoinQual
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinQual -> m JoinQual
gmapM :: (forall d. Data d => d -> m d) -> JoinQual -> m JoinQual
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinQual -> m JoinQual
gmapQi :: Int -> (forall d. Data d => d -> u) -> JoinQual -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JoinQual -> u
gmapQ :: (forall d. Data d => d -> u) -> JoinQual -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoinQual -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinQual -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinQual -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinQual -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinQual -> r
gmapT :: (forall b. Data b => b -> b) -> JoinQual -> JoinQual
$cgmapT :: (forall b. Data b => b -> b) -> JoinQual -> JoinQual
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinQual)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinQual)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JoinQual)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinQual)
dataTypeOf :: JoinQual -> DataType
$cdataTypeOf :: JoinQual -> DataType
toConstr :: JoinQual -> Constr
$ctoConstr :: JoinQual -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinQual
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinQual
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinQual -> c JoinQual
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinQual -> c JoinQual
$cp1Data :: Typeable JoinQual
Data, JoinQual -> Q Exp
JoinQual -> Q (TExp JoinQual)
(JoinQual -> Q Exp)
-> (JoinQual -> Q (TExp JoinQual)) -> Lift JoinQual
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: JoinQual -> Q (TExp JoinQual)
$cliftTyped :: JoinQual -> Q (TExp JoinQual)
lift :: JoinQual -> Q Exp
$clift :: JoinQual -> Q Exp
Lift)

data DistinctClause = DistinctAll | DistinctOn (NonEmpty Expr)
    deriving (Int -> DistinctClause -> ShowS
[DistinctClause] -> ShowS
DistinctClause -> String
(Int -> DistinctClause -> ShowS)
-> (DistinctClause -> String)
-> ([DistinctClause] -> ShowS)
-> Show DistinctClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistinctClause] -> ShowS
$cshowList :: [DistinctClause] -> ShowS
show :: DistinctClause -> String
$cshow :: DistinctClause -> String
showsPrec :: Int -> DistinctClause -> ShowS
$cshowsPrec :: Int -> DistinctClause -> ShowS
Show, DistinctClause -> DistinctClause -> Bool
(DistinctClause -> DistinctClause -> Bool)
-> (DistinctClause -> DistinctClause -> Bool) -> Eq DistinctClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistinctClause -> DistinctClause -> Bool
$c/= :: DistinctClause -> DistinctClause -> Bool
== :: DistinctClause -> DistinctClause -> Bool
$c== :: DistinctClause -> DistinctClause -> Bool
Eq, (forall x. DistinctClause -> Rep DistinctClause x)
-> (forall x. Rep DistinctClause x -> DistinctClause)
-> Generic DistinctClause
forall x. Rep DistinctClause x -> DistinctClause
forall x. DistinctClause -> Rep DistinctClause x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DistinctClause x -> DistinctClause
$cfrom :: forall x. DistinctClause -> Rep DistinctClause x
Generic, Typeable, Typeable DistinctClause
DataType
Constr
Typeable DistinctClause
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DistinctClause -> c DistinctClause)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DistinctClause)
-> (DistinctClause -> Constr)
-> (DistinctClause -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DistinctClause))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DistinctClause))
-> ((forall b. Data b => b -> b)
    -> DistinctClause -> DistinctClause)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DistinctClause -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DistinctClause -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DistinctClause -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DistinctClause -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DistinctClause -> m DistinctClause)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DistinctClause -> m DistinctClause)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DistinctClause -> m DistinctClause)
-> Data DistinctClause
DistinctClause -> DataType
DistinctClause -> Constr
(forall b. Data b => b -> b) -> DistinctClause -> DistinctClause
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DistinctClause -> c DistinctClause
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DistinctClause
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DistinctClause -> u
forall u. (forall d. Data d => d -> u) -> DistinctClause -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DistinctClause -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DistinctClause -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DistinctClause -> m DistinctClause
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DistinctClause -> m DistinctClause
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DistinctClause
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DistinctClause -> c DistinctClause
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DistinctClause)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DistinctClause)
$cDistinctOn :: Constr
$cDistinctAll :: Constr
$tDistinctClause :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DistinctClause -> m DistinctClause
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DistinctClause -> m DistinctClause
gmapMp :: (forall d. Data d => d -> m d)
-> DistinctClause -> m DistinctClause
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DistinctClause -> m DistinctClause
gmapM :: (forall d. Data d => d -> m d)
-> DistinctClause -> m DistinctClause
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DistinctClause -> m DistinctClause
gmapQi :: Int -> (forall d. Data d => d -> u) -> DistinctClause -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DistinctClause -> u
gmapQ :: (forall d. Data d => d -> u) -> DistinctClause -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DistinctClause -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DistinctClause -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DistinctClause -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DistinctClause -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DistinctClause -> r
gmapT :: (forall b. Data b => b -> b) -> DistinctClause -> DistinctClause
$cgmapT :: (forall b. Data b => b -> b) -> DistinctClause -> DistinctClause
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DistinctClause)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DistinctClause)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DistinctClause)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DistinctClause)
dataTypeOf :: DistinctClause -> DataType
$cdataTypeOf :: DistinctClause -> DataType
toConstr :: DistinctClause -> Constr
$ctoConstr :: DistinctClause -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DistinctClause
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DistinctClause
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DistinctClause -> c DistinctClause
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DistinctClause -> c DistinctClause
$cp1Data :: Typeable DistinctClause
Data, DistinctClause -> Q Exp
DistinctClause -> Q (TExp DistinctClause)
(DistinctClause -> Q Exp)
-> (DistinctClause -> Q (TExp DistinctClause))
-> Lift DistinctClause
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: DistinctClause -> Q (TExp DistinctClause)
$cliftTyped :: DistinctClause -> Q (TExp DistinctClause)
lift :: DistinctClause -> Q Exp
$clift :: DistinctClause -> Q Exp
Lift)

data SetOp = Union | Intersect | Except
    deriving (Int -> SetOp -> ShowS
[SetOp] -> ShowS
SetOp -> String
(Int -> SetOp -> ShowS)
-> (SetOp -> String) -> ([SetOp] -> ShowS) -> Show SetOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetOp] -> ShowS
$cshowList :: [SetOp] -> ShowS
show :: SetOp -> String
$cshow :: SetOp -> String
showsPrec :: Int -> SetOp -> ShowS
$cshowsPrec :: Int -> SetOp -> ShowS
Show, SetOp -> SetOp -> Bool
(SetOp -> SetOp -> Bool) -> (SetOp -> SetOp -> Bool) -> Eq SetOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetOp -> SetOp -> Bool
$c/= :: SetOp -> SetOp -> Bool
== :: SetOp -> SetOp -> Bool
$c== :: SetOp -> SetOp -> Bool
Eq, (forall x. SetOp -> Rep SetOp x)
-> (forall x. Rep SetOp x -> SetOp) -> Generic SetOp
forall x. Rep SetOp x -> SetOp
forall x. SetOp -> Rep SetOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetOp x -> SetOp
$cfrom :: forall x. SetOp -> Rep SetOp x
Generic, Typeable, Typeable SetOp
DataType
Constr
Typeable SetOp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SetOp -> c SetOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SetOp)
-> (SetOp -> Constr)
-> (SetOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SetOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp))
-> ((forall b. Data b => b -> b) -> SetOp -> SetOp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> SetOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SetOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SetOp -> m SetOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SetOp -> m SetOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SetOp -> m SetOp)
-> Data SetOp
SetOp -> DataType
SetOp -> Constr
(forall b. Data b => b -> b) -> SetOp -> SetOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SetOp -> u
forall u. (forall d. Data d => d -> u) -> SetOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp)
$cExcept :: Constr
$cIntersect :: Constr
$cUnion :: Constr
$tSetOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SetOp -> m SetOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
gmapMp :: (forall d. Data d => d -> m d) -> SetOp -> m SetOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
gmapM :: (forall d. Data d => d -> m d) -> SetOp -> m SetOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> SetOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SetOp -> u
gmapQ :: (forall d. Data d => d -> u) -> SetOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SetOp -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
gmapT :: (forall b. Data b => b -> b) -> SetOp -> SetOp
$cgmapT :: (forall b. Data b => b -> b) -> SetOp -> SetOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SetOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetOp)
dataTypeOf :: SetOp -> DataType
$cdataTypeOf :: SetOp -> DataType
toConstr :: SetOp -> Constr
$ctoConstr :: SetOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
$cp1Data :: Typeable SetOp
Data, SetOp -> Q Exp
SetOp -> Q (TExp SetOp)
(SetOp -> Q Exp) -> (SetOp -> Q (TExp SetOp)) -> Lift SetOp
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SetOp -> Q (TExp SetOp)
$cliftTyped :: SetOp -> Q (TExp SetOp)
lift :: SetOp -> Q Exp
$clift :: SetOp -> Q Exp
Lift, Int -> SetOp
SetOp -> Int
SetOp -> [SetOp]
SetOp -> SetOp
SetOp -> SetOp -> [SetOp]
SetOp -> SetOp -> SetOp -> [SetOp]
(SetOp -> SetOp)
-> (SetOp -> SetOp)
-> (Int -> SetOp)
-> (SetOp -> Int)
-> (SetOp -> [SetOp])
-> (SetOp -> SetOp -> [SetOp])
-> (SetOp -> SetOp -> [SetOp])
-> (SetOp -> SetOp -> SetOp -> [SetOp])
-> Enum SetOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SetOp -> SetOp -> SetOp -> [SetOp]
$cenumFromThenTo :: SetOp -> SetOp -> SetOp -> [SetOp]
enumFromTo :: SetOp -> SetOp -> [SetOp]
$cenumFromTo :: SetOp -> SetOp -> [SetOp]
enumFromThen :: SetOp -> SetOp -> [SetOp]
$cenumFromThen :: SetOp -> SetOp -> [SetOp]
enumFrom :: SetOp -> [SetOp]
$cenumFrom :: SetOp -> [SetOp]
fromEnum :: SetOp -> Int
$cfromEnum :: SetOp -> Int
toEnum :: Int -> SetOp
$ctoEnum :: Int -> SetOp
pred :: SetOp -> SetOp
$cpred :: SetOp -> SetOp
succ :: SetOp -> SetOp
$csucc :: SetOp -> SetOp
Enum, SetOp
SetOp -> SetOp -> Bounded SetOp
forall a. a -> a -> Bounded a
maxBound :: SetOp
$cmaxBound :: SetOp
minBound :: SetOp
$cminBound :: SetOp
Bounded)

data AllOrDistinct = All | Distinct
    deriving (Int -> AllOrDistinct -> ShowS
[AllOrDistinct] -> ShowS
AllOrDistinct -> String
(Int -> AllOrDistinct -> ShowS)
-> (AllOrDistinct -> String)
-> ([AllOrDistinct] -> ShowS)
-> Show AllOrDistinct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllOrDistinct] -> ShowS
$cshowList :: [AllOrDistinct] -> ShowS
show :: AllOrDistinct -> String
$cshow :: AllOrDistinct -> String
showsPrec :: Int -> AllOrDistinct -> ShowS
$cshowsPrec :: Int -> AllOrDistinct -> ShowS
Show, AllOrDistinct -> AllOrDistinct -> Bool
(AllOrDistinct -> AllOrDistinct -> Bool)
-> (AllOrDistinct -> AllOrDistinct -> Bool) -> Eq AllOrDistinct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllOrDistinct -> AllOrDistinct -> Bool
$c/= :: AllOrDistinct -> AllOrDistinct -> Bool
== :: AllOrDistinct -> AllOrDistinct -> Bool
$c== :: AllOrDistinct -> AllOrDistinct -> Bool
Eq, (forall x. AllOrDistinct -> Rep AllOrDistinct x)
-> (forall x. Rep AllOrDistinct x -> AllOrDistinct)
-> Generic AllOrDistinct
forall x. Rep AllOrDistinct x -> AllOrDistinct
forall x. AllOrDistinct -> Rep AllOrDistinct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllOrDistinct x -> AllOrDistinct
$cfrom :: forall x. AllOrDistinct -> Rep AllOrDistinct x
Generic, Typeable, Typeable AllOrDistinct
DataType
Constr
Typeable AllOrDistinct
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AllOrDistinct -> c AllOrDistinct)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AllOrDistinct)
-> (AllOrDistinct -> Constr)
-> (AllOrDistinct -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AllOrDistinct))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AllOrDistinct))
-> ((forall b. Data b => b -> b) -> AllOrDistinct -> AllOrDistinct)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AllOrDistinct -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AllOrDistinct -> r)
-> (forall u. (forall d. Data d => d -> u) -> AllOrDistinct -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AllOrDistinct -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct)
-> Data AllOrDistinct
AllOrDistinct -> DataType
AllOrDistinct -> Constr
(forall b. Data b => b -> b) -> AllOrDistinct -> AllOrDistinct
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AllOrDistinct -> c AllOrDistinct
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AllOrDistinct
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AllOrDistinct -> u
forall u. (forall d. Data d => d -> u) -> AllOrDistinct -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AllOrDistinct -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AllOrDistinct -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AllOrDistinct
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AllOrDistinct -> c AllOrDistinct
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AllOrDistinct)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AllOrDistinct)
$cDistinct :: Constr
$cAll :: Constr
$tAllOrDistinct :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct
gmapMp :: (forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct
gmapM :: (forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AllOrDistinct -> m AllOrDistinct
gmapQi :: Int -> (forall d. Data d => d -> u) -> AllOrDistinct -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AllOrDistinct -> u
gmapQ :: (forall d. Data d => d -> u) -> AllOrDistinct -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AllOrDistinct -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AllOrDistinct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AllOrDistinct -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AllOrDistinct -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AllOrDistinct -> r
gmapT :: (forall b. Data b => b -> b) -> AllOrDistinct -> AllOrDistinct
$cgmapT :: (forall b. Data b => b -> b) -> AllOrDistinct -> AllOrDistinct
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AllOrDistinct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AllOrDistinct)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AllOrDistinct)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AllOrDistinct)
dataTypeOf :: AllOrDistinct -> DataType
$cdataTypeOf :: AllOrDistinct -> DataType
toConstr :: AllOrDistinct -> Constr
$ctoConstr :: AllOrDistinct -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AllOrDistinct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AllOrDistinct
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AllOrDistinct -> c AllOrDistinct
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AllOrDistinct -> c AllOrDistinct
$cp1Data :: Typeable AllOrDistinct
Data, AllOrDistinct -> Q Exp
AllOrDistinct -> Q (TExp AllOrDistinct)
(AllOrDistinct -> Q Exp)
-> (AllOrDistinct -> Q (TExp AllOrDistinct)) -> Lift AllOrDistinct
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: AllOrDistinct -> Q (TExp AllOrDistinct)
$cliftTyped :: AllOrDistinct -> Q (TExp AllOrDistinct)
lift :: AllOrDistinct -> Q Exp
$clift :: AllOrDistinct -> Q Exp
Lift, Int -> AllOrDistinct
AllOrDistinct -> Int
AllOrDistinct -> [AllOrDistinct]
AllOrDistinct -> AllOrDistinct
AllOrDistinct -> AllOrDistinct -> [AllOrDistinct]
AllOrDistinct -> AllOrDistinct -> AllOrDistinct -> [AllOrDistinct]
(AllOrDistinct -> AllOrDistinct)
-> (AllOrDistinct -> AllOrDistinct)
-> (Int -> AllOrDistinct)
-> (AllOrDistinct -> Int)
-> (AllOrDistinct -> [AllOrDistinct])
-> (AllOrDistinct -> AllOrDistinct -> [AllOrDistinct])
-> (AllOrDistinct -> AllOrDistinct -> [AllOrDistinct])
-> (AllOrDistinct
    -> AllOrDistinct -> AllOrDistinct -> [AllOrDistinct])
-> Enum AllOrDistinct
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AllOrDistinct -> AllOrDistinct -> AllOrDistinct -> [AllOrDistinct]
$cenumFromThenTo :: AllOrDistinct -> AllOrDistinct -> AllOrDistinct -> [AllOrDistinct]
enumFromTo :: AllOrDistinct -> AllOrDistinct -> [AllOrDistinct]
$cenumFromTo :: AllOrDistinct -> AllOrDistinct -> [AllOrDistinct]
enumFromThen :: AllOrDistinct -> AllOrDistinct -> [AllOrDistinct]
$cenumFromThen :: AllOrDistinct -> AllOrDistinct -> [AllOrDistinct]
enumFrom :: AllOrDistinct -> [AllOrDistinct]
$cenumFrom :: AllOrDistinct -> [AllOrDistinct]
fromEnum :: AllOrDistinct -> Int
$cfromEnum :: AllOrDistinct -> Int
toEnum :: Int -> AllOrDistinct
$ctoEnum :: Int -> AllOrDistinct
pred :: AllOrDistinct -> AllOrDistinct
$cpred :: AllOrDistinct -> AllOrDistinct
succ :: AllOrDistinct -> AllOrDistinct
$csucc :: AllOrDistinct -> AllOrDistinct
Enum, AllOrDistinct
AllOrDistinct -> AllOrDistinct -> Bounded AllOrDistinct
forall a. a -> a -> Bounded a
maxBound :: AllOrDistinct
$cmaxBound :: AllOrDistinct
minBound :: AllOrDistinct
$cminBound :: AllOrDistinct
Bounded)

data ResTarget = Star | Column Expr (Maybe Name)
    deriving (Int -> ResTarget -> ShowS
[ResTarget] -> ShowS
ResTarget -> String
(Int -> ResTarget -> ShowS)
-> (ResTarget -> String)
-> ([ResTarget] -> ShowS)
-> Show ResTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResTarget] -> ShowS
$cshowList :: [ResTarget] -> ShowS
show :: ResTarget -> String
$cshow :: ResTarget -> String
showsPrec :: Int -> ResTarget -> ShowS
$cshowsPrec :: Int -> ResTarget -> ShowS
Show, ResTarget -> ResTarget -> Bool
(ResTarget -> ResTarget -> Bool)
-> (ResTarget -> ResTarget -> Bool) -> Eq ResTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResTarget -> ResTarget -> Bool
$c/= :: ResTarget -> ResTarget -> Bool
== :: ResTarget -> ResTarget -> Bool
$c== :: ResTarget -> ResTarget -> Bool
Eq, (forall x. ResTarget -> Rep ResTarget x)
-> (forall x. Rep ResTarget x -> ResTarget) -> Generic ResTarget
forall x. Rep ResTarget x -> ResTarget
forall x. ResTarget -> Rep ResTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResTarget x -> ResTarget
$cfrom :: forall x. ResTarget -> Rep ResTarget x
Generic, Typeable, Typeable ResTarget
DataType
Constr
Typeable ResTarget
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ResTarget -> c ResTarget)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ResTarget)
-> (ResTarget -> Constr)
-> (ResTarget -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ResTarget))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResTarget))
-> ((forall b. Data b => b -> b) -> ResTarget -> ResTarget)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ResTarget -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ResTarget -> r)
-> (forall u. (forall d. Data d => d -> u) -> ResTarget -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ResTarget -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ResTarget -> m ResTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ResTarget -> m ResTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ResTarget -> m ResTarget)
-> Data ResTarget
ResTarget -> DataType
ResTarget -> Constr
(forall b. Data b => b -> b) -> ResTarget -> ResTarget
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResTarget -> c ResTarget
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResTarget
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ResTarget -> u
forall u. (forall d. Data d => d -> u) -> ResTarget -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResTarget -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResTarget -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ResTarget -> m ResTarget
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResTarget -> m ResTarget
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResTarget
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResTarget -> c ResTarget
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResTarget)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResTarget)
$cColumn :: Constr
$cStar :: Constr
$tResTarget :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ResTarget -> m ResTarget
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResTarget -> m ResTarget
gmapMp :: (forall d. Data d => d -> m d) -> ResTarget -> m ResTarget
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResTarget -> m ResTarget
gmapM :: (forall d. Data d => d -> m d) -> ResTarget -> m ResTarget
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ResTarget -> m ResTarget
gmapQi :: Int -> (forall d. Data d => d -> u) -> ResTarget -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ResTarget -> u
gmapQ :: (forall d. Data d => d -> u) -> ResTarget -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ResTarget -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResTarget -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResTarget -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResTarget -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResTarget -> r
gmapT :: (forall b. Data b => b -> b) -> ResTarget -> ResTarget
$cgmapT :: (forall b. Data b => b -> b) -> ResTarget -> ResTarget
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResTarget)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResTarget)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ResTarget)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResTarget)
dataTypeOf :: ResTarget -> DataType
$cdataTypeOf :: ResTarget -> DataType
toConstr :: ResTarget -> Constr
$ctoConstr :: ResTarget -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResTarget
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResTarget
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResTarget -> c ResTarget
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResTarget -> c ResTarget
$cp1Data :: Typeable ResTarget
Data, ResTarget -> Q Exp
ResTarget -> Q (TExp ResTarget)
(ResTarget -> Q Exp)
-> (ResTarget -> Q (TExp ResTarget)) -> Lift ResTarget
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ResTarget -> Q (TExp ResTarget)
$cliftTyped :: ResTarget -> Q (TExp ResTarget)
lift :: ResTarget -> Q Exp
$clift :: ResTarget -> Q Exp
Lift)

data WindowDef = WindowDef Name WindowSpec
    deriving (Int -> WindowDef -> ShowS
[WindowDef] -> ShowS
WindowDef -> String
(Int -> WindowDef -> ShowS)
-> (WindowDef -> String)
-> ([WindowDef] -> ShowS)
-> Show WindowDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowDef] -> ShowS
$cshowList :: [WindowDef] -> ShowS
show :: WindowDef -> String
$cshow :: WindowDef -> String
showsPrec :: Int -> WindowDef -> ShowS
$cshowsPrec :: Int -> WindowDef -> ShowS
Show, WindowDef -> WindowDef -> Bool
(WindowDef -> WindowDef -> Bool)
-> (WindowDef -> WindowDef -> Bool) -> Eq WindowDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowDef -> WindowDef -> Bool
$c/= :: WindowDef -> WindowDef -> Bool
== :: WindowDef -> WindowDef -> Bool
$c== :: WindowDef -> WindowDef -> Bool
Eq, (forall x. WindowDef -> Rep WindowDef x)
-> (forall x. Rep WindowDef x -> WindowDef) -> Generic WindowDef
forall x. Rep WindowDef x -> WindowDef
forall x. WindowDef -> Rep WindowDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowDef x -> WindowDef
$cfrom :: forall x. WindowDef -> Rep WindowDef x
Generic, Typeable, Typeable WindowDef
DataType
Constr
Typeable WindowDef
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WindowDef -> c WindowDef)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WindowDef)
-> (WindowDef -> Constr)
-> (WindowDef -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WindowDef))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowDef))
-> ((forall b. Data b => b -> b) -> WindowDef -> WindowDef)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowDef -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowDef -> r)
-> (forall u. (forall d. Data d => d -> u) -> WindowDef -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WindowDef -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WindowDef -> m WindowDef)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowDef -> m WindowDef)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowDef -> m WindowDef)
-> Data WindowDef
WindowDef -> DataType
WindowDef -> Constr
(forall b. Data b => b -> b) -> WindowDef -> WindowDef
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowDef -> c WindowDef
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowDef
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WindowDef -> u
forall u. (forall d. Data d => d -> u) -> WindowDef -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowDef -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowDef -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WindowDef -> m WindowDef
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowDef -> m WindowDef
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowDef
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowDef -> c WindowDef
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowDef)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowDef)
$cWindowDef :: Constr
$tWindowDef :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WindowDef -> m WindowDef
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowDef -> m WindowDef
gmapMp :: (forall d. Data d => d -> m d) -> WindowDef -> m WindowDef
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowDef -> m WindowDef
gmapM :: (forall d. Data d => d -> m d) -> WindowDef -> m WindowDef
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WindowDef -> m WindowDef
gmapQi :: Int -> (forall d. Data d => d -> u) -> WindowDef -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WindowDef -> u
gmapQ :: (forall d. Data d => d -> u) -> WindowDef -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WindowDef -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowDef -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowDef -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowDef -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowDef -> r
gmapT :: (forall b. Data b => b -> b) -> WindowDef -> WindowDef
$cgmapT :: (forall b. Data b => b -> b) -> WindowDef -> WindowDef
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowDef)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowDef)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WindowDef)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowDef)
dataTypeOf :: WindowDef -> DataType
$cdataTypeOf :: WindowDef -> DataType
toConstr :: WindowDef -> Constr
$ctoConstr :: WindowDef -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowDef
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowDef
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowDef -> c WindowDef
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowDef -> c WindowDef
$cp1Data :: Typeable WindowDef
Data, WindowDef -> Q Exp
WindowDef -> Q (TExp WindowDef)
(WindowDef -> Q Exp)
-> (WindowDef -> Q (TExp WindowDef)) -> Lift WindowDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: WindowDef -> Q (TExp WindowDef)
$cliftTyped :: WindowDef -> Q (TExp WindowDef)
lift :: WindowDef -> Q Exp
$clift :: WindowDef -> Q Exp
Lift)

data Over = WindowName Name | Window WindowSpec
    deriving (Int -> Over -> ShowS
[Over] -> ShowS
Over -> String
(Int -> Over -> ShowS)
-> (Over -> String) -> ([Over] -> ShowS) -> Show Over
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Over] -> ShowS
$cshowList :: [Over] -> ShowS
show :: Over -> String
$cshow :: Over -> String
showsPrec :: Int -> Over -> ShowS
$cshowsPrec :: Int -> Over -> ShowS
Show, Over -> Over -> Bool
(Over -> Over -> Bool) -> (Over -> Over -> Bool) -> Eq Over
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Over -> Over -> Bool
$c/= :: Over -> Over -> Bool
== :: Over -> Over -> Bool
$c== :: Over -> Over -> Bool
Eq, (forall x. Over -> Rep Over x)
-> (forall x. Rep Over x -> Over) -> Generic Over
forall x. Rep Over x -> Over
forall x. Over -> Rep Over x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Over x -> Over
$cfrom :: forall x. Over -> Rep Over x
Generic, Typeable, Typeable Over
DataType
Constr
Typeable Over
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Over -> c Over)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Over)
-> (Over -> Constr)
-> (Over -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Over))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Over))
-> ((forall b. Data b => b -> b) -> Over -> Over)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Over -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Over -> r)
-> (forall u. (forall d. Data d => d -> u) -> Over -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Over -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Over -> m Over)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Over -> m Over)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Over -> m Over)
-> Data Over
Over -> DataType
Over -> Constr
(forall b. Data b => b -> b) -> Over -> Over
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Over -> c Over
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Over
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Over -> u
forall u. (forall d. Data d => d -> u) -> Over -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Over -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Over -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Over -> m Over
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Over -> m Over
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Over
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Over -> c Over
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Over)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Over)
$cWindow :: Constr
$cWindowName :: Constr
$tOver :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Over -> m Over
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Over -> m Over
gmapMp :: (forall d. Data d => d -> m d) -> Over -> m Over
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Over -> m Over
gmapM :: (forall d. Data d => d -> m d) -> Over -> m Over
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Over -> m Over
gmapQi :: Int -> (forall d. Data d => d -> u) -> Over -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Over -> u
gmapQ :: (forall d. Data d => d -> u) -> Over -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Over -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Over -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Over -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Over -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Over -> r
gmapT :: (forall b. Data b => b -> b) -> Over -> Over
$cgmapT :: (forall b. Data b => b -> b) -> Over -> Over
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Over)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Over)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Over)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Over)
dataTypeOf :: Over -> DataType
$cdataTypeOf :: Over -> DataType
toConstr :: Over -> Constr
$ctoConstr :: Over -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Over
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Over
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Over -> c Over
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Over -> c Over
$cp1Data :: Typeable Over
Data, Over -> Q Exp
Over -> Q (TExp Over)
(Over -> Q Exp) -> (Over -> Q (TExp Over)) -> Lift Over
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Over -> Q (TExp Over)
$cliftTyped :: Over -> Q (TExp Over)
lift :: Over -> Q Exp
$clift :: Over -> Q Exp
Lift)

data WindowSpec = WindowSpec
    { WindowSpec -> Maybe Name
refName :: Maybe Name
    , WindowSpec -> [Expr]
partitionClause :: [Expr]
    , WindowSpec -> [SortBy]
orderClause :: [SortBy ]
    -- , frameOptions :: _ -- FIXME implement
    } deriving (Int -> WindowSpec -> ShowS
[WindowSpec] -> ShowS
WindowSpec -> String
(Int -> WindowSpec -> ShowS)
-> (WindowSpec -> String)
-> ([WindowSpec] -> ShowS)
-> Show WindowSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowSpec] -> ShowS
$cshowList :: [WindowSpec] -> ShowS
show :: WindowSpec -> String
$cshow :: WindowSpec -> String
showsPrec :: Int -> WindowSpec -> ShowS
$cshowsPrec :: Int -> WindowSpec -> ShowS
Show, WindowSpec -> WindowSpec -> Bool
(WindowSpec -> WindowSpec -> Bool)
-> (WindowSpec -> WindowSpec -> Bool) -> Eq WindowSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowSpec -> WindowSpec -> Bool
$c/= :: WindowSpec -> WindowSpec -> Bool
== :: WindowSpec -> WindowSpec -> Bool
$c== :: WindowSpec -> WindowSpec -> Bool
Eq, (forall x. WindowSpec -> Rep WindowSpec x)
-> (forall x. Rep WindowSpec x -> WindowSpec) -> Generic WindowSpec
forall x. Rep WindowSpec x -> WindowSpec
forall x. WindowSpec -> Rep WindowSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowSpec x -> WindowSpec
$cfrom :: forall x. WindowSpec -> Rep WindowSpec x
Generic, Typeable, Typeable WindowSpec
DataType
Constr
Typeable WindowSpec
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WindowSpec -> c WindowSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WindowSpec)
-> (WindowSpec -> Constr)
-> (WindowSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WindowSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WindowSpec))
-> ((forall b. Data b => b -> b) -> WindowSpec -> WindowSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowSpec -> r)
-> (forall u. (forall d. Data d => d -> u) -> WindowSpec -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WindowSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec)
-> Data WindowSpec
WindowSpec -> DataType
WindowSpec -> Constr
(forall b. Data b => b -> b) -> WindowSpec -> WindowSpec
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowSpec -> c WindowSpec
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowSpec
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WindowSpec -> u
forall u. (forall d. Data d => d -> u) -> WindowSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowSpec -> c WindowSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowSpec)
$cWindowSpec :: Constr
$tWindowSpec :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec
gmapMp :: (forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec
gmapM :: (forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WindowSpec -> m WindowSpec
gmapQi :: Int -> (forall d. Data d => d -> u) -> WindowSpec -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WindowSpec -> u
gmapQ :: (forall d. Data d => d -> u) -> WindowSpec -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WindowSpec -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowSpec -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowSpec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowSpec -> r
gmapT :: (forall b. Data b => b -> b) -> WindowSpec -> WindowSpec
$cgmapT :: (forall b. Data b => b -> b) -> WindowSpec -> WindowSpec
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowSpec)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WindowSpec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowSpec)
dataTypeOf :: WindowSpec -> DataType
$cdataTypeOf :: WindowSpec -> DataType
toConstr :: WindowSpec -> Constr
$ctoConstr :: WindowSpec -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowSpec
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowSpec -> c WindowSpec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowSpec -> c WindowSpec
$cp1Data :: Typeable WindowSpec
Data, WindowSpec -> Q Exp
WindowSpec -> Q (TExp WindowSpec)
(WindowSpec -> Q Exp)
-> (WindowSpec -> Q (TExp WindowSpec)) -> Lift WindowSpec
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: WindowSpec -> Q (TExp WindowSpec)
$cliftTyped :: WindowSpec -> Q (TExp WindowSpec)
lift :: WindowSpec -> Q Exp
$clift :: WindowSpec -> Q Exp
Lift)

noWindow :: Over
noWindow :: Over
noWindow = WindowSpec -> Over
Window (Maybe Name -> [Expr] -> [SortBy] -> WindowSpec
WindowSpec Maybe Name
forall a. Maybe a
Nothing [] [])

data SortBy = SortBy
    { SortBy -> Expr
column :: Expr
    , SortBy -> SortOrderOrUsing
direction :: SortOrderOrUsing
    , SortBy -> NullsOrder
nulls :: NullsOrder
    } deriving (Int -> SortBy -> ShowS
[SortBy] -> ShowS
SortBy -> String
(Int -> SortBy -> ShowS)
-> (SortBy -> String) -> ([SortBy] -> ShowS) -> Show SortBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortBy] -> ShowS
$cshowList :: [SortBy] -> ShowS
show :: SortBy -> String
$cshow :: SortBy -> String
showsPrec :: Int -> SortBy -> ShowS
$cshowsPrec :: Int -> SortBy -> ShowS
Show, SortBy -> SortBy -> Bool
(SortBy -> SortBy -> Bool)
-> (SortBy -> SortBy -> Bool) -> Eq SortBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortBy -> SortBy -> Bool
$c/= :: SortBy -> SortBy -> Bool
== :: SortBy -> SortBy -> Bool
$c== :: SortBy -> SortBy -> Bool
Eq, (forall x. SortBy -> Rep SortBy x)
-> (forall x. Rep SortBy x -> SortBy) -> Generic SortBy
forall x. Rep SortBy x -> SortBy
forall x. SortBy -> Rep SortBy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SortBy x -> SortBy
$cfrom :: forall x. SortBy -> Rep SortBy x
Generic, Typeable, Typeable SortBy
DataType
Constr
Typeable SortBy
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SortBy -> c SortBy)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SortBy)
-> (SortBy -> Constr)
-> (SortBy -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SortBy))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortBy))
-> ((forall b. Data b => b -> b) -> SortBy -> SortBy)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SortBy -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SortBy -> r)
-> (forall u. (forall d. Data d => d -> u) -> SortBy -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SortBy -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SortBy -> m SortBy)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortBy -> m SortBy)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortBy -> m SortBy)
-> Data SortBy
SortBy -> DataType
SortBy -> Constr
(forall b. Data b => b -> b) -> SortBy -> SortBy
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortBy -> c SortBy
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortBy
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SortBy -> u
forall u. (forall d. Data d => d -> u) -> SortBy -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SortBy -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SortBy -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortBy -> m SortBy
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortBy -> m SortBy
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortBy
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortBy -> c SortBy
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortBy)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortBy)
$cSortBy :: Constr
$tSortBy :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SortBy -> m SortBy
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortBy -> m SortBy
gmapMp :: (forall d. Data d => d -> m d) -> SortBy -> m SortBy
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortBy -> m SortBy
gmapM :: (forall d. Data d => d -> m d) -> SortBy -> m SortBy
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortBy -> m SortBy
gmapQi :: Int -> (forall d. Data d => d -> u) -> SortBy -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortBy -> u
gmapQ :: (forall d. Data d => d -> u) -> SortBy -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SortBy -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SortBy -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SortBy -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SortBy -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SortBy -> r
gmapT :: (forall b. Data b => b -> b) -> SortBy -> SortBy
$cgmapT :: (forall b. Data b => b -> b) -> SortBy -> SortBy
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortBy)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortBy)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SortBy)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortBy)
dataTypeOf :: SortBy -> DataType
$cdataTypeOf :: SortBy -> DataType
toConstr :: SortBy -> Constr
$ctoConstr :: SortBy -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortBy
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortBy
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortBy -> c SortBy
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortBy -> c SortBy
$cp1Data :: Typeable SortBy
Data, SortBy -> Q Exp
SortBy -> Q (TExp SortBy)
(SortBy -> Q Exp) -> (SortBy -> Q (TExp SortBy)) -> Lift SortBy
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SortBy -> Q (TExp SortBy)
$cliftTyped :: SortBy -> Q (TExp SortBy)
lift :: SortBy -> Q Exp
$clift :: SortBy -> Q Exp
Lift)

data SortOrderOrUsing = SortOrder SortOrder | SortUsing BinOp
    deriving (Int -> SortOrderOrUsing -> ShowS
[SortOrderOrUsing] -> ShowS
SortOrderOrUsing -> String
(Int -> SortOrderOrUsing -> ShowS)
-> (SortOrderOrUsing -> String)
-> ([SortOrderOrUsing] -> ShowS)
-> Show SortOrderOrUsing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortOrderOrUsing] -> ShowS
$cshowList :: [SortOrderOrUsing] -> ShowS
show :: SortOrderOrUsing -> String
$cshow :: SortOrderOrUsing -> String
showsPrec :: Int -> SortOrderOrUsing -> ShowS
$cshowsPrec :: Int -> SortOrderOrUsing -> ShowS
Show, SortOrderOrUsing -> SortOrderOrUsing -> Bool
(SortOrderOrUsing -> SortOrderOrUsing -> Bool)
-> (SortOrderOrUsing -> SortOrderOrUsing -> Bool)
-> Eq SortOrderOrUsing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortOrderOrUsing -> SortOrderOrUsing -> Bool
$c/= :: SortOrderOrUsing -> SortOrderOrUsing -> Bool
== :: SortOrderOrUsing -> SortOrderOrUsing -> Bool
$c== :: SortOrderOrUsing -> SortOrderOrUsing -> Bool
Eq, (forall x. SortOrderOrUsing -> Rep SortOrderOrUsing x)
-> (forall x. Rep SortOrderOrUsing x -> SortOrderOrUsing)
-> Generic SortOrderOrUsing
forall x. Rep SortOrderOrUsing x -> SortOrderOrUsing
forall x. SortOrderOrUsing -> Rep SortOrderOrUsing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SortOrderOrUsing x -> SortOrderOrUsing
$cfrom :: forall x. SortOrderOrUsing -> Rep SortOrderOrUsing x
Generic, Typeable, Typeable SortOrderOrUsing
DataType
Constr
Typeable SortOrderOrUsing
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SortOrderOrUsing -> c SortOrderOrUsing)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SortOrderOrUsing)
-> (SortOrderOrUsing -> Constr)
-> (SortOrderOrUsing -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SortOrderOrUsing))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SortOrderOrUsing))
-> ((forall b. Data b => b -> b)
    -> SortOrderOrUsing -> SortOrderOrUsing)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SortOrderOrUsing -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SortOrderOrUsing -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SortOrderOrUsing -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SortOrderOrUsing -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SortOrderOrUsing -> m SortOrderOrUsing)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SortOrderOrUsing -> m SortOrderOrUsing)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SortOrderOrUsing -> m SortOrderOrUsing)
-> Data SortOrderOrUsing
SortOrderOrUsing -> DataType
SortOrderOrUsing -> Constr
(forall b. Data b => b -> b)
-> SortOrderOrUsing -> SortOrderOrUsing
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortOrderOrUsing -> c SortOrderOrUsing
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortOrderOrUsing
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SortOrderOrUsing -> u
forall u. (forall d. Data d => d -> u) -> SortOrderOrUsing -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrderOrUsing -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrderOrUsing -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SortOrderOrUsing -> m SortOrderOrUsing
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SortOrderOrUsing -> m SortOrderOrUsing
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortOrderOrUsing
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortOrderOrUsing -> c SortOrderOrUsing
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortOrderOrUsing)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SortOrderOrUsing)
$cSortUsing :: Constr
$cSortOrder :: Constr
$tSortOrderOrUsing :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SortOrderOrUsing -> m SortOrderOrUsing
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SortOrderOrUsing -> m SortOrderOrUsing
gmapMp :: (forall d. Data d => d -> m d)
-> SortOrderOrUsing -> m SortOrderOrUsing
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SortOrderOrUsing -> m SortOrderOrUsing
gmapM :: (forall d. Data d => d -> m d)
-> SortOrderOrUsing -> m SortOrderOrUsing
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SortOrderOrUsing -> m SortOrderOrUsing
gmapQi :: Int -> (forall d. Data d => d -> u) -> SortOrderOrUsing -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SortOrderOrUsing -> u
gmapQ :: (forall d. Data d => d -> u) -> SortOrderOrUsing -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SortOrderOrUsing -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrderOrUsing -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrderOrUsing -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrderOrUsing -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrderOrUsing -> r
gmapT :: (forall b. Data b => b -> b)
-> SortOrderOrUsing -> SortOrderOrUsing
$cgmapT :: (forall b. Data b => b -> b)
-> SortOrderOrUsing -> SortOrderOrUsing
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SortOrderOrUsing)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SortOrderOrUsing)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SortOrderOrUsing)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortOrderOrUsing)
dataTypeOf :: SortOrderOrUsing -> DataType
$cdataTypeOf :: SortOrderOrUsing -> DataType
toConstr :: SortOrderOrUsing -> Constr
$ctoConstr :: SortOrderOrUsing -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortOrderOrUsing
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortOrderOrUsing
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortOrderOrUsing -> c SortOrderOrUsing
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortOrderOrUsing -> c SortOrderOrUsing
$cp1Data :: Typeable SortOrderOrUsing
Data, SortOrderOrUsing -> Q Exp
SortOrderOrUsing -> Q (TExp SortOrderOrUsing)
(SortOrderOrUsing -> Q Exp)
-> (SortOrderOrUsing -> Q (TExp SortOrderOrUsing))
-> Lift SortOrderOrUsing
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SortOrderOrUsing -> Q (TExp SortOrderOrUsing)
$cliftTyped :: SortOrderOrUsing -> Q (TExp SortOrderOrUsing)
lift :: SortOrderOrUsing -> Q Exp
$clift :: SortOrderOrUsing -> Q Exp
Lift)

data SortOrder = Ascending | Descending | DefaultSortOrder
    deriving (Int -> SortOrder -> ShowS
[SortOrder] -> ShowS
SortOrder -> String
(Int -> SortOrder -> ShowS)
-> (SortOrder -> String)
-> ([SortOrder] -> ShowS)
-> Show SortOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortOrder] -> ShowS
$cshowList :: [SortOrder] -> ShowS
show :: SortOrder -> String
$cshow :: SortOrder -> String
showsPrec :: Int -> SortOrder -> ShowS
$cshowsPrec :: Int -> SortOrder -> ShowS
Show, SortOrder -> SortOrder -> Bool
(SortOrder -> SortOrder -> Bool)
-> (SortOrder -> SortOrder -> Bool) -> Eq SortOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortOrder -> SortOrder -> Bool
$c/= :: SortOrder -> SortOrder -> Bool
== :: SortOrder -> SortOrder -> Bool
$c== :: SortOrder -> SortOrder -> Bool
Eq, (forall x. SortOrder -> Rep SortOrder x)
-> (forall x. Rep SortOrder x -> SortOrder) -> Generic SortOrder
forall x. Rep SortOrder x -> SortOrder
forall x. SortOrder -> Rep SortOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SortOrder x -> SortOrder
$cfrom :: forall x. SortOrder -> Rep SortOrder x
Generic, Typeable, Typeable SortOrder
DataType
Constr
Typeable SortOrder
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SortOrder -> c SortOrder)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SortOrder)
-> (SortOrder -> Constr)
-> (SortOrder -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SortOrder))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortOrder))
-> ((forall b. Data b => b -> b) -> SortOrder -> SortOrder)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SortOrder -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SortOrder -> r)
-> (forall u. (forall d. Data d => d -> u) -> SortOrder -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SortOrder -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SortOrder -> m SortOrder)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortOrder -> m SortOrder)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortOrder -> m SortOrder)
-> Data SortOrder
SortOrder -> DataType
SortOrder -> Constr
(forall b. Data b => b -> b) -> SortOrder -> SortOrder
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortOrder -> c SortOrder
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortOrder
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SortOrder -> u
forall u. (forall d. Data d => d -> u) -> SortOrder -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrder -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrder -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortOrder -> m SortOrder
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortOrder -> m SortOrder
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortOrder
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortOrder -> c SortOrder
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortOrder)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortOrder)
$cDefaultSortOrder :: Constr
$cDescending :: Constr
$cAscending :: Constr
$tSortOrder :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SortOrder -> m SortOrder
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortOrder -> m SortOrder
gmapMp :: (forall d. Data d => d -> m d) -> SortOrder -> m SortOrder
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortOrder -> m SortOrder
gmapM :: (forall d. Data d => d -> m d) -> SortOrder -> m SortOrder
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortOrder -> m SortOrder
gmapQi :: Int -> (forall d. Data d => d -> u) -> SortOrder -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortOrder -> u
gmapQ :: (forall d. Data d => d -> u) -> SortOrder -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SortOrder -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrder -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrder -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrder -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortOrder -> r
gmapT :: (forall b. Data b => b -> b) -> SortOrder -> SortOrder
$cgmapT :: (forall b. Data b => b -> b) -> SortOrder -> SortOrder
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortOrder)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortOrder)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SortOrder)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortOrder)
dataTypeOf :: SortOrder -> DataType
$cdataTypeOf :: SortOrder -> DataType
toConstr :: SortOrder -> Constr
$ctoConstr :: SortOrder -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortOrder
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortOrder
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortOrder -> c SortOrder
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortOrder -> c SortOrder
$cp1Data :: Typeable SortOrder
Data, SortOrder -> Q Exp
SortOrder -> Q (TExp SortOrder)
(SortOrder -> Q Exp)
-> (SortOrder -> Q (TExp SortOrder)) -> Lift SortOrder
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SortOrder -> Q (TExp SortOrder)
$cliftTyped :: SortOrder -> Q (TExp SortOrder)
lift :: SortOrder -> Q Exp
$clift :: SortOrder -> Q Exp
Lift, Int -> SortOrder
SortOrder -> Int
SortOrder -> [SortOrder]
SortOrder -> SortOrder
SortOrder -> SortOrder -> [SortOrder]
SortOrder -> SortOrder -> SortOrder -> [SortOrder]
(SortOrder -> SortOrder)
-> (SortOrder -> SortOrder)
-> (Int -> SortOrder)
-> (SortOrder -> Int)
-> (SortOrder -> [SortOrder])
-> (SortOrder -> SortOrder -> [SortOrder])
-> (SortOrder -> SortOrder -> [SortOrder])
-> (SortOrder -> SortOrder -> SortOrder -> [SortOrder])
-> Enum SortOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SortOrder -> SortOrder -> SortOrder -> [SortOrder]
$cenumFromThenTo :: SortOrder -> SortOrder -> SortOrder -> [SortOrder]
enumFromTo :: SortOrder -> SortOrder -> [SortOrder]
$cenumFromTo :: SortOrder -> SortOrder -> [SortOrder]
enumFromThen :: SortOrder -> SortOrder -> [SortOrder]
$cenumFromThen :: SortOrder -> SortOrder -> [SortOrder]
enumFrom :: SortOrder -> [SortOrder]
$cenumFrom :: SortOrder -> [SortOrder]
fromEnum :: SortOrder -> Int
$cfromEnum :: SortOrder -> Int
toEnum :: Int -> SortOrder
$ctoEnum :: Int -> SortOrder
pred :: SortOrder -> SortOrder
$cpred :: SortOrder -> SortOrder
succ :: SortOrder -> SortOrder
$csucc :: SortOrder -> SortOrder
Enum, SortOrder
SortOrder -> SortOrder -> Bounded SortOrder
forall a. a -> a -> Bounded a
maxBound :: SortOrder
$cmaxBound :: SortOrder
minBound :: SortOrder
$cminBound :: SortOrder
Bounded)

data NullsOrder = NullsFirst | NullsLast | NullsOrderDefault
    deriving (Int -> NullsOrder -> ShowS
[NullsOrder] -> ShowS
NullsOrder -> String
(Int -> NullsOrder -> ShowS)
-> (NullsOrder -> String)
-> ([NullsOrder] -> ShowS)
-> Show NullsOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NullsOrder] -> ShowS
$cshowList :: [NullsOrder] -> ShowS
show :: NullsOrder -> String
$cshow :: NullsOrder -> String
showsPrec :: Int -> NullsOrder -> ShowS
$cshowsPrec :: Int -> NullsOrder -> ShowS
Show, NullsOrder -> NullsOrder -> Bool
(NullsOrder -> NullsOrder -> Bool)
-> (NullsOrder -> NullsOrder -> Bool) -> Eq NullsOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NullsOrder -> NullsOrder -> Bool
$c/= :: NullsOrder -> NullsOrder -> Bool
== :: NullsOrder -> NullsOrder -> Bool
$c== :: NullsOrder -> NullsOrder -> Bool
Eq, (forall x. NullsOrder -> Rep NullsOrder x)
-> (forall x. Rep NullsOrder x -> NullsOrder) -> Generic NullsOrder
forall x. Rep NullsOrder x -> NullsOrder
forall x. NullsOrder -> Rep NullsOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NullsOrder x -> NullsOrder
$cfrom :: forall x. NullsOrder -> Rep NullsOrder x
Generic, Typeable, Typeable NullsOrder
DataType
Constr
Typeable NullsOrder
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> NullsOrder -> c NullsOrder)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NullsOrder)
-> (NullsOrder -> Constr)
-> (NullsOrder -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NullsOrder))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c NullsOrder))
-> ((forall b. Data b => b -> b) -> NullsOrder -> NullsOrder)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NullsOrder -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NullsOrder -> r)
-> (forall u. (forall d. Data d => d -> u) -> NullsOrder -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NullsOrder -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder)
-> Data NullsOrder
NullsOrder -> DataType
NullsOrder -> Constr
(forall b. Data b => b -> b) -> NullsOrder -> NullsOrder
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NullsOrder -> c NullsOrder
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NullsOrder
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NullsOrder -> u
forall u. (forall d. Data d => d -> u) -> NullsOrder -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NullsOrder
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NullsOrder -> c NullsOrder
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NullsOrder)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NullsOrder)
$cNullsOrderDefault :: Constr
$cNullsLast :: Constr
$cNullsFirst :: Constr
$tNullsOrder :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
gmapMp :: (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
gmapM :: (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
gmapQi :: Int -> (forall d. Data d => d -> u) -> NullsOrder -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NullsOrder -> u
gmapQ :: (forall d. Data d => d -> u) -> NullsOrder -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NullsOrder -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
gmapT :: (forall b. Data b => b -> b) -> NullsOrder -> NullsOrder
$cgmapT :: (forall b. Data b => b -> b) -> NullsOrder -> NullsOrder
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NullsOrder)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NullsOrder)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c NullsOrder)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NullsOrder)
dataTypeOf :: NullsOrder -> DataType
$cdataTypeOf :: NullsOrder -> DataType
toConstr :: NullsOrder -> Constr
$ctoConstr :: NullsOrder -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NullsOrder
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NullsOrder
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NullsOrder -> c NullsOrder
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NullsOrder -> c NullsOrder
$cp1Data :: Typeable NullsOrder
Data, NullsOrder -> Q Exp
NullsOrder -> Q (TExp NullsOrder)
(NullsOrder -> Q Exp)
-> (NullsOrder -> Q (TExp NullsOrder)) -> Lift NullsOrder
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: NullsOrder -> Q (TExp NullsOrder)
$cliftTyped :: NullsOrder -> Q (TExp NullsOrder)
lift :: NullsOrder -> Q Exp
$clift :: NullsOrder -> Q Exp
Lift, Int -> NullsOrder
NullsOrder -> Int
NullsOrder -> [NullsOrder]
NullsOrder -> NullsOrder
NullsOrder -> NullsOrder -> [NullsOrder]
NullsOrder -> NullsOrder -> NullsOrder -> [NullsOrder]
(NullsOrder -> NullsOrder)
-> (NullsOrder -> NullsOrder)
-> (Int -> NullsOrder)
-> (NullsOrder -> Int)
-> (NullsOrder -> [NullsOrder])
-> (NullsOrder -> NullsOrder -> [NullsOrder])
-> (NullsOrder -> NullsOrder -> [NullsOrder])
-> (NullsOrder -> NullsOrder -> NullsOrder -> [NullsOrder])
-> Enum NullsOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NullsOrder -> NullsOrder -> NullsOrder -> [NullsOrder]
$cenumFromThenTo :: NullsOrder -> NullsOrder -> NullsOrder -> [NullsOrder]
enumFromTo :: NullsOrder -> NullsOrder -> [NullsOrder]
$cenumFromTo :: NullsOrder -> NullsOrder -> [NullsOrder]
enumFromThen :: NullsOrder -> NullsOrder -> [NullsOrder]
$cenumFromThen :: NullsOrder -> NullsOrder -> [NullsOrder]
enumFrom :: NullsOrder -> [NullsOrder]
$cenumFrom :: NullsOrder -> [NullsOrder]
fromEnum :: NullsOrder -> Int
$cfromEnum :: NullsOrder -> Int
toEnum :: Int -> NullsOrder
$ctoEnum :: Int -> NullsOrder
pred :: NullsOrder -> NullsOrder
$cpred :: NullsOrder -> NullsOrder
succ :: NullsOrder -> NullsOrder
$csucc :: NullsOrder -> NullsOrder
Enum, NullsOrder
NullsOrder -> NullsOrder -> Bounded NullsOrder
forall a. a -> a -> Bounded a
maxBound :: NullsOrder
$cmaxBound :: NullsOrder
minBound :: NullsOrder
$cminBound :: NullsOrder
Bounded)

data Locking = Locking
    { Locking -> LockingStrength
strength :: LockingStrength
    , Locking -> [Name]
tables :: [Name]
    , Locking -> LockWait
wait :: LockWait
    } deriving (Int -> Locking -> ShowS
[Locking] -> ShowS
Locking -> String
(Int -> Locking -> ShowS)
-> (Locking -> String) -> ([Locking] -> ShowS) -> Show Locking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Locking] -> ShowS
$cshowList :: [Locking] -> ShowS
show :: Locking -> String
$cshow :: Locking -> String
showsPrec :: Int -> Locking -> ShowS
$cshowsPrec :: Int -> Locking -> ShowS
Show, Locking -> Locking -> Bool
(Locking -> Locking -> Bool)
-> (Locking -> Locking -> Bool) -> Eq Locking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Locking -> Locking -> Bool
$c/= :: Locking -> Locking -> Bool
== :: Locking -> Locking -> Bool
$c== :: Locking -> Locking -> Bool
Eq, (forall x. Locking -> Rep Locking x)
-> (forall x. Rep Locking x -> Locking) -> Generic Locking
forall x. Rep Locking x -> Locking
forall x. Locking -> Rep Locking x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Locking x -> Locking
$cfrom :: forall x. Locking -> Rep Locking x
Generic, Typeable Locking
DataType
Constr
Typeable Locking
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Locking -> c Locking)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Locking)
-> (Locking -> Constr)
-> (Locking -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Locking))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Locking))
-> ((forall b. Data b => b -> b) -> Locking -> Locking)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Locking -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Locking -> r)
-> (forall u. (forall d. Data d => d -> u) -> Locking -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Locking -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Locking -> m Locking)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Locking -> m Locking)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Locking -> m Locking)
-> Data Locking
Locking -> DataType
Locking -> Constr
(forall b. Data b => b -> b) -> Locking -> Locking
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Locking -> c Locking
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Locking
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Locking -> u
forall u. (forall d. Data d => d -> u) -> Locking -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Locking -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Locking -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Locking -> m Locking
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Locking -> m Locking
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Locking
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Locking -> c Locking
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Locking)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Locking)
$cLocking :: Constr
$tLocking :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Locking -> m Locking
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Locking -> m Locking
gmapMp :: (forall d. Data d => d -> m d) -> Locking -> m Locking
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Locking -> m Locking
gmapM :: (forall d. Data d => d -> m d) -> Locking -> m Locking
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Locking -> m Locking
gmapQi :: Int -> (forall d. Data d => d -> u) -> Locking -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Locking -> u
gmapQ :: (forall d. Data d => d -> u) -> Locking -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Locking -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Locking -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Locking -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Locking -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Locking -> r
gmapT :: (forall b. Data b => b -> b) -> Locking -> Locking
$cgmapT :: (forall b. Data b => b -> b) -> Locking -> Locking
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Locking)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Locking)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Locking)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Locking)
dataTypeOf :: Locking -> DataType
$cdataTypeOf :: Locking -> DataType
toConstr :: Locking -> Constr
$ctoConstr :: Locking -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Locking
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Locking
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Locking -> c Locking
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Locking -> c Locking
$cp1Data :: Typeable Locking
Data, Locking -> Q Exp
Locking -> Q (TExp Locking)
(Locking -> Q Exp) -> (Locking -> Q (TExp Locking)) -> Lift Locking
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Locking -> Q (TExp Locking)
$cliftTyped :: Locking -> Q (TExp Locking)
lift :: Locking -> Q Exp
$clift :: Locking -> Q Exp
Lift)

data LockingStrength
    = ForUpdate | ForNoKeyUpdate | ForShare | ForKeyShare
    deriving (Int -> LockingStrength -> ShowS
[LockingStrength] -> ShowS
LockingStrength -> String
(Int -> LockingStrength -> ShowS)
-> (LockingStrength -> String)
-> ([LockingStrength] -> ShowS)
-> Show LockingStrength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockingStrength] -> ShowS
$cshowList :: [LockingStrength] -> ShowS
show :: LockingStrength -> String
$cshow :: LockingStrength -> String
showsPrec :: Int -> LockingStrength -> ShowS
$cshowsPrec :: Int -> LockingStrength -> ShowS
Show, LockingStrength -> LockingStrength -> Bool
(LockingStrength -> LockingStrength -> Bool)
-> (LockingStrength -> LockingStrength -> Bool)
-> Eq LockingStrength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LockingStrength -> LockingStrength -> Bool
$c/= :: LockingStrength -> LockingStrength -> Bool
== :: LockingStrength -> LockingStrength -> Bool
$c== :: LockingStrength -> LockingStrength -> Bool
Eq, Int -> LockingStrength
LockingStrength -> Int
LockingStrength -> [LockingStrength]
LockingStrength -> LockingStrength
LockingStrength -> LockingStrength -> [LockingStrength]
LockingStrength
-> LockingStrength -> LockingStrength -> [LockingStrength]
(LockingStrength -> LockingStrength)
-> (LockingStrength -> LockingStrength)
-> (Int -> LockingStrength)
-> (LockingStrength -> Int)
-> (LockingStrength -> [LockingStrength])
-> (LockingStrength -> LockingStrength -> [LockingStrength])
-> (LockingStrength -> LockingStrength -> [LockingStrength])
-> (LockingStrength
    -> LockingStrength -> LockingStrength -> [LockingStrength])
-> Enum LockingStrength
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LockingStrength
-> LockingStrength -> LockingStrength -> [LockingStrength]
$cenumFromThenTo :: LockingStrength
-> LockingStrength -> LockingStrength -> [LockingStrength]
enumFromTo :: LockingStrength -> LockingStrength -> [LockingStrength]
$cenumFromTo :: LockingStrength -> LockingStrength -> [LockingStrength]
enumFromThen :: LockingStrength -> LockingStrength -> [LockingStrength]
$cenumFromThen :: LockingStrength -> LockingStrength -> [LockingStrength]
enumFrom :: LockingStrength -> [LockingStrength]
$cenumFrom :: LockingStrength -> [LockingStrength]
fromEnum :: LockingStrength -> Int
$cfromEnum :: LockingStrength -> Int
toEnum :: Int -> LockingStrength
$ctoEnum :: Int -> LockingStrength
pred :: LockingStrength -> LockingStrength
$cpred :: LockingStrength -> LockingStrength
succ :: LockingStrength -> LockingStrength
$csucc :: LockingStrength -> LockingStrength
Enum, LockingStrength
LockingStrength -> LockingStrength -> Bounded LockingStrength
forall a. a -> a -> Bounded a
maxBound :: LockingStrength
$cmaxBound :: LockingStrength
minBound :: LockingStrength
$cminBound :: LockingStrength
Bounded, Typeable LockingStrength
DataType
Constr
Typeable LockingStrength
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LockingStrength -> c LockingStrength)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LockingStrength)
-> (LockingStrength -> Constr)
-> (LockingStrength -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LockingStrength))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LockingStrength))
-> ((forall b. Data b => b -> b)
    -> LockingStrength -> LockingStrength)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LockingStrength -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LockingStrength -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LockingStrength -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LockingStrength -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LockingStrength -> m LockingStrength)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LockingStrength -> m LockingStrength)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LockingStrength -> m LockingStrength)
-> Data LockingStrength
LockingStrength -> DataType
LockingStrength -> Constr
(forall b. Data b => b -> b) -> LockingStrength -> LockingStrength
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockingStrength -> c LockingStrength
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockingStrength
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LockingStrength -> u
forall u. (forall d. Data d => d -> u) -> LockingStrength -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockingStrength -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockingStrength -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LockingStrength -> m LockingStrength
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LockingStrength -> m LockingStrength
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockingStrength
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockingStrength -> c LockingStrength
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LockingStrength)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LockingStrength)
$cForKeyShare :: Constr
$cForShare :: Constr
$cForNoKeyUpdate :: Constr
$cForUpdate :: Constr
$tLockingStrength :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LockingStrength -> m LockingStrength
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LockingStrength -> m LockingStrength
gmapMp :: (forall d. Data d => d -> m d)
-> LockingStrength -> m LockingStrength
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LockingStrength -> m LockingStrength
gmapM :: (forall d. Data d => d -> m d)
-> LockingStrength -> m LockingStrength
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LockingStrength -> m LockingStrength
gmapQi :: Int -> (forall d. Data d => d -> u) -> LockingStrength -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LockingStrength -> u
gmapQ :: (forall d. Data d => d -> u) -> LockingStrength -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LockingStrength -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockingStrength -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockingStrength -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockingStrength -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockingStrength -> r
gmapT :: (forall b. Data b => b -> b) -> LockingStrength -> LockingStrength
$cgmapT :: (forall b. Data b => b -> b) -> LockingStrength -> LockingStrength
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LockingStrength)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LockingStrength)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LockingStrength)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LockingStrength)
dataTypeOf :: LockingStrength -> DataType
$cdataTypeOf :: LockingStrength -> DataType
toConstr :: LockingStrength -> Constr
$ctoConstr :: LockingStrength -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockingStrength
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockingStrength
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockingStrength -> c LockingStrength
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockingStrength -> c LockingStrength
$cp1Data :: Typeable LockingStrength
Data, LockingStrength -> Q Exp
LockingStrength -> Q (TExp LockingStrength)
(LockingStrength -> Q Exp)
-> (LockingStrength -> Q (TExp LockingStrength))
-> Lift LockingStrength
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: LockingStrength -> Q (TExp LockingStrength)
$cliftTyped :: LockingStrength -> Q (TExp LockingStrength)
lift :: LockingStrength -> Q Exp
$clift :: LockingStrength -> Q Exp
Lift, (forall x. LockingStrength -> Rep LockingStrength x)
-> (forall x. Rep LockingStrength x -> LockingStrength)
-> Generic LockingStrength
forall x. Rep LockingStrength x -> LockingStrength
forall x. LockingStrength -> Rep LockingStrength x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LockingStrength x -> LockingStrength
$cfrom :: forall x. LockingStrength -> Rep LockingStrength x
Generic)

data LockWait = LockWaitError | LockWaitSkip | LockWaitBlock
    deriving (Int -> LockWait -> ShowS
[LockWait] -> ShowS
LockWait -> String
(Int -> LockWait -> ShowS)
-> (LockWait -> String) -> ([LockWait] -> ShowS) -> Show LockWait
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockWait] -> ShowS
$cshowList :: [LockWait] -> ShowS
show :: LockWait -> String
$cshow :: LockWait -> String
showsPrec :: Int -> LockWait -> ShowS
$cshowsPrec :: Int -> LockWait -> ShowS
Show, LockWait -> LockWait -> Bool
(LockWait -> LockWait -> Bool)
-> (LockWait -> LockWait -> Bool) -> Eq LockWait
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LockWait -> LockWait -> Bool
$c/= :: LockWait -> LockWait -> Bool
== :: LockWait -> LockWait -> Bool
$c== :: LockWait -> LockWait -> Bool
Eq, Int -> LockWait
LockWait -> Int
LockWait -> [LockWait]
LockWait -> LockWait
LockWait -> LockWait -> [LockWait]
LockWait -> LockWait -> LockWait -> [LockWait]
(LockWait -> LockWait)
-> (LockWait -> LockWait)
-> (Int -> LockWait)
-> (LockWait -> Int)
-> (LockWait -> [LockWait])
-> (LockWait -> LockWait -> [LockWait])
-> (LockWait -> LockWait -> [LockWait])
-> (LockWait -> LockWait -> LockWait -> [LockWait])
-> Enum LockWait
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LockWait -> LockWait -> LockWait -> [LockWait]
$cenumFromThenTo :: LockWait -> LockWait -> LockWait -> [LockWait]
enumFromTo :: LockWait -> LockWait -> [LockWait]
$cenumFromTo :: LockWait -> LockWait -> [LockWait]
enumFromThen :: LockWait -> LockWait -> [LockWait]
$cenumFromThen :: LockWait -> LockWait -> [LockWait]
enumFrom :: LockWait -> [LockWait]
$cenumFrom :: LockWait -> [LockWait]
fromEnum :: LockWait -> Int
$cfromEnum :: LockWait -> Int
toEnum :: Int -> LockWait
$ctoEnum :: Int -> LockWait
pred :: LockWait -> LockWait
$cpred :: LockWait -> LockWait
succ :: LockWait -> LockWait
$csucc :: LockWait -> LockWait
Enum, LockWait
LockWait -> LockWait -> Bounded LockWait
forall a. a -> a -> Bounded a
maxBound :: LockWait
$cmaxBound :: LockWait
minBound :: LockWait
$cminBound :: LockWait
Bounded, Typeable LockWait
DataType
Constr
Typeable LockWait
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LockWait -> c LockWait)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LockWait)
-> (LockWait -> Constr)
-> (LockWait -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LockWait))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LockWait))
-> ((forall b. Data b => b -> b) -> LockWait -> LockWait)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LockWait -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LockWait -> r)
-> (forall u. (forall d. Data d => d -> u) -> LockWait -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> LockWait -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LockWait -> m LockWait)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LockWait -> m LockWait)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LockWait -> m LockWait)
-> Data LockWait
LockWait -> DataType
LockWait -> Constr
(forall b. Data b => b -> b) -> LockWait -> LockWait
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockWait -> c LockWait
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockWait
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LockWait -> u
forall u. (forall d. Data d => d -> u) -> LockWait -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockWait -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockWait -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LockWait -> m LockWait
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockWait -> m LockWait
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockWait
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockWait -> c LockWait
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LockWait)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LockWait)
$cLockWaitBlock :: Constr
$cLockWaitSkip :: Constr
$cLockWaitError :: Constr
$tLockWait :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LockWait -> m LockWait
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockWait -> m LockWait
gmapMp :: (forall d. Data d => d -> m d) -> LockWait -> m LockWait
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LockWait -> m LockWait
gmapM :: (forall d. Data d => d -> m d) -> LockWait -> m LockWait
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LockWait -> m LockWait
gmapQi :: Int -> (forall d. Data d => d -> u) -> LockWait -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LockWait -> u
gmapQ :: (forall d. Data d => d -> u) -> LockWait -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LockWait -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockWait -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LockWait -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockWait -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LockWait -> r
gmapT :: (forall b. Data b => b -> b) -> LockWait -> LockWait
$cgmapT :: (forall b. Data b => b -> b) -> LockWait -> LockWait
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LockWait)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LockWait)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LockWait)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LockWait)
dataTypeOf :: LockWait -> DataType
$cdataTypeOf :: LockWait -> DataType
toConstr :: LockWait -> Constr
$ctoConstr :: LockWait -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockWait
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LockWait
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockWait -> c LockWait
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LockWait -> c LockWait
$cp1Data :: Typeable LockWait
Data, LockWait -> Q Exp
LockWait -> Q (TExp LockWait)
(LockWait -> Q Exp)
-> (LockWait -> Q (TExp LockWait)) -> Lift LockWait
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: LockWait -> Q (TExp LockWait)
$cliftTyped :: LockWait -> Q (TExp LockWait)
lift :: LockWait -> Q Exp
$clift :: LockWait -> Q Exp
Lift, (forall x. LockWait -> Rep LockWait x)
-> (forall x. Rep LockWait x -> LockWait) -> Generic LockWait
forall x. Rep LockWait x -> LockWait
forall x. LockWait -> Rep LockWait x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LockWait x -> LockWait
$cfrom :: forall x. LockWait -> Rep LockWait x
Generic)

data WithClause = With
  { WithClause -> [CTE]
commonTables :: [ CTE ]
  , WithClause -> Recursive
recursive :: Recursive
  }
  deriving (Int -> WithClause -> ShowS
[WithClause] -> ShowS
WithClause -> String
(Int -> WithClause -> ShowS)
-> (WithClause -> String)
-> ([WithClause] -> ShowS)
-> Show WithClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithClause] -> ShowS
$cshowList :: [WithClause] -> ShowS
show :: WithClause -> String
$cshow :: WithClause -> String
showsPrec :: Int -> WithClause -> ShowS
$cshowsPrec :: Int -> WithClause -> ShowS
Show, WithClause -> WithClause -> Bool
(WithClause -> WithClause -> Bool)
-> (WithClause -> WithClause -> Bool) -> Eq WithClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithClause -> WithClause -> Bool
$c/= :: WithClause -> WithClause -> Bool
== :: WithClause -> WithClause -> Bool
$c== :: WithClause -> WithClause -> Bool
Eq, (forall x. WithClause -> Rep WithClause x)
-> (forall x. Rep WithClause x -> WithClause) -> Generic WithClause
forall x. Rep WithClause x -> WithClause
forall x. WithClause -> Rep WithClause x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WithClause x -> WithClause
$cfrom :: forall x. WithClause -> Rep WithClause x
Generic, Typeable, Typeable WithClause
DataType
Constr
Typeable WithClause
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WithClause -> c WithClause)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WithClause)
-> (WithClause -> Constr)
-> (WithClause -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WithClause))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WithClause))
-> ((forall b. Data b => b -> b) -> WithClause -> WithClause)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WithClause -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WithClause -> r)
-> (forall u. (forall d. Data d => d -> u) -> WithClause -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WithClause -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WithClause -> m WithClause)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WithClause -> m WithClause)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WithClause -> m WithClause)
-> Data WithClause
WithClause -> DataType
WithClause -> Constr
(forall b. Data b => b -> b) -> WithClause -> WithClause
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WithClause -> c WithClause
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WithClause
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WithClause -> u
forall u. (forall d. Data d => d -> u) -> WithClause -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WithClause -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WithClause -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WithClause -> m WithClause
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WithClause -> m WithClause
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WithClause
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WithClause -> c WithClause
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WithClause)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WithClause)
$cWith :: Constr
$tWithClause :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WithClause -> m WithClause
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WithClause -> m WithClause
gmapMp :: (forall d. Data d => d -> m d) -> WithClause -> m WithClause
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WithClause -> m WithClause
gmapM :: (forall d. Data d => d -> m d) -> WithClause -> m WithClause
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WithClause -> m WithClause
gmapQi :: Int -> (forall d. Data d => d -> u) -> WithClause -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WithClause -> u
gmapQ :: (forall d. Data d => d -> u) -> WithClause -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WithClause -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WithClause -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WithClause -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WithClause -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WithClause -> r
gmapT :: (forall b. Data b => b -> b) -> WithClause -> WithClause
$cgmapT :: (forall b. Data b => b -> b) -> WithClause -> WithClause
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WithClause)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WithClause)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WithClause)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WithClause)
dataTypeOf :: WithClause -> DataType
$cdataTypeOf :: WithClause -> DataType
toConstr :: WithClause -> Constr
$ctoConstr :: WithClause -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WithClause
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WithClause
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WithClause -> c WithClause
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WithClause -> c WithClause
$cp1Data :: Typeable WithClause
Data, WithClause -> Q Exp
WithClause -> Q (TExp WithClause)
(WithClause -> Q Exp)
-> (WithClause -> Q (TExp WithClause)) -> Lift WithClause
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: WithClause -> Q (TExp WithClause)
$cliftTyped :: WithClause -> Q (TExp WithClause)
lift :: WithClause -> Q Exp
$clift :: WithClause -> Q Exp
Lift)

data Recursive = Recursive | NotRecursive
    deriving (Int -> Recursive -> ShowS
[Recursive] -> ShowS
Recursive -> String
(Int -> Recursive -> ShowS)
-> (Recursive -> String)
-> ([Recursive] -> ShowS)
-> Show Recursive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recursive] -> ShowS
$cshowList :: [Recursive] -> ShowS
show :: Recursive -> String
$cshow :: Recursive -> String
showsPrec :: Int -> Recursive -> ShowS
$cshowsPrec :: Int -> Recursive -> ShowS
Show, Recursive -> Recursive -> Bool
(Recursive -> Recursive -> Bool)
-> (Recursive -> Recursive -> Bool) -> Eq Recursive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recursive -> Recursive -> Bool
$c/= :: Recursive -> Recursive -> Bool
== :: Recursive -> Recursive -> Bool
$c== :: Recursive -> Recursive -> Bool
Eq, Int -> Recursive
Recursive -> Int
Recursive -> [Recursive]
Recursive -> Recursive
Recursive -> Recursive -> [Recursive]
Recursive -> Recursive -> Recursive -> [Recursive]
(Recursive -> Recursive)
-> (Recursive -> Recursive)
-> (Int -> Recursive)
-> (Recursive -> Int)
-> (Recursive -> [Recursive])
-> (Recursive -> Recursive -> [Recursive])
-> (Recursive -> Recursive -> [Recursive])
-> (Recursive -> Recursive -> Recursive -> [Recursive])
-> Enum Recursive
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Recursive -> Recursive -> Recursive -> [Recursive]
$cenumFromThenTo :: Recursive -> Recursive -> Recursive -> [Recursive]
enumFromTo :: Recursive -> Recursive -> [Recursive]
$cenumFromTo :: Recursive -> Recursive -> [Recursive]
enumFromThen :: Recursive -> Recursive -> [Recursive]
$cenumFromThen :: Recursive -> Recursive -> [Recursive]
enumFrom :: Recursive -> [Recursive]
$cenumFrom :: Recursive -> [Recursive]
fromEnum :: Recursive -> Int
$cfromEnum :: Recursive -> Int
toEnum :: Int -> Recursive
$ctoEnum :: Int -> Recursive
pred :: Recursive -> Recursive
$cpred :: Recursive -> Recursive
succ :: Recursive -> Recursive
$csucc :: Recursive -> Recursive
Enum, Recursive
Recursive -> Recursive -> Bounded Recursive
forall a. a -> a -> Bounded a
maxBound :: Recursive
$cmaxBound :: Recursive
minBound :: Recursive
$cminBound :: Recursive
Bounded, Typeable Recursive
DataType
Constr
Typeable Recursive
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Recursive -> c Recursive)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Recursive)
-> (Recursive -> Constr)
-> (Recursive -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Recursive))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Recursive))
-> ((forall b. Data b => b -> b) -> Recursive -> Recursive)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Recursive -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Recursive -> r)
-> (forall u. (forall d. Data d => d -> u) -> Recursive -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Recursive -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Recursive -> m Recursive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Recursive -> m Recursive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Recursive -> m Recursive)
-> Data Recursive
Recursive -> DataType
Recursive -> Constr
(forall b. Data b => b -> b) -> Recursive -> Recursive
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Recursive -> c Recursive
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Recursive
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Recursive -> u
forall u. (forall d. Data d => d -> u) -> Recursive -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Recursive -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Recursive -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Recursive -> m Recursive
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Recursive -> m Recursive
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Recursive
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Recursive -> c Recursive
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Recursive)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Recursive)
$cNotRecursive :: Constr
$cRecursive :: Constr
$tRecursive :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Recursive -> m Recursive
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Recursive -> m Recursive
gmapMp :: (forall d. Data d => d -> m d) -> Recursive -> m Recursive
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Recursive -> m Recursive
gmapM :: (forall d. Data d => d -> m d) -> Recursive -> m Recursive
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Recursive -> m Recursive
gmapQi :: Int -> (forall d. Data d => d -> u) -> Recursive -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Recursive -> u
gmapQ :: (forall d. Data d => d -> u) -> Recursive -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Recursive -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Recursive -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Recursive -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Recursive -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Recursive -> r
gmapT :: (forall b. Data b => b -> b) -> Recursive -> Recursive
$cgmapT :: (forall b. Data b => b -> b) -> Recursive -> Recursive
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Recursive)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Recursive)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Recursive)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Recursive)
dataTypeOf :: Recursive -> DataType
$cdataTypeOf :: Recursive -> DataType
toConstr :: Recursive -> Constr
$ctoConstr :: Recursive -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Recursive
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Recursive
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Recursive -> c Recursive
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Recursive -> c Recursive
$cp1Data :: Typeable Recursive
Data, Recursive -> Q Exp
Recursive -> Q (TExp Recursive)
(Recursive -> Q Exp)
-> (Recursive -> Q (TExp Recursive)) -> Lift Recursive
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Recursive -> Q (TExp Recursive)
$cliftTyped :: Recursive -> Q (TExp Recursive)
lift :: Recursive -> Q Exp
$clift :: Recursive -> Q Exp
Lift, (forall x. Recursive -> Rep Recursive x)
-> (forall x. Rep Recursive x -> Recursive) -> Generic Recursive
forall x. Rep Recursive x -> Recursive
forall x. Recursive -> Rep Recursive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Recursive x -> Recursive
$cfrom :: forall x. Recursive -> Rep Recursive x
Generic)

data Materialized = Materialized | NotMaterialized | MaterializeDefault
    deriving (Int -> Materialized -> ShowS
[Materialized] -> ShowS
Materialized -> String
(Int -> Materialized -> ShowS)
-> (Materialized -> String)
-> ([Materialized] -> ShowS)
-> Show Materialized
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Materialized] -> ShowS
$cshowList :: [Materialized] -> ShowS
show :: Materialized -> String
$cshow :: Materialized -> String
showsPrec :: Int -> Materialized -> ShowS
$cshowsPrec :: Int -> Materialized -> ShowS
Show, Materialized -> Materialized -> Bool
(Materialized -> Materialized -> Bool)
-> (Materialized -> Materialized -> Bool) -> Eq Materialized
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Materialized -> Materialized -> Bool
$c/= :: Materialized -> Materialized -> Bool
== :: Materialized -> Materialized -> Bool
$c== :: Materialized -> Materialized -> Bool
Eq, Int -> Materialized
Materialized -> Int
Materialized -> [Materialized]
Materialized -> Materialized
Materialized -> Materialized -> [Materialized]
Materialized -> Materialized -> Materialized -> [Materialized]
(Materialized -> Materialized)
-> (Materialized -> Materialized)
-> (Int -> Materialized)
-> (Materialized -> Int)
-> (Materialized -> [Materialized])
-> (Materialized -> Materialized -> [Materialized])
-> (Materialized -> Materialized -> [Materialized])
-> (Materialized -> Materialized -> Materialized -> [Materialized])
-> Enum Materialized
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Materialized -> Materialized -> Materialized -> [Materialized]
$cenumFromThenTo :: Materialized -> Materialized -> Materialized -> [Materialized]
enumFromTo :: Materialized -> Materialized -> [Materialized]
$cenumFromTo :: Materialized -> Materialized -> [Materialized]
enumFromThen :: Materialized -> Materialized -> [Materialized]
$cenumFromThen :: Materialized -> Materialized -> [Materialized]
enumFrom :: Materialized -> [Materialized]
$cenumFrom :: Materialized -> [Materialized]
fromEnum :: Materialized -> Int
$cfromEnum :: Materialized -> Int
toEnum :: Int -> Materialized
$ctoEnum :: Int -> Materialized
pred :: Materialized -> Materialized
$cpred :: Materialized -> Materialized
succ :: Materialized -> Materialized
$csucc :: Materialized -> Materialized
Enum, Materialized
Materialized -> Materialized -> Bounded Materialized
forall a. a -> a -> Bounded a
maxBound :: Materialized
$cmaxBound :: Materialized
minBound :: Materialized
$cminBound :: Materialized
Bounded, Typeable Materialized
DataType
Constr
Typeable Materialized
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Materialized -> c Materialized)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Materialized)
-> (Materialized -> Constr)
-> (Materialized -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Materialized))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Materialized))
-> ((forall b. Data b => b -> b) -> Materialized -> Materialized)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Materialized -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Materialized -> r)
-> (forall u. (forall d. Data d => d -> u) -> Materialized -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Materialized -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Materialized -> m Materialized)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Materialized -> m Materialized)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Materialized -> m Materialized)
-> Data Materialized
Materialized -> DataType
Materialized -> Constr
(forall b. Data b => b -> b) -> Materialized -> Materialized
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Materialized -> c Materialized
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Materialized
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Materialized -> u
forall u. (forall d. Data d => d -> u) -> Materialized -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Materialized -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Materialized -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Materialized -> m Materialized
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Materialized -> m Materialized
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Materialized
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Materialized -> c Materialized
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Materialized)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Materialized)
$cMaterializeDefault :: Constr
$cNotMaterialized :: Constr
$cMaterialized :: Constr
$tMaterialized :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Materialized -> m Materialized
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Materialized -> m Materialized
gmapMp :: (forall d. Data d => d -> m d) -> Materialized -> m Materialized
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Materialized -> m Materialized
gmapM :: (forall d. Data d => d -> m d) -> Materialized -> m Materialized
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Materialized -> m Materialized
gmapQi :: Int -> (forall d. Data d => d -> u) -> Materialized -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Materialized -> u
gmapQ :: (forall d. Data d => d -> u) -> Materialized -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Materialized -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Materialized -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Materialized -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Materialized -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Materialized -> r
gmapT :: (forall b. Data b => b -> b) -> Materialized -> Materialized
$cgmapT :: (forall b. Data b => b -> b) -> Materialized -> Materialized
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Materialized)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Materialized)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Materialized)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Materialized)
dataTypeOf :: Materialized -> DataType
$cdataTypeOf :: Materialized -> DataType
toConstr :: Materialized -> Constr
$ctoConstr :: Materialized -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Materialized
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Materialized
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Materialized -> c Materialized
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Materialized -> c Materialized
$cp1Data :: Typeable Materialized
Data, Materialized -> Q Exp
Materialized -> Q (TExp Materialized)
(Materialized -> Q Exp)
-> (Materialized -> Q (TExp Materialized)) -> Lift Materialized
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Materialized -> Q (TExp Materialized)
$cliftTyped :: Materialized -> Q (TExp Materialized)
lift :: Materialized -> Q Exp
$clift :: Materialized -> Q Exp
Lift, (forall x. Materialized -> Rep Materialized x)
-> (forall x. Rep Materialized x -> Materialized)
-> Generic Materialized
forall x. Rep Materialized x -> Materialized
forall x. Materialized -> Rep Materialized x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Materialized x -> Materialized
$cfrom :: forall x. Materialized -> Rep Materialized x
Generic)

data CTE = CommonTableExpr
  { CTE -> Name
name :: Name
  , CTE -> [Name]
aliases :: [Name]
  , CTE -> Materialized
materialized :: Materialized
  , CTE -> Statement
query :: Statement
  }
  deriving (Int -> CTE -> ShowS
[CTE] -> ShowS
CTE -> String
(Int -> CTE -> ShowS)
-> (CTE -> String) -> ([CTE] -> ShowS) -> Show CTE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CTE] -> ShowS
$cshowList :: [CTE] -> ShowS
show :: CTE -> String
$cshow :: CTE -> String
showsPrec :: Int -> CTE -> ShowS
$cshowsPrec :: Int -> CTE -> ShowS
Show, CTE -> CTE -> Bool
(CTE -> CTE -> Bool) -> (CTE -> CTE -> Bool) -> Eq CTE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CTE -> CTE -> Bool
$c/= :: CTE -> CTE -> Bool
== :: CTE -> CTE -> Bool
$c== :: CTE -> CTE -> Bool
Eq, (forall x. CTE -> Rep CTE x)
-> (forall x. Rep CTE x -> CTE) -> Generic CTE
forall x. Rep CTE x -> CTE
forall x. CTE -> Rep CTE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CTE x -> CTE
$cfrom :: forall x. CTE -> Rep CTE x
Generic, Typeable, Typeable CTE
DataType
Constr
Typeable CTE
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CTE -> c CTE)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CTE)
-> (CTE -> Constr)
-> (CTE -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CTE))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CTE))
-> ((forall b. Data b => b -> b) -> CTE -> CTE)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CTE -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CTE -> r)
-> (forall u. (forall d. Data d => d -> u) -> CTE -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CTE -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CTE -> m CTE)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CTE -> m CTE)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CTE -> m CTE)
-> Data CTE
CTE -> DataType
CTE -> Constr
(forall b. Data b => b -> b) -> CTE -> CTE
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CTE -> c CTE
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CTE
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CTE -> u
forall u. (forall d. Data d => d -> u) -> CTE -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CTE -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CTE -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CTE -> m CTE
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTE -> m CTE
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CTE
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CTE -> c CTE
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CTE)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CTE)
$cCommonTableExpr :: Constr
$tCTE :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CTE -> m CTE
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTE -> m CTE
gmapMp :: (forall d. Data d => d -> m d) -> CTE -> m CTE
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CTE -> m CTE
gmapM :: (forall d. Data d => d -> m d) -> CTE -> m CTE
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CTE -> m CTE
gmapQi :: Int -> (forall d. Data d => d -> u) -> CTE -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CTE -> u
gmapQ :: (forall d. Data d => d -> u) -> CTE -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CTE -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CTE -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CTE -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CTE -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CTE -> r
gmapT :: (forall b. Data b => b -> b) -> CTE -> CTE
$cgmapT :: (forall b. Data b => b -> b) -> CTE -> CTE
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CTE)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CTE)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CTE)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CTE)
dataTypeOf :: CTE -> DataType
$cdataTypeOf :: CTE -> DataType
toConstr :: CTE -> Constr
$ctoConstr :: CTE -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CTE
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CTE
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CTE -> c CTE
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CTE -> c CTE
$cp1Data :: Typeable CTE
Data, CTE -> Q Exp
CTE -> Q (TExp CTE)
(CTE -> Q Exp) -> (CTE -> Q (TExp CTE)) -> Lift CTE
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: CTE -> Q (TExp CTE)
$cliftTyped :: CTE -> Q (TExp CTE)
lift :: CTE -> Q Exp
$clift :: CTE -> Q Exp
Lift)

data Expr = Lit !Literal | CRef Name
    | NumberedParam !Word
    | HaskellParam !Text
    | BinOp !BinOp !Expr !Expr
    | Unary !UnaryOp !Expr
    | Indirection Expr (NonEmpty Indirection)
    | SelectExpr SelectStmt
    | L LikeE
    | Fun FunctionApplication
    | Cas Case
    deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show, Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, (forall x. Expr -> Rep Expr x)
-> (forall x. Rep Expr x -> Expr) -> Generic Expr
forall x. Rep Expr x -> Expr
forall x. Expr -> Rep Expr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Expr x -> Expr
$cfrom :: forall x. Expr -> Rep Expr x
Generic, Typeable, Typeable Expr
DataType
Constr
Typeable Expr
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Expr -> c Expr)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Expr)
-> (Expr -> Constr)
-> (Expr -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Expr))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expr))
-> ((forall b. Data b => b -> b) -> Expr -> Expr)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r)
-> (forall u. (forall d. Data d => d -> u) -> Expr -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Expr -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Expr -> m Expr)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Expr -> m Expr)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Expr -> m Expr)
-> Data Expr
Expr -> DataType
Expr -> Constr
(forall b. Data b => b -> b) -> Expr -> Expr
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Expr -> u
forall u. (forall d. Data d => d -> u) -> Expr -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expr)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expr)
$cCas :: Constr
$cFun :: Constr
$cL :: Constr
$cSelectExpr :: Constr
$cIndirection :: Constr
$cUnary :: Constr
$cBinOp :: Constr
$cHaskellParam :: Constr
$cNumberedParam :: Constr
$cCRef :: Constr
$cLit :: Constr
$tExpr :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Expr -> m Expr
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
gmapMp :: (forall d. Data d => d -> m d) -> Expr -> m Expr
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
gmapM :: (forall d. Data d => d -> m d) -> Expr -> m Expr
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
gmapQi :: Int -> (forall d. Data d => d -> u) -> Expr -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Expr -> u
gmapQ :: (forall d. Data d => d -> u) -> Expr -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Expr -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
gmapT :: (forall b. Data b => b -> b) -> Expr -> Expr
$cgmapT :: (forall b. Data b => b -> b) -> Expr -> Expr
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expr)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Expr)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expr)
dataTypeOf :: Expr -> DataType
$cdataTypeOf :: Expr -> DataType
toConstr :: Expr -> Constr
$ctoConstr :: Expr -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr
$cp1Data :: Typeable Expr
Data, Expr -> Q Exp
Expr -> Q (TExp Expr)
(Expr -> Q Exp) -> (Expr -> Q (TExp Expr)) -> Lift Expr
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Expr -> Q (TExp Expr)
$cliftTyped :: Expr -> Q (TExp Expr)
lift :: Expr -> Q Exp
$clift :: Expr -> Q Exp
Lift)

type Indirection = Name -- FIXME

data BinOp = Mul | Div | Add | Sub | Exponent | Mod
           | Eq | LT | LTE | GT | GTE | NEq
           | IsDistinctFrom | IsNotDistinctFrom
           | And | Or
    deriving (Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> String
$cshow :: BinOp -> String
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show, BinOp -> BinOp -> Bool
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c== :: BinOp -> BinOp -> Bool
Eq, (forall x. BinOp -> Rep BinOp x)
-> (forall x. Rep BinOp x -> BinOp) -> Generic BinOp
forall x. Rep BinOp x -> BinOp
forall x. BinOp -> Rep BinOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinOp x -> BinOp
$cfrom :: forall x. BinOp -> Rep BinOp x
Generic, Typeable, Typeable BinOp
DataType
Constr
Typeable BinOp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BinOp -> c BinOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BinOp)
-> (BinOp -> Constr)
-> (BinOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BinOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp))
-> ((forall b. Data b => b -> b) -> BinOp -> BinOp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> BinOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> Data BinOp
BinOp -> DataType
BinOp -> Constr
(forall b. Data b => b -> b) -> BinOp -> BinOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u
forall u. (forall d. Data d => d -> u) -> BinOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
$cOr :: Constr
$cAnd :: Constr
$cIsNotDistinctFrom :: Constr
$cIsDistinctFrom :: Constr
$cNEq :: Constr
$cGTE :: Constr
$cGT :: Constr
$cLTE :: Constr
$cLT :: Constr
$cEq :: Constr
$cMod :: Constr
$cExponent :: Constr
$cSub :: Constr
$cAdd :: Constr
$cDiv :: Constr
$cMul :: Constr
$tBinOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BinOp -> m BinOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapMp :: (forall d. Data d => d -> m d) -> BinOp -> m BinOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapM :: (forall d. Data d => d -> m d) -> BinOp -> m BinOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> BinOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u
gmapQ :: (forall d. Data d => d -> u) -> BinOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BinOp -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
gmapT :: (forall b. Data b => b -> b) -> BinOp -> BinOp
$cgmapT :: (forall b. Data b => b -> b) -> BinOp -> BinOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BinOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinOp)
dataTypeOf :: BinOp -> DataType
$cdataTypeOf :: BinOp -> DataType
toConstr :: BinOp -> Constr
$ctoConstr :: BinOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
$cp1Data :: Typeable BinOp
Data, BinOp -> Q Exp
BinOp -> Q (TExp BinOp)
(BinOp -> Q Exp) -> (BinOp -> Q (TExp BinOp)) -> Lift BinOp
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: BinOp -> Q (TExp BinOp)
$cliftTyped :: BinOp -> Q (TExp BinOp)
lift :: BinOp -> Q Exp
$clift :: BinOp -> Q Exp
Lift, BinOp
BinOp -> BinOp -> Bounded BinOp
forall a. a -> a -> Bounded a
maxBound :: BinOp
$cmaxBound :: BinOp
minBound :: BinOp
$cminBound :: BinOp
Bounded, Int -> BinOp
BinOp -> Int
BinOp -> [BinOp]
BinOp -> BinOp
BinOp -> BinOp -> [BinOp]
BinOp -> BinOp -> BinOp -> [BinOp]
(BinOp -> BinOp)
-> (BinOp -> BinOp)
-> (Int -> BinOp)
-> (BinOp -> Int)
-> (BinOp -> [BinOp])
-> (BinOp -> BinOp -> [BinOp])
-> (BinOp -> BinOp -> [BinOp])
-> (BinOp -> BinOp -> BinOp -> [BinOp])
-> Enum BinOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BinOp -> BinOp -> BinOp -> [BinOp]
$cenumFromThenTo :: BinOp -> BinOp -> BinOp -> [BinOp]
enumFromTo :: BinOp -> BinOp -> [BinOp]
$cenumFromTo :: BinOp -> BinOp -> [BinOp]
enumFromThen :: BinOp -> BinOp -> [BinOp]
$cenumFromThen :: BinOp -> BinOp -> [BinOp]
enumFrom :: BinOp -> [BinOp]
$cenumFrom :: BinOp -> [BinOp]
fromEnum :: BinOp -> Int
$cfromEnum :: BinOp -> Int
toEnum :: Int -> BinOp
$ctoEnum :: Int -> BinOp
pred :: BinOp -> BinOp
$cpred :: BinOp -> BinOp
succ :: BinOp -> BinOp
$csucc :: BinOp -> BinOp
Enum)

data UnaryOp = Negate | Not | IsNull | NotNull
    deriving (Int -> UnaryOp -> ShowS
[UnaryOp] -> ShowS
UnaryOp -> String
(Int -> UnaryOp -> ShowS)
-> (UnaryOp -> String) -> ([UnaryOp] -> ShowS) -> Show UnaryOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnaryOp] -> ShowS
$cshowList :: [UnaryOp] -> ShowS
show :: UnaryOp -> String
$cshow :: UnaryOp -> String
showsPrec :: Int -> UnaryOp -> ShowS
$cshowsPrec :: Int -> UnaryOp -> ShowS
Show, UnaryOp -> UnaryOp -> Bool
(UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool) -> Eq UnaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnaryOp -> UnaryOp -> Bool
$c/= :: UnaryOp -> UnaryOp -> Bool
== :: UnaryOp -> UnaryOp -> Bool
$c== :: UnaryOp -> UnaryOp -> Bool
Eq, (forall x. UnaryOp -> Rep UnaryOp x)
-> (forall x. Rep UnaryOp x -> UnaryOp) -> Generic UnaryOp
forall x. Rep UnaryOp x -> UnaryOp
forall x. UnaryOp -> Rep UnaryOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnaryOp x -> UnaryOp
$cfrom :: forall x. UnaryOp -> Rep UnaryOp x
Generic, Typeable, Typeable UnaryOp
DataType
Constr
Typeable UnaryOp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UnaryOp -> c UnaryOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnaryOp)
-> (UnaryOp -> Constr)
-> (UnaryOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnaryOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp))
-> ((forall b. Data b => b -> b) -> UnaryOp -> UnaryOp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UnaryOp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UnaryOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnaryOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UnaryOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp)
-> Data UnaryOp
UnaryOp -> DataType
UnaryOp -> Constr
(forall b. Data b => b -> b) -> UnaryOp -> UnaryOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UnaryOp -> u
forall u. (forall d. Data d => d -> u) -> UnaryOp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnaryOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp)
$cNotNull :: Constr
$cIsNull :: Constr
$cNot :: Constr
$cNegate :: Constr
$tUnaryOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
gmapMp :: (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
gmapM :: (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> UnaryOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnaryOp -> u
gmapQ :: (forall d. Data d => d -> u) -> UnaryOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnaryOp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
gmapT :: (forall b. Data b => b -> b) -> UnaryOp -> UnaryOp
$cgmapT :: (forall b. Data b => b -> b) -> UnaryOp -> UnaryOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UnaryOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnaryOp)
dataTypeOf :: UnaryOp -> DataType
$cdataTypeOf :: UnaryOp -> DataType
toConstr :: UnaryOp -> Constr
$ctoConstr :: UnaryOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp
$cp1Data :: Typeable UnaryOp
Data, UnaryOp -> Q Exp
UnaryOp -> Q (TExp UnaryOp)
(UnaryOp -> Q Exp) -> (UnaryOp -> Q (TExp UnaryOp)) -> Lift UnaryOp
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: UnaryOp -> Q (TExp UnaryOp)
$cliftTyped :: UnaryOp -> Q (TExp UnaryOp)
lift :: UnaryOp -> Q Exp
$clift :: UnaryOp -> Q Exp
Lift, UnaryOp
UnaryOp -> UnaryOp -> Bounded UnaryOp
forall a. a -> a -> Bounded a
maxBound :: UnaryOp
$cmaxBound :: UnaryOp
minBound :: UnaryOp
$cminBound :: UnaryOp
Bounded, Int -> UnaryOp
UnaryOp -> Int
UnaryOp -> [UnaryOp]
UnaryOp -> UnaryOp
UnaryOp -> UnaryOp -> [UnaryOp]
UnaryOp -> UnaryOp -> UnaryOp -> [UnaryOp]
(UnaryOp -> UnaryOp)
-> (UnaryOp -> UnaryOp)
-> (Int -> UnaryOp)
-> (UnaryOp -> Int)
-> (UnaryOp -> [UnaryOp])
-> (UnaryOp -> UnaryOp -> [UnaryOp])
-> (UnaryOp -> UnaryOp -> [UnaryOp])
-> (UnaryOp -> UnaryOp -> UnaryOp -> [UnaryOp])
-> Enum UnaryOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UnaryOp -> UnaryOp -> UnaryOp -> [UnaryOp]
$cenumFromThenTo :: UnaryOp -> UnaryOp -> UnaryOp -> [UnaryOp]
enumFromTo :: UnaryOp -> UnaryOp -> [UnaryOp]
$cenumFromTo :: UnaryOp -> UnaryOp -> [UnaryOp]
enumFromThen :: UnaryOp -> UnaryOp -> [UnaryOp]
$cenumFromThen :: UnaryOp -> UnaryOp -> [UnaryOp]
enumFrom :: UnaryOp -> [UnaryOp]
$cenumFrom :: UnaryOp -> [UnaryOp]
fromEnum :: UnaryOp -> Int
$cfromEnum :: UnaryOp -> Int
toEnum :: Int -> UnaryOp
$ctoEnum :: Int -> UnaryOp
pred :: UnaryOp -> UnaryOp
$cpred :: UnaryOp -> UnaryOp
succ :: UnaryOp -> UnaryOp
$csucc :: UnaryOp -> UnaryOp
Enum)

data LikeOp = Like | ILike | Similar -- TODO add ~ !~ ~* !~*
    deriving (Int -> LikeOp -> ShowS
[LikeOp] -> ShowS
LikeOp -> String
(Int -> LikeOp -> ShowS)
-> (LikeOp -> String) -> ([LikeOp] -> ShowS) -> Show LikeOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LikeOp] -> ShowS
$cshowList :: [LikeOp] -> ShowS
show :: LikeOp -> String
$cshow :: LikeOp -> String
showsPrec :: Int -> LikeOp -> ShowS
$cshowsPrec :: Int -> LikeOp -> ShowS
Show, LikeOp -> LikeOp -> Bool
(LikeOp -> LikeOp -> Bool)
-> (LikeOp -> LikeOp -> Bool) -> Eq LikeOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LikeOp -> LikeOp -> Bool
$c/= :: LikeOp -> LikeOp -> Bool
== :: LikeOp -> LikeOp -> Bool
$c== :: LikeOp -> LikeOp -> Bool
Eq, (forall x. LikeOp -> Rep LikeOp x)
-> (forall x. Rep LikeOp x -> LikeOp) -> Generic LikeOp
forall x. Rep LikeOp x -> LikeOp
forall x. LikeOp -> Rep LikeOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LikeOp x -> LikeOp
$cfrom :: forall x. LikeOp -> Rep LikeOp x
Generic, Typeable, Typeable LikeOp
DataType
Constr
Typeable LikeOp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LikeOp -> c LikeOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LikeOp)
-> (LikeOp -> Constr)
-> (LikeOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LikeOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LikeOp))
-> ((forall b. Data b => b -> b) -> LikeOp -> LikeOp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LikeOp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LikeOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> LikeOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> LikeOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LikeOp -> m LikeOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LikeOp -> m LikeOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LikeOp -> m LikeOp)
-> Data LikeOp
LikeOp -> DataType
LikeOp -> Constr
(forall b. Data b => b -> b) -> LikeOp -> LikeOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LikeOp -> c LikeOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LikeOp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LikeOp -> u
forall u. (forall d. Data d => d -> u) -> LikeOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LikeOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LikeOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LikeOp -> m LikeOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LikeOp -> m LikeOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LikeOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LikeOp -> c LikeOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LikeOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LikeOp)
$cSimilar :: Constr
$cILike :: Constr
$cLike :: Constr
$tLikeOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LikeOp -> m LikeOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LikeOp -> m LikeOp
gmapMp :: (forall d. Data d => d -> m d) -> LikeOp -> m LikeOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LikeOp -> m LikeOp
gmapM :: (forall d. Data d => d -> m d) -> LikeOp -> m LikeOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LikeOp -> m LikeOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> LikeOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LikeOp -> u
gmapQ :: (forall d. Data d => d -> u) -> LikeOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LikeOp -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LikeOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LikeOp -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LikeOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LikeOp -> r
gmapT :: (forall b. Data b => b -> b) -> LikeOp -> LikeOp
$cgmapT :: (forall b. Data b => b -> b) -> LikeOp -> LikeOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LikeOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LikeOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LikeOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LikeOp)
dataTypeOf :: LikeOp -> DataType
$cdataTypeOf :: LikeOp -> DataType
toConstr :: LikeOp -> Constr
$ctoConstr :: LikeOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LikeOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LikeOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LikeOp -> c LikeOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LikeOp -> c LikeOp
$cp1Data :: Typeable LikeOp
Data, LikeOp -> Q Exp
LikeOp -> Q (TExp LikeOp)
(LikeOp -> Q Exp) -> (LikeOp -> Q (TExp LikeOp)) -> Lift LikeOp
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: LikeOp -> Q (TExp LikeOp)
$cliftTyped :: LikeOp -> Q (TExp LikeOp)
lift :: LikeOp -> Q Exp
$clift :: LikeOp -> Q Exp
Lift, LikeOp
LikeOp -> LikeOp -> Bounded LikeOp
forall a. a -> a -> Bounded a
maxBound :: LikeOp
$cmaxBound :: LikeOp
minBound :: LikeOp
$cminBound :: LikeOp
Bounded, Int -> LikeOp
LikeOp -> Int
LikeOp -> [LikeOp]
LikeOp -> LikeOp
LikeOp -> LikeOp -> [LikeOp]
LikeOp -> LikeOp -> LikeOp -> [LikeOp]
(LikeOp -> LikeOp)
-> (LikeOp -> LikeOp)
-> (Int -> LikeOp)
-> (LikeOp -> Int)
-> (LikeOp -> [LikeOp])
-> (LikeOp -> LikeOp -> [LikeOp])
-> (LikeOp -> LikeOp -> [LikeOp])
-> (LikeOp -> LikeOp -> LikeOp -> [LikeOp])
-> Enum LikeOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LikeOp -> LikeOp -> LikeOp -> [LikeOp]
$cenumFromThenTo :: LikeOp -> LikeOp -> LikeOp -> [LikeOp]
enumFromTo :: LikeOp -> LikeOp -> [LikeOp]
$cenumFromTo :: LikeOp -> LikeOp -> [LikeOp]
enumFromThen :: LikeOp -> LikeOp -> [LikeOp]
$cenumFromThen :: LikeOp -> LikeOp -> [LikeOp]
enumFrom :: LikeOp -> [LikeOp]
$cenumFrom :: LikeOp -> [LikeOp]
fromEnum :: LikeOp -> Int
$cfromEnum :: LikeOp -> Int
toEnum :: Int -> LikeOp
$ctoEnum :: Int -> LikeOp
pred :: LikeOp -> LikeOp
$cpred :: LikeOp -> LikeOp
succ :: LikeOp -> LikeOp
$csucc :: LikeOp -> LikeOp
Enum)

data LikeE = LikeE
    { LikeE -> LikeOp
op :: LikeOp
    , LikeE -> Expr
string :: Expr
    , LikeE -> Expr
likePattern :: Expr
    , LikeE -> Maybe Expr
escape :: Maybe Expr
    , LikeE -> Bool
invert :: Bool
    } deriving (Int -> LikeE -> ShowS
[LikeE] -> ShowS
LikeE -> String
(Int -> LikeE -> ShowS)
-> (LikeE -> String) -> ([LikeE] -> ShowS) -> Show LikeE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LikeE] -> ShowS
$cshowList :: [LikeE] -> ShowS
show :: LikeE -> String
$cshow :: LikeE -> String
showsPrec :: Int -> LikeE -> ShowS
$cshowsPrec :: Int -> LikeE -> ShowS
Show, LikeE -> LikeE -> Bool
(LikeE -> LikeE -> Bool) -> (LikeE -> LikeE -> Bool) -> Eq LikeE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LikeE -> LikeE -> Bool
$c/= :: LikeE -> LikeE -> Bool
== :: LikeE -> LikeE -> Bool
$c== :: LikeE -> LikeE -> Bool
Eq, (forall x. LikeE -> Rep LikeE x)
-> (forall x. Rep LikeE x -> LikeE) -> Generic LikeE
forall x. Rep LikeE x -> LikeE
forall x. LikeE -> Rep LikeE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LikeE x -> LikeE
$cfrom :: forall x. LikeE -> Rep LikeE x
Generic, Typeable, Typeable LikeE
DataType
Constr
Typeable LikeE
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LikeE -> c LikeE)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LikeE)
-> (LikeE -> Constr)
-> (LikeE -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LikeE))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LikeE))
-> ((forall b. Data b => b -> b) -> LikeE -> LikeE)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LikeE -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LikeE -> r)
-> (forall u. (forall d. Data d => d -> u) -> LikeE -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> LikeE -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LikeE -> m LikeE)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LikeE -> m LikeE)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LikeE -> m LikeE)
-> Data LikeE
LikeE -> DataType
LikeE -> Constr
(forall b. Data b => b -> b) -> LikeE -> LikeE
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LikeE -> c LikeE
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LikeE
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LikeE -> u
forall u. (forall d. Data d => d -> u) -> LikeE -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LikeE -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LikeE -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LikeE -> m LikeE
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LikeE -> m LikeE
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LikeE
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LikeE -> c LikeE
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LikeE)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LikeE)
$cLikeE :: Constr
$tLikeE :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LikeE -> m LikeE
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LikeE -> m LikeE
gmapMp :: (forall d. Data d => d -> m d) -> LikeE -> m LikeE
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LikeE -> m LikeE
gmapM :: (forall d. Data d => d -> m d) -> LikeE -> m LikeE
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LikeE -> m LikeE
gmapQi :: Int -> (forall d. Data d => d -> u) -> LikeE -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LikeE -> u
gmapQ :: (forall d. Data d => d -> u) -> LikeE -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LikeE -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LikeE -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LikeE -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LikeE -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LikeE -> r
gmapT :: (forall b. Data b => b -> b) -> LikeE -> LikeE
$cgmapT :: (forall b. Data b => b -> b) -> LikeE -> LikeE
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LikeE)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LikeE)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LikeE)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LikeE)
dataTypeOf :: LikeE -> DataType
$cdataTypeOf :: LikeE -> DataType
toConstr :: LikeE -> Constr
$ctoConstr :: LikeE -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LikeE
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LikeE
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LikeE -> c LikeE
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LikeE -> c LikeE
$cp1Data :: Typeable LikeE
Data, LikeE -> Q Exp
LikeE -> Q (TExp LikeE)
(LikeE -> Q Exp) -> (LikeE -> Q (TExp LikeE)) -> Lift LikeE
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: LikeE -> Q (TExp LikeE)
$cliftTyped :: LikeE -> Q (TExp LikeE)
lift :: LikeE -> Q Exp
$clift :: LikeE -> Q Exp
Lift)

like :: LikeOp -> Expr -> Expr -> LikeE
like :: LikeOp -> Expr -> Expr -> LikeE
like LikeOp
op Expr
string Expr
likePattern =
    LikeE :: LikeOp -> Expr -> Expr -> Maybe Expr -> Bool -> LikeE
LikeE { LikeOp
op :: LikeOp
$sel:op:LikeE :: LikeOp
op, Expr
string :: Expr
$sel:string:LikeE :: Expr
string, Expr
likePattern :: Expr
$sel:likePattern:LikeE :: Expr
likePattern, $sel:escape:LikeE :: Maybe Expr
escape = Maybe Expr
forall a. Maybe a
Nothing, $sel:invert:LikeE :: Bool
invert = Bool
False }

data FunctionApplication = FApp
    { FunctionApplication -> Name
name :: Name
    , FunctionApplication -> [Name]
indirection :: [Indirection]
    , FunctionApplication -> FunctionArguments
arguments :: FunctionArguments
    , FunctionApplication -> [SortBy]
withinGroup :: [SortBy] -- not allowed if sortBy in arguments isn't empty
    , FunctionApplication -> Maybe Expr
filterClause :: Maybe Expr
    , FunctionApplication -> Over
over :: Over
    } deriving (Int -> FunctionApplication -> ShowS
[FunctionApplication] -> ShowS
FunctionApplication -> String
(Int -> FunctionApplication -> ShowS)
-> (FunctionApplication -> String)
-> ([FunctionApplication] -> ShowS)
-> Show FunctionApplication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionApplication] -> ShowS
$cshowList :: [FunctionApplication] -> ShowS
show :: FunctionApplication -> String
$cshow :: FunctionApplication -> String
showsPrec :: Int -> FunctionApplication -> ShowS
$cshowsPrec :: Int -> FunctionApplication -> ShowS
Show, FunctionApplication -> FunctionApplication -> Bool
(FunctionApplication -> FunctionApplication -> Bool)
-> (FunctionApplication -> FunctionApplication -> Bool)
-> Eq FunctionApplication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionApplication -> FunctionApplication -> Bool
$c/= :: FunctionApplication -> FunctionApplication -> Bool
== :: FunctionApplication -> FunctionApplication -> Bool
$c== :: FunctionApplication -> FunctionApplication -> Bool
Eq, (forall x. FunctionApplication -> Rep FunctionApplication x)
-> (forall x. Rep FunctionApplication x -> FunctionApplication)
-> Generic FunctionApplication
forall x. Rep FunctionApplication x -> FunctionApplication
forall x. FunctionApplication -> Rep FunctionApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionApplication x -> FunctionApplication
$cfrom :: forall x. FunctionApplication -> Rep FunctionApplication x
Generic, Typeable, Typeable FunctionApplication
DataType
Constr
Typeable FunctionApplication
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> FunctionApplication
    -> c FunctionApplication)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FunctionApplication)
-> (FunctionApplication -> Constr)
-> (FunctionApplication -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FunctionApplication))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FunctionApplication))
-> ((forall b. Data b => b -> b)
    -> FunctionApplication -> FunctionApplication)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionApplication -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionApplication -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FunctionApplication -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FunctionApplication -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FunctionApplication -> m FunctionApplication)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionApplication -> m FunctionApplication)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionApplication -> m FunctionApplication)
-> Data FunctionApplication
FunctionApplication -> DataType
FunctionApplication -> Constr
(forall b. Data b => b -> b)
-> FunctionApplication -> FunctionApplication
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FunctionApplication
-> c FunctionApplication
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionApplication
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FunctionApplication -> u
forall u.
(forall d. Data d => d -> u) -> FunctionApplication -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionApplication -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionApplication -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionApplication -> m FunctionApplication
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionApplication -> m FunctionApplication
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionApplication
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FunctionApplication
-> c FunctionApplication
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionApplication)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionApplication)
$cFApp :: Constr
$tFunctionApplication :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> FunctionApplication -> m FunctionApplication
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionApplication -> m FunctionApplication
gmapMp :: (forall d. Data d => d -> m d)
-> FunctionApplication -> m FunctionApplication
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionApplication -> m FunctionApplication
gmapM :: (forall d. Data d => d -> m d)
-> FunctionApplication -> m FunctionApplication
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionApplication -> m FunctionApplication
gmapQi :: Int -> (forall d. Data d => d -> u) -> FunctionApplication -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionApplication -> u
gmapQ :: (forall d. Data d => d -> u) -> FunctionApplication -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> FunctionApplication -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionApplication -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionApplication -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionApplication -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionApplication -> r
gmapT :: (forall b. Data b => b -> b)
-> FunctionApplication -> FunctionApplication
$cgmapT :: (forall b. Data b => b -> b)
-> FunctionApplication -> FunctionApplication
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionApplication)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionApplication)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FunctionApplication)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionApplication)
dataTypeOf :: FunctionApplication -> DataType
$cdataTypeOf :: FunctionApplication -> DataType
toConstr :: FunctionApplication -> Constr
$ctoConstr :: FunctionApplication -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionApplication
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionApplication
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FunctionApplication
-> c FunctionApplication
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FunctionApplication
-> c FunctionApplication
$cp1Data :: Typeable FunctionApplication
Data, FunctionApplication -> Q Exp
FunctionApplication -> Q (TExp FunctionApplication)
(FunctionApplication -> Q Exp)
-> (FunctionApplication -> Q (TExp FunctionApplication))
-> Lift FunctionApplication
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FunctionApplication -> Q (TExp FunctionApplication)
$cliftTyped :: FunctionApplication -> Q (TExp FunctionApplication)
lift :: FunctionApplication -> Q Exp
$clift :: FunctionApplication -> Q Exp
Lift)

fapp :: (Name, [Indirection]) -> FunctionArguments -> FunctionApplication
fapp :: (Name, [Name]) -> FunctionArguments -> FunctionApplication
fapp (Name
name, [Name]
indirection) FunctionArguments
args = FApp :: Name
-> [Name]
-> FunctionArguments
-> [SortBy]
-> Maybe Expr
-> Over
-> FunctionApplication
FApp
    { Name
name :: Name
$sel:name:FApp :: Name
name, [Name]
indirection :: [Name]
$sel:indirection:FApp :: [Name]
indirection
    , $sel:arguments:FApp :: FunctionArguments
arguments = FunctionArguments
args
    , $sel:withinGroup:FApp :: [SortBy]
withinGroup = []
    , $sel:filterClause:FApp :: Maybe Expr
filterClause = Maybe Expr
forall a. Maybe a
Nothing
    , $sel:over:FApp :: Over
over = Over
noWindow
    }

fapp1 :: Name -> [Expr] -> FunctionApplication
fapp1 :: Name -> [Expr] -> FunctionApplication
fapp1 Name
fName [Expr]
args = (Name, [Name]) -> FunctionArguments -> FunctionApplication
fapp (Name
fName, []) FunctionArguments
args' where
  args' :: FunctionArguments
args' = case [Expr] -> Maybe (NonEmpty Expr)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Expr]
args of
    Maybe (NonEmpty Expr)
Nothing -> FunctionArguments
NoArgs
    Just NonEmpty Expr
ne -> ArgsList -> FunctionArguments
Args (NonEmpty Argument -> [SortBy] -> Bool -> ArgsList
ArgsList ((Expr -> Argument) -> NonEmpty Expr -> NonEmpty Argument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr -> Argument
E NonEmpty Expr
ne) [] Bool
False)

setSortBy :: FunctionApplication -> [SortBy] -> FunctionApplication
setSortBy :: FunctionApplication -> [SortBy] -> FunctionApplication
setSortBy f :: FunctionApplication
f@FApp{ FunctionArguments
arguments :: FunctionArguments
$sel:arguments:FApp :: FunctionApplication -> FunctionArguments
arguments } [SortBy]
sorts = case FunctionArguments
arguments of
  Args ArgsList
args -> FunctionApplication
f { $sel:arguments:FApp :: FunctionArguments
arguments = ArgsList -> FunctionArguments
Args ArgsList
args { $sel:sortBy:ArgsList :: [SortBy]
sortBy = [SortBy]
sorts } }
  FunctionArguments
_ -> FunctionApplication
f

data FunctionArguments = StarArg | NoArgs | Args ArgsList
    deriving (Int -> FunctionArguments -> ShowS
[FunctionArguments] -> ShowS
FunctionArguments -> String
(Int -> FunctionArguments -> ShowS)
-> (FunctionArguments -> String)
-> ([FunctionArguments] -> ShowS)
-> Show FunctionArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionArguments] -> ShowS
$cshowList :: [FunctionArguments] -> ShowS
show :: FunctionArguments -> String
$cshow :: FunctionArguments -> String
showsPrec :: Int -> FunctionArguments -> ShowS
$cshowsPrec :: Int -> FunctionArguments -> ShowS
Show, FunctionArguments -> FunctionArguments -> Bool
(FunctionArguments -> FunctionArguments -> Bool)
-> (FunctionArguments -> FunctionArguments -> Bool)
-> Eq FunctionArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionArguments -> FunctionArguments -> Bool
$c/= :: FunctionArguments -> FunctionArguments -> Bool
== :: FunctionArguments -> FunctionArguments -> Bool
$c== :: FunctionArguments -> FunctionArguments -> Bool
Eq, (forall x. FunctionArguments -> Rep FunctionArguments x)
-> (forall x. Rep FunctionArguments x -> FunctionArguments)
-> Generic FunctionArguments
forall x. Rep FunctionArguments x -> FunctionArguments
forall x. FunctionArguments -> Rep FunctionArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionArguments x -> FunctionArguments
$cfrom :: forall x. FunctionArguments -> Rep FunctionArguments x
Generic, Typeable, Typeable FunctionArguments
DataType
Constr
Typeable FunctionArguments
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> FunctionArguments
    -> c FunctionArguments)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FunctionArguments)
-> (FunctionArguments -> Constr)
-> (FunctionArguments -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FunctionArguments))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FunctionArguments))
-> ((forall b. Data b => b -> b)
    -> FunctionArguments -> FunctionArguments)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionArguments -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionArguments -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FunctionArguments -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FunctionArguments -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FunctionArguments -> m FunctionArguments)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionArguments -> m FunctionArguments)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionArguments -> m FunctionArguments)
-> Data FunctionArguments
FunctionArguments -> DataType
FunctionArguments -> Constr
(forall b. Data b => b -> b)
-> FunctionArguments -> FunctionArguments
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArguments -> c FunctionArguments
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArguments
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FunctionArguments -> u
forall u. (forall d. Data d => d -> u) -> FunctionArguments -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArguments -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArguments -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionArguments -> m FunctionArguments
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArguments -> m FunctionArguments
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArguments
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArguments -> c FunctionArguments
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionArguments)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArguments)
$cArgs :: Constr
$cNoArgs :: Constr
$cStarArg :: Constr
$tFunctionArguments :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> FunctionArguments -> m FunctionArguments
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArguments -> m FunctionArguments
gmapMp :: (forall d. Data d => d -> m d)
-> FunctionArguments -> m FunctionArguments
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArguments -> m FunctionArguments
gmapM :: (forall d. Data d => d -> m d)
-> FunctionArguments -> m FunctionArguments
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionArguments -> m FunctionArguments
gmapQi :: Int -> (forall d. Data d => d -> u) -> FunctionArguments -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionArguments -> u
gmapQ :: (forall d. Data d => d -> u) -> FunctionArguments -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionArguments -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArguments -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArguments -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArguments -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArguments -> r
gmapT :: (forall b. Data b => b -> b)
-> FunctionArguments -> FunctionArguments
$cgmapT :: (forall b. Data b => b -> b)
-> FunctionArguments -> FunctionArguments
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArguments)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArguments)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FunctionArguments)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionArguments)
dataTypeOf :: FunctionArguments -> DataType
$cdataTypeOf :: FunctionArguments -> DataType
toConstr :: FunctionArguments -> Constr
$ctoConstr :: FunctionArguments -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArguments
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArguments
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArguments -> c FunctionArguments
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArguments -> c FunctionArguments
$cp1Data :: Typeable FunctionArguments
Data, FunctionArguments -> Q Exp
FunctionArguments -> Q (TExp FunctionArguments)
(FunctionArguments -> Q Exp)
-> (FunctionArguments -> Q (TExp FunctionArguments))
-> Lift FunctionArguments
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FunctionArguments -> Q (TExp FunctionArguments)
$cliftTyped :: FunctionArguments -> Q (TExp FunctionArguments)
lift :: FunctionArguments -> Q Exp
$clift :: FunctionArguments -> Q Exp
Lift)

data ArgsList = ArgsList
  { ArgsList -> NonEmpty Argument
arguments :: NonEmpty Argument
  , ArgsList -> [SortBy]
sortBy :: [SortBy]
  , ArgsList -> Bool
distinct :: Bool
  }
    deriving (Int -> ArgsList -> ShowS
[ArgsList] -> ShowS
ArgsList -> String
(Int -> ArgsList -> ShowS)
-> (ArgsList -> String) -> ([ArgsList] -> ShowS) -> Show ArgsList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgsList] -> ShowS
$cshowList :: [ArgsList] -> ShowS
show :: ArgsList -> String
$cshow :: ArgsList -> String
showsPrec :: Int -> ArgsList -> ShowS
$cshowsPrec :: Int -> ArgsList -> ShowS
Show, ArgsList -> ArgsList -> Bool
(ArgsList -> ArgsList -> Bool)
-> (ArgsList -> ArgsList -> Bool) -> Eq ArgsList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgsList -> ArgsList -> Bool
$c/= :: ArgsList -> ArgsList -> Bool
== :: ArgsList -> ArgsList -> Bool
$c== :: ArgsList -> ArgsList -> Bool
Eq, (forall x. ArgsList -> Rep ArgsList x)
-> (forall x. Rep ArgsList x -> ArgsList) -> Generic ArgsList
forall x. Rep ArgsList x -> ArgsList
forall x. ArgsList -> Rep ArgsList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArgsList x -> ArgsList
$cfrom :: forall x. ArgsList -> Rep ArgsList x
Generic, Typeable, Typeable ArgsList
DataType
Constr
Typeable ArgsList
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ArgsList -> c ArgsList)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ArgsList)
-> (ArgsList -> Constr)
-> (ArgsList -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ArgsList))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgsList))
-> ((forall b. Data b => b -> b) -> ArgsList -> ArgsList)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ArgsList -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ArgsList -> r)
-> (forall u. (forall d. Data d => d -> u) -> ArgsList -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ArgsList -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ArgsList -> m ArgsList)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ArgsList -> m ArgsList)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ArgsList -> m ArgsList)
-> Data ArgsList
ArgsList -> DataType
ArgsList -> Constr
(forall b. Data b => b -> b) -> ArgsList -> ArgsList
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArgsList -> c ArgsList
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArgsList
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ArgsList -> u
forall u. (forall d. Data d => d -> u) -> ArgsList -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArgsList -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArgsList -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArgsList -> m ArgsList
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArgsList -> m ArgsList
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArgsList
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArgsList -> c ArgsList
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArgsList)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgsList)
$cArgsList :: Constr
$tArgsList :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ArgsList -> m ArgsList
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArgsList -> m ArgsList
gmapMp :: (forall d. Data d => d -> m d) -> ArgsList -> m ArgsList
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArgsList -> m ArgsList
gmapM :: (forall d. Data d => d -> m d) -> ArgsList -> m ArgsList
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArgsList -> m ArgsList
gmapQi :: Int -> (forall d. Data d => d -> u) -> ArgsList -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ArgsList -> u
gmapQ :: (forall d. Data d => d -> u) -> ArgsList -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArgsList -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArgsList -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArgsList -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArgsList -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArgsList -> r
gmapT :: (forall b. Data b => b -> b) -> ArgsList -> ArgsList
$cgmapT :: (forall b. Data b => b -> b) -> ArgsList -> ArgsList
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgsList)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgsList)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ArgsList)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArgsList)
dataTypeOf :: ArgsList -> DataType
$cdataTypeOf :: ArgsList -> DataType
toConstr :: ArgsList -> Constr
$ctoConstr :: ArgsList -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArgsList
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArgsList
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArgsList -> c ArgsList
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArgsList -> c ArgsList
$cp1Data :: Typeable ArgsList
Data, ArgsList -> Q Exp
ArgsList -> Q (TExp ArgsList)
(ArgsList -> Q Exp)
-> (ArgsList -> Q (TExp ArgsList)) -> Lift ArgsList
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ArgsList -> Q (TExp ArgsList)
$cliftTyped :: ArgsList -> Q (TExp ArgsList)
lift :: ArgsList -> Q Exp
$clift :: ArgsList -> Q Exp
Lift)

argsList :: NonEmpty Argument -> ArgsList
argsList :: NonEmpty Argument -> ArgsList
argsList NonEmpty Argument
args = NonEmpty Argument -> [SortBy] -> Bool -> ArgsList
ArgsList NonEmpty Argument
args [] Bool
False

data Argument = E Expr | Named Name Expr
    deriving (Int -> Argument -> ShowS
[Argument] -> ShowS
Argument -> String
(Int -> Argument -> ShowS)
-> (Argument -> String) -> ([Argument] -> ShowS) -> Show Argument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Argument] -> ShowS
$cshowList :: [Argument] -> ShowS
show :: Argument -> String
$cshow :: Argument -> String
showsPrec :: Int -> Argument -> ShowS
$cshowsPrec :: Int -> Argument -> ShowS
Show, Argument -> Argument -> Bool
(Argument -> Argument -> Bool)
-> (Argument -> Argument -> Bool) -> Eq Argument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Argument -> Argument -> Bool
$c/= :: Argument -> Argument -> Bool
== :: Argument -> Argument -> Bool
$c== :: Argument -> Argument -> Bool
Eq, (forall x. Argument -> Rep Argument x)
-> (forall x. Rep Argument x -> Argument) -> Generic Argument
forall x. Rep Argument x -> Argument
forall x. Argument -> Rep Argument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Argument x -> Argument
$cfrom :: forall x. Argument -> Rep Argument x
Generic, Typeable, Typeable Argument
DataType
Constr
Typeable Argument
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Argument -> c Argument)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Argument)
-> (Argument -> Constr)
-> (Argument -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Argument))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Argument))
-> ((forall b. Data b => b -> b) -> Argument -> Argument)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Argument -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Argument -> r)
-> (forall u. (forall d. Data d => d -> u) -> Argument -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Argument -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Argument -> m Argument)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Argument -> m Argument)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Argument -> m Argument)
-> Data Argument
Argument -> DataType
Argument -> Constr
(forall b. Data b => b -> b) -> Argument -> Argument
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Argument -> c Argument
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Argument
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Argument -> u
forall u. (forall d. Data d => d -> u) -> Argument -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Argument -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Argument -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Argument -> m Argument
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Argument -> m Argument
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Argument
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Argument -> c Argument
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Argument)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Argument)
$cNamed :: Constr
$cE :: Constr
$tArgument :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Argument -> m Argument
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Argument -> m Argument
gmapMp :: (forall d. Data d => d -> m d) -> Argument -> m Argument
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Argument -> m Argument
gmapM :: (forall d. Data d => d -> m d) -> Argument -> m Argument
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Argument -> m Argument
gmapQi :: Int -> (forall d. Data d => d -> u) -> Argument -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Argument -> u
gmapQ :: (forall d. Data d => d -> u) -> Argument -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Argument -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Argument -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Argument -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Argument -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Argument -> r
gmapT :: (forall b. Data b => b -> b) -> Argument -> Argument
$cgmapT :: (forall b. Data b => b -> b) -> Argument -> Argument
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Argument)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Argument)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Argument)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Argument)
dataTypeOf :: Argument -> DataType
$cdataTypeOf :: Argument -> DataType
toConstr :: Argument -> Constr
$ctoConstr :: Argument -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Argument
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Argument
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Argument -> c Argument
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Argument -> c Argument
$cp1Data :: Typeable Argument
Data, Argument -> Q Exp
Argument -> Q (TExp Argument)
(Argument -> Q Exp)
-> (Argument -> Q (TExp Argument)) -> Lift Argument
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Argument -> Q (TExp Argument)
$cliftTyped :: Argument -> Q (TExp Argument)
lift :: Argument -> Q Exp
$clift :: Argument -> Q Exp
Lift)

data Case = Case
  { Case -> [(Expr, Expr)]
whenClause :: [(Expr, Expr)] -- (condition, then)
  , Case -> Maybe Expr
implicitArg :: Maybe Expr
  , Case -> Maybe Expr
elseClause :: Maybe Expr
  } deriving (Int -> Case -> ShowS
[Case] -> ShowS
Case -> String
(Int -> Case -> ShowS)
-> (Case -> String) -> ([Case] -> ShowS) -> Show Case
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Case] -> ShowS
$cshowList :: [Case] -> ShowS
show :: Case -> String
$cshow :: Case -> String
showsPrec :: Int -> Case -> ShowS
$cshowsPrec :: Int -> Case -> ShowS
Show, Case -> Case -> Bool
(Case -> Case -> Bool) -> (Case -> Case -> Bool) -> Eq Case
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Case -> Case -> Bool
$c/= :: Case -> Case -> Bool
== :: Case -> Case -> Bool
$c== :: Case -> Case -> Bool
Eq, (forall x. Case -> Rep Case x)
-> (forall x. Rep Case x -> Case) -> Generic Case
forall x. Rep Case x -> Case
forall x. Case -> Rep Case x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Case x -> Case
$cfrom :: forall x. Case -> Rep Case x
Generic, Typeable Case
DataType
Constr
Typeable Case
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Case -> c Case)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Case)
-> (Case -> Constr)
-> (Case -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Case))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Case))
-> ((forall b. Data b => b -> b) -> Case -> Case)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Case -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Case -> r)
-> (forall u. (forall d. Data d => d -> u) -> Case -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Case -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Case -> m Case)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Case -> m Case)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Case -> m Case)
-> Data Case
Case -> DataType
Case -> Constr
(forall b. Data b => b -> b) -> Case -> Case
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Case -> c Case
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Case
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Case -> u
forall u. (forall d. Data d => d -> u) -> Case -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Case -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Case -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Case -> m Case
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Case -> m Case
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Case
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Case -> c Case
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Case)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Case)
$cCase :: Constr
$tCase :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Case -> m Case
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Case -> m Case
gmapMp :: (forall d. Data d => d -> m d) -> Case -> m Case
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Case -> m Case
gmapM :: (forall d. Data d => d -> m d) -> Case -> m Case
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Case -> m Case
gmapQi :: Int -> (forall d. Data d => d -> u) -> Case -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Case -> u
gmapQ :: (forall d. Data d => d -> u) -> Case -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Case -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Case -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Case -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Case -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Case -> r
gmapT :: (forall b. Data b => b -> b) -> Case -> Case
$cgmapT :: (forall b. Data b => b -> b) -> Case -> Case
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Case)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Case)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Case)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Case)
dataTypeOf :: Case -> DataType
$cdataTypeOf :: Case -> DataType
toConstr :: Case -> Constr
$ctoConstr :: Case -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Case
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Case
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Case -> c Case
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Case -> c Case
$cp1Data :: Typeable Case
Data, Case -> Q Exp
Case -> Q (TExp Case)
(Case -> Q Exp) -> (Case -> Q (TExp Case)) -> Lift Case
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Case -> Q (TExp Case)
$cliftTyped :: Case -> Q (TExp Case)
lift :: Case -> Q Exp
$clift :: Case -> Q Exp
Lift)