Refactor/Rename LayoutError -> BrittanyError

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
+          let customErrOrder ErrorInput{}         = 4
               customErrOrder LayoutWarning{}      = 0 :: Int
-              customErrOrder LayoutErrorOutputCheck{}   = 1
+              customErrOrder ErrorOutputCheck{}   = 1
-              customErrOrder LayoutErrorUnusedComment{} = 2
+              customErrOrder ErrorUnusedComment{} = 2
-              customErrOrder LayoutErrorUnknownNode{}   = 3
+              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,7 +192,7 @@ mainCmdParser helpDesc = do
                   ++ " present in the input haskell source file."
                 putStrErrLn $ "Affected are the following comments:"
                 unused `forM_` \case
-                  LayoutErrorUnusedComment str -> putStrErrLn str
+                  ErrorUnusedComment str -> putStrErrLn str
                   _                      -> error "cannot happen (TM)"
               [] -> error "cannot happen"
           -- TODO: don't output anything when there are errors unless user

src/Language/Haskell/Brittany.hs

@@ -3,7 +3,7 @@
 module Language.Haskell.Brittany
   ( pureModuleTransform
   , CConfig
-  , LayoutError(..)
+  , BrittanyError(..)
   )
 where
 

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
+  let customErrOrder ErrorInput{}         = 4
       customErrOrder LayoutWarning{}      = 0 :: Int
-      customErrOrder LayoutErrorOutputCheck{}   = 1
+      customErrOrder ErrorOutputCheck{}   = 1
-      customErrOrder LayoutErrorUnusedComment{} = 2
+      customErrOrder ErrorUnusedComment{} = 2
-      customErrOrder LayoutErrorUnknownNode{}   = 3
+      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
+  if hasErrors then left $ errsWarns else pure $ TextL.toStrict outputTextL
-    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
+          let errStrs = errs <&> \case
-            errStrs = errs <&> \case
+                ErrorInput         str -> str
-              LayoutErrorInput         str -> str
+                ErrorUnusedComment str -> str
-              LayoutErrorUnusedComment str -> str
                 LayoutWarning      str -> str
-              LayoutErrorUnknownNode str _ -> str
+                ErrorUnknownNode str _ -> str
-              LayoutErrorOutputCheck -> "Output is not syntactically valid."
+                ErrorOutputCheck       -> "Output is not syntactically valid."
-          in
+          in  Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
-            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 $ ()

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]

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
+data BrittanyError
-  = LayoutErrorInput String
+  = 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