{-
Copyright 2009 Jake Wheat

This file contains the code that handles the select list part of a
select expression.

TODO: stop wrapping string,type lists in unnamedcompositetypes, pointless

-}

SEM SelectItem
    | SelExp
        loc.annotatedTree = SelExp @ann $ fixStar @ex.annotatedTree
    | SelectItem
        loc.annotatedTree = SelectItem @ann (fixStar @ex.annotatedTree) @name

ATTR MaybeSelectList [||listType : {Maybe [(String,Type)]}]

ATTR SelectItemList SelectList [||listType : {[(String,Type)]}]
ATTR SelectItem [||itemType : Type]

ATTR SelectList [||libUpdates : {[LocalIdentifierBindingsUpdate]}]

SEM MaybeSelectList
    | Just lhs.listType = Just @just.listType
    | Nothing lhs.listType = Nothing

SEM SelectItemList
    | Cons lhs.listType = expandStar @lhs.lib @hd.columnName @hd.itemType @tl.listType
    | Nil lhs.listType = []


SEM SelectItem
    | SelExp SelectItem
        lhs.itemType = getTypeAnnotation @ex.annotatedTree



SEM SelectList
    | SelectList
        lhs.listType = @items.listType
-- check the into types
        loc.errs = case @loc.stuff of
                     (er,_) -> er
        loc.stuff =
          case () of
            _ | null sl -> ([],Nothing)
              | not (null targetTypeErrs) -> (targetTypeErrs,Nothing)
              | (case targetTypes of
                   [PgRecord _] -> True
                   _ -> False) -> ([],Just (head sl, CompositeType @items.listType))
              | matchingComposite /= Left [] -> (fromLeft [] matchingComposite,Nothing)
              | length sl /= length @items.listType -> ([WrongNumberOfColumns],Nothing)
              | not (null assignErrs) -> (assignErrs,Nothing)
              | otherwise -> ([],Nothing)
          where
            targetTypeEithers = map (libLookupID @lhs.lib) sl
            targetTypeErrs = concat $ lefts $ targetTypeEithers
            targetTypes = rights $ targetTypeEithers
            typePairs = zip (map snd @items.listType) targetTypes
            assignErrs = concat $ lefts $ map (uncurry $ checkAssignmentValid @lhs.env) typePairs
            sl = @into.strings
            matchingComposite =
                case targetTypes of
                  [t] | isCompositeType t -> checkAssignmentValid @lhs.env (AnonymousRecordType (map snd @items.listType)) t
                  _ -> Left []

        lhs.annotatedTree = SelectList (@ann ++ map TypeErrorA @loc.errs)
                                       @items.annotatedTree
                                       @into.annotatedTree
        lhs.libUpdates =
            case @loc.stuff of
              (_,Just r) -> [LibStackIDs [("", [r])]]
              _ -> []
--[(@var,@loc.selType)]

SEM Statement
    | SelectStatement
        loc.libUpdates = @ex.libUpdates

ATTR SelectExpression [||libUpdates : {[LocalIdentifierBindingsUpdate]}]

SEM SelectExpression
    | Select
        lhs.libUpdates = @selSelectList.libUpdates
    | CombineSelect Values
          lhs.libUpdates = []

-- utils to handle a star, bit hacky, maybe should use a separate pass
-- or something?

{
expandStar :: LocalIdentifierBindings
           -> String
           -> Type
           -> [(String,Type)]
           -> [(String,Type)]
expandStar env colName colType types =
    fromRight types $ do
    let (correlationName,iden) = splitIdentifier colName
    newCols <- if iden == "*"
                 then libExpandStar env correlationName
                 else return [(iden, colType)]
    return $ newCols ++ types

fixStar :: Expression -> Expression
fixStar =
    everywhere (mkT fixStar')
    where
      fixStar' :: Annotation -> Annotation
      fixStar' a =
          if TypeAnnotation TypeCheckFailed `elem` a
              && any (\an ->
                       case an of
                         TypeErrorA (UnrecognisedIdentifier x) |
                           let (_,iden) = splitIdentifier x
                           in iden == "*" -> True
                         _ -> False) a
             then filter (\an -> case an of
                                   TypeAnnotation TypeCheckFailed -> False
                                   TypeErrorA (UnrecognisedIdentifier _) -> False
                                   _ -> True) a
             else a
}


{-

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

= attribute names

columnName is used to collect the column names that the select list
produces, it is combined into an unnamedcompositetype in
selectitemlist, which is also where star expansion happens.

-}

ATTR SelectItem [||columnName : String]

{-
if the select item is just an identifier, then that column is named
after the identifier
e.g. select a, b as c, b + c from d, gives three columns one named
a, one named c, and one unnamed, even though only one has an alias
if the select item is a function or aggregate call at the top level,
then it is named after that function or aggregate

if it is a cast, the column is named after the target data type name
iff it is a simple type name

-}

--default value for non identifier nodes

{-
override for identifier nodes, this only makes it out to the selectitem
node if the identifier is not wrapped in parens, function calls, etc.
-}

ATTR Expression [||liftedColumnName : String]

SEM Expression
  | Identifier lhs.liftedColumnName = @i
  | FunCall lhs.liftedColumnName =
      if isOperatorName @funName
         then ""
         else @funName
  | Cast lhs.liftedColumnName = case @tn.annotatedTree of
                                  SimpleTypeName _ tn -> tn
                                  _ -> ""


SEM Expression
  | BooleanLit Case Exists FloatLit IntegerLit LiftOperator
    NullLit PositionalArg Placeholder ScalarSubQuery StringLit
      lhs.liftedColumnName = ""

-- collect the aliases and column names for use by the selectitemlist nodes
SEM SelectItem
    | SelExp lhs.columnName = case @ex.liftedColumnName of
                                "" -> "?column?"
                                s -> s
    | SelectItem lhs.columnName = @name