From dfec26e55b5687bbff575e6cdaa893df444afa12 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <lsp@informatik.uni-kiel.de>
Date: Tue, 23 May 2017 00:09:42 +0200
Subject: [PATCH] Refactor/Rename LayoutError -> BrittanyError
---
src-brittany/Main.hs | 24 +++++-----
src/Language/Haskell/Brittany.hs | 2 +-
src/Language/Haskell/Brittany/Internal.hs | 46 +++++++++----------
.../Brittany/Internal/LayouterBasics.hs | 4 +-
.../Haskell/Brittany/Internal/Types.hs | 14 +++---
5 files changed, 43 insertions(+), 47 deletions(-)
diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs
index b1035f8..c4e055b 100644
--- a/src-brittany/Main.hs
+++ b/src-brittany/Main.hs
@@ -159,22 +159,22 @@ mainCmdParser helpDesc = do
else pPrintModuleAndCheck config anns parsedSource
let hackF s = fromMaybe s $ TextL.stripPrefix (TextL.pack "-- BRITTANY_INCLUDE_HACK ") s
pure $ if hackAroundIncludes then (ews, TextL.unlines $ fmap hackF $ TextL.lines outRaw) else (ews, outRaw)
- let customErrOrder LayoutErrorInput{} = 4
- customErrOrder LayoutWarning{} = 0 :: Int
- customErrOrder LayoutErrorOutputCheck{} = 1
- customErrOrder LayoutErrorUnusedComment{} = 2
- customErrOrder LayoutErrorUnknownNode{} = 3
+ let customErrOrder ErrorInput{} = 4
+ customErrOrder LayoutWarning{} = 0 :: Int
+ customErrOrder ErrorOutputCheck{} = 1
+ customErrOrder ErrorUnusedComment{} = 2
+ customErrOrder ErrorUnknownNode{} = 3
when (not $ null errsWarns) $ do
let groupedErrsWarns = Data.List.Extra.groupOn customErrOrder $ List.sortOn customErrOrder $ errsWarns
groupedErrsWarns `forM_` \case
- (LayoutErrorOutputCheck{}:_) -> do
+ (ErrorOutputCheck{}:_) -> do
putStrErrLn $ "ERROR: brittany pretty printer" ++ " returned syntactically invalid result."
- (LayoutErrorInput str:_) -> do
+ (ErrorInput str:_) -> do
putStrErrLn $ "ERROR: parse error: " ++ str
- uns@(LayoutErrorUnknownNode{}:_) -> do
+ uns@(ErrorUnknownNode{}:_) -> do
putStrErrLn $ "ERROR: encountered unknown syntactical constructs:"
uns `forM_` \case
- LayoutErrorUnknownNode str ast -> do
+ ErrorUnknownNode str ast -> do
putStrErrLn str
when (config & _conf_debug & _dconf_dump_ast_unknown & confUnpack) $ do
putStrErrLn $ " " ++ show (astToDoc ast)
@@ -184,7 +184,7 @@ mainCmdParser helpDesc = do
warns `forM_` \case
LayoutWarning str -> putStrErrLn str
_ -> error "cannot happen (TM)"
- unused@(LayoutErrorUnusedComment{}:_) -> do
+ unused@(ErrorUnusedComment{}:_) -> do
putStrErrLn
$ "Error: detected unprocessed comments."
++ " The transformation output will most likely"
@@ -192,8 +192,8 @@ mainCmdParser helpDesc = do
++ " present in the input haskell source file."
putStrErrLn $ "Affected are the following comments:"
unused `forM_` \case
- LayoutErrorUnusedComment str -> putStrErrLn str
- _ -> error "cannot happen (TM)"
+ ErrorUnusedComment str -> putStrErrLn str
+ _ -> error "cannot happen (TM)"
[] -> error "cannot happen"
-- TODO: don't output anything when there are errors unless user
-- adds some override?
diff --git a/src/Language/Haskell/Brittany.hs b/src/Language/Haskell/Brittany.hs
index ac0b90d..67bae06 100644
--- a/src/Language/Haskell/Brittany.hs
+++ b/src/Language/Haskell/Brittany.hs
@@ -3,7 +3,7 @@
module Language.Haskell.Brittany
( pureModuleTransform
, CConfig
- , LayoutError(..)
+ , BrittanyError(..)
)
where
diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs
index 5bbfc54..d799290 100644
--- a/src/Language/Haskell/Brittany/Internal.hs
+++ b/src/Language/Haskell/Brittany/Internal.hs
@@ -60,7 +60,7 @@ import qualified GHC.LanguageExtensions.Type as GHC
--
-- Note that this function ignores/resets all config values regarding
-- debugging, i.e. it will never use `trace`/write to stderr.
-pureModuleTransform :: CConfig Option -> Text -> IO (Either [LayoutError] Text)
+pureModuleTransform :: CConfig Option -> Text -> IO (Either [BrittanyError] Text)
pureModuleTransform oConfigRaw inputText = runEitherT $ do
let configRaw = cZipWith fromOptionIdentity staticDefaultConfig oConfigRaw
let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }
@@ -87,7 +87,7 @@ pureModuleTransform oConfigRaw inputText = runEitherT $ do
cppCheckFunc
(hackTransform $ Text.unpack inputText)
case parseResult of
- Left err -> left $ [LayoutErrorInput err]
+ Left err -> left $ [ErrorInput err]
Right x -> pure $ x
(errsWarns, outputTextL) <- do
let omitCheck =
@@ -103,21 +103,19 @@ pureModuleTransform oConfigRaw inputText = runEitherT $ do
pure $ if hackAroundIncludes
then (ews, TextL.unlines $ fmap hackF $ TextL.lines outRaw)
else (ews, outRaw)
- let customErrOrder LayoutErrorInput{} = 4
- customErrOrder LayoutWarning{} = 0 :: Int
- customErrOrder LayoutErrorOutputCheck{} = 1
- customErrOrder LayoutErrorUnusedComment{} = 2
- customErrOrder LayoutErrorUnknownNode{} = 3
+ let customErrOrder ErrorInput{} = 4
+ customErrOrder LayoutWarning{} = 0 :: Int
+ customErrOrder ErrorOutputCheck{} = 1
+ customErrOrder ErrorUnusedComment{} = 2
+ customErrOrder ErrorUnknownNode{} = 3
let hasErrors =
case config & _conf_errorHandling & _econf_Werror & confUnpack of
False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
True -> not $ null errsWarns
- if hasErrors
- then left $ errsWarns
- else pure $ TextL.toStrict outputTextL
+ if hasErrors then left $ errsWarns else pure $ TextL.toStrict outputTextL
--- LayoutErrors can be non-fatal warnings, thus both are returned instead
+-- BrittanyErrors can be non-fatal warnings, thus both are returned instead
-- of an Either.
-- This should be cleaned up once it is clear what kinds of errors really
-- can occur.
@@ -125,7 +123,7 @@ pPrintModule
:: Config
-> ExactPrint.Types.Anns
-> GHC.ParsedSource
- -> ([LayoutError], TextL.Text)
+ -> ([BrittanyError], TextL.Text)
pPrintModule conf anns parsedModule =
let
((out, errs), debugStrings) =
@@ -160,7 +158,7 @@ pPrintModuleAndCheck
:: Config
-> ExactPrint.Types.Anns
-> GHC.ParsedSource
- -> IO ([LayoutError], TextL.Text)
+ -> IO ([BrittanyError], TextL.Text)
pPrintModuleAndCheck conf anns parsedModule = do
let ghcOptions = conf & _conf_forward & _options_ghc & runIdentity
let (errs, output) = pPrintModule conf anns parsedModule
@@ -169,7 +167,7 @@ pPrintModuleAndCheck conf anns parsedModule = do
(\_ -> return $ Right ())
(TextL.unpack output)
let errs' = errs ++ case parseResult of
- Left{} -> [LayoutErrorOutputCheck]
+ Left{} -> [ErrorOutputCheck]
Right{} -> []
return (errs', output)
@@ -193,15 +191,13 @@ parsePrintModule conf filename input = do
return $ if null errs
then Right $ TextL.toStrict $ ltext
else
- let
- errStrs = errs <&> \case
- LayoutErrorInput str -> str
- LayoutErrorUnusedComment str -> str
- LayoutWarning str -> str
- LayoutErrorUnknownNode str _ -> str
- LayoutErrorOutputCheck -> "Output is not syntactically valid."
- in
- Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
+ let errStrs = errs <&> \case
+ ErrorInput str -> str
+ ErrorUnusedComment str -> str
+ LayoutWarning str -> str
+ ErrorUnknownNode str _ -> str
+ ErrorOutputCheck -> "Output is not syntactically valid."
+ in Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
-- this approach would for with there was a pure GHC.parseDynamicFilePragma.
@@ -234,7 +230,7 @@ parsePrintModule conf filename input = do
-- if (not $ null errs)
-- then do
-- let errStrs = errs <&> \case
--- LayoutErrorUnusedComment str -> str
+-- ErrorUnusedComment str -> str
-- Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
-- else return $ TextL.toStrict $ Text.Builder.toLazyText out
@@ -396,6 +392,6 @@ layoutBriDoc ast briDoc = do
let remainingComments =
extractAllComments =<< Map.elems (_lstate_comments state')
remainingComments
- `forM_` (fst .> show .> LayoutErrorUnusedComment .> (:[]) .> mTell)
+ `forM_` (fst .> show .> ErrorUnusedComment .> (:[]) .> mTell)
return $ ()
diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
index 7ef4123..5314fcf 100644
--- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
+++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
@@ -156,7 +156,7 @@ briDocByExactInlineOnly infoStr ast = do
exactPrinted
let
errorAction = do
- mTell $ [LayoutErrorUnknownNode infoStr ast]
+ mTell $ [ErrorUnknownNode infoStr ast]
docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
case (fallbackMode, Text.lines exactPrinted) of
(ExactPrintFallbackModeNever, _ ) -> errorAction
@@ -607,7 +607,7 @@ docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd
unknownNodeError
:: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered
unknownNodeError infoStr ast = do
- mTell $ [LayoutErrorUnknownNode infoStr ast]
+ mTell $ [ErrorUnknownNode infoStr ast]
docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
spacifyDocs :: [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs
index 5420e7b..08cd750 100644
--- a/src/Language/Haskell/Brittany/Internal/Types.hs
+++ b/src/Language/Haskell/Brittany/Internal/Types.hs
@@ -28,7 +28,7 @@ import Data.Generics.Uniplate.Direct as Uniplate
-type PPM a = MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] '[Text.Builder.Builder, [LayoutError], Seq String] '[] a
+type PPM a = MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] '[Text.Builder.Builder, [BrittanyError], Seq String] '[] a
data LayoutState = LayoutState
{ _lstate_baseYs :: [Int]
@@ -114,17 +114,17 @@ instance Show LayoutState where
-- , _lsettings_initialAnns :: ExactPrint.Anns
-- }
-data LayoutError
- = LayoutErrorInput String
+data BrittanyError
+ = ErrorInput String
-- ^ parsing failed
- | LayoutErrorUnusedComment String
+ | ErrorUnusedComment String
-- ^ internal error: some comment went missing
| LayoutWarning String
-- ^ some warning
- | forall ast . Data.Data.Data ast => LayoutErrorUnknownNode String ast
+ | forall ast . Data.Data.Data ast => ErrorUnknownNode String ast
-- ^ internal error: pretty-printing is not implemented for type of node
-- in the syntax-tree
- | LayoutErrorOutputCheck
+ | ErrorOutputCheck
-- ^ checking the output for syntactic validity failed
data BriSpacing = BriSpacing
@@ -187,7 +187,7 @@ data BrIndent = BrIndentNone
| BrIndentSpecial Int
deriving (Eq, Ord, Typeable, Data.Data.Data, Show)
-type ToBriDocM = MultiRWSS.MultiRWS '[Config, Anns] '[[LayoutError], Seq String] '[NodeAllocIndex]
+type ToBriDocM = MultiRWSS.MultiRWS '[Config, Anns] '[[BrittanyError], Seq String] '[NodeAllocIndex]
type ToBriDoc (sym :: * -> *) = Located (sym RdrName) -> ToBriDocM BriDocNumbered
type ToBriDoc' sym = Located sym -> ToBriDocM BriDocNumbered