Define HsModule' to reduce CPP pragmas

hindent.cabal

@@ -37,6 +37,7 @@ library
       HIndent.CabalFile
       HIndent.CodeBlock
       HIndent.Config
+      HIndent.GhcLibParserWrapper.GHC.Hs
       HIndent.Language
       HIndent.LanguageExtension
       HIndent.LanguageExtension.Conversion

src/HIndent.hs

@@ -31,11 +31,11 @@ import Data.Functor.Identity
 import Data.List hiding (stripPrefix)
 import Data.Maybe
 import Data.Monoid
-import GHC.Hs
 import GHC.Parser.Lexer hiding (buffer)
 import GHC.Types.SrcLoc
 import HIndent.CodeBlock
 import HIndent.Config
+import HIndent.GhcLibParserWrapper.GHC.Hs
 import HIndent.LanguageExtension
 import qualified HIndent.LanguageExtension.Conversion as CE
 import HIndent.LanguageExtension.Types
@@ -123,12 +123,9 @@ reformat config mexts mfilepath =
                else x' <> "\n")
           (f x)
       | otherwise = f x
+
 -- | Generate an AST from the given module for debugging.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-testAst :: ByteString -> Either String (HsModule GhcPs)
-#else
-testAst :: ByteString -> Either String HsModule
-#endif
+testAst :: ByteString -> Either String HsModule'
 testAst x =
   case parseModule Nothing exts (UTF8.toString x) of
     POk _ m -> Right $ modifyASTForPrettyPrinting m
@@ -144,12 +141,9 @@ testAst x =
 -- | Does the strict bytestring have a trailing newline?
 hasTrailingLine :: ByteString -> Bool
 hasTrailingLine xs = not (S8.null xs) && S8.last xs == '\n'
+
 -- | Print the module.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-prettyPrint :: Config -> HsModule GhcPs -> Builder
-#else
-prettyPrint :: Config -> HsModule -> Builder
-#endif
+prettyPrint :: Config -> HsModule' -> Builder
 prettyPrint config m =
   runPrinterStyle config (pretty $ modifyASTForPrettyPrinting m)
 

src/HIndent/GhcLibParserWrapper/GHC/Hs.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE CPP #-}
+
+-- | Wrapper for 'GHC.Hs'
+module HIndent.GhcLibParserWrapper.GHC.Hs
+  ( module GHC.Hs
+  , HsModule'
+  ) where
+
+import GHC.Hs
+-- | The wrapper for `HsModule'`
+#if MIN_VERSION_ghc_lib_parser(9,6,1)
+type HsModule' = HsModule GhcPs
+#else
+type HsModule' = HsModule
+#endif

src/HIndent/ModulePreprocessing.hs

@@ -18,18 +18,16 @@ import Data.Maybe
 import GHC.Hs
 import GHC.Types.SrcLoc
 import Generics.SYB hiding (GT, typeOf, typeRep)
+import HIndent.GhcLibParserWrapper.GHC.Hs
 import HIndent.ModulePreprocessing.CommentRelocation
 import Language.Haskell.GhclibParserEx.Fixity
 import Type.Reflection
+
 -- | This function modifies the given module AST for pretty-printing.
 --
 -- Pretty-printing a module without calling this function for it before may
 -- raise an error or not print it correctly.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-modifyASTForPrettyPrinting :: HsModule GhcPs -> HsModule GhcPs
-#else
-modifyASTForPrettyPrinting :: HsModule -> HsModule
-#endif
+modifyASTForPrettyPrinting :: HsModule' -> HsModule'
 modifyASTForPrettyPrinting m = relocateComments (beforeRelocation m) allComments
   where
     beforeRelocation =
@@ -44,57 +42,42 @@ modifyASTForPrettyPrinting m = relocateComments (beforeRelocation m) allComments
     allComments = listify (not . isEofComment . ac_tok . unLoc) m
     isEofComment EpaEofComment = True
     isEofComment _ = False
+
 -- | This function modifies the given module AST to apply fixities of infix
 -- operators defined in the 'base' package.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-fixFixities :: HsModule GhcPs -> HsModule GhcPs
-#else
-fixFixities :: HsModule -> HsModule
-#endif
+fixFixities :: HsModule' -> HsModule'
 fixFixities = applyFixities baseFixities
+
 -- | This function sets an 'LGRHS's end position to the end position of the
 -- last RHS in the 'grhssGRHSs'.
 --
 -- The source span of an 'L?GRHS' contains the 'where' keyword, which
 -- locates comments in the wrong position in the process of comment
 -- relocation. This function prevents it by fixing the 'L?GRHS''s source
 -- span.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-resetLGRHSEndPositionInModule :: HsModule GhcPs -> HsModule GhcPs
-#else
-resetLGRHSEndPositionInModule :: HsModule -> HsModule
-#endif
+resetLGRHSEndPositionInModule :: HsModule' -> HsModule'
 resetLGRHSEndPositionInModule = everywhere (mkT resetLGRHSEndPosition)
+
 -- | This function sorts lists of statements in order their positions.
 --
 -- For example, the last element of 'HsDo' of 'HsExpr' is the element
 -- before a bar, and the elements are not sorted by their locations. This
 -- function fixes the orderings.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-sortExprLStmt :: HsModule GhcPs -> HsModule GhcPs
-#else
-sortExprLStmt :: HsModule -> HsModule
-#endif
+sortExprLStmt :: HsModule' -> HsModule'
 sortExprLStmt m@HsModule {hsmodDecls = xs} = m {hsmodDecls = sorted}
   where
     sorted = everywhere (mkT sortByLoc) xs
     sortByLoc :: [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
     sortByLoc = sortBy (compare `on` srcSpanToRealSrcSpan . locA . getLoc)
+
 -- | This function removes all comments from the given module not to
 -- duplicate them on comment relocation.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-removeComments :: HsModule GhcPs -> HsModule GhcPs
-#else
-removeComments :: HsModule -> HsModule
-#endif
+removeComments :: HsModule' -> HsModule'
 removeComments = everywhere (mkT $ const emptyComments)
+
 -- | This function replaces all 'EpAnnNotUsed's in 'SrcSpanAnn''s with
 -- 'EpAnn's to make it possible to locate comments on them.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-replaceAllNotUsedAnns :: HsModule GhcPs -> HsModule GhcPs
-#else
-replaceAllNotUsedAnns :: HsModule -> HsModule
-#endif
+replaceAllNotUsedAnns :: HsModule' -> HsModule'
 replaceAllNotUsedAnns = everywhere app
   where
     app ::
@@ -121,13 +104,10 @@ replaceAllNotUsedAnns = everywhere app
     emptyNameAnn = NameAnnTrailing []
     emptyAddEpAnn = AddEpAnn AnnAnyclass emptyEpaLocation
     emptyEpaLocation = EpaDelta (SameLine 0) []
+
 -- | This function sets the start column of 'hsmodName' of the given
 -- 'HsModule' to 1 to correctly locate comments above the module name.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-resetModuleNameColumn :: HsModule GhcPs -> HsModule GhcPs
-#else
-resetModuleNameColumn :: HsModule -> HsModule
-#endif
+resetModuleNameColumn :: HsModule' -> HsModule'
 resetModuleNameColumn m@HsModule {hsmodName = Just (L (SrcSpanAnn epa@EpAnn {..} sp) name)} =
   m {hsmodName = Just (L (SrcSpanAnn newAnn sp) name)}
   where
@@ -138,34 +118,28 @@ resetModuleNameColumn m@HsModule {hsmodName = Just (L (SrcSpanAnn epa@EpAnn {..}
         (realSrcSpanEnd anc)
     anc = anchor entry
 resetModuleNameColumn m = m
+
 -- | This function replaces the 'EpAnn' of 'fun_id' in 'FunBind' with
 -- 'EpAnnNotUsed'.
 --
 -- The 'fun_id' contains the function's name. However, 'FunRhs' of 'Match'
 -- also contains the name, and we use the latter one. This function
 -- prevents comments from being located in 'fun_id'.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-closeEpAnnOfFunBindFunId :: HsModule GhcPs -> HsModule GhcPs
-#else
-closeEpAnnOfFunBindFunId :: HsModule -> HsModule
-#endif
+closeEpAnnOfFunBindFunId :: HsModule' -> HsModule'
 closeEpAnnOfFunBindFunId = everywhere (mkT closeEpAnn)
   where
     closeEpAnn :: HsBind GhcPs -> HsBind GhcPs
     closeEpAnn bind@FunBind {fun_id = (L (SrcSpanAnn _ l) name)} =
       bind {fun_id = L (SrcSpanAnn EpAnnNotUsed l) name}
     closeEpAnn x = x
+
 -- | This function replaces the 'EpAnn' of 'm_ext' in 'Match' with
 -- 'EpAnnNotUsed.
 --
 -- The field contains the annotation of the match LHS. However, the same
 -- information is also stored inside the 'Match'. This function removes the
 -- duplication not to locate comments on a wrong point.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-closeEpAnnOfMatchMExt :: HsModule GhcPs -> HsModule GhcPs
-#else
-closeEpAnnOfMatchMExt :: HsModule -> HsModule
-#endif
+closeEpAnnOfMatchMExt :: HsModule' -> HsModule'
 closeEpAnnOfMatchMExt = everywhere closeEpAnn
   where
     closeEpAnn ::
@@ -177,29 +151,23 @@ closeEpAnnOfMatchMExt = everywhere closeEpAnn
       , Just HRefl <- eqTypeRep g (typeRep @Match)
       , Just HRefl <- eqTypeRep h (typeRep @GhcPs) = x {m_ext = EpAnnNotUsed}
       | otherwise = x
+
 -- | This function replaces the 'EpAnn' of the first argument of 'HsFunTy'
 -- of 'HsType'.
 --
 -- 'HsFunTy' should not have any comments. Instead, its LHS and RHS should
 -- have them.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-closeEpAnnOfHsFunTy :: HsModule GhcPs -> HsModule GhcPs
-#else
-closeEpAnnOfHsFunTy :: HsModule -> HsModule
-#endif
+closeEpAnnOfHsFunTy :: HsModule' -> HsModule'
 closeEpAnnOfHsFunTy = everywhere (mkT closeEpAnn)
   where
     closeEpAnn :: HsType GhcPs -> HsType GhcPs
     closeEpAnn (HsFunTy _ p l r) = HsFunTy EpAnnNotUsed p l r
     closeEpAnn x = x
+
 -- | This function replaces all 'EpAnn's that contain placeholder anchors
 -- to locate comments correctly. A placeholder anchor is an anchor pointing
 -- on (-1, -1).
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-closePlaceHolderEpAnns :: HsModule GhcPs -> HsModule GhcPs
-#else
-closePlaceHolderEpAnns :: HsModule -> HsModule
-#endif
+closePlaceHolderEpAnns :: HsModule' -> HsModule'
 closePlaceHolderEpAnns = everywhere closeEpAnn
   where
     closeEpAnn ::
@@ -212,14 +180,11 @@ closePlaceHolderEpAnns = everywhere closeEpAnn
       , (EpAnn (Anchor sp _) _ _) <- x
       , srcSpanEndLine sp == -1 && srcSpanEndCol sp == -1 = EpAnnNotUsed
       | otherwise = x
+
 -- | This function removes all 'DocD's from the given module. They have
 -- haddocks, but the same information is stored in 'EpaCommentTok's. Thus,
 -- we need to remove the duplication.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-removeAllDocDs :: HsModule GhcPs -> HsModule GhcPs
-#else
-removeAllDocDs :: HsModule -> HsModule
-#endif
+removeAllDocDs :: HsModule' -> HsModule'
 removeAllDocDs x@HsModule {hsmodDecls = decls} =
   x {hsmodDecls = filter (not . isDocD . unLoc) decls}
   where

src/HIndent/ModulePreprocessing/CommentRelocation.hs

@@ -44,9 +44,9 @@ import Data.Foldable
 import Data.Function
 import Data.List
 import GHC.Data.Bag
-import GHC.Hs
 import GHC.Types.SrcLoc
 import Generics.SYB hiding (GT, typeOf, typeRep)
+import HIndent.GhcLibParserWrapper.GHC.Hs
 import HIndent.Pretty.Pragma
 import HIndent.Pretty.SigBindFamily
 import Type.Reflection
@@ -61,13 +61,10 @@ data Wrapper =
 
 -- | 'State' with comments.
 type WithComments = State [LEpaComment]
+
 -- | This function collects all comments from the passed 'HsModule', and
 -- modifies all 'EpAnn's so that all 'EpAnn's have 'EpaCommentsBalanced's.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-relocateComments :: HsModule GhcPs -> [LEpaComment] -> HsModule GhcPs
-#else
-relocateComments :: HsModule -> [LEpaComment] -> HsModule
-#endif
+relocateComments :: HsModule' -> [LEpaComment] -> HsModule'
 relocateComments = evalState . relocate
   where
     relocate =
@@ -115,14 +112,9 @@ relocateCommentsBeforePragmas m@HsModule {hsmodAnn = ann}
   where
     startPosOfPragmas = anchor $ getLoc $ head $ priorComments $ comments ann
 #endif
-
 -- | This function locates comments that are located before each element of
 -- an export list.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-relocateCommentsInExportList :: HsModule GhcPs -> WithComments (HsModule GhcPs)
-#else
-relocateCommentsInExportList :: HsModule -> WithComments HsModule
-#endif
+relocateCommentsInExportList :: HsModule' -> WithComments HsModule'
 relocateCommentsInExportList m@HsModule {hsmodExports = Just (L listSp@SrcSpanAnn {ann = EpAnn {entry = listAnn}} xs)} = do
   newExports <- mapM insertCommentsBeforeElement xs
   pure m {hsmodExports = Just (L listSp newExports)}
@@ -139,13 +131,9 @@ relocateCommentsInExportList m@HsModule {hsmodExports = Just (L listSp@SrcSpanAn
       srcSpanStartLine comAnc < srcSpanStartLine anc &&
       realSrcSpanStart (anchor listAnn) < realSrcSpanStart comAnc
 relocateCommentsInExportList x = pure x
+
 -- | This function locates comments located before top-level declarations.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-relocateCommentsBeforeTopLevelDecls ::
-     HsModule GhcPs -> WithComments (HsModule GhcPs)
-#else
-relocateCommentsBeforeTopLevelDecls :: HsModule -> WithComments HsModule
-#endif
+relocateCommentsBeforeTopLevelDecls :: HsModule' -> WithComments HsModule'
 relocateCommentsBeforeTopLevelDecls = everywhereM (applyM f)
   where
     f epa@EpAnn {..} =
@@ -155,14 +143,11 @@ relocateCommentsBeforeTopLevelDecls = everywhereM (applyM f)
       srcSpanStartCol anc == 1 &&
       srcSpanStartCol comAnc == 1 &&
       srcSpanStartLine comAnc < srcSpanStartLine anc
+
 -- | This function scans the given AST from bottom to top and locates
 -- comments that are on the same line as the node.  Comments are stored in
 -- the 'followingComments' of 'EpaCommentsBalanced'.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-relocateCommentsSameLine :: HsModule GhcPs -> WithComments (HsModule GhcPs)
-#else
-relocateCommentsSameLine :: HsModule -> WithComments HsModule
-#endif
+relocateCommentsSameLine :: HsModule' -> WithComments HsModule'
 relocateCommentsSameLine = everywhereMEpAnnsBackwards f
   where
     f epa@EpAnn {..} =
@@ -174,14 +159,10 @@ relocateCommentsSameLine = everywhereMEpAnnsBackwards f
     isOnSameLine anc comAnc =
       srcSpanStartLine comAnc == srcSpanStartLine anc &&
       srcSpanStartLine comAnc == srcSpanEndLine anc
+
 -- | This function locates comments above the top-level declarations in
 -- a 'where' clause in the topmost declaration.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-relocateCommentsTopLevelWhereClause ::
-     HsModule GhcPs -> WithComments (HsModule GhcPs)
-#else
-relocateCommentsTopLevelWhereClause :: HsModule -> WithComments HsModule
-#endif
+relocateCommentsTopLevelWhereClause :: HsModule' -> WithComments HsModule'
 relocateCommentsTopLevelWhereClause m@HsModule {..} = do
   hsmodDecls' <- mapM relocateCommentsDeclWhereClause hsmodDecls
   pure m {hsmodDecls = hsmodDecls'}
@@ -224,13 +205,10 @@ relocateCommentsTopLevelWhereClause m@HsModule {..} = do
     isAbove comAnc anc =
       srcSpanStartCol comAnc == srcSpanStartCol anc &&
       srcSpanEndLine comAnc + 1 == srcSpanStartLine anc
+
 -- | This function scans the given AST from bottom to top and locates
 -- comments in the comment pool after each node on it.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
-relocateCommentsAfter :: HsModule GhcPs -> WithComments (HsModule GhcPs)
-#else
-relocateCommentsAfter :: HsModule -> WithComments HsModule
-#endif
+relocateCommentsAfter :: HsModule' -> WithComments HsModule'
 relocateCommentsAfter = everywhereMEpAnnsBackwards f
   where
     f epa@EpAnn {..} =

src/HIndent/Parse.hs

@@ -10,25 +10,20 @@ import Data.Maybe
 import qualified GHC.Data.EnumSet as ES
 import GHC.Data.FastString
 import GHC.Data.StringBuffer
-import GHC.Hs
 import qualified GHC.LanguageExtensions as GLP
 import qualified GHC.Parser as GLP
 import GHC.Parser.Lexer hiding (buffer)
 import GHC.Stack
 import GHC.Types.SrcLoc
+import HIndent.GhcLibParserWrapper.GHC.Hs
 #if MIN_VERSION_ghc_lib_parser(9,4,1)
 import GHC.Utils.Error
 import GHC.Utils.Outputable hiding ((<>), empty, text)
 #endif
 -- | This function parses the given Haskell source code with the given file
 -- path (if any) and parse options.
-#if MIN_VERSION_ghc_lib_parser(9,6,1)
 parseModule ::
-     Maybe FilePath -> [GLP.Extension] -> String -> ParseResult (HsModule GhcPs)
-#else
-parseModule ::
-     Maybe FilePath -> [GLP.Extension] -> String -> ParseResult HsModule
-#endif
+     Maybe FilePath -> [GLP.Extension] -> String -> ParseResult HsModule'
 parseModule filepath exts src =
   case unP GLP.parseModule initState of
     POk s m -> POk s $ unLoc m