Revert "Move check-ppr and check-api-annotations to testsuite/utils"

Unfortunately this (ironically) ended up breaking bindist testing since
we didn't have a package-data.mk. Unfortunately there is no easy way to
fix this.

This reverts commit 1e9f90af7311c33de0f7f5b7dba594725596d675.

8 files changed, 452 insertions, 0 deletions

diff --git a/utils/check-api-annotations/Main.hs b/utils/check-api-annotations/Main.hs
new file mode 100644
index 0000000000..6b973e12e8
--- /dev/null
+++ b/utils/check-api-annotations/Main.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE RankNTypes #-}
+
+import Data.Data
+import Data.List
+import GHC
+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
+
+main::IO()
+main = do
+  args <- getArgs
+  case args of
+   [libdir,fileName] -> testOneFile libdir fileName
+   _ -> putStrLn "invoke with the libdir and a file to parse."
+
+testOneFile :: FilePath -> String -> IO ()
+testOneFile libdir fileName = do
+       let modByFile m =
+             case ml_hs_file $ ms_location m of
+               Nothing -> False
+               Just fn -> fn == fileName
+       ((anns,_cs),p) <- runGhc (Just libdir) $ do
+                        dflags <- getSessionDynFlags
+                        _ <- setSessionDynFlags dflags
+                        addTarget Target { targetId = TargetFile fileName Nothing
+                                         , targetAllowObjCode = True
+                                         , targetContents = Nothing }
+                        _ <- load LoadAllTargets
+                        graph <- getModuleGraph
+                        let modSum =
+                              case filter modByFile (mgModSummaries graph) of
+                                [x] -> x
+                                xs -> error $ "Can't find module, got:"
+                                  ++ show (map (ml_hs_file . ms_location) xs)
+                        p <- parseModule modSum
+                        return (pm_annotations p,p)
+
+       let sspans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)
+
+           exploded = [((kw,ss),[anchor])
+                      | ((anchor,kw),sss) <- Map.toList anns,ss <- sss]
+
+           exploded' = Map.toList $ Map.fromListWith (++) exploded
+
+           problems' = filter (\(_,anchors)
+                               -> not (any (\a -> Set.member a sspans) anchors))
+                              exploded'
+
+           problems'' = filter (\((a,_),_) -> a /= AnnEofPos) problems'
+
+       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
+          getSrcSpan :: SrcSpan -> [SrcSpan]
+          getSrcSpan ss = [ss]
+
+
+showAnns :: Map.Map ApiAnnKey [SrcSpan] -> String
+showAnns anns = "[\n" ++ (intercalate ",\n"
+   $ map (\((s,k),v)
+              -- -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))
+              -> ("((" ++ pp s ++ "," ++ show k ++"), " ++ pp v ++ ")"))
+   $ Map.toList anns)
+    ++ "\n]\n"
+
+pp :: (Outputable a) => a -> String
+pp a = showPpr unsafeGlobalDynFlags a
+
+
+-- ---------------------------------------------------------------------
+
+-- Copied from syb for the test
+
+
+-- | Generic queries of type \"r\",
+--   i.e., take any \"a\" and return an \"r\"
+--
+type GenericQ r = forall a. Data a => a -> r
+
+
+-- | Make a generic query;
+--   start from a type-specific case;
+--   return a constant otherwise
+--
+mkQ :: ( Typeable a
+       , Typeable b
+       )
+    => r
+    -> (b -> r)
+    -> a
+    -> r
+(r `mkQ` br) a = case cast a of
+                        Just b  -> br b
+                        Nothing -> r
+
+
+
+-- | Summarise all nodes in top-down, left-to-right order
+everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
+
+-- Apply f to x to summarise top-level node;
+-- use gmapQ to recurse into immediate subterms;
+-- use ordinary foldl to reduce list of intermediate results
+
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
diff --git a/utils/check-api-annotations/README b/utils/check-api-annotations/README
new file mode 100644
index 0000000000..fcadc50ff6
--- /dev/null
+++ b/utils/check-api-annotations/README
@@ -0,0 +1,103 @@
+This programme is intended to be used by any GHC developers working on Parser.y
+or RdrHsSyn.hs, and who want to check that their changes do not break the API
+Annotations.
+
+It does a basic test that all annotations do make it to the final AST, and dumps
+a list of the annotations generated for a given file, so that they can be
+checked against the source being parsed for sanity.
+
+This utility is also intended to be used in tests, so that when new features are
+added the expected annotations are also captured.
+
+Usage
+
+In a test Makefile
+
+  $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" FileToParse.hs
+
+See examples in (REPO_HOME)/testsuite/tests/ghc-api/annotations/Makefile
+
+
+Description of operation
+------------------------
+
+The programme is called with the name of a haskell source file.
+
+It uses the GHC API to load and parse this, and extracts the API annotations.
+
+These are of the form
+
+    Map.Map ApiAnnKey [SrcSpan]
+
+where
+
+    type ApiAnnKey = (SrcSpan,AnnKeywordId)
+
+So an annotation is a key comprising the parent SrcSpan in the ParsedSource
+together with an AnnKeywordId, and this maps to a list of locations where the
+specific keyword item occurs in the original source.
+
+The utility extracts all SrcSpans in the ParsedSource, and makes sure that for
+every ApiAnnKey the SrcSpan is actually present in the final ParsedSource. This
+is to ensure that when a given parser production is postprocessed anywhere along
+the line the relevant SrcSpan is not discarded, thus detaching the annotation
+from the final output.
+
+It also provides a list of each ApiAnnKey and the corresponding source
+locations, so these can be checked against the original source for correctness.
+
+Example
+-------
+
+Test10255.hs in the ghc-api/annotations tests has the following source
+
+------------------------------
+1:{-# LANGUAGE ScopedTypeVariables #-}
+2:module Test10255 where
+3:
+4:import Data.Maybe
+5:
+6:fob (f :: (Maybe t -> Int)) =
+7:  undefined
+------------------------------
+
+The output of this utility is
+
+------------------------------------------------------------------------
+---Problems (should be empty list)---
+[]
+---Annotations-----------------------
+-- SrcSpan the annotation is attached to, AnnKeywordId,
+--    list of locations the keyword item appears in
+[
+((Test10255.hs:1:1,AnnModule), [Test10255.hs:2:1-6]),
+((Test10255.hs:1:1,AnnWhere), [Test10255.hs:2:18-22]),
+((Test10255.hs:4:1-17,AnnImport), [Test10255.hs:4:1-6]),
+((Test10255.hs:4:1-17,AnnSemi), [Test10255.hs:6:1]),
+((Test10255.hs:(6,1)-(7,11),AnnEqual), [Test10255.hs:6:29]),
+((Test10255.hs:(6,1)-(7,11),AnnFunId), [Test10255.hs:6:1-3]),
+((Test10255.hs:(6,1)-(7,11),AnnSemi), [Test10255.hs:8:1]),
+((Test10255.hs:6:5-27,AnnCloseP), [Test10255.hs:6:27]),
+((Test10255.hs:6:5-27,AnnOpenP), [Test10255.hs:6:5]),
+((Test10255.hs:6:6-26,AnnDcolon), [Test10255.hs:6:8-9]),
+((Test10255.hs:6:11-26,AnnCloseP), [Test10255.hs:6:26]),
+((Test10255.hs:6:11-26,AnnOpenP), [Test10255.hs:6:11]),
+((Test10255.hs:6:12-18,AnnRarrow), [Test10255.hs:6:20-21]),
+((Test10255.hs:6:12-25,AnnRarrow), [Test10255.hs:6:20-21]),
+((<no location info>,AnnEofPos), [Test10255.hs:8:1])
+]
+------------------------------------------------------------------------
+
+To interpret this, firstly the problems list is empty, so there are not
+annotations that do not appear in the final AST.
+
+Secondly, the list of annotations and locations can be checked against the test
+source code to ensure that every AnnKeywordId does in fact appear.
+
+It will return a zero exit code if the list of problems is empty, non-zero
+otherwise.
+
+Note: In some cases, such as T10269 in the ghc-api/annotations tests the list is
+non-empty, due to postprocessing of the parsed result. In general this should
+only happen for an `AnnVal` and if it does the actual annotations provided need
+to be inspected to check that an equivalent annotation is provided.
diff --git a/utils/check-api-annotations/check-api-annotations.cabal b/utils/check-api-annotations/check-api-annotations.cabal
new file mode 100644
index 0000000000..880f4d6603
--- /dev/null
+++ b/utils/check-api-annotations/check-api-annotations.cabal
@@ -0,0 +1,29 @@
+Name: check-api-annotations
+Version: 0.1
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: A utilities for checking the consistency of GHC's API annotations.
+Description:
+    This utility is used to check the consistency between GHC's syntax tree
+    and API annotations used to track token-level details of the original
+    source file. See @utils/check-api-annotations/README@ in GHC's source
+    distribution for details.
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable check-api-annotations
+    Default-Language: Haskell2010
+
+    Main-Is: Main.hs
+
+    Ghc-Options: -Wall
+
+    Build-Depends: base       >= 4   && < 5,
+                   containers,
+                   Cabal      >= 2.0 && < 2.1,
+                   directory,
+                   ghc
diff --git a/utils/check-api-annotations/ghc.mk b/utils/check-api-annotations/ghc.mk
new file mode 100644
index 0000000000..61f896d3d7
--- /dev/null
+++ b/utils/check-api-annotations/ghc.mk
@@ -0,0 +1,18 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+utils/check-api-annotations_USES_CABAL                   = YES
+utils/check-api-annotations_PACKAGE                      = check-api-annotations
+utils/check-api-annotations_dist-install_PROGNAME        = check-api-annotations
+utils/check-api-annotations_dist-install_INSTALL         = NO
+utils/check-api-annotations_dist-install_INSTALL_INPLACE = YES
+$(eval $(call build-prog,utils/check-api-annotations,dist-install,2))
diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
new file mode 100644
index 0000000000..a5aeee2f1d
--- /dev/null
+++ b/utils/check-ppr/Main.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Data.List
+import SrcLoc
+import GHC hiding (moduleName)
+import HsDumpAst
+import DynFlags
+import Outputable hiding (space)
+import System.Environment( getArgs )
+import System.Exit
+import System.FilePath
+
+import qualified Data.Map        as Map
+
+usage :: String
+usage = unlines
+    [ "usage: check-ppr (libdir) (file)"
+    , ""
+    , "where libdir is the GHC library directory (e.g. the output of"
+    , "ghc --print-libdir) and file is the file to parse."
+    ]
+
+main :: IO()
+main = do
+  args <- getArgs
+  case args of
+   [libdir,fileName] -> testOneFile libdir fileName
+   _ -> putStrLn usage
+
+testOneFile :: FilePath -> String -> IO ()
+testOneFile libdir fileName = do
+       p <- parseOneFile libdir fileName
+       let
+         origAst = showSDoc unsafeGlobalDynFlags
+                     $ showAstData BlankSrcSpan (pm_parsed_source p)
+         pped    = pragmas ++ "\n" ++ pp (pm_parsed_source p)
+         anns    = pm_annotations p
+         pragmas = getPragmas anns
+
+         newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName
+         astFile = fileName <.> "ast"
+         newAstFile = fileName <.> "ast.new"
+
+       writeFile astFile origAst
+       writeFile newFile pped
+
+       p' <- parseOneFile libdir newFile
+
+       let newAstStr :: String
+           newAstStr = showSDoc unsafeGlobalDynFlags
+                         $ showAstData BlankSrcSpan (pm_parsed_source p')
+       writeFile newAstFile newAstStr
+
+       if origAst == newAstStr
+         then do
+           -- putStrLn "ASTs matched"
+           exitSuccess
+         else do
+           putStrLn "AST Match Failed"
+           putStrLn "\n===================================\nOrig\n\n"
+           putStrLn origAst
+           putStrLn "\n===================================\nNew\n\n"
+           putStrLn newAstStr
+           exitFailure
+
+
+parseOneFile :: FilePath -> FilePath -> IO ParsedModule
+parseOneFile libdir fileName = do
+       let modByFile m =
+             case ml_hs_file $ ms_location m of
+               Nothing -> False
+               Just fn -> fn == fileName
+       runGhc (Just libdir) $ do
+         dflags <- getSessionDynFlags
+         let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream
+         _ <- setSessionDynFlags dflags2
+         addTarget Target { targetId = TargetFile fileName Nothing
+                          , targetAllowObjCode = True
+                          , targetContents = Nothing }
+         _ <- load LoadAllTargets
+         graph <- getModuleGraph
+         let
+           modSum = case filter modByFile (mgModSummaries graph) of
+                     [x] -> x
+                     xs -> error $ "Can't find module, got:"
+                              ++ show (map (ml_hs_file . ms_location) xs)
+         parseModule modSum
+
+getPragmas :: ApiAnns -> String
+getPragmas anns = pragmaStr
+  where
+    tokComment (L _ (AnnBlockComment s)) = s
+    tokComment (L _ (AnnLineComment  s)) = s
+    tokComment _ = ""
+
+    comments = case Map.lookup noSrcSpan (snd anns) of
+      Nothing -> []
+      Just cl -> map tokComment $ sortLocated cl
+    pragmas = filter (\c -> isPrefixOf "{-#" c ) comments
+    pragmaStr = intercalate "\n" pragmas
+
+pp :: (Outputable a) => a -> String
+pp a = showPpr unsafeGlobalDynFlags a
+
+
diff --git a/utils/check-ppr/README b/utils/check-ppr/README
new file mode 100644
index 0000000000..f9b502e4a7
--- /dev/null
+++ b/utils/check-ppr/README
@@ -0,0 +1,26 @@
+
+This programme is intended to be used by any GHC developers working on the AST
+and/or pretty printer by providing a way to check that the same AST is generated
+from the pretty printed AST as from the original source.
+
+i.e., it checks whether
+
+    parse (ppr (parse s)) === parse s
+
+
+This utility is also intended to be used in tests, so that when new features are
+added the ability to round-trip the AST via ppr is tested.
+
+Usage
+
+In a test Makefile
+
+  $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" FileToParse.hs
+
+See examples in (REPO_HOME)/testsuite/tests/printer/Makefile
+
+The utility generates the following files for ToBeTested.hs
+
+  - ToBeTested.ppr.hs      : the ppr result
+  - ToBeTested.hs.ast      : the AST of the original source
+  - ToBeTested.hs.ast.new  : the AST of the re-parsed ppr source
diff --git a/utils/check-ppr/check-ppr.cabal b/utils/check-ppr/check-ppr.cabal
new file mode 100644
index 0000000000..584558b3ff
--- /dev/null
+++ b/utils/check-ppr/check-ppr.cabal
@@ -0,0 +1,31 @@
+Name: check-ppr
+Version: 0.1
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: A utilities for checking the consistency of GHC's pretty printer
+Description:
+    This utility is used to check the consistency of the GHC pretty printer, by
+    parsing a file, pretty printing it, and then re-parsing the pretty printed
+    version. See @utils/check-ppr/README@ in GHC's source distribution for
+    details.
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable check-ppr
+    Default-Language: Haskell2010
+
+    Main-Is: Main.hs
+
+    Ghc-Options: -Wall
+
+    Build-Depends: base       >= 4   && < 5,
+                   bytestring,
+                   containers,
+                   Cabal      >= 2.0 && < 2.1,
+                   directory,
+                   filepath,
+                   ghc
diff --git a/utils/check-ppr/ghc.mk b/utils/check-ppr/ghc.mk
new file mode 100644
index 0000000000..189b447171
--- /dev/null
+++ b/utils/check-ppr/ghc.mk
@@ -0,0 +1,18 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+utils/check-ppr_USES_CABAL                   = YES
+utils/check-ppr_PACKAGE                      = check-ppr
+utils/check-ppr_dist-install_PROGNAME        = check-ppr
+utils/check-ppr_dist-install_INSTALL         = NO
+utils/check-ppr_dist-install_INSTALL_INPLACE = YES
+$(eval $(call build-prog,utils/check-ppr,dist-install,2))