>
>
> module Database.HsSqlPpp.Internals.Catalog.CatalogTypes
> (
>
> Catalog(..)
> ,emptyCatalog
> ,NameComponent(..)
> ,ncStr
> ,ncStrT
> ,CompositeFlavour(..)
> ,CatName
> ,CatNameExtra(..)
> ,mkCatNameExtra
> ,mkCatNameExtraNN
>
> ,CatalogUpdate(..)
>
> ,OperatorPrototype
> ,CastContext(..)
> ) where
>
>
> import Data.Data
> import Data.Char
>
> import qualified Data.Map as M
> import qualified Data.Set as S
> import Database.HsSqlPpp.Internals.TypesInternal
>
> import Data.Text (Text)
> import qualified Data.Text as T
>
>
>
> type CatName = Text
>
> data CatNameExtra = CatNameExtra {
> catName:: CatName,
> catPrecision:: Maybe Int,
> catScale:: Maybe Int,
> catNullable:: Bool
> } deriving (Eq,Ord,Show,Typeable,Data)
> mkCatNameExtra:: CatName -> CatNameExtra
> mkCatNameExtra cn = CatNameExtra cn Nothing Nothing True
> mkCatNameExtraNN:: CatName -> CatNameExtra
> mkCatNameExtraNN cn = CatNameExtra cn Nothing Nothing False
> data CompositeFlavour = Composite | TableComposite | ViewComposite
> deriving (Eq,Show,Ord,Data,Typeable)
---------------------------------------------------------------
operators
operators is used as the generic term for all sorts of function things:
prefix, postfix, binary operators, functions, aggregate functions and
window functions
The information currently stored is:
name, parameter types, return type and variadic flag
>
> type OperatorPrototype = (CatName, [Type], Type, Bool)
>
>
> data Catalog = Catalog
> {catSchemas :: S.Set CatName
> ,catScalarTypeNames :: S.Set CatName
> ,catDomainTypes :: M.Map CatName CatName
>
>
> ,catCompositeTypes :: M.Map CatName
> (CompositeFlavour
> ,[(Text,CatNameExtra)]
> ,[(Text,CatName)])
> ,catArrayTypes :: M.Map CatName CatName
> ,catPrefixOps :: M.Map CatName [OperatorPrototype]
> ,catPostfixOps :: M.Map CatName [OperatorPrototype]
> ,catBinaryOps :: M.Map CatName [OperatorPrototype]
> ,catFunctions :: M.Map CatName [OperatorPrototype]
> ,catAggregateFunctions :: M.Map CatName [OperatorPrototype]
> ,catWindowFunctions :: M.Map CatName [OperatorPrototype]
> ,catTables :: M.Map (CatName,CatName)
> ([(Text,TypeExtra)]
> ,[(Text,Type)])
>
> ,catCasts :: S.Set (Type,Type,CastContext)
> ,catTypeCategories :: M.Map Type (Text,Bool)
>
> ,catUpdates :: [CatalogUpdate]
> }
> deriving (Eq,Show,Data,Typeable)
>
>
> data CastContext = ImplicitCastContext
> | AssignmentCastContext
> | ExplicitCastContext
> deriving (Eq,Show,Ord,Typeable,Data)
>
> emptyCatalog :: Catalog
> emptyCatalog = Catalog S.empty S.empty M.empty M.empty M.empty
> M.empty M.empty
> M.empty M.empty M.empty M.empty M.empty
> S.empty M.empty
> []
--------------------------------------------------
name component - this represents quoted and unquoted
possibly-qualified names (so names of things are lists of
namecomponents). Perhaps should be a syntactic namecomponent which is
in AstInternal, and a semantic namecomponent which is used here, but I
am lazy so the same type is shared.
The name components are only used here so that the logic for ignoring
or respecting case is in one place, these are only used in the query
functions and not in catalog values themselves.
> data NameComponent = Nmc String
> | QNmc String
> | AntiNameComponent String
> deriving (Data,Eq,Show,Typeable,Ord)
>
>
>
> ncStr :: NameComponent -> String
> ncStr (Nmc n) = map toLower n
> ncStr (QNmc n) = n
> ncStr (AntiNameComponent _n) =
> error "tried to get the name component string of an anti name component"
> ncStrT :: NameComponent -> Text
> ncStrT (Nmc n) = T.pack $ map toLower n
> ncStrT (QNmc n) = T.pack n
> ncStrT (AntiNameComponent _n) =
> error "tried to get the name component string of an anti name component"
todo: use left or something instead of error
------------------------------------------------------
updates
> data CatalogUpdate =
>
> CatCreateSchema CatName
>
> | CatCreateScalarType CatName
>
> | CatCreateDomainType CatName CatName
>
> | CatCreateArrayType CatName CatName
>
> | CatCreatePrefixOp CatName CatName CatName
>
> | CatCreatePostfixOp CatName CatName CatName
>
> | CatCreateBinaryOp CatName CatName CatName CatName
>
> | CatCreateFunction CatName [CatName] Bool CatName
>
>
> | CatCreateVariadicFunction CatName [CatName] Bool CatName
>
>
>
> | CatCreateSpecialOp CatName [CatName] Bool CatName
>
> | CatCreateAggregate CatName [CatName] CatName
>
> | CatCreateTable (CatName,CatName) [(CatName,CatNameExtra)]
>
> | CatCreateCast CatName CatName CastContext
>
> | CatCreateTypeCategoryEntry CatName (Text,Bool)
> deriving (Eq,Ord,Typeable,Data,Show)