mirror of
https://github.com/tweag/ormolu.git
synced 2024-09-11 13:16:13 +03:00
Throw exception when CPP is enabled (plus some refactoring)
This commit is contained in:
parent
bf22720b61
commit
b2e05d6f65
44
app/Main.hs
44
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
|
||||
|
@ -40,6 +40,7 @@ library
|
||||
, Ormolu.Comments
|
||||
, Ormolu.Config
|
||||
, Ormolu.Diff
|
||||
, Ormolu.Exception
|
||||
, Ormolu.Parser
|
||||
, Ormolu.Printer
|
||||
, Ormolu.Printer.Combinators
|
||||
|
@ -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
|
||||
|
70
src/Ormolu/Exception.hs
Normal file
70
src/Ormolu/Exception.hs
Normal file
@ -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
|
@ -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)
|
||||
|
@ -5,7 +5,8 @@
|
||||
-- | Pretty-printer for Haskell AST.
|
||||
|
||||
module Ormolu.Printer
|
||||
( printModule )
|
||||
( printModule
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Char (isAlphaNum)
|
||||
|
Loading…
Reference in New Issue
Block a user