{-# 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 Control.Applicative
import Data.Function
import Data.List
import Data.Maybe
import GHC.Hs
import GHC.Stack
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
import Type.Reflection
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
import qualified GHC.Data.Strict as Strict
#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. HasCallStack => EpaLocation' a -> RealSrcSpan
getAnc (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. HasCallStack => EpaLocation' a -> RealSrcSpan
getAnc 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
#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
#endif
resetLGRHSEndPosition LGRHS GhcPs (LHsExpr GhcPs)
x = LGRHS GhcPs (LHsExpr GhcPs)
x

isEofComment :: EpaCommentTok -> Bool
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
isEofComment EpaEofComment = True
#endif
isEofComment :: EpaCommentTok -> Bool
isEofComment EpaCommentTok
_ = Bool
False
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
getAnc :: HasCallStack => EpaLocation' a -> RealSrcSpan
getAnc :: forall a. HasCallStack => EpaLocation' a -> RealSrcSpan
getAnc (EpaSpan (RealSrcSpan RealSrcSpan
x Maybe BufSpan
_)) = RealSrcSpan
x
getAnc EpaLocation' a
_ = RealSrcSpan
forall a. HasCallStack => a
undefined
#else
getAnc = anchor
#endif