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