-- Copyright   :  Daan Leijen (c) 1999, daan@cs.uu.nl
--                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net
-- License     :  BSD-style

{-# LANGUAGE DeriveTraversable #-}

module Opaleye.Internal.HaskellDB.PrimQuery where

import qualified Opaleye.Internal.Tag as T
import Data.ByteString (ByteString)
import qualified Data.List.NonEmpty as NEL
import qualified Data.Scientific as Sci

type TableName  = String
type Attribute  = String
type Name = String
type Scheme     = [Attribute]
type Assoc      = [(Attribute,PrimExpr)]

data Symbol = Symbol String T.Tag deriving (ReadPrec [Symbol]
ReadPrec Symbol
Int -> ReadS Symbol
ReadS [Symbol]
(Int -> ReadS Symbol)
-> ReadS [Symbol]
-> ReadPrec Symbol
-> ReadPrec [Symbol]
-> Read Symbol
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Symbol
readsPrec :: Int -> ReadS Symbol
$creadList :: ReadS [Symbol]
readList :: ReadS [Symbol]
$creadPrec :: ReadPrec Symbol
readPrec :: ReadPrec Symbol
$creadListPrec :: ReadPrec [Symbol]
readListPrec :: ReadPrec [Symbol]
Read, Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> String
(Int -> Symbol -> ShowS)
-> (Symbol -> String) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Symbol -> ShowS
showsPrec :: Int -> Symbol -> ShowS
$cshow :: Symbol -> String
show :: Symbol -> String
$cshowList :: [Symbol] -> ShowS
showList :: [Symbol] -> ShowS
Show)

data PrimExpr   = AttrExpr  Symbol
                | BaseTableAttrExpr Attribute
                | CompositeExpr     PrimExpr Attribute -- ^ Composite Type Query
                | BinExpr   BinOp PrimExpr PrimExpr
                | UnExpr    UnOp PrimExpr
                | AggrExpr  (Aggr' PrimExpr)
                | WndwExpr  WndwOp Partition
                | ConstExpr Literal
                | CaseExpr [(PrimExpr,PrimExpr)] PrimExpr
                | ListExpr (NEL.NonEmpty PrimExpr)
                | ParamExpr (Maybe Name) PrimExpr
                | FunExpr Name [PrimExpr]
                | CastExpr Name PrimExpr -- ^ Cast an expression to a given type.
                | DefaultInsertExpr -- Indicate that we want to insert the
                                    -- default value into a column.
                                    -- TODO: I'm not sure this belongs
                                    -- here.  Perhaps a special type is
                                    -- needed for insert expressions.
                | ArrayExpr [PrimExpr] -- ^ ARRAY[..]
                | RangeExpr String BoundExpr BoundExpr
                | ArrayIndex PrimExpr PrimExpr
                deriving (ReadPrec [PrimExpr]
ReadPrec PrimExpr
Int -> ReadS PrimExpr
ReadS [PrimExpr]
(Int -> ReadS PrimExpr)
-> ReadS [PrimExpr]
-> ReadPrec PrimExpr
-> ReadPrec [PrimExpr]
-> Read PrimExpr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PrimExpr
readsPrec :: Int -> ReadS PrimExpr
$creadList :: ReadS [PrimExpr]
readList :: ReadS [PrimExpr]
$creadPrec :: ReadPrec PrimExpr
readPrec :: ReadPrec PrimExpr
$creadListPrec :: ReadPrec [PrimExpr]
readListPrec :: ReadPrec [PrimExpr]
Read,Int -> PrimExpr -> ShowS
[PrimExpr] -> ShowS
PrimExpr -> String
(Int -> PrimExpr -> ShowS)
-> (PrimExpr -> String) -> ([PrimExpr] -> ShowS) -> Show PrimExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimExpr -> ShowS
showsPrec :: Int -> PrimExpr -> ShowS
$cshow :: PrimExpr -> String
show :: PrimExpr -> String
$cshowList :: [PrimExpr] -> ShowS
showList :: [PrimExpr] -> ShowS
Show)

data Literal = NullLit
             | DefaultLit            -- ^ represents a default value
             | BoolLit Bool
             | StringLit String
             | ByteStringLit ByteString
             | IntegerLit Integer
             | DoubleLit Double
             | NumericLit Sci.Scientific
             | OtherLit String       -- ^ used for hacking in custom SQL
               deriving (ReadPrec [Literal]
ReadPrec Literal
Int -> ReadS Literal
ReadS [Literal]
(Int -> ReadS Literal)
-> ReadS [Literal]
-> ReadPrec Literal
-> ReadPrec [Literal]
-> Read Literal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Literal
readsPrec :: Int -> ReadS Literal
$creadList :: ReadS [Literal]
readList :: ReadS [Literal]
$creadPrec :: ReadPrec Literal
readPrec :: ReadPrec Literal
$creadListPrec :: ReadPrec [Literal]
readListPrec :: ReadPrec [Literal]
Read,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
$cshowsPrec :: Int -> Literal -> ShowS
showsPrec :: Int -> Literal -> ShowS
$cshow :: Literal -> String
show :: Literal -> String
$cshowList :: [Literal] -> ShowS
showList :: [Literal] -> ShowS
Show)

data BinOp      = (:==) | (:<) | (:<=) | (:>) | (:>=) | (:<>)
                | OpAnd | OpOr
                | OpLike | OpILike | OpIn
                | OpOther String

                | (:||)
                | (:+) | (:-) | (:*) | (:/) | OpMod
                | (:~) | (:&) | (:|) | (:^)
                | (:=) | OpAtTimeZone

                | (:->) | (:->>) | (:#>) | (:#>>)
                | (:@>) | (:<@) | (:?) | (:?|) | (:?&)
                | (:&&) | (:<<) | (:>>) | (:&<) | (:&>) | (:-|-)
                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
$cshowsPrec :: Int -> BinOp -> ShowS
showsPrec :: Int -> BinOp -> ShowS
$cshow :: BinOp -> String
show :: BinOp -> String
$cshowList :: [BinOp] -> ShowS
showList :: [BinOp] -> ShowS
Show,ReadPrec [BinOp]
ReadPrec BinOp
Int -> ReadS BinOp
ReadS [BinOp]
(Int -> ReadS BinOp)
-> ReadS [BinOp]
-> ReadPrec BinOp
-> ReadPrec [BinOp]
-> Read BinOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BinOp
readsPrec :: Int -> ReadS BinOp
$creadList :: ReadS [BinOp]
readList :: ReadS [BinOp]
$creadPrec :: ReadPrec BinOp
readPrec :: ReadPrec BinOp
$creadListPrec :: ReadPrec [BinOp]
readListPrec :: ReadPrec [BinOp]
Read)

data UnOp = OpNot
          | OpIsNull
          | OpIsNotNull
          | OpLength
          | OpAbs
          | OpNegate
          | OpLower
          | OpUpper
          | UnOpOther String
          deriving (Int -> UnOp -> ShowS
[UnOp] -> ShowS
UnOp -> String
(Int -> UnOp -> ShowS)
-> (UnOp -> String) -> ([UnOp] -> ShowS) -> Show UnOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnOp -> ShowS
showsPrec :: Int -> UnOp -> ShowS
$cshow :: UnOp -> String
show :: UnOp -> String
$cshowList :: [UnOp] -> ShowS
showList :: [UnOp] -> ShowS
Show,ReadPrec [UnOp]
ReadPrec UnOp
Int -> ReadS UnOp
ReadS [UnOp]
(Int -> ReadS UnOp)
-> ReadS [UnOp] -> ReadPrec UnOp -> ReadPrec [UnOp] -> Read UnOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UnOp
readsPrec :: Int -> ReadS UnOp
$creadList :: ReadS [UnOp]
readList :: ReadS [UnOp]
$creadPrec :: ReadPrec UnOp
readPrec :: ReadPrec UnOp
$creadListPrec :: ReadPrec [UnOp]
readListPrec :: ReadPrec [UnOp]
Read)

data AggrOp     = AggrCount | AggrSum | AggrAvg | AggrMin | AggrMax
                | AggrStdDev | AggrStdDevP | AggrVar | AggrVarP
                | AggrBoolOr | AggrBoolAnd | AggrArr | JsonArr
                | AggrStringAggr
                | AggrOther String
                deriving (Int -> AggrOp -> ShowS
[AggrOp] -> ShowS
AggrOp -> String
(Int -> AggrOp -> ShowS)
-> (AggrOp -> String) -> ([AggrOp] -> ShowS) -> Show AggrOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AggrOp -> ShowS
showsPrec :: Int -> AggrOp -> ShowS
$cshow :: AggrOp -> String
show :: AggrOp -> String
$cshowList :: [AggrOp] -> ShowS
showList :: [AggrOp] -> ShowS
Show,ReadPrec [AggrOp]
ReadPrec AggrOp
Int -> ReadS AggrOp
ReadS [AggrOp]
(Int -> ReadS AggrOp)
-> ReadS [AggrOp]
-> ReadPrec AggrOp
-> ReadPrec [AggrOp]
-> Read AggrOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AggrOp
readsPrec :: Int -> ReadS AggrOp
$creadList :: ReadS [AggrOp]
readList :: ReadS [AggrOp]
$creadPrec :: ReadPrec AggrOp
readPrec :: ReadPrec AggrOp
$creadListPrec :: ReadPrec [AggrOp]
readListPrec :: ReadPrec [AggrOp]
Read)

data AggrDistinct = AggrDistinct | AggrAll
                  deriving (AggrDistinct -> AggrDistinct -> Bool
(AggrDistinct -> AggrDistinct -> Bool)
-> (AggrDistinct -> AggrDistinct -> Bool) -> Eq AggrDistinct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AggrDistinct -> AggrDistinct -> Bool
== :: AggrDistinct -> AggrDistinct -> Bool
$c/= :: AggrDistinct -> AggrDistinct -> Bool
/= :: AggrDistinct -> AggrDistinct -> Bool
Eq,Int -> AggrDistinct -> ShowS
[AggrDistinct] -> ShowS
AggrDistinct -> String
(Int -> AggrDistinct -> ShowS)
-> (AggrDistinct -> String)
-> ([AggrDistinct] -> ShowS)
-> Show AggrDistinct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AggrDistinct -> ShowS
showsPrec :: Int -> AggrDistinct -> ShowS
$cshow :: AggrDistinct -> String
show :: AggrDistinct -> String
$cshowList :: [AggrDistinct] -> ShowS
showList :: [AggrDistinct] -> ShowS
Show,ReadPrec [AggrDistinct]
ReadPrec AggrDistinct
Int -> ReadS AggrDistinct
ReadS [AggrDistinct]
(Int -> ReadS AggrDistinct)
-> ReadS [AggrDistinct]
-> ReadPrec AggrDistinct
-> ReadPrec [AggrDistinct]
-> Read AggrDistinct
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AggrDistinct
readsPrec :: Int -> ReadS AggrDistinct
$creadList :: ReadS [AggrDistinct]
readList :: ReadS [AggrDistinct]
$creadPrec :: ReadPrec AggrDistinct
readPrec :: ReadPrec AggrDistinct
$creadListPrec :: ReadPrec [AggrDistinct]
readListPrec :: ReadPrec [AggrDistinct]
Read)

type Aggregate = Aggregate' PrimExpr

data Aggregate' a = GroupBy a | Aggregate (Aggr' a)
  deriving ((forall a b. (a -> b) -> Aggregate' a -> Aggregate' b)
-> (forall a b. a -> Aggregate' b -> Aggregate' a)
-> Functor Aggregate'
forall a b. a -> Aggregate' b -> Aggregate' a
forall a b. (a -> b) -> Aggregate' a -> Aggregate' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Aggregate' a -> Aggregate' b
fmap :: forall a b. (a -> b) -> Aggregate' a -> Aggregate' b
$c<$ :: forall a b. a -> Aggregate' b -> Aggregate' a
<$ :: forall a b. a -> Aggregate' b -> Aggregate' a
Functor, (forall m. Monoid m => Aggregate' m -> m)
-> (forall m a. Monoid m => (a -> m) -> Aggregate' a -> m)
-> (forall m a. Monoid m => (a -> m) -> Aggregate' a -> m)
-> (forall a b. (a -> b -> b) -> b -> Aggregate' a -> b)
-> (forall a b. (a -> b -> b) -> b -> Aggregate' a -> b)
-> (forall b a. (b -> a -> b) -> b -> Aggregate' a -> b)
-> (forall b a. (b -> a -> b) -> b -> Aggregate' a -> b)
-> (forall a. (a -> a -> a) -> Aggregate' a -> a)
-> (forall a. (a -> a -> a) -> Aggregate' a -> a)
-> (forall a. Aggregate' a -> [a])
-> (forall a. Aggregate' a -> Bool)
-> (forall a. Aggregate' a -> Int)
-> (forall a. Eq a => a -> Aggregate' a -> Bool)
-> (forall a. Ord a => Aggregate' a -> a)
-> (forall a. Ord a => Aggregate' a -> a)
-> (forall a. Num a => Aggregate' a -> a)
-> (forall a. Num a => Aggregate' a -> a)
-> Foldable Aggregate'
forall a. Eq a => a -> Aggregate' a -> Bool
forall a. Num a => Aggregate' a -> a
forall a. Ord a => Aggregate' a -> a
forall m. Monoid m => Aggregate' m -> m
forall a. Aggregate' a -> Bool
forall a. Aggregate' a -> Int
forall a. Aggregate' a -> [a]
forall a. (a -> a -> a) -> Aggregate' a -> a
forall m a. Monoid m => (a -> m) -> Aggregate' a -> m
forall b a. (b -> a -> b) -> b -> Aggregate' a -> b
forall a b. (a -> b -> b) -> b -> Aggregate' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Aggregate' m -> m
fold :: forall m. Monoid m => Aggregate' m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Aggregate' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Aggregate' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Aggregate' a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Aggregate' a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Aggregate' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Aggregate' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Aggregate' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Aggregate' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Aggregate' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Aggregate' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Aggregate' a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Aggregate' a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Aggregate' a -> a
foldr1 :: forall a. (a -> a -> a) -> Aggregate' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Aggregate' a -> a
foldl1 :: forall a. (a -> a -> a) -> Aggregate' a -> a
$ctoList :: forall a. Aggregate' a -> [a]
toList :: forall a. Aggregate' a -> [a]
$cnull :: forall a. Aggregate' a -> Bool
null :: forall a. Aggregate' a -> Bool
$clength :: forall a. Aggregate' a -> Int
length :: forall a. Aggregate' a -> Int
$celem :: forall a. Eq a => a -> Aggregate' a -> Bool
elem :: forall a. Eq a => a -> Aggregate' a -> Bool
$cmaximum :: forall a. Ord a => Aggregate' a -> a
maximum :: forall a. Ord a => Aggregate' a -> a
$cminimum :: forall a. Ord a => Aggregate' a -> a
minimum :: forall a. Ord a => Aggregate' a -> a
$csum :: forall a. Num a => Aggregate' a -> a
sum :: forall a. Num a => Aggregate' a -> a
$cproduct :: forall a. Num a => Aggregate' a -> a
product :: forall a. Num a => Aggregate' a -> a
Foldable, Functor Aggregate'
Foldable Aggregate'
(Functor Aggregate', Foldable Aggregate') =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Aggregate' a -> f (Aggregate' b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Aggregate' (f a) -> f (Aggregate' a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Aggregate' a -> m (Aggregate' b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Aggregate' (m a) -> m (Aggregate' a))
-> Traversable Aggregate'
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Aggregate' (m a) -> m (Aggregate' a)
forall (f :: * -> *) a.
Applicative f =>
Aggregate' (f a) -> f (Aggregate' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Aggregate' a -> m (Aggregate' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Aggregate' a -> f (Aggregate' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Aggregate' a -> f (Aggregate' b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Aggregate' a -> f (Aggregate' b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Aggregate' (f a) -> f (Aggregate' a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Aggregate' (f a) -> f (Aggregate' a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Aggregate' a -> m (Aggregate' b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Aggregate' a -> m (Aggregate' b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Aggregate' (m a) -> m (Aggregate' a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Aggregate' (m a) -> m (Aggregate' a)
Traversable, Int -> Aggregate' a -> ShowS
[Aggregate' a] -> ShowS
Aggregate' a -> String
(Int -> Aggregate' a -> ShowS)
-> (Aggregate' a -> String)
-> ([Aggregate' a] -> ShowS)
-> Show (Aggregate' a)
forall a. Show a => Int -> Aggregate' a -> ShowS
forall a. Show a => [Aggregate' a] -> ShowS
forall a. Show a => Aggregate' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Aggregate' a -> ShowS
showsPrec :: Int -> Aggregate' a -> ShowS
$cshow :: forall a. Show a => Aggregate' a -> String
show :: Aggregate' a -> String
$cshowList :: forall a. Show a => [Aggregate' a] -> ShowS
showList :: [Aggregate' a] -> ShowS
Show, ReadPrec [Aggregate' a]
ReadPrec (Aggregate' a)
Int -> ReadS (Aggregate' a)
ReadS [Aggregate' a]
(Int -> ReadS (Aggregate' a))
-> ReadS [Aggregate' a]
-> ReadPrec (Aggregate' a)
-> ReadPrec [Aggregate' a]
-> Read (Aggregate' a)
forall a. Read a => ReadPrec [Aggregate' a]
forall a. Read a => ReadPrec (Aggregate' a)
forall a. Read a => Int -> ReadS (Aggregate' a)
forall a. Read a => ReadS [Aggregate' a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Aggregate' a)
readsPrec :: Int -> ReadS (Aggregate' a)
$creadList :: forall a. Read a => ReadS [Aggregate' a]
readList :: ReadS [Aggregate' a]
$creadPrec :: forall a. Read a => ReadPrec (Aggregate' a)
readPrec :: ReadPrec (Aggregate' a)
$creadListPrec :: forall a. Read a => ReadPrec [Aggregate' a]
readListPrec :: ReadPrec [Aggregate' a]
Read)

data Aggr' a = Aggr
  { forall a. Aggr' a -> AggrOp
aggrOp :: !AggrOp
  , forall a. Aggr' a -> [a]
aggrExprs :: ![a]
  , forall a. Aggr' a -> [OrderExpr' a]
aggrOrder :: ![OrderExpr' a]
  , forall a. Aggr' a -> AggrDistinct
aggrDistinct :: !AggrDistinct
  , forall a. Aggr' a -> [OrderExpr' a]
aggrGroup :: ![OrderExpr' a]
  , forall a. Aggr' a -> Maybe PrimExpr
aggrFilter :: !(Maybe PrimExpr)
  }
  deriving ((forall a b. (a -> b) -> Aggr' a -> Aggr' b)
-> (forall a b. a -> Aggr' b -> Aggr' a) -> Functor Aggr'
forall a b. a -> Aggr' b -> Aggr' a
forall a b. (a -> b) -> Aggr' a -> Aggr' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Aggr' a -> Aggr' b
fmap :: forall a b. (a -> b) -> Aggr' a -> Aggr' b
$c<$ :: forall a b. a -> Aggr' b -> Aggr' a
<$ :: forall a b. a -> Aggr' b -> Aggr' a
Functor, (forall m. Monoid m => Aggr' m -> m)
-> (forall m a. Monoid m => (a -> m) -> Aggr' a -> m)
-> (forall m a. Monoid m => (a -> m) -> Aggr' a -> m)
-> (forall a b. (a -> b -> b) -> b -> Aggr' a -> b)
-> (forall a b. (a -> b -> b) -> b -> Aggr' a -> b)
-> (forall b a. (b -> a -> b) -> b -> Aggr' a -> b)
-> (forall b a. (b -> a -> b) -> b -> Aggr' a -> b)
-> (forall a. (a -> a -> a) -> Aggr' a -> a)
-> (forall a. (a -> a -> a) -> Aggr' a -> a)
-> (forall a. Aggr' a -> [a])
-> (forall a. Aggr' a -> Bool)
-> (forall a. Aggr' a -> Int)
-> (forall a. Eq a => a -> Aggr' a -> Bool)
-> (forall a. Ord a => Aggr' a -> a)
-> (forall a. Ord a => Aggr' a -> a)
-> (forall a. Num a => Aggr' a -> a)
-> (forall a. Num a => Aggr' a -> a)
-> Foldable Aggr'
forall a. Eq a => a -> Aggr' a -> Bool
forall a. Num a => Aggr' a -> a
forall a. Ord a => Aggr' a -> a
forall m. Monoid m => Aggr' m -> m
forall a. Aggr' a -> Bool
forall a. Aggr' a -> Int
forall a. Aggr' a -> [a]
forall a. (a -> a -> a) -> Aggr' a -> a
forall m a. Monoid m => (a -> m) -> Aggr' a -> m
forall b a. (b -> a -> b) -> b -> Aggr' a -> b
forall a b. (a -> b -> b) -> b -> Aggr' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Aggr' m -> m
fold :: forall m. Monoid m => Aggr' m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Aggr' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Aggr' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Aggr' a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Aggr' a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Aggr' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Aggr' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Aggr' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Aggr' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Aggr' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Aggr' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Aggr' a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Aggr' a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Aggr' a -> a
foldr1 :: forall a. (a -> a -> a) -> Aggr' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Aggr' a -> a
foldl1 :: forall a. (a -> a -> a) -> Aggr' a -> a
$ctoList :: forall a. Aggr' a -> [a]
toList :: forall a. Aggr' a -> [a]
$cnull :: forall a. Aggr' a -> Bool
null :: forall a. Aggr' a -> Bool
$clength :: forall a. Aggr' a -> Int
length :: forall a. Aggr' a -> Int
$celem :: forall a. Eq a => a -> Aggr' a -> Bool
elem :: forall a. Eq a => a -> Aggr' a -> Bool
$cmaximum :: forall a. Ord a => Aggr' a -> a
maximum :: forall a. Ord a => Aggr' a -> a
$cminimum :: forall a. Ord a => Aggr' a -> a
minimum :: forall a. Ord a => Aggr' a -> a
$csum :: forall a. Num a => Aggr' a -> a
sum :: forall a. Num a => Aggr' a -> a
$cproduct :: forall a. Num a => Aggr' a -> a
product :: forall a. Num a => Aggr' a -> a
Foldable, Functor Aggr'
Foldable Aggr'
(Functor Aggr', Foldable Aggr') =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Aggr' a -> f (Aggr' b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Aggr' (f a) -> f (Aggr' a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Aggr' a -> m (Aggr' b))
-> (forall (m :: * -> *) a. Monad m => Aggr' (m a) -> m (Aggr' a))
-> Traversable Aggr'
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Aggr' (m a) -> m (Aggr' a)
forall (f :: * -> *) a. Applicative f => Aggr' (f a) -> f (Aggr' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Aggr' a -> m (Aggr' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Aggr' a -> f (Aggr' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Aggr' a -> f (Aggr' b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Aggr' a -> f (Aggr' b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Aggr' (f a) -> f (Aggr' a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Aggr' (f a) -> f (Aggr' a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Aggr' a -> m (Aggr' b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Aggr' a -> m (Aggr' b)
$csequence :: forall (m :: * -> *) a. Monad m => Aggr' (m a) -> m (Aggr' a)
sequence :: forall (m :: * -> *) a. Monad m => Aggr' (m a) -> m (Aggr' a)
Traversable, Int -> Aggr' a -> ShowS
[Aggr' a] -> ShowS
Aggr' a -> String
(Int -> Aggr' a -> ShowS)
-> (Aggr' a -> String) -> ([Aggr' a] -> ShowS) -> Show (Aggr' a)
forall a. Show a => Int -> Aggr' a -> ShowS
forall a. Show a => [Aggr' a] -> ShowS
forall a. Show a => Aggr' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Aggr' a -> ShowS
showsPrec :: Int -> Aggr' a -> ShowS
$cshow :: forall a. Show a => Aggr' a -> String
show :: Aggr' a -> String
$cshowList :: forall a. Show a => [Aggr' a] -> ShowS
showList :: [Aggr' a] -> ShowS
Show, ReadPrec [Aggr' a]
ReadPrec (Aggr' a)
Int -> ReadS (Aggr' a)
ReadS [Aggr' a]
(Int -> ReadS (Aggr' a))
-> ReadS [Aggr' a]
-> ReadPrec (Aggr' a)
-> ReadPrec [Aggr' a]
-> Read (Aggr' a)
forall a. Read a => ReadPrec [Aggr' a]
forall a. Read a => ReadPrec (Aggr' a)
forall a. Read a => Int -> ReadS (Aggr' a)
forall a. Read a => ReadS [Aggr' a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Aggr' a)
readsPrec :: Int -> ReadS (Aggr' a)
$creadList :: forall a. Read a => ReadS [Aggr' a]
readList :: ReadS [Aggr' a]
$creadPrec :: forall a. Read a => ReadPrec (Aggr' a)
readPrec :: ReadPrec (Aggr' a)
$creadListPrec :: forall a. Read a => ReadPrec [Aggr' a]
readListPrec :: ReadPrec [Aggr' a]
Read)

type OrderExpr = OrderExpr' PrimExpr

data OrderExpr' a = OrderExpr OrderOp a
  deriving ((forall a b. (a -> b) -> OrderExpr' a -> OrderExpr' b)
-> (forall a b. a -> OrderExpr' b -> OrderExpr' a)
-> Functor OrderExpr'
forall a b. a -> OrderExpr' b -> OrderExpr' a
forall a b. (a -> b) -> OrderExpr' a -> OrderExpr' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> OrderExpr' a -> OrderExpr' b
fmap :: forall a b. (a -> b) -> OrderExpr' a -> OrderExpr' b
$c<$ :: forall a b. a -> OrderExpr' b -> OrderExpr' a
<$ :: forall a b. a -> OrderExpr' b -> OrderExpr' a
Functor, (forall m. Monoid m => OrderExpr' m -> m)
-> (forall m a. Monoid m => (a -> m) -> OrderExpr' a -> m)
-> (forall m a. Monoid m => (a -> m) -> OrderExpr' a -> m)
-> (forall a b. (a -> b -> b) -> b -> OrderExpr' a -> b)
-> (forall a b. (a -> b -> b) -> b -> OrderExpr' a -> b)
-> (forall b a. (b -> a -> b) -> b -> OrderExpr' a -> b)
-> (forall b a. (b -> a -> b) -> b -> OrderExpr' a -> b)
-> (forall a. (a -> a -> a) -> OrderExpr' a -> a)
-> (forall a. (a -> a -> a) -> OrderExpr' a -> a)
-> (forall a. OrderExpr' a -> [a])
-> (forall a. OrderExpr' a -> Bool)
-> (forall a. OrderExpr' a -> Int)
-> (forall a. Eq a => a -> OrderExpr' a -> Bool)
-> (forall a. Ord a => OrderExpr' a -> a)
-> (forall a. Ord a => OrderExpr' a -> a)
-> (forall a. Num a => OrderExpr' a -> a)
-> (forall a. Num a => OrderExpr' a -> a)
-> Foldable OrderExpr'
forall a. Eq a => a -> OrderExpr' a -> Bool
forall a. Num a => OrderExpr' a -> a
forall a. Ord a => OrderExpr' a -> a
forall m. Monoid m => OrderExpr' m -> m
forall a. OrderExpr' a -> Bool
forall a. OrderExpr' a -> Int
forall a. OrderExpr' a -> [a]
forall a. (a -> a -> a) -> OrderExpr' a -> a
forall m a. Monoid m => (a -> m) -> OrderExpr' a -> m
forall b a. (b -> a -> b) -> b -> OrderExpr' a -> b
forall a b. (a -> b -> b) -> b -> OrderExpr' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => OrderExpr' m -> m
fold :: forall m. Monoid m => OrderExpr' m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> OrderExpr' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> OrderExpr' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> OrderExpr' a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> OrderExpr' a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> OrderExpr' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> OrderExpr' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> OrderExpr' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> OrderExpr' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> OrderExpr' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> OrderExpr' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> OrderExpr' a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> OrderExpr' a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> OrderExpr' a -> a
foldr1 :: forall a. (a -> a -> a) -> OrderExpr' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> OrderExpr' a -> a
foldl1 :: forall a. (a -> a -> a) -> OrderExpr' a -> a
$ctoList :: forall a. OrderExpr' a -> [a]
toList :: forall a. OrderExpr' a -> [a]
$cnull :: forall a. OrderExpr' a -> Bool
null :: forall a. OrderExpr' a -> Bool
$clength :: forall a. OrderExpr' a -> Int
length :: forall a. OrderExpr' a -> Int
$celem :: forall a. Eq a => a -> OrderExpr' a -> Bool
elem :: forall a. Eq a => a -> OrderExpr' a -> Bool
$cmaximum :: forall a. Ord a => OrderExpr' a -> a
maximum :: forall a. Ord a => OrderExpr' a -> a
$cminimum :: forall a. Ord a => OrderExpr' a -> a
minimum :: forall a. Ord a => OrderExpr' a -> a
$csum :: forall a. Num a => OrderExpr' a -> a
sum :: forall a. Num a => OrderExpr' a -> a
$cproduct :: forall a. Num a => OrderExpr' a -> a
product :: forall a. Num a => OrderExpr' a -> a
Foldable, Functor OrderExpr'
Foldable OrderExpr'
(Functor OrderExpr', Foldable OrderExpr') =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> OrderExpr' a -> f (OrderExpr' b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    OrderExpr' (f a) -> f (OrderExpr' a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> OrderExpr' a -> m (OrderExpr' b))
-> (forall (m :: * -> *) a.
    Monad m =>
    OrderExpr' (m a) -> m (OrderExpr' a))
-> Traversable OrderExpr'
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
OrderExpr' (m a) -> m (OrderExpr' a)
forall (f :: * -> *) a.
Applicative f =>
OrderExpr' (f a) -> f (OrderExpr' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrderExpr' a -> m (OrderExpr' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrderExpr' a -> f (OrderExpr' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrderExpr' a -> f (OrderExpr' b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrderExpr' a -> f (OrderExpr' b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
OrderExpr' (f a) -> f (OrderExpr' a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
OrderExpr' (f a) -> f (OrderExpr' a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrderExpr' a -> m (OrderExpr' b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrderExpr' a -> m (OrderExpr' b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
OrderExpr' (m a) -> m (OrderExpr' a)
sequence :: forall (m :: * -> *) a.
Monad m =>
OrderExpr' (m a) -> m (OrderExpr' a)
Traversable, Int -> OrderExpr' a -> ShowS
[OrderExpr' a] -> ShowS
OrderExpr' a -> String
(Int -> OrderExpr' a -> ShowS)
-> (OrderExpr' a -> String)
-> ([OrderExpr' a] -> ShowS)
-> Show (OrderExpr' a)
forall a. Show a => Int -> OrderExpr' a -> ShowS
forall a. Show a => [OrderExpr' a] -> ShowS
forall a. Show a => OrderExpr' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> OrderExpr' a -> ShowS
showsPrec :: Int -> OrderExpr' a -> ShowS
$cshow :: forall a. Show a => OrderExpr' a -> String
show :: OrderExpr' a -> String
$cshowList :: forall a. Show a => [OrderExpr' a] -> ShowS
showList :: [OrderExpr' a] -> ShowS
Show, ReadPrec [OrderExpr' a]
ReadPrec (OrderExpr' a)
Int -> ReadS (OrderExpr' a)
ReadS [OrderExpr' a]
(Int -> ReadS (OrderExpr' a))
-> ReadS [OrderExpr' a]
-> ReadPrec (OrderExpr' a)
-> ReadPrec [OrderExpr' a]
-> Read (OrderExpr' a)
forall a. Read a => ReadPrec [OrderExpr' a]
forall a. Read a => ReadPrec (OrderExpr' a)
forall a. Read a => Int -> ReadS (OrderExpr' a)
forall a. Read a => ReadS [OrderExpr' a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (OrderExpr' a)
readsPrec :: Int -> ReadS (OrderExpr' a)
$creadList :: forall a. Read a => ReadS [OrderExpr' a]
readList :: ReadS [OrderExpr' a]
$creadPrec :: forall a. Read a => ReadPrec (OrderExpr' a)
readPrec :: ReadPrec (OrderExpr' a)
$creadListPrec :: forall a. Read a => ReadPrec [OrderExpr' a]
readListPrec :: ReadPrec [OrderExpr' a]
Read)

data OrderNulls = NullsFirst | NullsLast
                deriving (Int -> OrderNulls -> ShowS
[OrderNulls] -> ShowS
OrderNulls -> String
(Int -> OrderNulls -> ShowS)
-> (OrderNulls -> String)
-> ([OrderNulls] -> ShowS)
-> Show OrderNulls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrderNulls -> ShowS
showsPrec :: Int -> OrderNulls -> ShowS
$cshow :: OrderNulls -> String
show :: OrderNulls -> String
$cshowList :: [OrderNulls] -> ShowS
showList :: [OrderNulls] -> ShowS
Show,ReadPrec [OrderNulls]
ReadPrec OrderNulls
Int -> ReadS OrderNulls
ReadS [OrderNulls]
(Int -> ReadS OrderNulls)
-> ReadS [OrderNulls]
-> ReadPrec OrderNulls
-> ReadPrec [OrderNulls]
-> Read OrderNulls
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OrderNulls
readsPrec :: Int -> ReadS OrderNulls
$creadList :: ReadS [OrderNulls]
readList :: ReadS [OrderNulls]
$creadPrec :: ReadPrec OrderNulls
readPrec :: ReadPrec OrderNulls
$creadListPrec :: ReadPrec [OrderNulls]
readListPrec :: ReadPrec [OrderNulls]
Read)

data OrderDirection = OpAsc | OpDesc
                    deriving (Int -> OrderDirection -> ShowS
[OrderDirection] -> ShowS
OrderDirection -> String
(Int -> OrderDirection -> ShowS)
-> (OrderDirection -> String)
-> ([OrderDirection] -> ShowS)
-> Show OrderDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrderDirection -> ShowS
showsPrec :: Int -> OrderDirection -> ShowS
$cshow :: OrderDirection -> String
show :: OrderDirection -> String
$cshowList :: [OrderDirection] -> ShowS
showList :: [OrderDirection] -> ShowS
Show,ReadPrec [OrderDirection]
ReadPrec OrderDirection
Int -> ReadS OrderDirection
ReadS [OrderDirection]
(Int -> ReadS OrderDirection)
-> ReadS [OrderDirection]
-> ReadPrec OrderDirection
-> ReadPrec [OrderDirection]
-> Read OrderDirection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OrderDirection
readsPrec :: Int -> ReadS OrderDirection
$creadList :: ReadS [OrderDirection]
readList :: ReadS [OrderDirection]
$creadPrec :: ReadPrec OrderDirection
readPrec :: ReadPrec OrderDirection
$creadListPrec :: ReadPrec [OrderDirection]
readListPrec :: ReadPrec [OrderDirection]
Read)

data OrderOp = OrderOp { OrderOp -> OrderDirection
orderDirection :: OrderDirection
                       , OrderOp -> OrderNulls
orderNulls     :: OrderNulls }
               deriving (Int -> OrderOp -> ShowS
[OrderOp] -> ShowS
OrderOp -> String
(Int -> OrderOp -> ShowS)
-> (OrderOp -> String) -> ([OrderOp] -> ShowS) -> Show OrderOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrderOp -> ShowS
showsPrec :: Int -> OrderOp -> ShowS
$cshow :: OrderOp -> String
show :: OrderOp -> String
$cshowList :: [OrderOp] -> ShowS
showList :: [OrderOp] -> ShowS
Show,ReadPrec [OrderOp]
ReadPrec OrderOp
Int -> ReadS OrderOp
ReadS [OrderOp]
(Int -> ReadS OrderOp)
-> ReadS [OrderOp]
-> ReadPrec OrderOp
-> ReadPrec [OrderOp]
-> Read OrderOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OrderOp
readsPrec :: Int -> ReadS OrderOp
$creadList :: ReadS [OrderOp]
readList :: ReadS [OrderOp]
$creadPrec :: ReadPrec OrderOp
readPrec :: ReadPrec OrderOp
$creadListPrec :: ReadPrec [OrderOp]
readListPrec :: ReadPrec [OrderOp]
Read)

data BoundExpr = Inclusive PrimExpr | Exclusive PrimExpr | PosInfinity | NegInfinity
                 deriving (Int -> BoundExpr -> ShowS
[BoundExpr] -> ShowS
BoundExpr -> String
(Int -> BoundExpr -> ShowS)
-> (BoundExpr -> String)
-> ([BoundExpr] -> ShowS)
-> Show BoundExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundExpr -> ShowS
showsPrec :: Int -> BoundExpr -> ShowS
$cshow :: BoundExpr -> String
show :: BoundExpr -> String
$cshowList :: [BoundExpr] -> ShowS
showList :: [BoundExpr] -> ShowS
Show,ReadPrec [BoundExpr]
ReadPrec BoundExpr
Int -> ReadS BoundExpr
ReadS [BoundExpr]
(Int -> ReadS BoundExpr)
-> ReadS [BoundExpr]
-> ReadPrec BoundExpr
-> ReadPrec [BoundExpr]
-> Read BoundExpr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BoundExpr
readsPrec :: Int -> ReadS BoundExpr
$creadList :: ReadS [BoundExpr]
readList :: ReadS [BoundExpr]
$creadPrec :: ReadPrec BoundExpr
readPrec :: ReadPrec BoundExpr
$creadListPrec :: ReadPrec [BoundExpr]
readListPrec :: ReadPrec [BoundExpr]
Read)

data WndwOp
  = WndwRowNumber
  | WndwRank
  | WndwDenseRank
  | WndwPercentRank
  | WndwCumeDist
  | WndwNtile PrimExpr
  | WndwLag PrimExpr PrimExpr PrimExpr
  | WndwLead PrimExpr PrimExpr PrimExpr
  | WndwFirstValue PrimExpr
  | WndwLastValue PrimExpr
  | WndwNthValue PrimExpr PrimExpr
  | WndwAggregate AggrOp [PrimExpr]
  deriving (Int -> WndwOp -> ShowS
[WndwOp] -> ShowS
WndwOp -> String
(Int -> WndwOp -> ShowS)
-> (WndwOp -> String) -> ([WndwOp] -> ShowS) -> Show WndwOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WndwOp -> ShowS
showsPrec :: Int -> WndwOp -> ShowS
$cshow :: WndwOp -> String
show :: WndwOp -> String
$cshowList :: [WndwOp] -> ShowS
showList :: [WndwOp] -> ShowS
Show,ReadPrec [WndwOp]
ReadPrec WndwOp
Int -> ReadS WndwOp
ReadS [WndwOp]
(Int -> ReadS WndwOp)
-> ReadS [WndwOp]
-> ReadPrec WndwOp
-> ReadPrec [WndwOp]
-> Read WndwOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WndwOp
readsPrec :: Int -> ReadS WndwOp
$creadList :: ReadS [WndwOp]
readList :: ReadS [WndwOp]
$creadPrec :: ReadPrec WndwOp
readPrec :: ReadPrec WndwOp
$creadListPrec :: ReadPrec [WndwOp]
readListPrec :: ReadPrec [WndwOp]
Read)

data Partition = Partition
  { Partition -> [PrimExpr]
partitionBy :: [PrimExpr]
  , Partition -> [OrderExpr]
orderBy :: [OrderExpr]
  }
  deriving (ReadPrec [Partition]
ReadPrec Partition
Int -> ReadS Partition
ReadS [Partition]
(Int -> ReadS Partition)
-> ReadS [Partition]
-> ReadPrec Partition
-> ReadPrec [Partition]
-> Read Partition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Partition
readsPrec :: Int -> ReadS Partition
$creadList :: ReadS [Partition]
readList :: ReadS [Partition]
$creadPrec :: ReadPrec Partition
readPrec :: ReadPrec Partition
$creadListPrec :: ReadPrec [Partition]
readListPrec :: ReadPrec [Partition]
Read, Int -> Partition -> ShowS
[Partition] -> ShowS
Partition -> String
(Int -> Partition -> ShowS)
-> (Partition -> String)
-> ([Partition] -> ShowS)
-> Show Partition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Partition -> ShowS
showsPrec :: Int -> Partition -> ShowS
$cshow :: Partition -> String
show :: Partition -> String
$cshowList :: [Partition] -> ShowS
showList :: [Partition] -> ShowS
Show)