Append input path name to UnknownNode errors #185
|
@ -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
|
||||
|
|
|
@ -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 -}"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue