b2e05d6 · ormolu · git.iko.soy

git.iko.soy/ormolu

Throw exception when CPP is enabled (plus some refactoring)

commitb2e05d6f652de0874aa5e8582b35b94749f1ff4a authormrkkrp <mark.karpov@tweag.io> dateSun 24 Feb 2019, 20:50 (8 years ago) parentbf22720

6 files changed+126−51

compare with master

unifiedsplit

app/Main.hs+23−21 ormolu.cabal+1 src/Ormolu.hs+8−21 src/Ormolu/Exception.hs+70 src/Ormolu/Parser.hs+22−8 src/Ormolu/Printer.hs+2−1

app/Main.hs+23−21

@@ -1,30 +1,32 @@

11module Main (main) where

3−import Control.Monad

4−import Ormolu.Parser

5−import Ormolu.Printer

3+-- import Control.Monad

4+import Ormolu

65import System.Environment (getArgs)

76import qualified Data.Text.IO as TIO

8−import qualified Outputable as GHC

7+-- import qualified Outputable as GHC

109main :: IO ()

11−main = do

10+main = withPrettyOrmoluExceptions $ do

1211 (path:_) <- getArgs

13− input <- readFile path

12+ r <- ormoluFile defaultConfig path

13+ TIO.putStr r

14+ -- TIO.

1415

15− (ws, r) <- parseModule [] path input

16− unless (null ws) $

17− putStrLn "dynamic option warnings:"

18− case r of

19− Left (srcSpan, err) -> do

20− putStrLn (showOutputable srcSpan)

21− putStrLn err

22− Right (anns, parsedModule) -> do

23− putStrLn "\nannotations:\n"

24− putStrLn (showOutputable anns)

25− putStrLn "\nparsed module:\n"

26− putStrLn (showOutputable parsedModule)

27− TIO.putStr (printModule anns parsedModule)

16+ -- input <- readFile path

2817

29−showOutputable :: GHC.Outputable o => o -> String

30−showOutputable = GHC.showSDocUnsafe . GHC.ppr

18+ -- (ws, r) <- parseModule [] path input

19+ -- unless (null ws) $

20+ -- putStrLn "dynamic option warnings:"

21+ -- case r of

22+ -- Left (srcSpan, err) -> do

23+ -- putStrLn (showOutputable srcSpan)

24+ -- putStrLn err

25+ -- Right (anns, parsedModule) -> do

26+ -- putStrLn "\nannotations:\n"

27+ -- putStrLn (showOutputable anns)

28+ -- putStrLn "\nparsed module:\n"

29+ -- putStrLn (showOutputable parsedModule)

30+

31+-- showOutputable :: GHC.Outputable o => o -> String

32+-- showOutputable = GHC.showSDocUnsafe . GHC.ppr

ormolu.cabal+1

@@ -40,6 +40,7 @@ library

4040 , Ormolu.Comments

4141 , Ormolu.Config

4242 , Ormolu.Diff

43+ , Ormolu.Exception

4344 , Ormolu.Parser

4445 , Ormolu.Printer

4546 , Ormolu.Printer.Combinators

src/Ormolu.hs+8−21

@@ -9,17 +9,18 @@ module Ormolu

99 , defaultConfig

1010 , DynOption (..)

1111 , OrmoluException (..)

12+ , withPrettyOrmoluExceptions

1213 )

1314where

1415

1516import Control.Exception

1617import Control.Monad

17−import Control.Monad.Catch (MonadThrow (..))

1818import Control.Monad.IO.Class (MonadIO (..))

1919import Data.Text (Text)

2020import Language.Haskell.GHC.ExactPrint.Types

2121import Ormolu.Config

2222import Ormolu.Diff

23+import Ormolu.Exception

2324import Ormolu.Parser

2425import Ormolu.Printer

2526import qualified Data.Text as T

@@ -37,7 +38,7 @@ import qualified GHC

3738-- * Throws 'OrmoluException'.

3839

3940ormolu

40− :: (MonadIO m, MonadThrow m)

41+ :: MonadIO m

4142 => Config -- ^ Ormolu configuration

4243 -> FilePath -- ^ Location of source file

4344 -> String -- ^ Input to format

@@ -51,7 +52,7 @@ ormolu cfg path str = do

5152 (anns1, parsedSrc1) <-

5253 parseModule' cfg OrmoluOutputParsingFailed "<rendered>" (T.unpack txt)

5354 when (diff (anns0, parsedSrc0) (anns1, parsedSrc1)) $

54− throwM (OrmoluASTDiffers str txt)

55+ liftIO $ throwIO (OrmoluASTDiffers str txt)

5556 return txt

5657

5758-- | Load a file and format it. The file stays intact and the rendered

@@ -61,7 +62,7 @@ ormolu cfg path str = do

6162-- > liftIO (readFile path) >>= ormolu cfg path

6263

6364ormoluFile

64− :: (MonadIO m, MonadThrow m)

65+ :: MonadIO m

6566 => Config -- ^ Ormolu configuration

6667 -> FilePath -- ^ Location of source file

6768 -> m Text -- ^ Resulting rendition

@@ -71,7 +72,7 @@ ormoluFile cfg path =

7172-- | A wrapper around 'parseModule'.

7273

7374parseModule'

74− :: (MonadIO m, MonadThrow m)

75+ :: MonadIO m

7576 => Config -- ^ Ormolu configuration

7677 -> (GHC.SrcSpan -> String -> OrmoluException)

7778 -- ^ How to obtain 'OrmoluException' to throw when parsing fails

@@ -79,21 +80,7 @@ parseModule'

7980 -> String -- ^ Actual input for the parser

8081 -> m (Anns, GHC.ParsedSource) -- ^ Annotations and parsed source

8182parseModule' Config {..} mkException path str = do

82− (_, r) <- liftIO (parseModule cfgDynOptions path str)

83+ (_, r) <- parseModule cfgDynOptions path str

8384 case r of

84− Left (spn, err) -> throwM (mkException spn err)

85+ Left (spn, err) -> liftIO $ throwIO (mkException spn err)

8586 Right x -> return x

86−

87−-- | Ormolu exception representing all cases when 'ormoluFile' can fail.

88−

89−data OrmoluException

90− = OrmoluParsingFailed GHC.SrcSpan String

91− -- ^ Parsing of original source code failed

92− | OrmoluOutputParsingFailed GHC.SrcSpan String

93− -- ^ Parsing of formatted source code failed

94− | OrmoluASTDiffers String Text

95− -- ^ Original and resulting ASTs differ, first argument is the original

96− -- source code, second argument is rendered source code

97− deriving (Eq, Show)

98−

99−instance Exception OrmoluException

src/Ormolu/Exception.hsnew file+70

@@ -0,0 +1,70 @@

1+-- | 'OrmoluException' type and surrounding definitions.

3+{-# LANGUAGE LambdaCase #-}

5+module Ormolu.Exception

6+ ( OrmoluException (..)

7+ , withPrettyOrmoluExceptions

8+ )

9+where

10+

11+import Control.Exception

12+import Data.Text (Text)

13+import System.Exit (exitFailure)

14+import System.IO

15+import qualified GHC

16+import qualified Outputable as GHC

17+

18+-- | Ormolu exception representing all cases when 'ormoluFile' can fail.

19+

20+data OrmoluException

21+ = OrmoluCppEnabled

22+ -- ^ Ormolu does not work with source files that use CPP

23+ | OrmoluParsingFailed GHC.SrcSpan String

24+ -- ^ Parsing of original source code failed

25+ | OrmoluOutputParsingFailed GHC.SrcSpan String

26+ -- ^ Parsing of formatted source code failed

27+ | OrmoluASTDiffers String Text

28+ -- ^ Original and resulting ASTs differ, first argument is the original

29+ -- source code, second argument is rendered source code

30+ deriving (Eq, Show)

31+

32+instance Exception OrmoluException where

33+ displayException = \case

34+ OrmoluCppEnabled -> "CPP is not supported"

35+ OrmoluParsingFailed s e ->

36+ showParsingErr "parsing of source code failed:" s e

37+ OrmoluOutputParsingFailed s e ->

38+ showParsingErr "parsing of formatted code failed (report the bug):" s e

39+ OrmoluASTDiffers _ _ ->

40+ "AST of input and AST of formatted code differ, report the bug"

41+

42+-- | Inside this wrapper 'OrmoluException' will be caught and displayed

43+-- nicely using 'displayException'.

44+

45+withPrettyOrmoluExceptions

46+ :: IO a -- ^ Action that may throw the exception

47+ -> IO a

48+withPrettyOrmoluExceptions m = m `catch` h

49+ where

50+ h :: OrmoluException -> IO a

51+ h e = do

52+ hPutStrLn stderr (displayException e)

53+ exitFailure

54+

55+----------------------------------------------------------------------------

56+-- Helpers

57+

58+-- | Show a parse error.

59+

60+showParsingErr :: String -> GHC.SrcSpan -> String -> String

61+showParsingErr msg spn err = unlines

62+ [ msg

63+ , showOutputable spn

64+ , err

65+ ]

66+

67+-- | Display something 'GHC.Outputable'.

68+

69+showOutputable :: GHC.Outputable o => o -> String

70+showOutputable = GHC.showSDocUnsafe . GHC.ppr

src/Ormolu/Parser.hs+22−8

@@ -1,12 +1,18 @@

11-- | Parser for Haskell source code.

33module Ormolu.Parser

4− ( parseModule )

4+ ( parseModule

5+ )

56where

8+import Control.Exception

9+import Control.Monad

10+import Control.Monad.IO.Class

11+import GHC.LanguageExtensions.Type (Extension (Cpp))

712import Language.Haskell.GHC.ExactPrint.Parsers hiding (parseModule)

813import Language.Haskell.GHC.ExactPrint.Types

914import Ormolu.Config

15+import Ormolu.Exception

1016import qualified CmdLineParser as GHC

1117import qualified DynFlags as GHC

1218import qualified GHC hiding (parseModule)

@@ -14,12 +20,20 @@ import qualified GHC hiding (parseModule)

1420-- | Parse a complete module from string.

1521

1622parseModule

17− :: [DynOption] -- ^ Dynamic options that affect parsing

23+ :: MonadIO m

24+ => [DynOption] -- ^ Dynamic options that affect parsing

1825 -> FilePath -- ^ File name (only for source location annotations)

1926 -> String -- ^ Input for parser

20− -> IO ([GHC.Warn], Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))

21−parseModule dynOpts path input = ghcWrapper $ do

22− dynFlags0 <- initDynFlagsPure path input

23− (dynFlags1, _, ws) <-

24− GHC.parseDynamicFilePragma dynFlags0 (dynOptionToLocatedStr <$> dynOpts)

25− return (ws, parseModuleFromStringInternal dynFlags1 path input)

27+ -> m ([GHC.Warn], Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))

28+parseModule dynOpts path input = liftIO $ do

29+ (ws, dynFlags) <- ghcWrapper $ do

30+ dynFlags0 <- initDynFlagsPure path input

31+ (dynFlags1, _, ws) <-

32+ GHC.parseDynamicFilePragma dynFlags0 (dynOptionToLocatedStr <$> dynOpts)

33+ return (ws, dynFlags1)

34+ -- NOTE It's better to throw this outside of 'ghcWrapper' because

35+ -- otherwise the exception will be wrapped as a GHC panic, which we don't

36+ -- want.

37+ when (GHC.xopt Cpp dynFlags) $

38+ throwIO OrmoluCppEnabled

39+ return (ws, parseModuleFromStringInternal dynFlags path input)

src/Ormolu/Printer.hs+2−1

@@ -5,7 +5,8 @@

55-- | Pretty-printer for Haskell AST.

77module Ormolu.Printer

8− ( printModule )

8+ ( printModule

9+ )

910where

1011

1112import Data.Char (isAlphaNum)