CreateTable.ag

{-
Copyright 2009 Jake Wheat

This file contains the code for typechecking create table statements
(and also create table as statements). It's pretty limited at the
moment, the bits that work are:

gathers enough information to add the table attributes types to the
catalog

typechecks row check constraints properly, but table check constraints
and all other constraints are not checked at all.

doesn't check for duplicate attribute names. doesn't check if the
types are valid for a table (e.g. disallow setof types)

We produce a valid catalog update if the types of the attributes
check ok, any errors in the constraints aren't leaked.

-}


SEM Statement
    | CreateTable
        loc.tpe = dependsOnRTpe @loc.attrTypes $ Right $ Pseudo Void
        loc.catUpdates = dependsOn @loc.attrTypes []
                           [CatCreateTable @name @atts.attrs defaultSystemColumns]
        loc.attrTypes : {[Type]}
        loc.attrTypes = map snd @atts.attrs

        loc.statementType = []
        loc.backTree = CreateTable @ann
                                   @name
                                   @atts.annotatedTree
                                   @cons.annotatedTree
        cons.lib = case updateBindings @lhs.lib @lhs.cat
                     [LibStackIDs [("", @atts.attrs)]] of
                      Left x -> error $ show x
                      Right e -> e
{
defaultSystemColumns :: [(String,Type)]
defaultSystemColumns = [("tableoid", ScalarType "oid")
                       ,("cmax", ScalarType "cid")
                       ,("xmax", ScalarType "xid")
                       ,("cmin", ScalarType "cid")
                       ,("xmin", ScalarType "xid")
                       ,("ctid", ScalarType "tid")]
}


SEM Statement
    | CreateTableAs
        loc.tpe =
            dependsOnRTpe [@loc.selType] $ do
              @loc.attrs
              Right @loc.selType
        loc.catUpdates =
           leftToEmpty (\as -> [CatCreateTable @name as defaultSystemColumns]) $ do
              ats <- @loc.attrs
              return $ dependsOn (tpeToT @loc.tpe :
                                  (map snd ats)) [] ats

        loc.selType = getTypeAnnotation @expr.annotatedTree
        -- type of the columns in the select expression
        loc.attrs = unwrapSetOfComposite @loc.selType

        loc.backTree = CreateTableAs @ann @name @expr.annotatedTree
        loc.statementType = []

{-
attribute name and type gathering
-}

ATTR AttributeDef [||attrName : String
                     namedType : Type]

SEM AttributeDef
    | AttributeDef
        lhs.attrName = map toLower @name
        lhs.namedType = @typ.namedType

ATTR AttributeDefList [||attrs : {[(String, Type)]}]

SEM AttributeDefList
    | Cons lhs.attrs = (@hd.attrName, @hd.namedType) : @tl.attrs
    | Nil lhs.attrs = []

{-
row check constraint:
inject the column name and type into the column constraints
-}

SEM AttributeDef
    | AttributeDef
        cons.lib =
            case updateBindings @lhs.lib @lhs.cat
                     [LibStackIDs [("", [(@name, @typ.namedType)])]] of
              Left x -> error $ show x
              Right e -> e