Copyright 2009 Jake Wheat
The purpose of this module is to add annotations in comments to the
original source code, so that we can preserve the original formatting
and comments.
A second goal will be to update these comments if they are already
present, so we can run this process repeatedly on a file and not fill
it with junk, or can e.g. make a few changes to the sql, run this
process, then use source control diff to view how the types, etc. have
changed.
Algorithm design
Get all the annotations ordered by source position. Split the original
text on these points, then zip it and output it.
>
> module Database.HsSqlPpp.PrettyPrinter.AnnotateSource
> (annotateSource) where
> import Data.List
> import Data.Maybe
> import Debug.Trace
> import Database.HsSqlPpp.Ast.Ast
> import Database.HsSqlPpp.Ast.Annotation
> import Database.HsSqlPpp.Ast.Annotator
> annotateSource :: Bool -> String -> StatementList -> String
> annotateSource doErrs src aast =
Details:
First need better syb so we can get two separate lists of annotations,
one for statements and one for nonstatements. This will allow us to
output full information for each statement, but output reduced
information for other nodes just want to output type error
annotations for now. (This could be made more general by allowing a
different kind of annotation pretty printer depending on the node
type, value or context?)
filter these two lists, mainly to strip all the annotations from the
nonstatement annotation list except the source positions and the type
errors.
merge these two lists and sort by source position, then map to get
[(sourceposition, annotation without sourceposition)]
Now we have a list of sourcepositions that we can split the original source with:
0->firstsp, firstsp->secondsp, ... second last sp-> last sp, last sp -> eof
-> this produces a [string] from the original source
use a zip:
zip splitSource $ ([]:map snd mungedAnnotationlist)
to get [(string,annotation)]
then do map second prettyPrint over this
to gives us a [(string,string)] which we can concatenate to produce
the output text.
To replace existing comments rather than repeatedly add them:
1) make sure the pretty printed comments have some marker
2) strip all the comments with this marker out after splitting the
string on the annotation source positions, i.e. when we get to
[(string,annotation)] or [(string,string)] stage.
> let allAnn = sortBy ordSps $ getStatementPosStringPairs ++ getTypeErrorPosPairs
> splitPoints = map ((\(SourcePos _ l _) -> l 1) . fst) allAnn
> splitsSrc = splitAts src splitPoints
> anSrcPairs = zip splitsSrc $ map snd allAnn
> in concatMap (uncurry (++)) anSrcPairs
>
> ++ last splitsSrc
> where
> ordSps :: (AnnotationElement,String) -> (AnnotationElement,String) -> Ordering
> ordSps a b = case (a,b) of
> ((SourcePos _ l c, _),(SourcePos _ l1 c1, _)) -> compare (l,c) (l1,c1)
> _ -> EQ
> getTypeErrorPosPairs :: [(AnnotationElement, String)]
> getTypeErrorPosPairs =
> if doErrs
> then map (\(a,b) -> (a,"\n/*ERROR:" ++ show b ++ "*/\n")) typeErrorsWithPositions
> else []
> where
> typeErrorsWithPositions = mapMaybe (\(a,b) -> case a of
> Nothing -> Nothing
> Just a1 -> Just (a1,b)) typeErrors
> typeErrors = getTypeErrors aast
> getStatementPosStringPairs :: [(AnnotationElement, String)]
> getStatementPosStringPairs =
> let statementAnnotations = map interestingAnn $ getStatementAnnotations aast
> split = mapMaybe (\l -> let notSp = filter (not.isSp) l
> in if notSp == []
> then Nothing
> else Just (find isSp l, notSp)) statementAnnotations
> splitsWithSps = mapMaybe (\(a,b) -> case a of
> Nothing -> Nothing
> Just a1 -> Just (a1,b)) split
> in map (\(a,b) -> (a, "\n/*" ++ show b ++ "*/\n")) splitsWithSps
> where
> interestingAnn anns =
> flip filter anns (\a ->
> case a of
> TypeAnnotation _ -> False
> EnvUpdates [] -> False
> _ -> True)
> isSp t = case t of
> SourcePos _ _ _ -> True
> _ -> False
> splitAts :: String -> [Int] -> [String]
> splitAts s splits =
> let slines = lines s
>
> splits1 = splits ++ [length slines]
> pairs :: [(Int,Int)]
> pairs = zip (0:splits) splits1
> in map (\(st,en) -> unlines $ take (en st) $ drop st slines) pairs