Append input path name to UnknownNode errors #185

Merged
5outh merged 2 commits from benjamin/file-name-errors into master 2018-09-23 22:29:43 +02:00
4 changed files with 23 additions and 14 deletions

View File

@ -15,6 +15,11 @@ import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Monoid import qualified Data.Monoid
import GHC ( GenLocated(L) )
import Outputable ( Outputable(..)
, showSDocUnsafe
)
import Text.Read ( Read(..) ) import Text.Read ( Read(..) )
import qualified Text.ParserCombinators.ReadP as ReadP import qualified Text.ParserCombinators.ReadP as ReadP
import qualified Text.ParserCombinators.ReadPrec as ReadPrec import qualified Text.ParserCombinators.ReadPrec as ReadPrec
@ -384,8 +389,8 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
uns@(ErrorUnknownNode{} : _) -> do uns@(ErrorUnknownNode{} : _) -> do
putErrorLn $ "ERROR: encountered unknown syntactical constructs:" putErrorLn $ "ERROR: encountered unknown syntactical constructs:"
uns `forM_` \case uns `forM_` \case
ErrorUnknownNode str ast -> do ErrorUnknownNode str ast@(L loc _) -> do
putErrorLn str putErrorLn $ str <> " at " <> showSDocUnsafe (ppr loc)
when when
( config ( config
& _conf_debug & _conf_debug

View File

@ -694,7 +694,10 @@ docEnsureIndent
docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd
unknownNodeError unknownNodeError
:: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered :: Data.Data.Data ast
=> String
-> GenLocated GHC.SrcSpan ast
-> ToBriDocM BriDocNumbered
unknownNodeError infoStr ast = do unknownNodeError infoStr ast = do
mTell [ErrorUnknownNode infoStr ast] mTell [ErrorUnknownNode infoStr ast]
docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}" docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"

View File

@ -27,7 +27,7 @@ import Language.Haskell.Brittany.Internal.ExactPrintUtils
import Language.Haskell.Brittany.Internal.Utils import Language.Haskell.Brittany.Internal.Utils
import GHC ( runGhc, GenLocated(L), moduleNameString ) import GHC ( runGhc, GenLocated(L), moduleNameString )
import SrcLoc ( SrcSpan ) import SrcLoc ( SrcSpan, noSrcSpan )
import HsSyn import HsSyn
import Name import Name
import BasicTypes ( InlinePragma(..) import BasicTypes ( InlinePragma(..)
@ -202,20 +202,21 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
-- x@(HsValBinds (ValBindsIn{})) -> -- x@(HsValBinds (ValBindsIn{})) ->
-- Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x -- Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x
HsValBinds (ValBindsIn bindlrs sigs) -> do HsValBinds (ValBindsIn bindlrs sigs) -> do
let let unordered =
unordered [ BagBind b | b <- Data.Foldable.toList bindlrs ]
= [ BagBind b | b <- Data.Foldable.toList bindlrs ] ++ [ BagSig s | s <- sigs ]
++ [ BagSig s | s <- sigs ] ordered = sortBy (comparing bindOrSigtoSrcSpan) unordered
ordered = sortBy (comparing bindOrSigtoSrcSpan) unordered
docs <- docWrapNode lbinds $ join <$> ordered `forM` \case docs <- docWrapNode lbinds $ join <$> ordered `forM` \case
BagBind b -> either id return <$> layoutBind b BagBind b -> either id return <$> layoutBind b
BagSig s -> return <$> layoutSig s BagSig s -> return <$> layoutSig s
return $ Just $ docs return $ Just $ docs
x@(HsValBinds (ValBindsOut _binds _lsigs)) -> x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
-- i _think_ this case never occurs in non-processed ast -- i _think_ this case never occurs in non-processed ast
Just . (:[]) <$> unknownNodeError "HsValBinds ValBindsOut{}" x Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}"
x@(HsIPBinds _ipBinds) -> Just . (:[]) <$> unknownNodeError "HsIPBinds" x (L noSrcSpan x)
EmptyLocalBinds -> return $ Nothing 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 -- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is
-- parSpacing stuff.B -- parSpacing stuff.B

View File

@ -17,7 +17,7 @@ import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import qualified Data.Text.Lazy.Builder as Text.Builder 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 ( AnnKey, Comment )
import Language.Haskell.GHC.ExactPrint.Types ( KeywordId, Anns, DeltaPos, mkAnnKey ) import Language.Haskell.GHC.ExactPrint.Types ( KeywordId, Anns, DeltaPos, mkAnnKey )
@ -134,7 +134,7 @@ data BrittanyError
-- output and second the corresponding, ill-formed input. -- output and second the corresponding, ill-formed input.
| LayoutWarning String | LayoutWarning String
-- ^ some warning -- ^ 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 -- ^ internal error: pretty-printing is not implemented for type of node
-- in the syntax-tree -- in the syntax-tree
| ErrorOutputCheck | ErrorOutputCheck