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

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

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

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

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

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

type Aggregate = Aggregate' PrimExpr

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

type OrderExpr = OrderExpr' PrimExpr

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

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

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

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

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

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