diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index 4581adf..8bbd111 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -15,6 +15,11 @@ import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers import qualified Data.Map as Map import qualified Data.Monoid +import GHC ( GenLocated(L) ) +import Outputable ( Outputable(..) + , showSDocUnsafe + ) + import Text.Read ( Read(..) ) import qualified Text.ParserCombinators.ReadP as ReadP import qualified Text.ParserCombinators.ReadPrec as ReadPrec @@ -384,8 +389,8 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = uns@(ErrorUnknownNode{} : _) -> do putErrorLn $ "ERROR: encountered unknown syntactical constructs:" uns `forM_` \case - ErrorUnknownNode str ast -> do - putErrorLn str + ErrorUnknownNode str ast@(L loc _) -> do + putErrorLn $ str <> " at " <> showSDocUnsafe (ppr loc) when ( config & _conf_debug diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index d5aac63..d4acb9f 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -694,7 +694,10 @@ docEnsureIndent docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd unknownNodeError - :: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered + :: Data.Data.Data ast + => String + -> GenLocated GHC.SrcSpan ast + -> ToBriDocM BriDocNumbered unknownNodeError infoStr ast = do mTell [ErrorUnknownNode infoStr ast] docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}" diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index ee0596f..4d0440f 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -27,7 +27,7 @@ import Language.Haskell.Brittany.Internal.ExactPrintUtils import Language.Haskell.Brittany.Internal.Utils import GHC ( runGhc, GenLocated(L), moduleNameString ) -import SrcLoc ( SrcSpan ) +import SrcLoc ( SrcSpan, noSrcSpan ) import HsSyn import Name import BasicTypes ( InlinePragma(..) @@ -202,20 +202,21 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of -- x@(HsValBinds (ValBindsIn{})) -> -- Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x HsValBinds (ValBindsIn bindlrs sigs) -> do - let - unordered - = [ BagBind b | b <- Data.Foldable.toList bindlrs ] - ++ [ BagSig s | s <- sigs ] - ordered = sortBy (comparing bindOrSigtoSrcSpan) unordered + let unordered = + [ BagBind b | b <- Data.Foldable.toList bindlrs ] + ++ [ BagSig s | s <- sigs ] + ordered = sortBy (comparing bindOrSigtoSrcSpan) unordered docs <- docWrapNode lbinds $ join <$> ordered `forM` \case BagBind b -> either id return <$> layoutBind b BagSig s -> return <$> layoutSig s return $ Just $ docs x@(HsValBinds (ValBindsOut _binds _lsigs)) -> -- i _think_ this case never occurs in non-processed ast - Just . (:[]) <$> unknownNodeError "HsValBinds ValBindsOut{}" x - x@(HsIPBinds _ipBinds) -> Just . (:[]) <$> unknownNodeError "HsIPBinds" x - EmptyLocalBinds -> return $ Nothing + Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}" + (L noSrcSpan x) + x@(HsIPBinds _ipBinds) -> + Just . (: []) <$> unknownNodeError "HsIPBinds" (L noSrcSpan x) + EmptyLocalBinds -> return $ Nothing -- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is -- parSpacing stuff.B diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs index ded4170..9358c2b 100644 --- a/src/Language/Haskell/Brittany/Internal/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Types.hs @@ -17,7 +17,7 @@ import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types import qualified Data.Text.Lazy.Builder as Text.Builder -import GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeywordId ) +import GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeywordId, SrcSpan ) import Language.Haskell.GHC.ExactPrint ( AnnKey, Comment ) import Language.Haskell.GHC.ExactPrint.Types ( KeywordId, Anns, DeltaPos, mkAnnKey ) @@ -134,7 +134,7 @@ data BrittanyError -- output and second the corresponding, ill-formed input. | LayoutWarning String -- ^ some warning - | forall ast . Data.Data.Data ast => ErrorUnknownNode String ast + | forall ast . Data.Data.Data ast => ErrorUnknownNode String (GenLocated SrcSpan ast) -- ^ internal error: pretty-printing is not implemented for type of node -- in the syntax-tree | ErrorOutputCheck