{-# LANGUAGE
ConstraintKinds
, DeriveGeneric
, DerivingStrategies
, FlexibleContexts
, FlexibleInstances
, GADTs
, GeneralizedNewtypeDeriving
, LambdaCase
, MultiParamTypeClasses
, OverloadedLabels
, OverloadedStrings
, QuantifiedConstraints
, ScopedTypeVariables
, StandaloneDeriving
, TypeApplications
, TypeFamilies
, TypeInType
, TypeOperators
, RankNTypes
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Query.Table
(
TableExpression (..)
, from
, where_
, groupBy
, having
, limit
, offset
, By (..)
, GroupByClause (..)
, HavingClause (..)
) where
import Control.DeepSeq
import Data.ByteString (ByteString)
import Data.String
import Data.Word
import Generics.SOP hiding (from)
import GHC.TypeLits
import qualified GHC.Generics as GHC
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Expression.Logic
import Squeal.PostgreSQL.Expression.Sort
import Squeal.PostgreSQL.Query.From
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema
data TableExpression
(grp :: Grouping)
(lat :: FromType)
(with :: FromType)
(db :: SchemasType)
(params :: [NullType])
(from :: FromType)
= TableExpression
{ fromClause :: FromClause lat with db params from
, whereClause :: [Condition 'Ungrouped lat with db params from]
, groupByClause :: GroupByClause grp from
, havingClause :: HavingClause grp lat with db params from
, orderByClause :: [SortExpression grp lat with db params from]
, limitClause :: [Word64]
, offsetClause :: [Word64]
} deriving (GHC.Generic)
instance RenderSQL (TableExpression grp lat with db params from) where
renderSQL
(TableExpression frm' whs' grps' hvs' srts' lims' offs') = mconcat
[ "FROM ", renderSQL frm'
, renderWheres whs'
, renderSQL grps'
, renderSQL hvs'
, renderSQL srts'
, renderLimits lims'
, renderOffsets offs' ]
where
renderWheres = \case
[] -> ""
wh:whs -> " WHERE" <+> renderSQL (foldr (.&&) wh whs)
renderLimits = \case
[] -> ""
lims -> " LIMIT" <+> fromString (show (minimum lims))
renderOffsets = \case
[] -> ""
offs -> " OFFSET" <+> fromString (show (sum offs))
from
:: FromClause lat with db params from
-> TableExpression 'Ungrouped lat with db params from
from tab = TableExpression tab [] noGroups NoHaving [] [] []
where_
:: Condition 'Ungrouped lat with db params from
-> TableExpression grp lat with db params from
-> TableExpression grp lat with db params from
where_ wh rels = rels {whereClause = wh : whereClause rels}
groupBy
:: SListI bys
=> NP (By from) bys
-> TableExpression 'Ungrouped lat with db params from
-> TableExpression ('Grouped bys) lat with db params from
groupBy bys rels = TableExpression
{ fromClause = fromClause rels
, whereClause = whereClause rels
, groupByClause = group bys
, havingClause = Having []
, orderByClause = []
, limitClause = limitClause rels
, offsetClause = offsetClause rels
}
having
:: Condition ('Grouped bys) lat with db params from
-> TableExpression ('Grouped bys) lat with db params from
-> TableExpression ('Grouped bys) lat with db params from
having hv rels = rels
{ havingClause = case havingClause rels of Having hvs -> Having (hv:hvs) }
instance OrderBy (TableExpression grp) grp where
orderBy srts rels = rels {orderByClause = orderByClause rels ++ srts}
limit
:: Word64
-> TableExpression grp lat with db params from
-> TableExpression grp lat with db params from
limit lim rels = rels {limitClause = lim : limitClause rels}
offset
:: Word64
-> TableExpression grp lat with db params from
-> TableExpression grp lat with db params from
offset off rels = rels {offsetClause = off : offsetClause rels}
data By
(from :: FromType)
(by :: (Symbol,Symbol)) where
By1
:: (HasUnique table from columns, Has column columns ty)
=> Alias column
-> By from '(table, column)
By2
:: (Has table from columns, Has column columns ty)
=> Alias table
-> Alias column
-> By from '(table, column)
deriving instance Show (By from by)
deriving instance Eq (By from by)
deriving instance Ord (By from by)
instance RenderSQL (By from by) where
renderSQL = \case
By1 column -> renderSQL column
By2 rel column -> renderSQL rel <> "." <> renderSQL column
instance (HasUnique rel rels cols, Has col cols ty, by ~ '(rel, col))
=> IsLabel col (By rels by) where fromLabel = By1 fromLabel
instance (HasUnique rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])
=> IsLabel col (NP (By rels) bys) where fromLabel = By1 fromLabel :* Nil
instance (Has rel rels cols, Has col cols ty, by ~ '(rel, col))
=> IsQualified rel col (By rels by) where (!) = By2
instance (Has rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])
=> IsQualified rel col (NP (By rels) bys) where
rel ! col = By2 rel col :* Nil
newtype GroupByClause grp from = UnsafeGroupByClause
{ renderGroupByClause :: ByteString }
deriving stock (GHC.Generic,Show,Eq,Ord)
deriving newtype (NFData)
instance RenderSQL (GroupByClause grp from) where
renderSQL = renderGroupByClause
noGroups :: GroupByClause 'Ungrouped from
noGroups = UnsafeGroupByClause ""
group
:: SListI bys
=> NP (By from) bys
-> GroupByClause ('Grouped bys) from
group bys = UnsafeGroupByClause $ case bys of
Nil -> ""
_ -> " GROUP BY" <+> renderCommaSeparated renderSQL bys
data HavingClause grp lat with db params from where
NoHaving :: HavingClause 'Ungrouped lat with db params from
Having
:: [Condition ('Grouped bys) lat with db params from]
-> HavingClause ('Grouped bys) lat with db params from
deriving instance Show (HavingClause grp lat with db params from)
deriving instance Eq (HavingClause grp lat with db params from)
deriving instance Ord (HavingClause grp lat with db params from)
instance RenderSQL (HavingClause grp lat with db params from) where
renderSQL = \case
NoHaving -> ""
Having [] -> ""
Having conditions ->
" HAVING" <+> commaSeparated (renderSQL <$> conditions)