diff --git a/source/library/Language/Haskell/Brittany/Internal/Types.hs b/source/library/Language/Haskell/Brittany/Internal/Types.hs index c6b7765..7ee6ecd 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Types.hs +++ b/source/library/Language/Haskell/Brittany/Internal/Types.hs @@ -170,22 +170,34 @@ newtype CommentCounter = CommentCounter { unCommentCounter :: Int } -- to remember to call `docFlushRemaining` in combination with this! briDocMToPPM :: ToBriDocM a -> PPMLocal (a, Int) briDocMToPPM m = do - readers <- MultiRWSS.mGetRawR + readers <- MultiRWSS.mGetRawR initCount <- MultiRWSS.mGet @CommentCounter - let - (((x, errs), debugs), commentCount) = - runIdentity - $ MultiRWSS.runMultiRWSTNil - $ MultiRWSS.withMultiStateAS initCount - $ MultiRWSS.withMultiStateA (NodeAllocIndex 1) - $ MultiRWSS.withMultiReaders readers - $ MultiRWSS.withMultiWriterAW - $ MultiRWSS.withMultiWriterAW - $ m + let (((x, errs), debugs), commentCount) = + runIdentity + $ MultiRWSS.runMultiRWSTNil + $ MultiRWSS.withMultiStateAS initCount + $ MultiRWSS.withMultiStateA (NodeAllocIndex 1) + $ MultiRWSS.withMultiReaders readers + $ MultiRWSS.withMultiWriterAW + $ MultiRWSS.withMultiWriterAW + $ m mTell debugs mTell errs mSet commentCount - pure (x, length errs) + pure + ( x + , sum + [ case e of + ErrorInput{} -> 1 + ErrorUnusedComment{} -> 1 + ErrorUnusedComments{} -> 1 + ErrorMacroConfig{} -> 0 + LayoutWarning{} -> 0 + ErrorUnknownNode{} -> 1 + ErrorOutputCheck{} -> 0 + | e <- errs + ] + )