Provide a utility to check API Annotations docs

A utility to check API Annotations was provided in
https://git.haskell.org/ghc.git/commitdiff/43751b2436f370d956d8021b3cdd3
eb77801470b

This commit had poor documentation.

This patch improves the output generated by the utility as well as
supplying better documentation

Test Plan: ./validate

Reviewers: simonpj, austin, bgamari

Reviewed By: austin, bgamari

Subscribers: thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D1397

GHC Trac Issues: #10917

1 files changed, 18 insertions, 16 deletions

diff --git a/utils/check-api-annotations/Main.hs b/utils/check-api-annotations/Main.hs
index 7dc2eb3f77..20e6aa0ca2 100644
--- a/utils/check-api-annotations/Main.hs
+++ b/utils/check-api-annotations/Main.hs
@@ -7,6 +7,7 @@ import DynFlags
 import Outputable
 import ApiAnnotation
 import System.Environment( getArgs )
+import System.Exit
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
@@ -19,7 +20,7 @@ main = do
 
 testOneFile :: FilePath -> String -> IO ()
 testOneFile libdir fileName = do
-       ((anns,cs),p) <- runGhc (Just libdir) $ do
+       ((anns,_cs),p) <- runGhc (Just libdir) $ do
                         dflags <- getSessionDynFlags
                         _ <- setSessionDynFlags dflags
                         let mn =mkModuleName fileName
@@ -33,9 +34,6 @@ testOneFile libdir fileName = do
 
        let sspans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)
 
-           problems = filter (\(s,_a) -> not (Set.member s sspans))
-                             $ getAnnSrcSpans (anns,cs)
-
            exploded = [((kw,ss),[anchor])
                       | ((anchor,kw),sss) <- Map.toList anns,ss <- sss]
 
@@ -45,17 +43,20 @@ testOneFile libdir fileName = do
                                -> not (any (\a -> Set.member a sspans) anchors))
                               exploded'
 
-       putStrLn "---Problems---------------------"
-       putStrLn (intercalate "\n" [showAnns $ Map.fromList $ map snd problems])
-       putStrLn "---Problems'--------------------"
-       putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems'])
-       putStrLn "--------------------------------"
-       putStrLn (intercalate "\n" [showAnns anns])
+           problems'' = filter (\((a,_),_) -> a /= AnnEofPos) problems'
 
-    where
-      getAnnSrcSpans :: ApiAnns -> [(SrcSpan,(ApiAnnKey,[SrcSpan]))]
-      getAnnSrcSpans (anns,_) = map (\a@((ss,_),_) -> (ss,a)) $ Map.toList anns
+       putStrLn "---Problems (should be empty list)---"
+       putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems''])
+       putStrLn "---Annotations-----------------------"
+       putStrLn "-- SrcSpan the annotation is attached to, AnnKeywordId,"
+       putStrLn "--    list of locations the keyword item appears in"
+       -- putStrLn (intercalate "\n" [showAnns anns])
+       putStrLn (showAnns anns)
+       if null problems''
+          then exitSuccess
+          else exitFailure
 
+    where
       getAllSrcSpans :: (Data t) => t -> [SrcSpan]
       getAllSrcSpans ast = everything (++) ([] `mkQ` getSrcSpan) ast
         where
@@ -64,11 +65,12 @@ testOneFile libdir fileName = do
 
 
 showAnns :: Map.Map ApiAnnKey [SrcSpan] -> String
-showAnns anns = "[\n" ++ (intercalate "\n"
+showAnns anns = "[\n" ++ (intercalate ",\n"
    $ map (\((s,k),v)
-              -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))
+              -- -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))
+              -> ("((" ++ pp s ++ "," ++ show k ++"), " ++ pp v ++ ")"))
    $ Map.toList anns)
-    ++ "]\n"
+    ++ "\n]\n"
 
 pp :: (Outputable a) => a -> String
 pp a = showPpr unsafeGlobalDynFlags a