From 342cf16c564962a13c56665627cac301bb092923 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Fri, 3 Jan 2020 11:58:53 +0100 Subject: [PATCH 1/2] Improve error message printing - Omit unnecessary show-invocation - Use showOutputable for the error span (location) before/after: "RealSrcSpan SrcSpanPoint \"stdin\" 2 1: parse error (possibly incorrect indentation or mismatched brackets)" stdin:2:1: parse error (possibly incorrect indentation or mismatched brackets) --- src-brittany/Main.hs | 2 +- src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index 527d2e8..423320b 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -325,7 +325,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = case parseResult of Left left -> do putErrorLn "parse error:" - putErrorLn $ show left + putErrorLn left ExceptT.throwE 60 Right (anns, parsedSource, hasCPP) -> do (inlineConf, perItemConf) <- diff --git a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs index 1fabf9c..0273d85 100644 --- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -123,7 +123,7 @@ parseModuleFromString args fp dynCheck str = dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1 let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str case res of - Left (span, err) -> ExceptT.throwE $ show span ++ ": " ++ err + Left (span, err) -> ExceptT.throwE $ showOutputable span ++ ": " ++ err Right (a , m ) -> pure (a, m, dynCheckRes) From d0256bb0dba8d085ef2c19a48b46b79d5159abb0 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Fri, 3 Jan 2020 11:58:53 +0100 Subject: [PATCH 2/2] Make unknown syntax errors non-fatal/Fall back on exactprint --- src-brittany/Main.hs | 9 +++++---- src/Language/Haskell/Brittany/Internal.hs | 12 +++++++++--- .../Haskell/Brittany/Internal/LayouterBasics.hs | 12 +++++++++--- src/Language/Haskell/Brittany/Internal/Types.hs | 5 ++++- 4 files changed, 27 insertions(+), 11 deletions(-) diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index 423320b..ff59b4c 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -374,10 +374,10 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = else pure out pure $ (ews, out') let customErrOrder ErrorInput{} = 4 - customErrOrder LayoutWarning{} = 0 :: Int + customErrOrder LayoutWarning{} = -1 :: Int customErrOrder ErrorOutputCheck{} = 1 customErrOrder ErrorUnusedComment{} = 2 - customErrOrder ErrorUnknownNode{} = 3 + customErrOrder ErrorUnknownNode{} = -2 :: Int customErrOrder ErrorMacroConfig{} = 5 when (not $ null errsWarns) $ do let groupedErrsWarns = @@ -392,10 +392,10 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = (ErrorInput str : _) -> do putErrorLn $ "ERROR: parse error: " ++ str uns@(ErrorUnknownNode{} : _) -> do - putErrorLn $ "ERROR: encountered unknown syntactical constructs:" + putErrorLn $ "WARNING: encountered unknown syntactical constructs:" uns `forM_` \case ErrorUnknownNode str ast@(L loc _) -> do - putErrorLn $ str <> " at " <> showSDocUnsafe (ppr loc) + putErrorLn $ " " <> str <> " at " <> showSDocUnsafe (ppr loc) when ( config & _conf_debug @@ -405,6 +405,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = $ do putErrorLn $ " " ++ show (astToDoc ast) _ -> error "cannot happen (TM)" + putErrorLn " -> falling back on exactprint for this element of the module" warns@(LayoutWarning{} : _) -> do putErrorLn $ "WARNINGS:" warns `forM_` \case diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs index e98c0fc..f2e4c11 100644 --- a/src/Language/Haskell/Brittany/Internal.hs +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -460,9 +460,15 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do let exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack toLocal config' filteredAnns $ do - bd <- briDocMToPPM $ if exactprintOnly - then briDocByExactNoComment decl - else layoutDecl decl + bd <- if exactprintOnly + then briDocMToPPM $ briDocByExactNoComment decl + else do + (r, errs, debugs) <- briDocMToPPMInner $ layoutDecl decl + mTell debugs + mTell errs + if null errs + then pure r + else briDocMToPPM $ briDocByExactNoComment decl layoutBriDoc bd let finalComments = filter diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 6263f50..76ec7a3 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -62,6 +62,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , docTick , spacifyDocs , briDocMToPPM + , briDocMToPPMInner , allocateNode , docSharedWrapper , hasAnyCommentsBelow @@ -814,6 +815,13 @@ spacifyDocs ds = fmap appSep (List.init ds) ++ [List.last ds] briDocMToPPM :: ToBriDocM a -> PPMLocal a briDocMToPPM m = do + (x, errs, debugs) <- briDocMToPPMInner m + mTell debugs + mTell errs + return x + +briDocMToPPMInner :: ToBriDocM a -> PPMLocal (a, [BrittanyError], Seq String) +briDocMToPPMInner m = do readers <- MultiRWSS.mGetRawR let ((x, errs), debugs) = runIdentity @@ -823,9 +831,7 @@ briDocMToPPM m = do $ MultiRWSS.withMultiWriterAW $ MultiRWSS.withMultiWriterAW $ m - mTell debugs - mTell errs - return x + pure (x, errs, debugs) docSharedWrapper :: Monad m => (x -> m y) -> x -> m (m y) docSharedWrapper f x = return <$> f x diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs index 109013f..620a39b 100644 --- a/src/Language/Haskell/Brittany/Internal/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Types.hs @@ -215,7 +215,10 @@ data BrIndent = BrIndentNone | BrIndentSpecial Int deriving (Eq, Ord, Typeable, Data.Data.Data, Show) -type ToBriDocM = MultiRWSS.MultiRWS '[Config, Anns] '[[BrittanyError], Seq String] '[NodeAllocIndex] +type ToBriDocM = MultiRWSS.MultiRWS + '[Config, Anns] -- reader + '[[BrittanyError], Seq String] -- writer + '[NodeAllocIndex] -- state type ToBriDoc (sym :: * -> *) = Located (sym GhcPs) -> ToBriDocM BriDocNumbered type ToBriDoc' sym = Located sym -> ToBriDocM BriDocNumbered