Cabal-tests/tests/misc/ghc-supported-languages.hs

   1 -- | A test program to check that ghc has got all of its extensions registered
   2 --
   3 module Main where
   4
   5 import Language.Haskell.Extension
   6 import Distribution.Text
   7 import Distribution.Simple.Utils
   8 import Distribution.Verbosity
   9
  10 import Data.List ((\\))
  11 import Data.Maybe
  12 import Control.Applicative
  13 import Control.Monad
  14 import System.Environment
  15 import 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 --
  20 exceptions = map readExtension []
  21
  22 checkProblems :: [Extension] -> [String]
  23 checkProblems 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
  73 main = 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
  82 getExtensions :: FilePath -> IO [Extension]
  83 getExtensions ghcPath =
  84         map readExtension . lines
  85     <$> rawSystemStdout normal ghcPath ["--supported-languages"]
  86
  87 readExtension :: String -> Extension
  88 readExtension 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)