Merge pull request #185 from 5outh/benjamin/file-name-errors

Append input path name to UnknownNode errors
pull/187/head
Lennart Spitzner 2018-09-23 22:29:42 +02:00 committed by GitHub
commit 460bd4dd2b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
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.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

View File

@ -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 -}"

View File

@ -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,9 +202,8 @@ 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 ]
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
@ -213,8 +212,10 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
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
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

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 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