{-
Copyright 2009 Jake Wheat

= basic select statements

This is a bit of a mess, will be rewritten with a proper literate
flavour once all the different bits are type checking ok, which should
make it much more readable.

-}

SEM Statement
    | SelectStatement
        loc.tpe = dependsOnRTpe [getTypeAnnotation @ex.annotatedTree] $ Right $ Pseudo Void
        loc.statementType = [StatementType ph $ leftToEmpty id  $
                                                unwrapSetOfComposite $
                                                getTypeAnnotation @ex.annotatedTree]
                            where
                              ph = flip map (getPlaceholders @ex.annotatedTree)
                                     $ const $ ScalarType "text"
        loc.backTree = SelectStatement @ann @ex.annotatedTree
        loc.envUpdates = []

SEM SelectExpression
    | Values Select CombineSelect
        lhs.annotatedTree = annTypesAndErrors @loc.backTree
                              (tpeToT @loc.tpe)
                              (getErrors @loc.tpe)
                              Nothing
{-

================================================================================

Type checking select expressions

The main issue is the complicated flow of identifier bindings through the
various parts. This is the rough order in which this happens:

with
from
where
groupby
having
select
combine
orderby
limit

if a type error occurs, we want to give up on any following stages,
rather than create loads of type errors (maybe this could be refined
more).

The select list produces the final type which the selectexpression has.

inside the from, if we have any join expressions we need to pass the types
from the joined trefs to the join expressions.

So, the basic plan is to propagate the iden bindings in the env attribute
as elsewhere, and also pass along a flag to say whether the previous stage
type checked or not, so we can bail if it has failed.

alternative idea: explore transforming the ast for a select expression into
something using relational algebra-like operations - can then follow the flow
of ids easily. The problem might be with updating the annotations in the original
tree though.

== env passing current bodge

env flow:
current simple version:
from tref -> select list
          -> where

(so we take the identifiers and types from the tref part, and send
them into the selectlist and where parts)

full order of identifier passing:
   1. from
   2. where
   3. group by
   4. having
   5. select


group by notes, from the pg manual:
group by expressions can be an input column name, or the name or
ordinal number of an output column (SELECT list item), or an arbitrary
expression formed from input-column values. In case of ambiguity, a
GROUP BY name will be interpreted as an input-column name rather than
an output column name.

For now, just send the input columns in as identifiers
-}

SEM SelectExpression
    | Select
         loc.newLib = case updateBindings @lhs.lib @lhs.env @selTref.libUpdates of
                        Left x -> error $ show x -- @lhs.env
                        Right e -> e
         selSelectList.lib = @loc.newLib
         selWhere.lib = @loc.newLib
         selGroupBy.lib = @loc.newLib
         selOrderBy.lib = @loc.newLib



SEM SelectExpression
    | Values
        loc.tpe = typeCheckValuesExpr
                              @lhs.env
                              @vll.typeListList
        loc.backTree = Values @ann @vll.annotatedTree
    | Select
        loc.tpe =
           do
           --let trefType = fromMaybe typeBool $ fmap getTypeAnnotation
           --                                         @selTref.annotatedTree
           Right $ case @selSelectList.listType of
                     [(_,Pseudo Void)] -> Pseudo Void
                     _ -> SetOfType $ CompositeType @selSelectList.listType
        loc.backTree = Select @ann
                              @selDistinct.annotatedTree
                              @selSelectList.annotatedTree
                              @selTref.annotatedTree
                              @selWhere.annotatedTree
                              @selGroupBy.annotatedTree
                              @selHaving.annotatedTree
                              @selOrderBy.annotatedTree
                              @selLimit.annotatedTree
                              @selOffset.annotatedTree
    | CombineSelect
        loc.tpe =
          let sel1t = getTypeAnnotation @sel1.annotatedTree
              sel2t = getTypeAnnotation @sel2.annotatedTree
          in dependsOnRTpe [sel1t, sel2t] $
                typeCheckCombineSelect @lhs.env sel1t sel2t
        loc.backTree = CombineSelect @ann @ctype.annotatedTree
                                     @sel1.annotatedTree
                                     @sel2.annotatedTree

{

typeCheckValuesExpr :: Environment -> [[Type]] -> Either [TypeError] Type
typeCheckValuesExpr env rowsTs =
        let colNames = zipWith (++)
                           (repeat "column")
                           (map show [1..length $ head rowsTs])
        in unionRelTypes env rowsTs colNames


typeCheckCombineSelect :: Environment -> Type -> Type -> Either [TypeError] Type
typeCheckCombineSelect env v1 v2 = do
    u1 <- unwrapSetOfComposite v1
    let colNames = map fst u1
    u2 <- unwrapSetOfComposite v2
    let colTypes1 = map snd u1
    let colTypes2 = map snd u2
    unionRelTypes env [colTypes1,colTypes2] colNames

unionRelTypes :: Environment -> [[Type]] -> [String] -> Either [TypeError] Type
unionRelTypes env rowsTs colNames =
  let lengths = map length rowsTs
  in case () of
             _ | null rowsTs ->
                   Left [NoRowsGivenForValues]
               | not (all (==head lengths) lengths) ->
                   Left [ValuesListsMustBeSameLength]
               | otherwise ->
                   --i don't think this propagates all the errors, just the first set
                   mapM (resolveResultSetType env) (transpose rowsTs) >>=
                     (return . SetOfType . CompositeType . zip colNames)

}

INCLUDE "TypeChecking/TableRefs.ag"

INCLUDE "TypeChecking/SelectLists.ag"


{
getPlaceholders :: Data a => a -> [Expression]
getPlaceholders st =
    filter isPlaceholder $ everything (++) (mkQ [] ga) st
    where
      ga :: Expression -> [Expression]
      ga s = [s]
      isPlaceholder e = case e of
                          PositionalArg _ _ -> True
                          Placeholder _ -> True
                          _ -> False
}