packages feed

hssqlppp-0.2.0: Database/HsSqlPpp/AstInternals/TypeChecking/TableRefs.ag

{-
Copyright 2009 Jake Wheat

This file contains the checking for tablerefs (the from part of a
select expression).

-}

-- lib update contains the updated id and star expansions coming out
-- of the tableref part of a select expression. These updates aren't
-- used for chaining these things for nested table refs (in join
-- statements) - use attributes for them

ATTR TableRef TableRefList [|| libUpdates: {[LocalIdentifierBindingsUpdate]}]

-- use these attributes which contain a copy of the info in lib
-- updates in a form more digestible to the join attributes resolution
-- the main advantages is we don't have to pull the ids out of a list
-- of update wrappers, and we don't have to split the id bindings into
-- qualified and unqualified parts. We could do it just using the
-- libupdates in principle, but this way seems to be a bit more direct
-- and clear to write and read (i.e. when I tried to to it using
-- libupdates I failed and gave up several times).
ATTR TableRef [|| idLookups : {[(String,Type)]}
                  starExpansion : {[(String,Type)]}
                  qidLookups : {[(String,[(String,Type)])]}
                  qstarExpansion : {[(String,[(String,Type)])]}]

-- set the annotations, just need to pick up any type errors whilst
-- calculating the new bindings
SEM TableRef
    | SubTref Tref TrefFun JoinedTref
        lhs.annotatedTree =
            updateAnnotation (map TypeErrorA @loc.errs ++) @loc.backTree

SEM TableRefList
    | Nil
        lhs.libUpdates = []
    | Cons
        lhs.libUpdates = @hd.libUpdates

{-

in the individual sem parts, we set four values:
idlookups : [(string,type)] pairs for all the unqualified ids which will be in scope coming out of the tref
qidlookups: [(string, [(string,type)])] for all the qualified ids
starexpansion: to expand unqualified *
qstarexpansion: to expand qualified *
(we need idlookups and starexpansion because of pg system columns,
which are a serious pain to deal with).

These are set as local vars, because we need to feed the resultant lib
update into the on expressions in joins lower down, which we can't do
directly with a syn attribute, so we collect them in locals, the
combined the in a local for libupdates. We copy all the parts and the
lib updates to regular attributes so we can access them from other
sems (the components (idlookups, etc.) are needed in working out joins
attributes, and the libupdate is used in the join expression, so all
this extra copying is only needed to support joins).

in each part, we collect errors in the errs local which we can then
add to the annotation for the node. when this happens, further type
checking in the select statement should stop but this isn't properly
implemented yet (this is to avoid too many type errors all over the
tree resulting from one mistake - a user friendliness consideration)

-}

SEM TableRef
    | SubTref Tref TrefFun JoinedTref
        loc.idLookups : {[(String,Type)]}
        loc.qidLookups : {[(String,[(String,Type)])]}
        loc.starExpansion : {[(String,Type)]}
        loc.qstarExpansion : {[(String,[(String,Type)])]}
        loc.libUpdates = if null @errs
                           then [LibStackIDs $ ("", @loc.idLookups): @loc.qidLookups
                                ,LibSetStarExpansion $ ("", @loc.starExpansion): @loc.qstarExpansion]
                           else []

ATTR TableRef [jlibUpdates: {[LocalIdentifierBindingsUpdate]}||]

{-

similar sort of pattern for each sem:
forward the errs
get the information we need to fill in the lookups and expansions as an either
fill in the lookups and expansions

-}
SEM TableRef
    | SubTref
        loc.errs = case @loc.selectAttrs of
                           Left e -> e
                           Right _ -> []
        loc.selectAttrs : {Either [TypeError] [(String,Type)]}
        loc.selectAttrs = unwrapSetOfComposite (getTypeAnnotation @sel.annotatedTree)

        loc.idLookups = fromRight [] @loc.selectAttrs
        loc.qidLookups = [(getAlias "" @alias.annotatedTree, @loc.idLookups)]
        loc.starExpansion = @loc.idLookups
        loc.qstarExpansion = @loc.qidLookups

    | Tref
        loc.errs = case @loc.relType of
                     Left e -> e
                     Right _ -> []
        loc.relType : {Either [TypeError] ([(String, Type)], [(String, Type)])}
        loc.relType = catCompositeAttrsPair @lhs.cat [] @tbl
        loc.relType1 = fromRight ([],[]) @loc.relType
        loc.pAttrs = fst @loc.relType1
        loc.sAttrs = snd @loc.relType1

        loc.idLookups = @loc.pAttrs ++ @loc.sAttrs
        loc.alias = getAlias @tbl @alias.annotatedTree
        loc.qidLookups = [(@loc.alias, @loc.idLookups)]
        loc.starExpansion = @loc.pAttrs
        loc.qstarExpansion = [(@loc.alias, @loc.pAttrs)]

    | TrefFun
        loc.errs = case @eqfunIdens of
                     Left e -> e
                     Right _ -> []
        loc.eqfunIdens : {Either [TypeError] (String,[(String,Type)])}
        loc.eqfunIdens = funIdens @lhs.cat @loc.alias @fn.annotatedTree
        loc.qfunIdens = fromRight ("",[]) @loc.eqfunIdens
        loc.alias2 = fst @loc.qfunIdens
        loc.funIdens = snd @loc.qfunIdens
        loc.alias = getAlias "" @alias.annotatedTree

        loc.idLookups = @loc.funIdens
        loc.qidLookups = [(@alias2, @loc.idLookups)]
        loc.starExpansion = @loc.idLookups
        loc.qstarExpansion = @loc.qidLookups
    | JoinedTref
        loc.errs = fromLeft [] @loc.ejoinAttrs
        loc.removeJoinAttrs = filter (\(n,_) -> n `notElem` @loc.joinNames)
        --the main meat: find out the name and types of all the common
        -- join attributes that need to be combined in the result
        -- (this is all the attributes which appear in both tables in
        -- the case of a natural join, or all the attributes appearing
        -- in the join list in the case of a using join.  for other
        -- joins, this list is empty
        -- all the attributes which don't appear in this list just
        -- get added together so we don't need to worry about them
        loc.ejoinAttrs : {Either [TypeError] [(String,Type)]}
        loc.ejoinAttrs =
            do
            -- get the names of the join columns
            let jns = case (@nat.annotatedTree, @onExpr.originalTree) of
                          (Natural, _) -> commonFieldNames
                          (_,Just (JoinUsing _ s)) -> s
                          _ -> []
                --make sure these columns appear in both tables
                tjtsm = map (flip lookup @tbl.idLookups) jns
                t1jtsm = map (flip lookup @tbl1.idLookups) jns
            errorWhen (not $ null $ filter (==Nothing) $ tjtsm ++ t1jtsm)
                      [MissingJoinAttribute]
            let tjts = catMaybes tjtsm -- should be no nothings at this stage
                t1jts = catMaybes t1jtsm
                -- find the types of these columns - this uses the result set
                -- type resolution (see typeconversion.lhs for more details
                -- and the relevant link to the pg manual
                resolvedTypes :: [Either [TypeError] Type]
                resolvedTypes = map (\(a,b) -> resolveResultSetType @lhs.cat [a,b]) $ zip tjts t1jts
            liftErrors $ concat $ lefts resolvedTypes
            return $ zip jns $ rights resolvedTypes
            where
              commonFieldNames = intersect (f @tbl.starExpansion) (f @tbl1.starExpansion)
                                 where f = map fst
        loc.joinNames = map fst @loc.joinAttrs
        loc.joinAttrs = fromRight [] @loc.ejoinAttrs

        --this is where we use the joinAttrs to filter the lookups and
        --expansions: stick the joinattrs at the start
        -- and add the other two lists minus the join attributes
        loc.idLookups = @loc.joinAttrs ++
                          @loc.removeJoinAttrs @tbl.idLookups ++
                          @loc.removeJoinAttrs @tbl1.idLookups
        loc.qidLookups = @tbl.qidLookups ++ @tbl1.qidLookups
        loc.starExpansion = @loc.joinAttrs ++
                              @loc.removeJoinAttrs @tbl.starExpansion ++
                              @loc.removeJoinAttrs @tbl1.starExpansion
        loc.qstarExpansion = @tbl.qstarExpansion ++ @tbl1.qstarExpansion

        -- we need the attributes from the joined tables to be available
        -- in the join expression.
        loc.newLib = case updateBindings @lhs.lib @lhs.cat (@loc.libUpdates ++ @lhs.jlibUpdates) of
                       Left x -> error $ show x
                       Right e -> {-trace ("on expr lib:" ++ show e)-} e
        onExpr.lib = @loc.newLib
        --need to pass this into nested joins also
        tbl.jlibUpdates = @loc.libUpdates
        tbl1.jlibUpdates = @loc.libUpdates


SEM TableRefList
    | Cons hd.jlibUpdates = []


{
{-
convert a function call into a [String,[(string,type)]] list for use
in a tableref context
first consideration is the alias: if there is an alias in the select,
e.g. select * from generate_series(1,2) x;  (alias is x)
we use that, otherwise we use the name of the function
second consideration is the attributes coming out, roughly speaking
we have to convert an arbitrary type to a relation type
if we have a relation valued function, we don't need to do anything
if we have a setof non composite, we lift the single type to an
attribute, using the function name for the attribute name
if we have a non setof, we lift the single type to an attribute and
then relation, using the function name for the attribute name
need to check to see what should happen with arrayof

-}
funIdens :: Catalog -> String -> Expression -> Either [TypeError] (String,[(String,Type)])
funIdens cat alias fnVal = do
   errorWhen (case fnVal of
                FunCall _ _ _ -> False
                _ -> True)
             [ContextError "FunCall"]
   let (FunCall _ fnName _) = fnVal
       correlationName = if alias /= ""
                           then alias
                           else fnName
   attrs <- do
     case getTypeAnnotation fnVal of
       SetOfType (NamedCompositeType t) -> catCompositePublicAttrs cat [] t
       SetOfType x -> return [(correlationName,x)]
       y -> return [(correlationName,y)]
   return (correlationName, attrs)

getAlias :: String -> TableAlias -> String
getAlias def alias =
  case alias of
    NoAlias -> def
    TableAlias t -> t
    FullAlias t _ -> t

}

-- boilerplate
-- copying the locals to syn attrs

SEM TableRef
    | SubTref Tref TrefFun JoinedTref
        lhs.libUpdates = @loc.libUpdates
        lhs.idLookups = @loc.idLookups
        lhs.qidLookups = @loc.qidLookups
        lhs.starExpansion = @loc.starExpansion
        lhs.qstarExpansion = @loc.qstarExpansion

-- backtrees

SEM TableRef
    | SubTref
        loc.backTree = SubTref @ann @sel.annotatedTree @alias.annotatedTree
    | Tref
        loc.backTree = Tref @ann @tbl @alias.annotatedTree
    | TrefFun
        loc.backTree = TrefFun @ann @fn.annotatedTree @alias.annotatedTree
    | JoinedTref
        loc.backTree = JoinedTref @ann
                                  @tbl.annotatedTree
                                  @nat.annotatedTree
                                  @joinType.annotatedTree
                                  @tbl1.annotatedTree
                                  @onExpr.annotatedTree
                                  @alias.annotatedTree