{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}

-- |
-- Module      : Database.Relational.SqlSyntax.Types
-- Copyright   : 2015-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines sub-query structure used in query products.
module Database.Relational.SqlSyntax.Types (
  -- * The SubQuery
  SubQuery (..),

  -- * Set operations
  Duplication (..), SetOp (..), BinOp (..),

  -- * Qualifiers for nested query
  Qualifier (..), Qualified (..), qualifier, unQualify, qualify,

  -- * Ordering types
  Order (..), Nulls (..), OrderColumn, OrderingTerm,

  -- * Aggregating types
  AggregateColumnRef,
  AggregateBitKey (..), AggregateSet (..), AggregateElem (..),

  AggregateKey (..),

  -- * Product tree type
  NodeAttr (..), ProductTree (..),
  Node (..), nodeAttr, nodeTree,
  JoinProduct,

  -- * Case
  CaseClause (..), WhenClauses(..),

  -- * Column, Tuple, Record and Projection
  Column (..), Tuple, tupleWidth,
  Record, untypeRecord, record, PI,
  recordWidth,
  typeFromRawColumns,
  typeFromScalarSubQuery,

  -- * Predicate to restrict Query result
  Predicate,
  )  where

import Prelude hiding (and, product)
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)

import Database.Relational.Internal.Config (Config)
import Database.Relational.Internal.ContextType (Flat, Aggregated)
import Database.Relational.Internal.String (StringSQL)
import Database.Relational.Internal.UntypedTable (Untyped)


-- | Result record duplication attribute
data Duplication = All | Distinct  deriving Int -> Duplication -> ShowS
[Duplication] -> ShowS
Duplication -> String
(Int -> Duplication -> ShowS)
-> (Duplication -> String)
-> ([Duplication] -> ShowS)
-> Show Duplication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duplication] -> ShowS
$cshowList :: [Duplication] -> ShowS
show :: Duplication -> String
$cshow :: Duplication -> String
showsPrec :: Int -> Duplication -> ShowS
$cshowsPrec :: Int -> Duplication -> ShowS
Show

-- | Set operators
data SetOp = Union | Except | Intersect  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

-- | Set binary operators
newtype BinOp = BinOp (SetOp, Duplication) 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

-- | Order direction. Ascendant or Descendant.
data Order = Asc | Desc  deriving Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
(Int -> Order -> ShowS)
-> (Order -> String) -> ([Order] -> ShowS) -> Show Order
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show

-- | Order of null.
data Nulls =  NullsFirst | NullsLast deriving Int -> Nulls -> ShowS
[Nulls] -> ShowS
Nulls -> String
(Int -> Nulls -> ShowS)
-> (Nulls -> String) -> ([Nulls] -> ShowS) -> Show Nulls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nulls] -> ShowS
$cshowList :: [Nulls] -> ShowS
show :: Nulls -> String
$cshow :: Nulls -> String
showsPrec :: Int -> Nulls -> ShowS
$cshowsPrec :: Int -> Nulls -> ShowS
Show

-- | Type for order-by column
type OrderColumn = Column

-- | Type for order-by term
type OrderingTerm = ((Order, Maybe Nulls), OrderColumn)

-- | Type for group-by term
type AggregateColumnRef = Column

-- | Type for group key.
newtype AggregateBitKey = AggregateBitKey [AggregateColumnRef] deriving Int -> AggregateBitKey -> ShowS
[AggregateBitKey] -> ShowS
AggregateBitKey -> String
(Int -> AggregateBitKey -> ShowS)
-> (AggregateBitKey -> String)
-> ([AggregateBitKey] -> ShowS)
-> Show AggregateBitKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggregateBitKey] -> ShowS
$cshowList :: [AggregateBitKey] -> ShowS
show :: AggregateBitKey -> String
$cshow :: AggregateBitKey -> String
showsPrec :: Int -> AggregateBitKey -> ShowS
$cshowsPrec :: Int -> AggregateBitKey -> ShowS
Show

-- | Type for grouping set
newtype AggregateSet = AggregateSet [AggregateElem] deriving Int -> AggregateSet -> ShowS
[AggregateSet] -> ShowS
AggregateSet -> String
(Int -> AggregateSet -> ShowS)
-> (AggregateSet -> String)
-> ([AggregateSet] -> ShowS)
-> Show AggregateSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggregateSet] -> ShowS
$cshowList :: [AggregateSet] -> ShowS
show :: AggregateSet -> String
$cshow :: AggregateSet -> String
showsPrec :: Int -> AggregateSet -> ShowS
$cshowsPrec :: Int -> AggregateSet -> ShowS
Show

-- | Type for group-by tree
data AggregateElem = ColumnRef AggregateColumnRef
                   | Rollup [AggregateBitKey]
                   | Cube   [AggregateBitKey]
                   | GroupingSets [AggregateSet]
                   deriving Int -> AggregateElem -> ShowS
[AggregateElem] -> ShowS
AggregateElem -> String
(Int -> AggregateElem -> ShowS)
-> (AggregateElem -> String)
-> ([AggregateElem] -> ShowS)
-> Show AggregateElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggregateElem] -> ShowS
$cshowList :: [AggregateElem] -> ShowS
show :: AggregateElem -> String
$cshow :: AggregateElem -> String
showsPrec :: Int -> AggregateElem -> ShowS
$cshowsPrec :: Int -> AggregateElem -> ShowS
Show

-- | Typeful aggregate element.
newtype AggregateKey a = AggregateKey (a, AggregateElem)

-- | Sub-query type
data SubQuery = Table Untyped
              | Flat Config
                Tuple Duplication JoinProduct [Predicate Flat]
                [OrderingTerm]
              | Aggregated Config
                Tuple Duplication JoinProduct [Predicate Flat]
                [AggregateElem] [Predicate Aggregated] [OrderingTerm]
              | Bin BinOp SubQuery SubQuery
              deriving Int -> SubQuery -> ShowS
[SubQuery] -> ShowS
SubQuery -> String
(Int -> SubQuery -> ShowS)
-> (SubQuery -> String) -> ([SubQuery] -> ShowS) -> Show SubQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubQuery] -> ShowS
$cshowList :: [SubQuery] -> ShowS
show :: SubQuery -> String
$cshow :: SubQuery -> String
showsPrec :: Int -> SubQuery -> ShowS
$cshowsPrec :: Int -> SubQuery -> ShowS
Show

-- | Qualifier type.
newtype Qualifier = Qualifier Int  deriving Int -> Qualifier -> ShowS
[Qualifier] -> ShowS
Qualifier -> String
(Int -> Qualifier -> ShowS)
-> (Qualifier -> String)
-> ([Qualifier] -> ShowS)
-> Show Qualifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Qualifier] -> ShowS
$cshowList :: [Qualifier] -> ShowS
show :: Qualifier -> String
$cshow :: Qualifier -> String
showsPrec :: Int -> Qualifier -> ShowS
$cshowsPrec :: Int -> Qualifier -> ShowS
Show

-- | Qualified query.
data Qualified a =
  Qualified Qualifier a
  deriving (Int -> Qualified a -> ShowS
[Qualified a] -> ShowS
Qualified a -> String
(Int -> Qualified a -> ShowS)
-> (Qualified a -> String)
-> ([Qualified a] -> ShowS)
-> Show (Qualified a)
forall a. Show a => Int -> Qualified a -> ShowS
forall a. Show a => [Qualified a] -> ShowS
forall a. Show a => Qualified a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Qualified a] -> ShowS
$cshowList :: forall a. Show a => [Qualified a] -> ShowS
show :: Qualified a -> String
$cshow :: forall a. Show a => Qualified a -> String
showsPrec :: Int -> Qualified a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Qualified a -> ShowS
Show, a -> Qualified b -> Qualified a
(a -> b) -> Qualified a -> Qualified b
(forall a b. (a -> b) -> Qualified a -> Qualified b)
-> (forall a b. a -> Qualified b -> Qualified a)
-> Functor Qualified
forall a b. a -> Qualified b -> Qualified a
forall a b. (a -> b) -> Qualified a -> Qualified b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Qualified b -> Qualified a
$c<$ :: forall a b. a -> Qualified b -> Qualified a
fmap :: (a -> b) -> Qualified a -> Qualified b
$cfmap :: forall a b. (a -> b) -> Qualified a -> Qualified b
Functor, Qualified a -> Bool
(a -> m) -> Qualified a -> m
(a -> b -> b) -> b -> Qualified a -> b
(forall m. Monoid m => Qualified m -> m)
-> (forall m a. Monoid m => (a -> m) -> Qualified a -> m)
-> (forall m a. Monoid m => (a -> m) -> Qualified a -> m)
-> (forall a b. (a -> b -> b) -> b -> Qualified a -> b)
-> (forall a b. (a -> b -> b) -> b -> Qualified a -> b)
-> (forall b a. (b -> a -> b) -> b -> Qualified a -> b)
-> (forall b a. (b -> a -> b) -> b -> Qualified a -> b)
-> (forall a. (a -> a -> a) -> Qualified a -> a)
-> (forall a. (a -> a -> a) -> Qualified a -> a)
-> (forall a. Qualified a -> [a])
-> (forall a. Qualified a -> Bool)
-> (forall a. Qualified a -> Int)
-> (forall a. Eq a => a -> Qualified a -> Bool)
-> (forall a. Ord a => Qualified a -> a)
-> (forall a. Ord a => Qualified a -> a)
-> (forall a. Num a => Qualified a -> a)
-> (forall a. Num a => Qualified a -> a)
-> Foldable Qualified
forall a. Eq a => a -> Qualified a -> Bool
forall a. Num a => Qualified a -> a
forall a. Ord a => Qualified a -> a
forall m. Monoid m => Qualified m -> m
forall a. Qualified a -> Bool
forall a. Qualified a -> Int
forall a. Qualified a -> [a]
forall a. (a -> a -> a) -> Qualified a -> a
forall m a. Monoid m => (a -> m) -> Qualified a -> m
forall b a. (b -> a -> b) -> b -> Qualified a -> b
forall a b. (a -> b -> b) -> b -> Qualified 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 :: Qualified a -> a
$cproduct :: forall a. Num a => Qualified a -> a
sum :: Qualified a -> a
$csum :: forall a. Num a => Qualified a -> a
minimum :: Qualified a -> a
$cminimum :: forall a. Ord a => Qualified a -> a
maximum :: Qualified a -> a
$cmaximum :: forall a. Ord a => Qualified a -> a
elem :: a -> Qualified a -> Bool
$celem :: forall a. Eq a => a -> Qualified a -> Bool
length :: Qualified a -> Int
$clength :: forall a. Qualified a -> Int
null :: Qualified a -> Bool
$cnull :: forall a. Qualified a -> Bool
toList :: Qualified a -> [a]
$ctoList :: forall a. Qualified a -> [a]
foldl1 :: (a -> a -> a) -> Qualified a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Qualified a -> a
foldr1 :: (a -> a -> a) -> Qualified a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Qualified a -> a
foldl' :: (b -> a -> b) -> b -> Qualified a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Qualified a -> b
foldl :: (b -> a -> b) -> b -> Qualified a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Qualified a -> b
foldr' :: (a -> b -> b) -> b -> Qualified a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Qualified a -> b
foldr :: (a -> b -> b) -> b -> Qualified a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Qualified a -> b
foldMap' :: (a -> m) -> Qualified a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Qualified a -> m
foldMap :: (a -> m) -> Qualified a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Qualified a -> m
fold :: Qualified m -> m
$cfold :: forall m. Monoid m => Qualified m -> m
Foldable, Functor Qualified
Foldable Qualified
Functor Qualified
-> Foldable Qualified
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Qualified a -> f (Qualified b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Qualified (f a) -> f (Qualified a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Qualified a -> m (Qualified b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Qualified (m a) -> m (Qualified a))
-> Traversable Qualified
(a -> f b) -> Qualified a -> f (Qualified b)
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 =>
Qualified (m a) -> m (Qualified a)
forall (f :: * -> *) a.
Applicative f =>
Qualified (f a) -> f (Qualified a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Qualified a -> m (Qualified b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Qualified a -> f (Qualified b)
sequence :: Qualified (m a) -> m (Qualified a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Qualified (m a) -> m (Qualified a)
mapM :: (a -> m b) -> Qualified a -> m (Qualified b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Qualified a -> m (Qualified b)
sequenceA :: Qualified (f a) -> f (Qualified a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Qualified (f a) -> f (Qualified a)
traverse :: (a -> f b) -> Qualified a -> f (Qualified b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Qualified a -> f (Qualified b)
$cp2Traversable :: Foldable Qualified
$cp1Traversable :: Functor Qualified
Traversable)

-- | Get qualifier
qualifier :: Qualified a -> Qualifier
qualifier :: Qualified a -> Qualifier
qualifier (Qualified Qualifier
q a
_) = Qualifier
q

-- | Unqualify.
unQualify :: Qualified a -> a
unQualify :: Qualified a -> a
unQualify (Qualified Qualifier
_ a
a) = a
a

-- | Add qualifier
qualify :: Qualifier -> a -> Qualified a
qualify :: Qualifier -> a -> Qualified a
qualify = Qualifier -> a -> Qualified a
forall a. Qualifier -> a -> Qualified a
Qualified


-- | node attribute for product.
data NodeAttr = Just' | Maybe deriving Int -> NodeAttr -> ShowS
[NodeAttr] -> ShowS
NodeAttr -> String
(Int -> NodeAttr -> ShowS)
-> (NodeAttr -> String) -> ([NodeAttr] -> ShowS) -> Show NodeAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeAttr] -> ShowS
$cshowList :: [NodeAttr] -> ShowS
show :: NodeAttr -> String
$cshow :: NodeAttr -> String
showsPrec :: Int -> NodeAttr -> ShowS
$cshowsPrec :: Int -> NodeAttr -> ShowS
Show

-- | Product tree type. Product tree is constructed by left node and right node.
data ProductTree rs
  = Leaf (Bool, Qualified SubQuery)
  | Join !(Node rs) !(Node rs) !rs
  deriving (Int -> ProductTree rs -> ShowS
[ProductTree rs] -> ShowS
ProductTree rs -> String
(Int -> ProductTree rs -> ShowS)
-> (ProductTree rs -> String)
-> ([ProductTree rs] -> ShowS)
-> Show (ProductTree rs)
forall rs. Show rs => Int -> ProductTree rs -> ShowS
forall rs. Show rs => [ProductTree rs] -> ShowS
forall rs. Show rs => ProductTree rs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductTree rs] -> ShowS
$cshowList :: forall rs. Show rs => [ProductTree rs] -> ShowS
show :: ProductTree rs -> String
$cshow :: forall rs. Show rs => ProductTree rs -> String
showsPrec :: Int -> ProductTree rs -> ShowS
$cshowsPrec :: forall rs. Show rs => Int -> ProductTree rs -> ShowS
Show, a -> ProductTree b -> ProductTree a
(a -> b) -> ProductTree a -> ProductTree b
(forall a b. (a -> b) -> ProductTree a -> ProductTree b)
-> (forall a b. a -> ProductTree b -> ProductTree a)
-> Functor ProductTree
forall a b. a -> ProductTree b -> ProductTree a
forall a b. (a -> b) -> ProductTree a -> ProductTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ProductTree b -> ProductTree a
$c<$ :: forall a b. a -> ProductTree b -> ProductTree a
fmap :: (a -> b) -> ProductTree a -> ProductTree b
$cfmap :: forall a b. (a -> b) -> ProductTree a -> ProductTree b
Functor)

-- | Product node. node attribute and product tree.
data Node rs = Node !NodeAttr !(ProductTree rs)  deriving (Int -> Node rs -> ShowS
[Node rs] -> ShowS
Node rs -> String
(Int -> Node rs -> ShowS)
-> (Node rs -> String) -> ([Node rs] -> ShowS) -> Show (Node rs)
forall rs. Show rs => Int -> Node rs -> ShowS
forall rs. Show rs => [Node rs] -> ShowS
forall rs. Show rs => Node rs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node rs] -> ShowS
$cshowList :: forall rs. Show rs => [Node rs] -> ShowS
show :: Node rs -> String
$cshow :: forall rs. Show rs => Node rs -> String
showsPrec :: Int -> Node rs -> ShowS
$cshowsPrec :: forall rs. Show rs => Int -> Node rs -> ShowS
Show, a -> Node b -> Node a
(a -> b) -> Node a -> Node b
(forall a b. (a -> b) -> Node a -> Node b)
-> (forall a b. a -> Node b -> Node a) -> Functor Node
forall a b. a -> Node b -> Node a
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Node b -> Node a
$c<$ :: forall a b. a -> Node b -> Node a
fmap :: (a -> b) -> Node a -> Node b
$cfmap :: forall a b. (a -> b) -> Node a -> Node b
Functor)

-- | Get node attribute.
nodeAttr :: Node rs -> NodeAttr
nodeAttr :: Node rs -> NodeAttr
nodeAttr (Node NodeAttr
a ProductTree rs
_) = NodeAttr
a  where

-- | Get tree from node.
nodeTree :: Node rs -> ProductTree rs
nodeTree :: Node rs -> ProductTree rs
nodeTree (Node NodeAttr
_ ProductTree rs
t) = ProductTree rs
t

-- | Type for join product of query.
type JoinProduct = Maybe (ProductTree [Predicate Flat])

-- | when clauses
data WhenClauses =
  WhenClauses [(Tuple, Tuple)] Tuple
  deriving Int -> WhenClauses -> ShowS
[WhenClauses] -> ShowS
WhenClauses -> String
(Int -> WhenClauses -> ShowS)
-> (WhenClauses -> String)
-> ([WhenClauses] -> ShowS)
-> Show WhenClauses
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhenClauses] -> ShowS
$cshowList :: [WhenClauses] -> ShowS
show :: WhenClauses -> String
$cshow :: WhenClauses -> String
showsPrec :: Int -> WhenClauses -> ShowS
$cshowsPrec :: Int -> WhenClauses -> ShowS
Show

-- | case clause
data CaseClause
  = CaseSearch WhenClauses
  | CaseSimple Tuple WhenClauses
  deriving Int -> CaseClause -> ShowS
[CaseClause] -> ShowS
CaseClause -> String
(Int -> CaseClause -> ShowS)
-> (CaseClause -> String)
-> ([CaseClause] -> ShowS)
-> Show CaseClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseClause] -> ShowS
$cshowList :: [CaseClause] -> ShowS
show :: CaseClause -> String
$cshow :: CaseClause -> String
showsPrec :: Int -> CaseClause -> ShowS
$cshowsPrec :: Int -> CaseClause -> ShowS
Show

-- | Projected column structure unit with single column width
data Column
  = RawColumn StringSQL            -- ^ used in immediate value or unsafe operations
  | SubQueryRef (Qualified Int)    -- ^ normalized sub-query reference T<n> with Int index
  | Scalar SubQuery                -- ^ scalar sub-query
  | Case CaseClause Int            -- ^ <n>th column of case clause
  deriving Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show

-- | Untyped projected tuple. Forgot record type.
type Tuple = [Column]

-- | Width of 'Tuple'.
tupleWidth :: Tuple -> Int
tupleWidth :: [Column] -> Int
tupleWidth = [Column] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | Phantom typed record. Projected into Haskell record type 't'.
newtype Record c t =
  Record
  { Record c t -> [Column]
untypeRecord :: Tuple {- ^ Discard record type -} }  deriving Int -> Record c t -> ShowS
[Record c t] -> ShowS
Record c t -> String
(Int -> Record c t -> ShowS)
-> (Record c t -> String)
-> ([Record c t] -> ShowS)
-> Show (Record c t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c t. Int -> Record c t -> ShowS
forall c t. [Record c t] -> ShowS
forall c t. Record c t -> String
showList :: [Record c t] -> ShowS
$cshowList :: forall c t. [Record c t] -> ShowS
show :: Record c t -> String
$cshow :: forall c t. Record c t -> String
showsPrec :: Int -> Record c t -> ShowS
$cshowsPrec :: forall c t. Int -> Record c t -> ShowS
Show

-- | Type for predicate to restrict of query result.
type Predicate c = Record c (Maybe Bool)

-- | Type for projection function.
type PI c a b = Record c a -> Record c b

-- | Unsafely type 'Tuple' value to 'Record' type.
record :: Tuple -> Record c t
record :: [Column] -> Record c t
record = [Column] -> Record c t
forall c t. [Column] -> Record c t
Record

-- | Width of 'Record'.
recordWidth :: Record c r -> Int
recordWidth :: Record c r -> Int
recordWidth = [Column] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Column] -> Int) -> (Record c r -> [Column]) -> Record c r -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c r -> [Column]
forall c t. Record c t -> [Column]
untypeRecord

-- | Unsafely generate 'Record' from SQL string list.
typeFromRawColumns :: [StringSQL] -- ^ SQL string list specifies columns
                   -> Record c r  -- ^ Result 'Record'
typeFromRawColumns :: [StringSQL] -> Record c r
typeFromRawColumns =  [Column] -> Record c r
forall c t. [Column] -> Record c t
record ([Column] -> Record c r)
-> ([StringSQL] -> [Column]) -> [StringSQL] -> Record c r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StringSQL -> Column) -> [StringSQL] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map StringSQL -> Column
RawColumn

-- | Unsafely generate 'Record' from scalar sub-query.
typeFromScalarSubQuery :: SubQuery -> Record c t
typeFromScalarSubQuery :: SubQuery -> Record c t
typeFromScalarSubQuery = [Column] -> Record c t
forall c t. [Column] -> Record c t
record ([Column] -> Record c t)
-> (SubQuery -> [Column]) -> SubQuery -> Record c t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column -> [Column] -> [Column]
forall a. a -> [a] -> [a]
:[]) (Column -> [Column])
-> (SubQuery -> Column) -> SubQuery -> [Column]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubQuery -> Column
Scalar