{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleInstances, FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP, DataKinds, UndecidableInstances #-} -- | Helpers for working with inner queries. module Database.Selda.Inner where import Database.Selda.Column import Database.Selda.SQL (SQL) import Database.Selda.SqlType (SqlType) import Database.Selda.Types import Data.Text (Text) import Data.Typeable #if MIN_VERSION_base(4, 9, 0) import GHC.TypeLits as TL #endif -- | A single aggregate column. -- Aggregate columns may not be used to restrict queries. -- When returned from an 'aggregate' subquery, an aggregate column is -- converted into a non-aggregate column. newtype Aggr s a = Aggr {unAggr :: Exp SQL a} -- | Lift a function over columns to aggregates. liftAggr :: (Col s a -> Col s b) -> Aggr s a -> Aggr s b liftAggr f = Aggr . unOne . f . One . unAggr where unOne (One x) = x -- | Denotes an inner query. -- For aggregation, treating sequencing as the cartesian product of queries -- does not work well. -- Instead, we treat the sequencing of 'aggregate' with other -- queries as the cartesian product of the aggregated result of the query, -- a small but important difference. -- -- However, for this to work, the aggregate query must not depend on any -- columns in the outer product. Therefore, we let the aggregate query be -- parameterized over @Inner s@ if the parent query is parameterized over @s@, -- to enforce this separation. data Inner s deriving Typeable -- | Create a named aggregate function. -- Like 'fun', this function is generally unsafe and should ONLY be used -- to implement missing backend-specific functionality. aggr :: SqlType a => Text -> Col s a -> Aggr s b aggr f (One x) = Aggr (AggrEx f x) -- | Convert one or more inner column to equivalent columns in the outer query. -- @OuterCols (Aggr (Inner s) a :*: Aggr (Inner s) b) = Col s a :*: Col s b@, -- for instance. type family OuterCols a where OuterCols (Col (Inner s) a :*: b) = Col s a :*: OuterCols b OuterCols (Col (Inner s) a) = Col s a OuterCols (Row (Inner s) a :*: b) = Row s a :*: OuterCols b OuterCols (Row (Inner s) a) = Row s a #if MIN_VERSION_base(4, 9, 0) OuterCols (Col s a) = TypeError ( 'TL.Text "An inner query can only return rows and columns from its own scope." ) OuterCols (Row s a) = TypeError ( 'TL.Text "An inner query can only return rows and columns from its own scope." ) OuterCols a = TypeError ( 'TL.Text "Only (inductive tuples of) row and columns can be returned from" ':$$: 'TL.Text "an inner query." ) #endif type family AggrCols a where AggrCols (Aggr (Inner s) a :*: b) = Col s a :*: AggrCols b AggrCols (Aggr (Inner s) a) = Col s a #if MIN_VERSION_base(4, 9, 0) AggrCols (Aggr s a) = TypeError ( 'TL.Text "An aggregate query can only return columns from its own" ':$$: 'TL.Text "scope." ) AggrCols a = TypeError ( 'TL.Text "Only (inductive tuples of) aggregates can be returned from" ':$$: 'TL.Text "an aggregate query." ) #endif -- | The results of a left join are always nullable, as there is no guarantee -- that all joined columns will be non-null. -- @JoinCols a@ where @a@ is an extensible tuple is that same tuple, but in -- the outer query and with all elements nullable. -- For instance: -- -- > LeftCols (Col (Inner s) Int :*: Col (Inner s) Text) -- > = Col s (Maybe Int) :*: Col s (Maybe Text) type family LeftCols a where LeftCols (Col (Inner s) (Maybe a) :*: b) = Col s (Maybe a) :*: LeftCols b LeftCols (Col (Inner s) a :*: b) = Col s (Maybe a) :*: LeftCols b LeftCols (Col (Inner s) (Maybe a)) = Col s (Maybe a) LeftCols (Col (Inner s) a) = Col s (Maybe a) LeftCols (Row (Inner s) (Maybe a) :*: b) = Row s (Maybe a) :*: LeftCols b LeftCols (Row (Inner s) a :*: b) = Row s (Maybe a) :*: LeftCols b LeftCols (Row (Inner s) (Maybe a)) = Row s (Maybe a) LeftCols (Row (Inner s) a) = Row s (Maybe a) #if MIN_VERSION_base(4, 9, 0) LeftCols a = TypeError ( 'TL.Text "Only (inductive tuples of) rows and columns can be returned" ':$$: 'TL.Text "from a join." ) #endif -- | One or more aggregate columns. class Aggregates a where unAggrs :: a -> [UntypedCol SQL] instance Aggregates (Aggr (Inner s) a) where unAggrs (Aggr x) = [Untyped x] instance Aggregates b => Aggregates (Aggr (Inner s) a :*: b) where unAggrs (Aggr a :*: b) = Untyped a : unAggrs b