{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP, DataKinds, UndecidableInstances #-}
module Database.Selda.Inner where
import Database.Selda.Column
import Database.Selda.SQL (SQL)
import Database.Selda.Types
import Data.Text (Text)
import Data.Typeable
import GHC.Exts
import GHC.TypeLits as TL
newtype Aggr s a = Aggr {unAggr :: Exp SQL a}
data Inner s
deriving Typeable
aggr :: Text -> Col s a -> Aggr s b
aggr f = Aggr . AggrEx f . unC
type family OuterCols a where
OuterCols (Col (Inner s) a :*: b) = Col s a :*: OuterCols b
OuterCols (Col (Inner s) a) = Col s a
#if MIN_VERSION_base(4, 9, 0)
OuterCols (Col s a) = TypeError
( TL.Text "An inner query can only return columns from its own scope."
)
#endif
#if MIN_VERSION_base(4, 9, 0)
OuterCols a = TypeError
( TL.Text "Only (inductive tuples of) 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."
)
#endif
#if MIN_VERSION_base(4, 9, 0)
AggrCols a = TypeError
( TL.Text "Only (inductive tuples of) aggregates can be returned from" :$$:
TL.Text "an aggregate query."
)
#endif
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)
#if MIN_VERSION_base(4, 9, 0)
LeftCols a = TypeError
( TL.Text "Only (inductive tuples of) columns can be returned" :$$:
TL.Text "from a join."
)
#endif
class Aggregates a where
unAggrs :: a -> [SomeCol SQL]
instance Aggregates (Aggr (Inner s) a) where
unAggrs (Aggr x) = [Some x]
instance Aggregates b => Aggregates (Aggr (Inner s) a :*: b) where
unAggrs (Aggr a :*: b) = Some a : unAggrs b