{- 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 = envCompositeAttrsPair @lhs.env [] @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.env @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.env [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.env (@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 :: Environment -> String -> Expression -> Either [TypeError] (String,[(String,Type)]) funIdens env 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) -> envCompositePublicAttrs env [] 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