68 lines
2.6 KiB
Haskell
68 lines
2.6 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
|
|
module Language.Haskell.Brittany.Internal.PerDecl
|
|
( ppToplevelDecl
|
|
) where
|
|
|
|
import Language.Haskell.Brittany.Internal.Prelude
|
|
|
|
import qualified GHC
|
|
import GHC ( EpaCommentTok
|
|
, GenLocated(L)
|
|
, LHsDecl
|
|
, SrcSpanAnn'(SrcSpanAnn)
|
|
)
|
|
|
|
import Language.Haskell.Brittany.Internal.Config.Types
|
|
import Language.Haskell.Brittany.Internal.Config.Types.Instances2
|
|
( )
|
|
import Language.Haskell.Brittany.Internal.ToBriDocTools
|
|
import Language.Haskell.Brittany.Internal.WriteBriDoc
|
|
( ppBriDoc )
|
|
import Language.Haskell.Brittany.Internal.ToBriDoc.Decl
|
|
import Language.Haskell.Brittany.Internal.ToBriDoc.Comment
|
|
import Language.Haskell.Brittany.Internal.Types
|
|
import Language.Haskell.Brittany.Internal.ToBriDoc
|
|
( layouters )
|
|
|
|
|
|
|
|
ppToplevelDecl :: LHsDecl GhcPs -> [(Int, EpaCommentTok)] -> PPMLocal ()
|
|
ppToplevelDecl decl immediateAfterComms = do
|
|
exactprintOnly <- mAsk <&> \declConfig ->
|
|
declConfig & _conf_roundtrip_exactprint_only & confUnpack
|
|
bd <- fmap fst $ if exactprintOnly
|
|
then briDocMToPPM layouters $ docSeq
|
|
(briDocByExactNoComment decl : map commentToDoc immediateAfterComms)
|
|
else do
|
|
let innerDoc = case decl of
|
|
L (SrcSpanAnn _ (GHC.RealSrcSpan s _)) _ ->
|
|
docFlushRemaining (GHC.srcSpanFile s) $ layoutDecl decl
|
|
_ -> layoutDecl decl
|
|
(r, errorCount) <- briDocMToPPM layouters $ docSeq
|
|
(innerDoc : map commentToDoc immediateAfterComms)
|
|
if errorCount == 0
|
|
then pure (r, 0)
|
|
else briDocMToPPM layouters $ briDocByExactNoComment decl
|
|
ppBriDoc bd False
|
|
let commCntIn = connectedCommentCount decl
|
|
commCntOut <- mGet
|
|
when (commCntIn /= commCntOut) $ if commCntOut < commCntIn
|
|
then mTell
|
|
[ ErrorUnusedComments decl
|
|
(unCommentCounter commCntIn)
|
|
(unCommentCounter commCntOut)
|
|
]
|
|
else mTell
|
|
[ ErrorUnusedComments decl
|
|
(unCommentCounter commCntIn)
|
|
(unCommentCounter commCntOut)
|
|
]
|
|
-- error
|
|
-- $ "internal brittany error: inconsistent comment count ("
|
|
-- ++ show commCntOut
|
|
-- ++ ">"
|
|
-- ++ show commCntIn
|
|
-- ++ ")!"
|