b2e05d6 · ormolu · git.iko.soy

git.iko.soy/ormolu

on master help sign in

Throw exception when CPP is enabled (plus some refactoring)

b2e05d6mrkkrp8 years ago

app/Main.hs+23−21

compare with master

unifiedsplit

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

1module Main (main) where

3−import Control.Monad

3+-- import Control.Monad

4−import Ormolu.Parser

4+import Ormolu

5−import Ormolu.Printer

6import System.Environment (getArgs)

5import System.Environment (getArgs)

7import qualified Data.Text.IO as TIO

6import qualified Data.Text.IO as TIO

8−import qualified Outputable as GHC

7+-- import qualified Outputable as GHC

10main :: IO ()

9main :: IO ()

11−main = do

10+main = withPrettyOrmoluExceptions $ do

12 (path:_) <- getArgs

11 (path:_) <- getArgs

13− input <- readFile path

12+ r <- ormoluFile defaultConfig path

13+ TIO.putStr r

14+ -- TIO.

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

16+ -- input <- readFile path

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)

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+

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

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

30−showOutputable = GHC.showSDocUnsafe . GHC.ppr

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

ormolu.cabal+1

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

40 , Ormolu.Comments

41 , Ormolu.Config

42 , Ormolu.Diff

43+ , Ormolu.Exception

43 , Ormolu.Parser

44 , Ormolu.Parser

44 , Ormolu.Printer

45 , Ormolu.Printer

45 , Ormolu.Printer.Combinators

46 , Ormolu.Printer.Combinators

src/Ormolu.hs+8−21

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

9 , defaultConfig

10 , DynOption (..)

11 , OrmoluException (..)

12+ , withPrettyOrmoluExceptions

12 )

13 )

13where

14where

15import Control.Exception

16import Control.Exception

16import Control.Monad

17import Control.Monad

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

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

19import Data.Text (Text)

20import Language.Haskell.GHC.ExactPrint.Types

21import Ormolu.Config

22import Ormolu.Diff

23+import Ormolu.Exception

23import Ormolu.Parser

24import Ormolu.Parser

24import Ormolu.Printer

25import Ormolu.Printer

25import qualified Data.Text as T

26import qualified Data.Text as T

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

37-- * Throws 'OrmoluException'.

38-- * Throws 'OrmoluException'.

39ormolu

40ormolu

40− :: (MonadIO m, MonadThrow m)

41+ :: MonadIO m

41 => Config -- ^ Ormolu configuration

42 => Config -- ^ Ormolu configuration

42 -> FilePath -- ^ Location of source file

43 -> FilePath -- ^ Location of source file

43 -> String -- ^ Input to format

44 -> String -- ^ Input to format

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

51 (anns1, parsedSrc1) <-

52 (anns1, parsedSrc1) <-

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

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

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

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

54− throwM (OrmoluASTDiffers str txt)

55+ liftIO $ throwIO (OrmoluASTDiffers str txt)

55 return txt

56 return txt

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

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

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

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

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

63ormoluFile

64ormoluFile

64− :: (MonadIO m, MonadThrow m)

65+ :: MonadIO m

65 => Config -- ^ Ormolu configuration

66 => Config -- ^ Ormolu configuration

66 -> FilePath -- ^ Location of source file

67 -> FilePath -- ^ Location of source file

67 -> m Text -- ^ Resulting rendition

68 -> m Text -- ^ Resulting rendition

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

71-- | A wrapper around 'parseModule'.

72-- | A wrapper around 'parseModule'.

73parseModule'

74parseModule'

74− :: (MonadIO m, MonadThrow m)

75+ :: MonadIO m

75 => Config -- ^ Ormolu configuration

76 => Config -- ^ Ormolu configuration

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

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

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

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

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

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

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

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

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

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

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

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

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

83 case r of

84 case r of

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

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

85 Right x -> return x

86 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 @@

1-- | Parser for Haskell source code.

3module Ormolu.Parser

4− ( parseModule )

4+ ( parseModule

5+ )

5where

6where

8+import Control.Exception

9+import Control.Monad

10+import Control.Monad.IO.Class

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

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

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

8import Language.Haskell.GHC.ExactPrint.Types

13import Language.Haskell.GHC.ExactPrint.Types

9import Ormolu.Config

14import Ormolu.Config

15+import Ormolu.Exception

10import qualified CmdLineParser as GHC

16import qualified CmdLineParser as GHC

11import qualified DynFlags as GHC

17import qualified DynFlags as GHC

12import qualified GHC hiding (parseModule)

18import qualified GHC hiding (parseModule)

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

14-- | Parse a complete module from string.

20-- | Parse a complete module from string.

16parseModule

22parseModule

23+ :: MonadIO m

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

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

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

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

19 -> String -- ^ Input for parser

26 -> String -- ^ Input for parser

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

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

21−parseModule dynOpts path input = ghcWrapper $ do

28+parseModule dynOpts path input = liftIO $ do

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

22− dynFlags0 <- initDynFlagsPure path input

30+ dynFlags0 <- initDynFlagsPure path input

23− (dynFlags1, _, ws) <-

31+ (dynFlags1, _, ws) <-

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

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

25− return (ws, parseModuleFromStringInternal dynFlags1 path input)

39+ return (ws, parseModuleFromStringInternal dynFlags path input)

src/Ormolu/Printer.hs+2−1

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

5-- | Pretty-printer for Haskell AST.

7module Ormolu.Printer

8− ( printModule )

8+ ( printModule

9+ )

9where

10where

11import Data.Char (isAlphaNum)

12import Data.Char (isAlphaNum)