Fix up exact print utils

pull/356/head
Taylor Fausak 2021-10-29 00:30:59 +00:00 committed by GitHub
parent 8509f5decc
commit dc9e515b79
1 changed files with 39 additions and 0 deletions

View File

@ -20,6 +20,22 @@ import Language.Haskell.Brittany.Internal.Utils
import Data.Data import Data.Data
import Data.HList.HList import Data.HList.HList
#if MIN_VERSION_ghc(9,0,0)
import GHC.Driver.Session ( getDynFlags )
import GHC ( runGhc, GenLocated(L), moduleNameString )
import qualified GHC.Driver.Session as GHC
import qualified GHC as GHC hiding (parseModule)
import qualified GHC.Parser as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Data.FastString as GHC
import qualified GHC.Parser.Lexer as GHC
import qualified GHC.Data.StringBuffer as GHC
import qualified GHC.Utils.Outputable as GHC
import qualified GHC.Driver.CmdLine as GHC
import GHC.Hs
import GHC.Data.Bag
import GHC.Types.SrcLoc ( SrcSpan, Located )
#else
import DynFlags ( getDynFlags ) import DynFlags ( getDynFlags )
import GHC ( runGhc, GenLocated(L), moduleNameString ) import GHC ( runGhc, GenLocated(L), moduleNameString )
import qualified DynFlags as GHC import qualified DynFlags as GHC
@ -41,6 +57,7 @@ import HsSyn
#endif #endif
import SrcLoc ( SrcSpan, Located ) import SrcLoc ( SrcSpan, Located )
#endif
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
@ -153,7 +170,11 @@ commentAnnFixTransformGlob ast = do
annsMap = Map.fromListWith annsMap = Map.fromListWith
(flip const) (flip const)
[ (GHC.realSrcSpanEnd span, annKey) [ (GHC.realSrcSpanEnd span, annKey)
#if MIN_VERSION_ghc(9,0,0)
| (GHC.RealSrcSpan span _, annKey) <- Foldable.toList nodes
#else
| (GHC.RealSrcSpan span, annKey) <- Foldable.toList nodes | (GHC.RealSrcSpan span, annKey) <- Foldable.toList nodes
#endif
] ]
nodes `forM_` (snd .> processComs annsMap) nodes `forM_` (snd .> processComs annsMap)
where where
@ -168,9 +189,14 @@ commentAnnFixTransformGlob ast = do
:: (ExactPrint.Comment, ExactPrint.DeltaPos) :: (ExactPrint.Comment, ExactPrint.DeltaPos)
-> ExactPrint.TransformT Identity Bool -> ExactPrint.TransformT Identity Bool
processCom comPair@(com, _) = processCom comPair@(com, _) =
#if MIN_VERSION_ghc(9,0,0)
case GHC.realSrcSpanStart $ ExactPrint.commentIdentifier com of
comLoc -> case Map.lookupLE comLoc annsMap of
#else
case GHC.srcSpanStart $ ExactPrint.commentIdentifier com of case GHC.srcSpanStart $ ExactPrint.commentIdentifier com of
GHC.UnhelpfulLoc{} -> return True -- retain comment at current node. GHC.UnhelpfulLoc{} -> return True -- retain comment at current node.
GHC.RealSrcLoc comLoc -> case Map.lookupLE comLoc annsMap of GHC.RealSrcLoc comLoc -> case Map.lookupLE comLoc annsMap of
#endif
Just (_, annKey2) | loc1 /= loc2 -> case (con1, con2) of Just (_, annKey2) | loc1 /= loc2 -> case (con1, con2) of
(ExactPrint.CN "RecordCon", ExactPrint.CN "HsRecField") -> (ExactPrint.CN "RecordCon", ExactPrint.CN "HsRecField") ->
move $> False move $> False
@ -179,8 +205,13 @@ commentAnnFixTransformGlob ast = do
where where
ExactPrint.AnnKey annKeyLoc1 con1 = annKey1 ExactPrint.AnnKey annKeyLoc1 con1 = annKey1
ExactPrint.AnnKey annKeyLoc2 con2 = annKey2 ExactPrint.AnnKey annKeyLoc2 con2 = annKey2
#if MIN_VERSION_ghc(9,0,0)
loc1 = GHC.realSrcSpanStart annKeyLoc1
loc2 = GHC.realSrcSpanStart annKeyLoc2
#else
loc1 = GHC.srcSpanStart annKeyLoc1 loc1 = GHC.srcSpanStart annKeyLoc1
loc2 = GHC.srcSpanStart annKeyLoc2 loc2 = GHC.srcSpanStart annKeyLoc2
#endif
move = ExactPrint.modifyAnnsT $ \anns -> move = ExactPrint.modifyAnnsT $ \anns ->
let let
ann2 = Data.Maybe.fromJust $ Map.lookup annKey2 anns ann2 = Data.Maybe.fromJust $ Map.lookup annKey2 anns
@ -271,12 +302,20 @@ moveTrailingComments astFrom astTo = do
-- elements to the relevant annotations. Avoids quadratic behaviour a trivial -- elements to the relevant annotations. Avoids quadratic behaviour a trivial
-- implementation would have. -- implementation would have.
extractToplevelAnns extractToplevelAnns
#if MIN_VERSION_ghc(9,0,0)
:: Located HsModule
#else
:: Located (HsModule GhcPs) :: Located (HsModule GhcPs)
#endif
-> ExactPrint.Anns -> ExactPrint.Anns
-> Map ExactPrint.AnnKey ExactPrint.Anns -> Map ExactPrint.AnnKey ExactPrint.Anns
extractToplevelAnns lmod anns = output extractToplevelAnns lmod anns = output
where where
#if MIN_VERSION_ghc(9,0,0)
(L _ (HsModule _ _ _ _ ldecls _ _)) = lmod
#else
(L _ (HsModule _ _ _ ldecls _ _)) = lmod (L _ (HsModule _ _ _ ldecls _ _)) = lmod
#endif
declMap1 :: Map ExactPrint.AnnKey ExactPrint.AnnKey declMap1 :: Map ExactPrint.AnnKey ExactPrint.AnnKey
declMap1 = Map.unions $ ldecls <&> \ldecl -> declMap1 = Map.unions $ ldecls <&> \ldecl ->
Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl) Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl)