content: {-# 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
      ( Exp(AggrEx), UntypedCol(..), Row, Col(..) )
  import Database.Selda.SQL (SQL)
  import Database.Selda.SqlType (SqlType)
  import Database.Selda.Types ( type (:*:)(..) )
  import Data.Text (Text)
  import Data.Typeable ( Typeable )
  import GHC.TypeLits as TL ( TypeError, ErrorMessage(Text, (:$$:)) )
  
  -- | 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
    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."
      )
  
  type family AggrCols a where
    AggrCols (Aggr (Inner s) a :*: b) = Col s a :*: AggrCols b
    AggrCols (Aggr (Inner s) a)       = Col s a
    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."
      )
  
  -- | 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)
    LeftCols a = TypeError
      ( 'TL.Text "Only (inductive tuples of) rows and columns can be returned" ':$$:
        'TL.Text "from a join."
      )
  
  -- | 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
  