Ticket #4437: ghc-supported-languages.hs

File ghc-supported-languages.hs, 3.5 KB (added by duncan, 4 years ago)

Test program to check for unregistered ghc extensions

Line 
1-- | A test program to check that ghc has got all of its extensions registered
2--
3module Main where
4
5import Language.Haskell.Extension
6import Distribution.Text
7import Distribution.Simple.Utils
8import Distribution.Verbosity
9
10import Data.List ((\\))
11import Data.Maybe
12import Control.Applicative
13import Control.Monad
14import System.Environment
15import System.Exit
16
17-- | A list of GHC extensions that are deliberately not registered,
18-- e.g. due to being experimental and not ready for public consumption
19--
20exceptions = map readExtension
21  [ "PArr"   -- still classed as experimental, will be renamed and registered
22  ]
23
24checkProblems :: [Extension] -> [String]
25checkProblems implemented =
26
27  let unregistered  =
28        [ ext | ext <- implemented          -- extensions that ghc knows about
29              , not (registered ext)        -- but that are not registered
30              , ext `notElem` exceptions ]  -- except for the exceptions
31
32      -- check if someone has forgotten to update the exceptions list...
33
34      -- exceptions that are not implemented
35      badExceptions  = exceptions \\ implemented
36     
37      -- exceptions that are now registered
38      badExceptions' = filter registered exceptions
39     
40   in catMaybes
41      [ check unregistered $ unlines
42          [ "The following extensions are known to GHC but are not in the "
43          , "extension registry in Language.Haskell.Extension."
44          , "  " ++ intercalate "\n  " (map display unregistered)
45          , "If these extensions are ready for public consumption then they "
46          , "should be registered. If they are still experimental and you "
47          , "think they are not ready to be registered then please add them "
48          , "to the exceptions list in this test program along with an "
49          , "explanation."
50          ]
51      , check badExceptions $ unlines
52          [ "Error in the extension exception list. The following extensions"
53          , "are listed as exceptions but are not even implemented by GHC:"
54          , "  " ++ intercalate "\n  " (map display badExceptions)
55          , "Please fix this test program by correcting the list of"
56          , "exceptions."
57          ]
58      , check badExceptions' $ unlines
59          [ "Error in the extension exception list. The following extensions"
60          , "are listed as exceptions to registration but they are in fact"
61          , "now registered in Language.Haskell.Extension:"
62          , "  " ++ intercalate "\n  " (map display badExceptions')
63          , "Please fix this test program by correcting the list of"
64          , "exceptions."
65          ]
66      ]
67  where
68   registered (UnknownExtension _) = False
69   registered _                    = True
70
71   check [] _ = Nothing 
72   check _  i = Just i
73
74
75main = topHandler $ do
76  [ghcPath] <- getArgs
77  exts      <- getExtensions ghcPath
78  let problems = checkProblems exts
79  putStrLn (intercalate "\n" problems)
80  if null problems
81    then exitSuccess
82    else exitFailure
83
84getExtensions :: FilePath -> IO [Extension]
85getExtensions ghcPath =
86        map readExtension . lines
87    <$> rawSystemStdout normal ghcPath ["--supported-languages"]
88
89readExtension :: String -> Extension
90readExtension str = handleNoParse $ do
91    -- GHC defines extensions in a positive way, Cabal defines them
92    -- relative to H98 so we try parsing ("No" ++ extName) first
93    ext <- simpleParse ("No" ++ str)
94    case ext of
95      UnknownExtension _ -> simpleParse str
96      _                  -> return ext
97  where
98    handleNoParse :: Maybe Extension -> Extension
99    handleNoParse = fromMaybe (error $ "unparsable extension " ++ show str)