The annotation data types and utilities for working with them.
Annotations are used to store source positions, types, errors,
warnings, catalog deltas, information, and other stuff a client might
want to use when looking at an ast. Internal annotations which are
used in the type-checking/ annotation process use the attribute
grammar code and aren't exposed.
>
>
> module Database.HsSqlPpp.Internals.AstAnnotation
> (
> Annotation(..)
> ,SourcePosition
> ,ParameterizedStatementType
> ,getAnnotation
> ,updateAnnotations
> ,getAnnotations
> ,emptyAnnotation
> ,getTypeAnnotation
> ,updateAnnotation
> ) where
>
> import Data.Generics
>
> import Data.Generics.Uniplate.Data
>
>
> import Database.HsSqlPpp.Internals.TypeType
> import Database.HsSqlPpp.Internals.Catalog.CatalogInternal
>
>
>
> type SourcePosition = (String,Int,Int)
>
> type ParameterizedStatementType = ([Type],[(String,Type)])
>
>
> data Annotation = Annotation {
> asrc :: Maybe SourcePosition
>
> ,atype :: Maybe Type
>
> ,errs :: [TypeError]
>
> ,stType :: Maybe ParameterizedStatementType
>
> ,catUpd :: [CatalogUpdate]
>
> ,fnProt :: Maybe FunctionPrototype
>
> ,infType :: Maybe Type}
> deriving (Eq, Show,Typeable,Data)
>
>
> emptyAnnotation :: Annotation
> emptyAnnotation = Annotation Nothing Nothing [] Nothing [] Nothing Nothing
>
> getAnnotation :: Data a => a -> Annotation
> getAnnotation = head . childrenBi
>
> getAnnotations :: Data a => a -> [Annotation]
> getAnnotations = universeBi
>
> updateAnnotations :: Data a => (Annotation -> Annotation) -> a -> a
> updateAnnotations = transformBi
> getTypeAnnotation :: Data a => a -> Maybe Type
> getTypeAnnotation = atype . getAnnotation
Use syb/uniplate to pull annotation values from an ast.
I like to cut and paste code from the internet which I don't
understand, then keep changing it till it compiles and passes the tests.
>
>
>
>
>
>
> getTypeErrors :: (Data a) => a -> [(Maybe AnnotationElement,[TypeError])]
> getTypeErrors sts =
> filter (\(_,te) -> not $ null te) $ map (gtsp &&& gte) $ getAnnotations sts
> where
> gte (a:as) = case a of
> TypeErrorA e -> e:gte as
> _ -> gte as
> gte _ = []
> gtsp (a:as) = case a of
> s@(SourcePos _ _ _) -> Just s
> _ -> gtsp as
> gtsp _ = Nothing
~~~~
question:
if a node has no source position e.g. the all in select all or select
distinct may correspond to a token or may be synthesized as the
default if neither all or distinct is present. Should this have the
source position of where the token would have appeared, should it
inherit it from its parent, should there be a separate ctor to
represent a fake node with no source position?
~~~~
hack job, often not interested in the source positions when testing
the asts produced, so this function will reset all the source
positions to empty ("", 0, 0) so you can compare them for equality, etc.
without having to get the positions correct.
> }
> -- | strip all the annotations from a tree. E.g. can be used to compare
> -- two asts are the same, ignoring any source position annotation differences.
> stripAnnotations :: Data a => a -> a
> stripAnnotations = filterAnnotations (const False)
>
> filterAnnotations :: Data a => (Annotation -> Bool) -> a -> a
> filterAnnotations f = transformBi (filter f)
>
>
> updateAnnotation :: Data a => (Annotation -> Annotation) -> a -> a
> updateAnnotation f = gmapT (mkT f)
>
> case gmapQ (mkQ [] f) a of
> an:_ -> an
> [] -> []
> where
> f :: Annotation -> Annotation
> f = id
>
>
> getAnnotations :: Data a => a -> [Annotation]
> getAnnotations = listifyWholeLists (\(_::Annotation) -> True)
>
>
-------------------------------------------------------------------------------
utils
> listifyWholeLists :: Typeable b => ([b] -> Bool) -> GenericQ [[b]]
> listifyWholeLists blp = flip (synthesize id (.) (mkQ id (\bl _ -> if blp bl then (bl:) else id))) []
this might need to be maybe and change head?
> getTopLevelAnnotation :: Data a => a -> Annotation
> getTopLevelAnnotation st = head $ childrenBi st