Throw exception when CPP is enabled (plus some refactoring)

app/Main.hs

@@ -1,30 +1,32 @@
 module Main (main) where
 
-import Control.Monad
-import Ormolu.Parser
-import Ormolu.Printer
+-- import Control.Monad
+import Ormolu
 import System.Environment (getArgs)
 import qualified Data.Text.IO as TIO
-import qualified Outputable as GHC
+-- import qualified Outputable as GHC
 
 main :: IO ()
-main = do
+main = withPrettyOrmoluExceptions $ do
   (path:_) <- getArgs
-  input <- readFile path
+  r <- ormoluFile defaultConfig path
+  TIO.putStr r
+  -- TIO.
 
-  (ws, r) <- parseModule [] path input
-  unless (null ws) $
-    putStrLn "dynamic option warnings:"
-  case r of
-    Left (srcSpan, err) -> do
-      putStrLn (showOutputable srcSpan)
-      putStrLn err
-    Right (anns, parsedModule) -> do
-      putStrLn "\nannotations:\n"
-      putStrLn (showOutputable anns)
-      putStrLn "\nparsed module:\n"
-      putStrLn (showOutputable parsedModule)
-      TIO.putStr (printModule anns parsedModule)
+  -- input <- readFile path
 
-showOutputable :: GHC.Outputable o => o -> String
-showOutputable = GHC.showSDocUnsafe . GHC.ppr
+  -- (ws, r) <- parseModule [] path input
+  -- unless (null ws) $
+  --   putStrLn "dynamic option warnings:"
+  -- case r of
+  --   Left (srcSpan, err) -> do
+  --     putStrLn (showOutputable srcSpan)
+  --     putStrLn err
+  --   Right (anns, parsedModule) -> do
+  --     putStrLn "\nannotations:\n"
+  --     putStrLn (showOutputable anns)
+  --     putStrLn "\nparsed module:\n"
+  --     putStrLn (showOutputable parsedModule)
+
+-- showOutputable :: GHC.Outputable o => o -> String
+-- showOutputable = GHC.showSDocUnsafe . GHC.ppr

ormolu.cabal

@@ -40,6 +40,7 @@ library
                     , Ormolu.Comments
                     , Ormolu.Config
                     , Ormolu.Diff
+                    , Ormolu.Exception
                     , Ormolu.Parser
                     , Ormolu.Printer
                     , Ormolu.Printer.Combinators

src/Ormolu.hs

@@ -9,17 +9,18 @@ module Ormolu
   , defaultConfig
   , DynOption (..)
   , OrmoluException (..)
+  , withPrettyOrmoluExceptions
   )
 where
 
 import Control.Exception
 import Control.Monad
-import Control.Monad.Catch (MonadThrow (..))
 import Control.Monad.IO.Class (MonadIO (..))
 import Data.Text (Text)
 import Language.Haskell.GHC.ExactPrint.Types
 import Ormolu.Config
 import Ormolu.Diff
+import Ormolu.Exception
 import Ormolu.Parser
 import Ormolu.Printer
 import qualified Data.Text as T
@@ -37,7 +38,7 @@ import qualified GHC
 --     * Throws 'OrmoluException'.
 
 ormolu
-  :: (MonadIO m, MonadThrow m)
+  :: MonadIO m
   => Config                     -- ^ Ormolu configuration
   -> FilePath                   -- ^ Location of source file
   -> String                     -- ^ Input to format
@@ -51,7 +52,7 @@ ormolu cfg path str = do
   (anns1, parsedSrc1) <-
     parseModule' cfg OrmoluOutputParsingFailed "<rendered>" (T.unpack txt)
   when (diff (anns0, parsedSrc0) (anns1, parsedSrc1)) $
-    throwM (OrmoluASTDiffers str txt)
+    liftIO $ throwIO (OrmoluASTDiffers str txt)
   return txt
 
 -- | Load a file and format it. The file stays intact and the rendered
@@ -61,7 +62,7 @@ ormolu cfg path str = do
 -- >   liftIO (readFile path) >>= ormolu cfg path
 
 ormoluFile
-  :: (MonadIO m, MonadThrow m)
+  :: MonadIO m
   => Config                     -- ^ Ormolu configuration
   -> FilePath                   -- ^ Location of source file
   -> m Text                     -- ^ Resulting rendition
@@ -71,7 +72,7 @@ ormoluFile cfg path =
 -- | A wrapper around 'parseModule'.
 
 parseModule'
-  :: (MonadIO m, MonadThrow m)
+  :: MonadIO m
   => Config                     -- ^ Ormolu configuration
   -> (GHC.SrcSpan -> String -> OrmoluException)
      -- ^ How to obtain 'OrmoluException' to throw when parsing fails
@@ -79,21 +80,7 @@ parseModule'
   -> String                     -- ^ Actual input for the parser
   -> m (Anns, GHC.ParsedSource) -- ^ Annotations and parsed source
 parseModule' Config {..} mkException path str = do
-  (_, r) <- liftIO (parseModule cfgDynOptions path str)
+  (_, r) <- parseModule cfgDynOptions path str
   case r of
-    Left (spn, err) -> throwM (mkException spn err)
+    Left (spn, err) -> liftIO $ throwIO (mkException spn err)
     Right x -> return x
-
--- | Ormolu exception representing all cases when 'ormoluFile' can fail.
-
-data OrmoluException
-  = OrmoluParsingFailed GHC.SrcSpan String
-    -- ^ Parsing of original source code failed
-  | OrmoluOutputParsingFailed GHC.SrcSpan String
-    -- ^ Parsing of formatted source code failed
-  | OrmoluASTDiffers String Text
-    -- ^ Original and resulting ASTs differ, first argument is the original
-    -- source code, second argument is rendered source code
-  deriving (Eq, Show)
-
-instance Exception OrmoluException

src/Ormolu/Exception.hs

@@ -0,0 +1,70 @@
+-- | 'OrmoluException' type and surrounding definitions.
+
+{-# LANGUAGE LambdaCase #-}
+
+module Ormolu.Exception
+  ( OrmoluException (..)
+  , withPrettyOrmoluExceptions
+  )
+where
+
+import Control.Exception
+import Data.Text (Text)
+import System.Exit (exitFailure)
+import System.IO
+import qualified GHC
+import qualified Outputable as GHC
+
+-- | Ormolu exception representing all cases when 'ormoluFile' can fail.
+
+data OrmoluException
+  = OrmoluCppEnabled
+    -- ^ Ormolu does not work with source files that use CPP
+  | OrmoluParsingFailed GHC.SrcSpan String
+    -- ^ Parsing of original source code failed
+  | OrmoluOutputParsingFailed GHC.SrcSpan String
+    -- ^ Parsing of formatted source code failed
+  | OrmoluASTDiffers String Text
+    -- ^ Original and resulting ASTs differ, first argument is the original
+    -- source code, second argument is rendered source code
+  deriving (Eq, Show)
+
+instance Exception OrmoluException where
+  displayException = \case
+    OrmoluCppEnabled -> "CPP is not supported"
+    OrmoluParsingFailed s e ->
+      showParsingErr "parsing of source code failed:" s e
+    OrmoluOutputParsingFailed s e ->
+      showParsingErr "parsing of formatted code failed (report the bug):" s e
+    OrmoluASTDiffers _ _ ->
+      "AST of input and AST of formatted code differ, report the bug"
+
+-- | Inside this wrapper 'OrmoluException' will be caught and displayed
+-- nicely using 'displayException'.
+
+withPrettyOrmoluExceptions
+  :: IO a                       -- ^ Action that may throw the exception
+  -> IO a
+withPrettyOrmoluExceptions m = m `catch` h
+  where
+    h :: OrmoluException -> IO a
+    h e = do
+      hPutStrLn stderr (displayException e)
+      exitFailure
+
+----------------------------------------------------------------------------
+-- Helpers
+
+-- | Show a parse error.
+
+showParsingErr :: String -> GHC.SrcSpan -> String -> String
+showParsingErr msg spn err = unlines
+  [ msg
+  , showOutputable spn
+  , err
+  ]
+
+-- | Display something 'GHC.Outputable'.
+
+showOutputable :: GHC.Outputable o => o -> String
+showOutputable = GHC.showSDocUnsafe . GHC.ppr

src/Ormolu/Parser.hs

@@ -1,12 +1,18 @@
 -- | Parser for Haskell source code.
 
 module Ormolu.Parser
-  ( parseModule )
+  ( parseModule
+  )
 where
 
+import Control.Exception
+import Control.Monad
+import Control.Monad.IO.Class
+import GHC.LanguageExtensions.Type (Extension (Cpp))
 import Language.Haskell.GHC.ExactPrint.Parsers hiding (parseModule)
 import Language.Haskell.GHC.ExactPrint.Types
 import Ormolu.Config
+import Ormolu.Exception
 import qualified CmdLineParser as GHC
 import qualified DynFlags as GHC
 import qualified GHC hiding (parseModule)
@@ -14,12 +20,20 @@ import qualified GHC hiding (parseModule)
 -- | Parse a complete module from string.
 
 parseModule
-  :: [DynOption]        -- ^ Dynamic options that affect parsing
+  :: MonadIO m
+  => [DynOption]        -- ^ Dynamic options that affect parsing
   -> FilePath           -- ^ File name (only for source location annotations)
   -> String             -- ^ Input for parser
-  -> IO ([GHC.Warn], Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))
-parseModule dynOpts path input = ghcWrapper $ do
-  dynFlags0 <- initDynFlagsPure path input
-  (dynFlags1, _, ws) <-
-    GHC.parseDynamicFilePragma dynFlags0 (dynOptionToLocatedStr <$> dynOpts)
-  return (ws, parseModuleFromStringInternal dynFlags1 path input)
+  -> m ([GHC.Warn], Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))
+parseModule dynOpts path input = liftIO $ do
+  (ws, dynFlags) <- ghcWrapper $ do
+    dynFlags0 <- initDynFlagsPure path input
+    (dynFlags1, _, ws) <-
+      GHC.parseDynamicFilePragma dynFlags0 (dynOptionToLocatedStr <$> dynOpts)
+    return (ws, dynFlags1)
+  -- NOTE It's better to throw this outside of 'ghcWrapper' because
+  -- otherwise the exception will be wrapped as a GHC panic, which we don't
+  -- want.
+  when (GHC.xopt Cpp dynFlags) $
+   throwIO OrmoluCppEnabled
+  return (ws, parseModuleFromStringInternal dynFlags path input)

src/Ormolu/Printer.hs

@@ -5,7 +5,8 @@
 -- | Pretty-printer for Haskell AST.
 
 module Ormolu.Printer
-  ( printModule )
+  ( printModule
+  )
 where
 
 import Data.Char (isAlphaNum)