diff --git a/CHANGELOG.md b/CHANGELOG.md index 39b993c..4f2c566 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,9 @@ necessarily depending on the newest version of the compiler. In addition to that Ormolu is now GHCJS-compatible. +* Now unrecognized GHC options passed with `--ghc-opt` cause Ormolu to fail + (exit code 7). + * Fixed formatting of result type in closed type families. See [issue 420](https://github.com/tweag/ormolu/issues/420). diff --git a/src/Ormolu.hs b/src/Ormolu.hs index e4e5bac..600beec 100644 --- a/src/Ormolu.hs +++ b/src/Ormolu.hs @@ -51,11 +51,11 @@ ormolu :: String -> m Text ormolu cfg path str = do - (ws, result0) <- + (warnings, result0) <- parseModule' cfg OrmoluParsingFailed path str when (cfgDebug cfg) $ do traceM "warnings:\n" - traceM (concatMap showWarn ws) + traceM (concatMap showWarn warnings) traceM (prettyPrintParseResult result0) -- NOTE We're forcing 'txt' here because otherwise errors (such as -- messages about not-yet-supported functionality) will be thrown later @@ -133,10 +133,10 @@ parseModule' :: String -> m ([GHC.Warn], ParseResult) parseModule' cfg mkException path str = do - (ws, r) <- parseModule cfg path str + (warnings, r) <- parseModule cfg path str case r of Left (spn, err) -> liftIO $ throwIO (mkException spn err) - Right x -> return (ws, x) + Right x -> return (warnings, x) -- | Pretty-print a 'GHC.Warn'. showWarn :: GHC.Warn -> String diff --git a/src/Ormolu/Exception.hs b/src/Ormolu/Exception.hs index 3bc88dd..6e8f8a2 100644 --- a/src/Ormolu/Exception.hs +++ b/src/Ormolu/Exception.hs @@ -8,6 +8,8 @@ module Ormolu.Exception where import Control.Exception +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import Data.Text (Text) import qualified GHC import Ormolu.Utils (showOutputable) @@ -27,6 +29,8 @@ data OrmoluException OrmoluASTDiffers FilePath [GHC.SrcSpan] | -- | Formatted source code is not idempotent OrmoluNonIdempotentOutput GHC.RealSrcLoc Text Text + | -- | Some GHC options were not recognized + OrmoluUnrecognizedOpts (NonEmpty String) deriving (Eq, Show) instance Exception OrmoluException where @@ -56,6 +60,11 @@ instance Exception OrmoluException where loc ["before: " ++ show left, "after: " ++ show right] ++ "Please, consider reporting the bug.\n" + OrmoluUnrecognizedOpts opts -> + unlines + [ "The following GHC options were not recognized:", + (withIndent . unwords . NE.toList) opts + ] -- | Inside this wrapper 'OrmoluException' will be caught and displayed -- nicely using 'displayException'. @@ -76,6 +85,7 @@ withPrettyOrmoluExceptions m = m `catch` h OrmoluOutputParsingFailed _ _ -> 4 OrmoluASTDiffers _ _ -> 5 OrmoluNonIdempotentOutput _ _ _ -> 6 + OrmoluUnrecognizedOpts _ -> 7 ---------------------------------------------------------------------------- -- Helpers diff --git a/src/Ormolu/Parser.hs b/src/Ormolu/Parser.hs index 9c0a6b5..a82fd8e 100644 --- a/src/Ormolu/Parser.hs +++ b/src/Ormolu/Parser.hs @@ -15,6 +15,7 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class import Data.List ((\\), foldl', isPrefixOf) +import qualified Data.List.NonEmpty as NE import Data.Maybe (catMaybes) import qualified DynFlags as GHC import DynFlags as GHC @@ -57,8 +58,9 @@ parseModule Config {..} path input' = liftIO $ do GHC.setGeneralFlag' GHC.Opt_Haddock (setDefaultExts baseDynFlags) + extraOpts = dynOptionToLocatedStr <$> cfgDynOptions (warnings, dynFlags) <- - parsePragmasIntoDynFlags baseFlags path input' >>= \case + parsePragmasIntoDynFlags baseFlags extraOpts path input' >>= \case Right res -> pure res Left err -> let loc = @@ -170,14 +172,24 @@ setDefaultExts flags = foldl' GHC.xopt_set flags autoExts -- More helpers (taken from HLint) parsePragmasIntoDynFlags :: + -- | Pre-set 'DynFlags' DynFlags -> + -- | Extra options (provided by user) + [Located String] -> + -- | File name (only for source location annotations) FilePath -> + -- | Input for parser String -> IO (Either String ([GHC.Warn], DynFlags)) -parsePragmasIntoDynFlags flags filepath str = +parsePragmasIntoDynFlags flags extraOpts filepath str = catchErrors $ do let opts = GHC.getOptions flags (GHC.stringToStringBuffer str) filepath - (flags', _, warnings) <- parseDynamicFilePragma flags opts + (flags', leftovers, warnings) <- + parseDynamicFilePragma flags (opts <> extraOpts) + case NE.nonEmpty leftovers of + Nothing -> return () + Just unrecognizedOpts -> + throwIO (OrmoluUnrecognizedOpts (unLoc <$> unrecognizedOpts)) let flags'' = flags' `gopt_set` Opt_KeepRawTokenStream return $ Right (warnings, flags'') where