{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Module preprocessing before pretty-printing.
module HIndent.ModulePreprocessing
  ( modifyASTForPrettyPrinting
  ) where

import Data.Function
import Data.List
import GHC.Hs
import GHC.Types.SrcLoc
import Generics.SYB hiding (GT, typeOf, typeRep)
import HIndent.Fixity
import HIndent.GhcLibParserWrapper.GHC.Hs
import HIndent.ModulePreprocessing.CommentRelocation
import Language.Haskell.GhclibParserEx.Fixity
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
import qualified GHC.Data.Strict as Strict
#else
import Control.Applicative
import Data.Maybe
import Type.Reflection
#endif
-- | 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.
modifyASTForPrettyPrinting :: HsModule' -> HsModule'
modifyASTForPrettyPrinting :: HsModule' -> HsModule'
modifyASTForPrettyPrinting HsModule'
m = HsModule'
-> [GenLocated NoCommentsLocation EpaComment] -> HsModule'
relocateComments (HsModule' -> HsModule'
beforeRelocation HsModule'
m) [GenLocated NoCommentsLocation EpaComment]
allComments
  where
    beforeRelocation :: HsModule' -> HsModule'
beforeRelocation =
      HsModule' -> HsModule'
resetListCompRange
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
resetLGRHSEndPositionInModule
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
removeAllDocDs
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
closeEpAnnOfHsFunTy
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
closeEpAnnOfMatchMExt
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
closePlaceHolderEpAnns
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
closeEpAnnOfFunBindFunId
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
resetModuleNameColumn
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
replaceAllNotUsedAnns
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
removeComments
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
sortExprLStmt
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
fixFixities
    allComments :: [GenLocated NoCommentsLocation EpaComment]
allComments = (GenLocated NoCommentsLocation EpaComment -> Bool)
-> GenericQ [GenLocated NoCommentsLocation EpaComment]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (Bool -> Bool
not (Bool -> Bool)
-> (GenLocated NoCommentsLocation EpaComment -> Bool)
-> GenLocated NoCommentsLocation EpaComment
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpaCommentTok -> Bool
isEofComment (EpaCommentTok -> Bool)
-> (GenLocated NoCommentsLocation EpaComment -> EpaCommentTok)
-> GenLocated NoCommentsLocation EpaComment
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpaComment -> EpaCommentTok
ac_tok (EpaComment -> EpaCommentTok)
-> (GenLocated NoCommentsLocation EpaComment -> EpaComment)
-> GenLocated NoCommentsLocation EpaComment
-> EpaCommentTok
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated NoCommentsLocation EpaComment -> EpaComment
forall l e. GenLocated l e -> e
unLoc) HsModule'
m

-- | This function modifies the given module AST to apply fixities of infix
-- operators defined in the 'base' package.
fixFixities :: HsModule' -> HsModule'
fixFixities :: HsModule' -> HsModule'
fixFixities = [(String, Fixity)] -> HsModule' -> HsModule'
forall a. Data a => [(String, Fixity)] -> a -> a
applyFixities [(String, Fixity)]
fixities

-- | This function modifies the range of `HsDo` with `ListComp` so that it
-- includes the whole list comprehension.
--
-- This function is necessary for `ghc-lib-parser>=9.10.1` because `HsDo`
-- no longer includes brackets of list comprehensions in its range.
resetListCompRange :: HsModule' -> HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
resetListCompRange :: HsModule' -> HsModule'
resetListCompRange = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((HsExpr GhcPs -> HsExpr GhcPs) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT HsExpr GhcPs -> HsExpr GhcPs
resetListCompRange')
  where
    resetListCompRange' :: HsExpr GhcPs -> HsExpr GhcPs
    resetListCompRange' :: HsExpr GhcPs -> HsExpr GhcPs
resetListCompRange' (HsDo al :: XDo GhcPs
al@AnnList { al_open :: AnnList -> Maybe AddEpAnn
al_open = Just (AddEpAnn AnnKeywordId
_ (EpaSpan (RealSrcSpan RealSrcSpan
open Maybe BufSpan
_)))
                                         , al_close :: AnnList -> Maybe AddEpAnn
al_close = Just (AddEpAnn AnnKeywordId
_ (EpaSpan (RealSrcSpan RealSrcSpan
close Maybe BufSpan
_)))
                                         } HsDoFlavour
ListComp (L EpAnn {Anchor
AnnList
EpAnnComments
entry :: Anchor
anns :: AnnList
comments :: EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
anns :: forall ann. EpAnn ann -> ann
entry :: forall ann. EpAnn ann -> Anchor
..} [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs)) =
      XDo GhcPs
-> HsDoFlavour -> XRec GhcPs [ExprLStmt GhcPs] -> HsExpr GhcPs
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo
        XDo GhcPs
al
        HsDoFlavour
ListComp
        (EpAnn AnnList
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     (EpAnn AnnList)
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L EpAnn
             { entry :: Anchor
entry =
                 SrcSpan -> Anchor
forall a. SrcSpan -> EpaLocation' a
EpaSpan
                   (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan
                       (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan
                          (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
open)
                          (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
close))
                       Maybe BufSpan
forall a. Maybe a
Strict.Nothing
             , AnnList
EpAnnComments
anns :: AnnList
comments :: EpAnnComments
comments :: EpAnnComments
anns :: AnnList
..
             }
           [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs)
    resetListCompRange' HsExpr GhcPs
x = HsExpr GhcPs
x
#else
resetListCompRange = id
#endif
-- | 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.
resetLGRHSEndPositionInModule :: HsModule' -> HsModule'
resetLGRHSEndPositionInModule :: HsModule' -> HsModule'
resetLGRHSEndPositionInModule = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs))
-> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
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.
sortExprLStmt :: HsModule' -> HsModule'
sortExprLStmt :: HsModule' -> HsModule'
sortExprLStmt m :: HsModule'
m@HsModule {hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls = [LHsDecl GhcPs]
xs} = HsModule'
m {hsmodDecls = sorted}
  where
    sorted :: [LHsDecl GhcPs]
sorted = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (([ExprLStmt GhcPs] -> [ExprLStmt GhcPs]) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
sortByLoc) [LHsDecl GhcPs]
xs
    sortByLoc :: [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
    sortByLoc :: [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
sortByLoc = (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Ordering)
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Maybe RealSrcSpan -> Maybe RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Maybe RealSrcSpan -> Maybe RealSrcSpan -> Ordering)
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> Maybe RealSrcSpan)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> SrcSpan)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA (SrcSpanAnnA -> SrcSpan)
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> SrcSpanAnnA)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc)

-- | This function removes all comments from the given module not to
-- duplicate them on comment relocation.
removeComments :: HsModule' -> HsModule'
removeComments :: HsModule' -> HsModule'
removeComments = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((EpAnnComments -> EpAnnComments) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT ((EpAnnComments -> EpAnnComments) -> a -> a)
-> (EpAnnComments -> EpAnnComments) -> a -> a
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> EpAnnComments -> EpAnnComments
forall a b. a -> b -> a
const EpAnnComments
emptyComments)

-- | This function replaces all 'EpAnnNotUsed's in 'SrcSpanAnn''s with
-- 'EpAnn's to make it possible to locate comments on them.
replaceAllNotUsedAnns :: HsModule' -> HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- 'EpAnnNotUsed' is not used since 9.10.1.
replaceAllNotUsedAnns :: HsModule' -> HsModule'
replaceAllNotUsedAnns = HsModule' -> HsModule'
forall a. a -> a
id
#else
replaceAllNotUsedAnns = everywhere app
  where
    app ::
         forall a. Data a
      => (a -> a)
    app sp
      | App g (App y z) <- typeRep @a
      , Just HRefl <- eqTypeRep g (typeRep @SrcSpanAnn')
      , Just HRefl <- eqTypeRep y (typeRep @EpAnn) =
        fromMaybe sp $ do
          let try :: Typeable b => b -> Maybe a
              try ann = do
                HRefl <- eqTypeRep (typeOf ann) z
                pure sp {ann = EpAnn (spanAsAnchor $ locA sp) ann emptyComments}
          try emptyListItem
            <|> try emptyList
            <|> try emptyPragma
            <|> try emptyContext
            <|> try emptyNameAnn
            <|> try NoEpAnns
    app x = x
    emptyListItem = AnnListItem []
    emptyList = AnnList Nothing Nothing Nothing [] []
    emptyPragma = AnnPragma emptyAddEpAnn emptyAddEpAnn []
    emptyContext = AnnContext Nothing [] []
    emptyNameAnn = NameAnnTrailing []
    emptyAddEpAnn = AddEpAnn AnnAnyclass emptyEpaLocation
    emptyEpaLocation = EpaDelta (SameLine 0) []
#endif
-- | This function sets the start column of 'hsmodName' of the given
-- 'HsModule' to 1 to correctly locate comments above the module name.
resetModuleNameColumn :: HsModule' -> HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
resetModuleNameColumn :: HsModule' -> HsModule'
resetModuleNameColumn m :: HsModule'
m@HsModule {hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodName = Just (L epa :: SrcSpanAnnA
epa@EpAnn {Anchor
AnnListItem
EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
anns :: forall ann. EpAnn ann -> ann
entry :: forall ann. EpAnn ann -> Anchor
entry :: Anchor
anns :: AnnListItem
comments :: EpAnnComments
..} ModuleName
name)} =
  HsModule'
m {hsmodName = Just (L newAnn name)}
  where
    newAnn :: SrcSpanAnnA
newAnn = SrcSpanAnnA
epa {entry = realSpanAsAnchor newSpan}
    newSpan :: RealSrcSpan
newSpan =
      RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan
        (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
anc) (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
anc) Int
1)
        (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
anc)
    anc :: RealSrcSpan
anc =
      case Anchor
entry of
        EpaSpan (RealSrcSpan RealSrcSpan
a Maybe BufSpan
_) -> RealSrcSpan
a
        Anchor
_ -> String -> RealSrcSpan
forall a. HasCallStack => String -> a
error String
"resetModuleNameColumn: not a RealSrcSpan"
#else
resetModuleNameColumn m@HsModule {hsmodName = Just (L (SrcSpanAnn epa@EpAnn {..} sp) name)} =
  m {hsmodName = Just (L (SrcSpanAnn newAnn sp) name)}
  where
    newAnn = epa {entry = realSpanAsAnchor newSpan}
    newSpan =
      mkRealSrcSpan
        (mkRealSrcLoc (srcSpanFile anc) (srcSpanStartLine anc) 1)
        (realSrcSpanEnd anc)
    anc = anchor entry
#endif
resetModuleNameColumn HsModule'
m = HsModule'
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'.
closeEpAnnOfFunBindFunId :: HsModule' -> HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- TODO: 'EpAnnNotUsed' is not used since 9.10.1. We need to find another
-- way to close 'EpAnn's.
closeEpAnnOfFunBindFunId :: HsModule' -> HsModule'
closeEpAnnOfFunBindFunId = HsModule' -> HsModule'
forall a. a -> a
id
#else
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
#endif
-- | 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.
closeEpAnnOfMatchMExt :: HsModule' -> HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- TODO: 'EpAnnNotUsed' is not used since 9.10.1. We need to find another
-- way to close 'EpAnn's.
closeEpAnnOfMatchMExt :: HsModule' -> HsModule'
closeEpAnnOfMatchMExt = HsModule' -> HsModule'
forall a. a -> a
id
#else
closeEpAnnOfMatchMExt = everywhere closeEpAnn
  where
    closeEpAnn ::
         forall a. Typeable a
      => a
      -> a
    closeEpAnn x
      | App (App g h) _ <- typeRep @a
      , Just HRefl <- eqTypeRep g (typeRep @Match)
      , Just HRefl <- eqTypeRep h (typeRep @GhcPs) = x {m_ext = EpAnnNotUsed}
      | otherwise = x
#endif
-- | 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.
closeEpAnnOfHsFunTy :: HsModule' -> HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- TODO: 'EpAnnNotUsed' is not used since 9.10.1. We need to find another
-- way to close 'EpAnn's.
closeEpAnnOfHsFunTy :: HsModule' -> HsModule'
closeEpAnnOfHsFunTy = HsModule' -> HsModule'
forall a. a -> a
id
#else
closeEpAnnOfHsFunTy = everywhere (mkT closeEpAnn)
  where
    closeEpAnn :: HsType GhcPs -> HsType GhcPs
    closeEpAnn (HsFunTy _ p l r) = HsFunTy EpAnnNotUsed p l r
    closeEpAnn x = x
#endif
-- | This function replaces all 'EpAnn's that contain placeholder anchors
-- to locate comments correctly. A placeholder anchor is an anchor pointing
-- on (-1, -1).
closePlaceHolderEpAnns :: HsModule' -> HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- TODO: 'EpAnnNotUsed' is not used since 9.10.1. We need to find another
-- way to close 'EpAnn's.
closePlaceHolderEpAnns :: HsModule' -> HsModule'
closePlaceHolderEpAnns = HsModule' -> HsModule'
forall a. a -> a
id
#else
closePlaceHolderEpAnns = everywhere closeEpAnn
  where
    closeEpAnn ::
         forall a. Typeable a
      => a
      -> a
    closeEpAnn x
      | App g _ <- typeRep @a
      , Just HRefl <- eqTypeRep g (typeRep @EpAnn)
      , (EpAnn (Anchor sp _) _ _) <- x
      , srcSpanEndLine sp == -1 && srcSpanEndCol sp == -1 = EpAnnNotUsed
      | otherwise = x
#endif
-- | 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.
removeAllDocDs :: HsModule' -> HsModule'
removeAllDocDs :: HsModule' -> HsModule'
removeAllDocDs x :: HsModule'
x@HsModule {hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls = [LHsDecl GhcPs]
decls} =
  HsModule'
x {hsmodDecls = filter (not . isDocD . unLoc) decls}
  where
    isDocD :: HsDecl p -> Bool
isDocD DocD {} = Bool
True
    isDocD HsDecl p
_ = Bool
False

-- | This function sets the position of the given 'LGRHS' to the end
-- position of the last RHS in it.
--
-- See the documentation of 'resetLGRHSEndPositionInModule' for the reason.
resetLGRHSEndPosition ::
     LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
resetLGRHSEndPosition :: LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
resetLGRHSEndPosition (L EpAnnCO
locAnn (GRHS ext :: XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ext@EpAnn {Anchor
EpAnnComments
GrhsAnn
comments :: forall ann. EpAnn ann -> EpAnnComments
anns :: forall ann. EpAnn ann -> ann
entry :: forall ann. EpAnn ann -> Anchor
entry :: Anchor
anns :: GrhsAnn
comments :: EpAnnComments
..} [ExprLStmt GhcPs]
stmt GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)) =
  let lastPosition :: RealSrcLoc
lastPosition =
        [RealSrcLoc] -> RealSrcLoc
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([RealSrcLoc] -> RealSrcLoc) -> [RealSrcLoc] -> RealSrcLoc
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
realSrcSpanEnd (RealSrcSpan -> RealSrcLoc)
-> (Anchor -> RealSrcSpan) -> Anchor -> RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchor -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor (Anchor -> RealSrcLoc) -> [Anchor] -> [RealSrcLoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Anchor -> Bool) -> GenericQ [Anchor]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify Anchor -> Bool
collectAnchor GenLocated SrcSpanAnnA (HsExpr GhcPs)
body
      newSpan :: RealSrcSpan
newSpan = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan (RealSrcSpan -> RealSrcLoc
realSrcSpanStart (RealSrcSpan -> RealSrcLoc) -> RealSrcSpan -> RealSrcLoc
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor Anchor
entry) RealSrcLoc
lastPosition
      newLocAnn :: EpAnnCO
newLocAnn = EpAnnCO
locAnn {entry = realSpanAsAnchor newSpan}
      newAnn :: EpAnn GrhsAnn
newAnn = XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ext {entry = realSpanAsAnchor newSpan}
   in EpAnnCO
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L EpAnnCO
newLocAnn (XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [ExprLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
newAnn [ExprLStmt GhcPs]
stmt GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)
  where
    collectAnchor :: Anchor -> Bool
    collectAnchor :: Anchor -> Bool
collectAnchor (EpaSpan RealSrcSpan {}) = Bool
True
    collectAnchor Anchor
_ = Bool
False
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
resetLGRHSEndPosition (L (SrcSpanAnn locAnn@EpAnn {} sp) (GRHS ext@EpAnn {..} stmt body)) =
  let lastPosition =
        maximum $ realSrcSpanEnd . anchor <$> listify collectAnchor body
      newSpan = mkRealSrcSpan (realSrcSpanStart $ anchor entry) lastPosition
      newLocAnn = locAnn {entry = realSpanAsAnchor newSpan}
      newAnn = ext {entry = realSpanAsAnchor newSpan}
   in L (SrcSpanAnn newLocAnn sp) (GRHS newAnn stmt body)
  where
    collectAnchor :: Anchor -> Bool
    collectAnchor _ = True
resetLGRHSEndPosition x = x
#else
resetLGRHSEndPosition (L _ (GRHS ext@EpAnn {..} stmt body)) =
  let lastPosition =
        maximum $ realSrcSpanEnd . anchor <$> listify collectAnchor body
      newSpan = mkRealSrcSpan (realSrcSpanStart $ anchor entry) lastPosition
      newLoc = RealSrcSpan newSpan Nothing
      newAnn = ext {entry = realSpanAsAnchor newSpan}
   in L newLoc (GRHS newAnn stmt body)
  where
    collectAnchor :: Anchor -> Bool
    collectAnchor _ = True
resetLGRHSEndPosition x = x
#endif
isEofComment :: EpaCommentTok -> Bool
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
isEofComment EpaEofComment = True
#endif
isEofComment :: EpaCommentTok -> Bool
isEofComment EpaCommentTok
_ = Bool
False