    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ViewPatterns #-}

    -- | Functions for working with comment stream.
    module Ormolu.Parser.CommentStream
      ( -- * Comment stream
        CommentStream (..),
        mkCommentStream,

        -- * Comment
        LComment,
        Comment (..),
        unComment,
        hasAtomsBefore,
        isMultilineComment,
      )
    where

    import Control.Monad ((<=<))
    import Data.Char (isSpace)
    import Data.Data (Data)
    import Data.Generics.Schemes
    import Data.List.NonEmpty (NonEmpty (..))
    import Data.List.NonEmpty qualified as NE
    import Data.Map.Lazy qualified as M
    import Data.Maybe
    import Data.Set qualified as S
    import Data.Text (Text)
    import Data.Text qualified as T
    import GHC.Data.Strict qualified as Strict
    import GHC.Hs (HsModule)
    import GHC.Hs.Doc
    import GHC.Hs.Extension
    import GHC.Hs.ImpExp
    import GHC.Parser.Annotation (EpAnnComments (..), getLocA)
    import GHC.Parser.Annotation qualified as GHC
    import GHC.Types.SrcLoc
    import Ormolu.Parser.Pragma
    import Ormolu.Utils (onTheSameLine)

    ----------------------------------------------------------------------------
    -- Comment stream

    -- | A stream of 'RealLocated' 'Comment's in ascending order with respect to
    -- beginning of corresponding spans.
    newtype CommentStream = CommentStream [LComment]
      deriving (CommentStream -> CommentStream -> Bool
    (CommentStream -> CommentStream -> Bool)
    -> (CommentStream -> CommentStream -> Bool) -> Eq CommentStream
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CommentStream -> CommentStream -> Bool
    == :: CommentStream -> CommentStream -> Bool
    $c/= :: CommentStream -> CommentStream -> Bool
    /= :: CommentStream -> CommentStream -> Bool
    Eq, Typeable CommentStream
    Typeable CommentStream =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> CommentStream -> c CommentStream)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c CommentStream)
    -> (CommentStream -> Constr)
    -> (CommentStream -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c CommentStream))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e))
        -> Maybe (c CommentStream))
    -> ((forall b. Data b => b -> b) -> CommentStream -> CommentStream)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> CommentStream -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> CommentStream -> r)
    -> (forall u. (forall d. Data d => d -> u) -> CommentStream -> [u])
    -> (forall u.
        Int -> (forall d. Data d => d -> u) -> CommentStream -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream)
    -> Data CommentStream
    CommentStream -> Constr
    CommentStream -> DataType
    (forall b. Data b => b -> b) -> CommentStream -> CommentStream
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> CommentStream -> u
    forall u. (forall d. Data d => d -> u) -> CommentStream -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentStream -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentStream -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CommentStream
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CommentStream -> c CommentStream
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CommentStream)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CommentStream)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CommentStream -> c CommentStream
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CommentStream -> c CommentStream
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CommentStream
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CommentStream
    $ctoConstr :: CommentStream -> Constr
    toConstr :: CommentStream -> Constr
    $cdataTypeOf :: CommentStream -> DataType
    dataTypeOf :: CommentStream -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CommentStream)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CommentStream)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CommentStream)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CommentStream)
    $cgmapT :: (forall b. Data b => b -> b) -> CommentStream -> CommentStream
    gmapT :: (forall b. Data b => b -> b) -> CommentStream -> CommentStream
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentStream -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentStream -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentStream -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentStream -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> CommentStream -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> CommentStream -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CommentStream -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CommentStream -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentStream -> m CommentStream
    Data, NonEmpty CommentStream -> CommentStream
    CommentStream -> CommentStream -> CommentStream
    (CommentStream -> CommentStream -> CommentStream)
    -> (NonEmpty CommentStream -> CommentStream)
    -> (forall b. Integral b => b -> CommentStream -> CommentStream)
    -> Semigroup CommentStream
    forall b. Integral b => b -> CommentStream -> CommentStream
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    $c<> :: CommentStream -> CommentStream -> CommentStream
    <> :: CommentStream -> CommentStream -> CommentStream
    $csconcat :: NonEmpty CommentStream -> CommentStream
    sconcat :: NonEmpty CommentStream -> CommentStream
    $cstimes :: forall b. Integral b => b -> CommentStream -> CommentStream
    stimes :: forall b. Integral b => b -> CommentStream -> CommentStream
    Semigroup, Semigroup CommentStream
    CommentStream
    Semigroup CommentStream =>
    CommentStream
    -> (CommentStream -> CommentStream -> CommentStream)
    -> ([CommentStream] -> CommentStream)
    -> Monoid CommentStream
    [CommentStream] -> CommentStream
    CommentStream -> CommentStream -> CommentStream
    forall a.
    Semigroup a =>
    a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    $cmempty :: CommentStream
    mempty :: CommentStream
    $cmappend :: CommentStream -> CommentStream -> CommentStream
    mappend :: CommentStream -> CommentStream -> CommentStream
    $cmconcat :: [CommentStream] -> CommentStream
    mconcat :: [CommentStream] -> CommentStream
    Monoid)

    -- | Create 'CommentStream' from 'HsModule'. The pragmas are
    -- removed from the 'CommentStream'.
    mkCommentStream ::
      -- | Original input
      Text ->
      -- | Module to use for comment extraction
      HsModule GhcPs ->
      -- | Stack header, pragmas, and comment stream
      ( Maybe LComment,
        [([LComment], Pragma)],
        CommentStream
      )
    mkCommentStream :: Text
    -> HsModule GhcPs
    -> (Maybe LComment, [([LComment], Pragma)], CommentStream)
    mkCommentStream Text
    input HsModule GhcPs
    hsModule =
      ( Maybe LComment
    mstackHeader,
        [([LComment], Pragma)]
    pragmas,
        [LComment] -> CommentStream
    CommentStream [LComment]
    comments
      )
      where
        ([LComment]
    comments, [([LComment], Pragma)]
    pragmas) = Text -> [RealLocated Text] -> ([LComment], [([LComment], Pragma)])
    extractPragmas Text
    input [RealLocated Text]
    rawComments1
        ([RealLocated Text]
    rawComments1, Maybe LComment
    mstackHeader) = [RealLocated Text] -> ([RealLocated Text], Maybe LComment)
    extractStackHeader [RealLocated Text]
    rawComments0

        -- We want to extract all comments except _valid_ Haddock comments
        rawComments0 :: [RealLocated Text]
    rawComments0 =
          ((RealSrcSpan, Text) -> RealLocated Text)
    -> [(RealSrcSpan, Text)] -> [RealLocated Text]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((RealSrcSpan -> Text -> RealLocated Text)
    -> (RealSrcSpan, Text) -> RealLocated Text
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry RealSrcSpan -> Text -> RealLocated Text
    forall l e. l -> e -> GenLocated l e
    L)
            ([(RealSrcSpan, Text)] -> [RealLocated Text])
    -> ([RealLocated Text] -> [(RealSrcSpan, Text)])
    -> [RealLocated Text]
    -> [RealLocated Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map RealSrcSpan Text -> [(RealSrcSpan, Text)]
    forall k a. Map k a -> [(k, a)]
    M.toAscList
            (Map RealSrcSpan Text -> [(RealSrcSpan, Text)])
    -> ([RealLocated Text] -> Map RealSrcSpan Text)
    -> [RealLocated Text]
    -> [(RealSrcSpan, Text)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map RealSrcSpan Text -> Set RealSrcSpan -> Map RealSrcSpan Text)
    -> Set RealSrcSpan -> Map RealSrcSpan Text -> Map RealSrcSpan Text
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Map RealSrcSpan Text -> Set RealSrcSpan -> Map RealSrcSpan Text
    forall k a. Ord k => Map k a -> Set k -> Map k a
    M.withoutKeys Set RealSrcSpan
    validHaddockCommentSpans
            (Map RealSrcSpan Text -> Map RealSrcSpan Text)
    -> ([RealLocated Text] -> Map RealSrcSpan Text)
    -> [RealLocated Text]
    -> Map RealSrcSpan Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(RealSrcSpan, Text)] -> Map RealSrcSpan Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList
            ([(RealSrcSpan, Text)] -> Map RealSrcSpan Text)
    -> ([RealLocated Text] -> [(RealSrcSpan, Text)])
    -> [RealLocated Text]
    -> Map RealSrcSpan Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RealLocated Text -> (RealSrcSpan, Text))
    -> [RealLocated Text] -> [(RealSrcSpan, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(L RealSrcSpan
    l Text
    a) -> (RealSrcSpan
    l, Text
    a))
            ([RealLocated Text] -> [RealLocated Text])
    -> [RealLocated Text] -> [RealLocated Text]
    forall a b. (a -> b) -> a -> b
    $ [RealLocated Text]
    allComments
          where
            -- All comments, including valid and invalid Haddock comments
            allComments :: [RealLocated Text]
    allComments =
              (LEpaComment -> Maybe (RealLocated Text))
    -> [LEpaComment] -> [RealLocated Text]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe LEpaComment -> Maybe (RealLocated Text)
    unAnnotationComment ([LEpaComment] -> [RealLocated Text])
    -> [LEpaComment] -> [RealLocated Text]
    forall a b. (a -> b) -> a -> b
    $
                EpAnnComments -> [LEpaComment]
    epAnnCommentsToList (EpAnnComments -> [LEpaComment])
    -> [EpAnnComments] -> [LEpaComment]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (EpAnnComments -> Bool) -> GenericQ [EpAnnComments]
    forall r. Typeable r => (r -> Bool) -> GenericQ [r]
    listify (forall a. a -> Bool
    only @EpAnnComments) HsModule GhcPs
    hsModule
              where
                epAnnCommentsToList :: EpAnnComments -> [LEpaComment]
    epAnnCommentsToList = \case
                  EpaComments [LEpaComment]
    cs -> [LEpaComment]
    cs
                  EpaCommentsBalanced [LEpaComment]
    pcs [LEpaComment]
    fcs -> [LEpaComment]
    pcs [LEpaComment] -> [LEpaComment] -> [LEpaComment]
    forall a. Semigroup a => a -> a -> a
    <> [LEpaComment]
    fcs
            -- All spans of valid Haddock comments
            validHaddockCommentSpans :: Set RealSrcSpan
    validHaddockCommentSpans =
              [RealSrcSpan] -> Set RealSrcSpan
    forall a. Ord a => [a] -> Set a
    S.fromList
                ([RealSrcSpan] -> Set RealSrcSpan)
    -> (HsModule GhcPs -> [RealSrcSpan])
    -> HsModule GhcPs
    -> Set RealSrcSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SrcSpan -> Maybe RealSrcSpan) -> [SrcSpan] -> [RealSrcSpan]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe SrcSpan -> Maybe RealSrcSpan
    srcSpanToRealSrcSpan
                ([SrcSpan] -> [RealSrcSpan])
    -> (HsModule GhcPs -> [SrcSpan]) -> HsModule GhcPs -> [RealSrcSpan]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [HsModule GhcPs -> [SrcSpan]] -> HsModule GhcPs -> [SrcSpan]
    forall a. Monoid a => [a] -> a
    mconcat
                  [ (GenLocated SrcSpan (HsDoc GhcPs) -> SrcSpan)
    -> [GenLocated SrcSpan (HsDoc GhcPs)] -> [SrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GenLocated SrcSpan (HsDoc GhcPs) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc ([GenLocated SrcSpan (HsDoc GhcPs)] -> [SrcSpan])
    -> (HsModule GhcPs -> [GenLocated SrcSpan (HsDoc GhcPs)])
    -> HsModule GhcPs
    -> [SrcSpan]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenLocated SrcSpan (HsDoc GhcPs) -> Bool)
    -> GenericQ [GenLocated SrcSpan (HsDoc GhcPs)]
    forall r. Typeable r => (r -> Bool) -> GenericQ [r]
    listify (forall a. a -> Bool
    only @(LHsDoc GhcPs)),
                    (GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpan)
    -> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [SrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpan
    forall a e. HasLoc a => GenLocated a e -> SrcSpan
    getLocA ([GenLocated SrcSpanAnnA (IE GhcPs)] -> [SrcSpan])
    -> (HsModule GhcPs -> [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> HsModule GhcPs
    -> [SrcSpan]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenLocated SrcSpanAnnA (IE GhcPs) -> Bool)
    -> GenericQ [GenLocated SrcSpanAnnA (IE GhcPs)]
    forall r. Typeable r => (r -> Bool) -> GenericQ [r]
    listify LIE GhcPs -> Bool
    GenLocated SrcSpanAnnA (IE GhcPs) -> Bool
    isIEDocLike
                  ]
                (HsModule GhcPs -> Set RealSrcSpan)
    -> HsModule GhcPs -> Set RealSrcSpan
    forall a b. (a -> b) -> a -> b
    $ HsModule GhcPs
    hsModule
              where
                isIEDocLike :: LIE GhcPs -> Bool
                isIEDocLike :: LIE GhcPs -> Bool
    isIEDocLike = \case
                  L SrcSpanAnnA
    _ IEGroup {} -> Bool
    True
                  L SrcSpanAnnA
    _ IEDoc {} -> Bool
    True
                  L SrcSpanAnnA
    _ IEDocNamed {} -> Bool
    True
                  LIE GhcPs
    _ -> Bool
    False
        only :: a -> Bool
        only :: forall a. a -> Bool
    only a
    _ = Bool
    True

    ----------------------------------------------------------------------------
    -- Comment

    type LComment = RealLocated Comment

    -- | A wrapper for a single comment. The 'Bool' indicates whether there were
    -- atoms before beginning of the comment in the original input. The
    -- 'NonEmpty' list inside contains lines of multiline comment @{- … -}@ or
    -- just single item\/line otherwise.
    data Comment = Comment Bool (NonEmpty Text)
      deriving (Comment -> Comment -> Bool
    (Comment -> Comment -> Bool)
    -> (Comment -> Comment -> Bool) -> Eq Comment
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Comment -> Comment -> Bool
    == :: Comment -> Comment -> Bool
    $c/= :: Comment -> Comment -> Bool
    /= :: Comment -> Comment -> Bool
    Eq, Int -> Comment -> ShowS
    [Comment] -> ShowS
    Comment -> String
    (Int -> Comment -> ShowS)
    -> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Comment -> ShowS
    showsPrec :: Int -> Comment -> ShowS
    $cshow :: Comment -> String
    show :: Comment -> String
    $cshowList :: [Comment] -> ShowS
    showList :: [Comment] -> ShowS
    Show, Typeable Comment
    Typeable Comment =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> Comment -> c Comment)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c Comment)
    -> (Comment -> Constr)
    -> (Comment -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c Comment))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment))
    -> ((forall b. Data b => b -> b) -> Comment -> Comment)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> Comment -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> Comment -> r)
    -> (forall u. (forall d. Data d => d -> u) -> Comment -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> Comment -> m Comment)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> Comment -> m Comment)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> Comment -> m Comment)
    -> Data Comment
    Comment -> Constr
    Comment -> DataType
    (forall b. Data b => b -> b) -> Comment -> Comment
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
    forall u. (forall d. Data d => d -> u) -> Comment -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comment
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Comment -> c Comment
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comment)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Comment -> c Comment
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Comment -> c Comment
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comment
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comment
    $ctoConstr :: Comment -> Constr
    toConstr :: Comment -> Constr
    $cdataTypeOf :: Comment -> DataType
    dataTypeOf :: Comment -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comment)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comment)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
    $cgmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
    gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment
    Data)

    -- | Normalize comment string. Sometimes one multi-line comment is turned
    -- into several lines for subsequent outputting with correct indentation for
    -- each line.
    mkComment ::
      -- | Lines of original input with their indices
      [(Int, Text)] ->
      -- | Raw comment string
      RealLocated Text ->
      -- | Remaining lines of original input and the constructed 'Comment'
      ([(Int, Text)], LComment)
    mkComment :: [(Int, Text)] -> RealLocated Text -> ([(Int, Text)], LComment)
    mkComment [(Int, Text)]
    ls (L RealSrcSpan
    l Text
    s) = ([(Int, Text)]
    ls', LComment
    comment)
      where
        comment :: LComment
    comment =
          RealSrcSpan -> Comment -> LComment
    forall l e. l -> e -> GenLocated l e
    L RealSrcSpan
    l (Comment -> LComment)
    -> (NonEmpty Text -> Comment) -> NonEmpty Text -> LComment
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> NonEmpty Text -> Comment
    Comment Bool
    atomsBefore (NonEmpty Text -> Comment)
    -> (NonEmpty Text -> NonEmpty Text) -> NonEmpty Text -> Comment
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty Text -> NonEmpty Text
    removeConseqBlanks (NonEmpty Text -> NonEmpty Text)
    -> (NonEmpty Text -> NonEmpty Text)
    -> NonEmpty Text
    -> NonEmpty Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Text) -> NonEmpty Text -> NonEmpty Text
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> Text
    T.stripEnd (NonEmpty Text -> LComment) -> NonEmpty Text -> LComment
    forall a b. (a -> b) -> a -> b
    $
            case [Text] -> Maybe (NonEmpty Text)
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty (Text -> [Text]
    T.lines Text
    s) of
              Maybe (NonEmpty Text)
    Nothing -> Text
    s Text -> [Text] -> NonEmpty Text
    forall a. a -> [a] -> NonEmpty a
    :| []
              Just (Text
    x :| [Text]
    xs) ->
                let getIndent :: Text -> Int
    getIndent Text
    y =
                      if (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    isSpace Text
    y
                        then Int
    startIndent
                        else Text -> Int
    T.length ((Char -> Bool) -> Text -> Text
    T.takeWhile Char -> Bool
    isSpace Text
    y)
                    n :: Int
    n = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum (Int
    startIndent Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : (Text -> Int) -> [Text] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> Int
    getIndent [Text]
    xs)
                    commentPrefix :: Text
    commentPrefix = if Text
    "{-" Text -> Text -> Bool
    `T.isPrefixOf` Text
    s then Text
    "" else Text
    "-- "
                 in Text
    x Text -> [Text] -> NonEmpty Text
    forall a. a -> [a] -> NonEmpty a
    :| ((Text
    commentPrefix Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>) (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    escapeHaddockTriggers (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Text -> Text
    T.drop Int
    n (Text -> Text) -> [Text] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Text]
    xs)
        (Bool
    atomsBefore, [(Int, Text)]
    ls') =
          case ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ((Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    commentLine) (Int -> Bool) -> ((Int, Text) -> Int) -> (Int, Text) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Text) -> Int
    forall a b. (a, b) -> a
    fst) [(Int, Text)]
    ls of
            [] -> (Bool
    False, [])
            ((Int
    _, Text
    i) : [(Int, Text)]
    ls'') ->
              case Int -> Text -> Text
    T.take Int
    2 (Text -> Text
    T.stripStart Text
    i) of
                Text
    "--" -> (Bool
    False, [(Int, Text)]
    ls'')
                Text
    "{-" -> (Bool
    False, [(Int, Text)]
    ls'')
                Text
    _ -> (Bool
    True, [(Int, Text)]
    ls'')
        startIndent :: Int
    startIndent
          -- srcSpanStartCol counts columns starting from 1, so we subtract 1
          | Text
    "{-" Text -> Text -> Bool
    `T.isPrefixOf` Text
    s = RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
          -- For single-line comments, the only case where xs != [] is when an
          -- invalid haddock comment composed of several single-line comments is
          -- encountered. In that case, each line of xs is prefixed with an
          -- extra space (not present in the original comment), so we set
          -- startIndent = 1 to remove this space.
          | Bool
    otherwise = Int
    1
        commentLine :: Int
    commentLine = RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    l

    -- | Get a collection of lines from a 'Comment'.
    unComment :: Comment -> NonEmpty Text
    unComment :: Comment -> NonEmpty Text
    unComment (Comment Bool
    _ NonEmpty Text
    xs) = NonEmpty Text
    xs

    -- | Check whether the 'Comment' had some non-whitespace atoms in front of
    -- it in the original input.
    hasAtomsBefore :: Comment -> Bool
    hasAtomsBefore :: Comment -> Bool
    hasAtomsBefore (Comment Bool
    atomsBefore NonEmpty Text
    _) = Bool
    atomsBefore

    -- | Is this comment multiline-style?
    isMultilineComment :: Comment -> Bool
    isMultilineComment :: Comment -> Bool
    isMultilineComment (Comment Bool
    _ (Text
    x :| [Text]
    _)) = Text
    "{-" Text -> Text -> Bool
    `T.isPrefixOf` Text
    x

    ----------------------------------------------------------------------------
    -- Helpers

    -- | Detect and extract stack header if it is present.
    extractStackHeader ::
      -- | Comment stream to analyze
      [RealLocated Text] ->
      ([RealLocated Text], Maybe LComment)
    extractStackHeader :: [RealLocated Text] -> ([RealLocated Text], Maybe LComment)
    extractStackHeader = \case
      [] -> ([], Maybe LComment
    forall a. Maybe a
    Nothing)
      (RealLocated Text
    x : [RealLocated Text]
    xs) ->
        let comment :: LComment
    comment = ([(Int, Text)], LComment) -> LComment
    forall a b. (a, b) -> b
    snd ([(Int, Text)] -> RealLocated Text -> ([(Int, Text)], LComment)
    mkComment [] RealLocated Text
    x)
         in if Comment -> Bool
    isStackHeader (LComment -> Comment
    forall a. RealLocated a -> a
    unRealSrcSpan LComment
    comment)
              then ([RealLocated Text]
    xs, LComment -> Maybe LComment
    forall a. a -> Maybe a
    Just LComment
    comment)
              else (RealLocated Text
    x RealLocated Text -> [RealLocated Text] -> [RealLocated Text]
    forall a. a -> [a] -> [a]
    : [RealLocated Text]
    xs, Maybe LComment
    forall a. Maybe a
    Nothing)
      where
        isStackHeader :: Comment -> Bool
    isStackHeader (Comment Bool
    _ (Text
    x :| [Text]
    _)) =
          Text
    "stack" Text -> Text -> Bool
    `T.isPrefixOf` Text -> Text
    T.stripStart (Int -> Text -> Text
    T.drop Int
    2 Text
    x)

    -- | Extract pragmas and their associated comments.
    extractPragmas ::
      -- | Input
      Text ->
      -- | Comment stream to analyze
      [RealLocated Text] ->
      ([LComment], [([LComment], Pragma)])
    extractPragmas :: Text -> [RealLocated Text] -> ([LComment], [([LComment], Pragma)])
    extractPragmas Text
    input = [(Int, Text)]
    -> ([LComment] -> [LComment])
    -> ([([LComment], Pragma)] -> [([LComment], Pragma)])
    -> [RealLocated Text]
    -> ([LComment], [([LComment], Pragma)])
    forall {b}.
    [(Int, Text)]
    -> ([LComment] -> [LComment])
    -> ([([LComment], Pragma)] -> b)
    -> [RealLocated Text]
    -> ([LComment], b)
    go [(Int, Text)]
    initialLs [LComment] -> [LComment]
    forall a. a -> a
    id [([LComment], Pragma)] -> [([LComment], Pragma)]
    forall a. a -> a
    id
      where
        initialLs :: [(Int, Text)]
    initialLs = [Int] -> [Text] -> [(Int, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1 ..] (Text -> [Text]
    T.lines Text
    input)
        go :: [(Int, Text)]
    -> ([LComment] -> [LComment])
    -> ([([LComment], Pragma)] -> b)
    -> [RealLocated Text]
    -> ([LComment], b)
    go [(Int, Text)]
    ls [LComment] -> [LComment]
    csSoFar [([LComment], Pragma)] -> b
    pragmasSoFar = \case
          [] -> ([LComment] -> [LComment]
    csSoFar [], [([LComment], Pragma)] -> b
    pragmasSoFar [])
          (RealLocated Text
    x : [RealLocated Text]
    xs) ->
            case Text -> Maybe Pragma
    parsePragma (RealLocated Text -> Text
    forall a. RealLocated a -> a
    unRealSrcSpan RealLocated Text
    x) of
              Maybe Pragma
    Nothing ->
                let ([(Int, Text)]
    ls', LComment
    x') = [(Int, Text)] -> RealLocated Text -> ([(Int, Text)], LComment)
    mkComment [(Int, Text)]
    ls RealLocated Text
    x
                 in [(Int, Text)]
    -> ([LComment] -> [LComment])
    -> ([([LComment], Pragma)] -> b)
    -> [RealLocated Text]
    -> ([LComment], b)
    go [(Int, Text)]
    ls' ([LComment] -> [LComment]
    csSoFar ([LComment] -> [LComment])
    -> ([LComment] -> [LComment]) -> [LComment] -> [LComment]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LComment
    x' LComment -> [LComment] -> [LComment]
    forall a. a -> [a] -> [a]
    :)) [([LComment], Pragma)] -> b
    pragmasSoFar [RealLocated Text]
    xs
              Just Pragma
    pragma ->
                let combined :: [LComment] -> ([LComment], Pragma)
    combined [LComment]
    ys = ([LComment] -> [LComment]
    csSoFar [LComment]
    ys, Pragma
    pragma)
                    go' :: [(Int, Text)]
    -> [LComment] -> [RealLocated Text] -> ([LComment], b)
    go' [(Int, Text)]
    ls' [LComment]
    ys [RealLocated Text]
    rest = [(Int, Text)]
    -> ([LComment] -> [LComment])
    -> ([([LComment], Pragma)] -> b)
    -> [RealLocated Text]
    -> ([LComment], b)
    go [(Int, Text)]
    ls' [LComment] -> [LComment]
    forall a. a -> a
    id ([([LComment], Pragma)] -> b
    pragmasSoFar ([([LComment], Pragma)] -> b)
    -> ([([LComment], Pragma)] -> [([LComment], Pragma)])
    -> [([LComment], Pragma)]
    -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([LComment] -> ([LComment], Pragma)
    combined [LComment]
    ys ([LComment], Pragma)
    -> [([LComment], Pragma)] -> [([LComment], Pragma)]
    forall a. a -> [a] -> [a]
    :)) [RealLocated Text]
    rest
                 in case [RealLocated Text]
    xs of
                      [] -> [(Int, Text)]
    -> [LComment] -> [RealLocated Text] -> ([LComment], b)
    go' [(Int, Text)]
    ls [] [RealLocated Text]
    xs
                      (RealLocated Text
    y : [RealLocated Text]
    ys) ->
                        let ([(Int, Text)]
    ls', LComment
    y') = [(Int, Text)] -> RealLocated Text -> ([(Int, Text)], LComment)
    mkComment [(Int, Text)]
    ls RealLocated Text
    y
                         in if SrcSpan -> SrcSpan -> Bool
    onTheSameLine
                              (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (RealLocated Text -> RealSrcSpan
    forall a. RealLocated a -> RealSrcSpan
    getRealSrcSpan RealLocated Text
    x) Maybe BufSpan
    forall a. Maybe a
    Strict.Nothing)
                              (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (RealLocated Text -> RealSrcSpan
    forall a. RealLocated a -> RealSrcSpan
    getRealSrcSpan RealLocated Text
    y) Maybe BufSpan
    forall a. Maybe a
    Strict.Nothing)
                              then [(Int, Text)]
    -> [LComment] -> [RealLocated Text] -> ([LComment], b)
    go' [(Int, Text)]
    ls' [LComment
    y'] [RealLocated Text]
    ys
                              else [(Int, Text)]
    -> [LComment] -> [RealLocated Text] -> ([LComment], b)
    go' [(Int, Text)]
    ls [] [RealLocated Text]
    xs

    -- | Extract @'RealLocated' 'Text'@ from 'GHC.LEpaComment'.
    unAnnotationComment :: GHC.LEpaComment -> Maybe (RealLocated Text)
    unAnnotationComment :: LEpaComment -> Maybe (RealLocated Text)
    unAnnotationComment (L NoCommentsLocation
    epaLoc (GHC.EpaComment EpaCommentTok
    eck RealSrcSpan
    _)) =
      case EpaCommentTok
    eck of
        GHC.EpaDocComment HsDocString
    s ->
          let trigger :: Maybe HsDocStringDecorator
    trigger = case HsDocString
    s of
                MultiLineDocString HsDocStringDecorator
    t NonEmpty LHsDocStringChunk
    _ -> HsDocStringDecorator -> Maybe HsDocStringDecorator
    forall a. a -> Maybe a
    Just HsDocStringDecorator
    t
                NestedDocString HsDocStringDecorator
    t LHsDocStringChunk
    _ -> HsDocStringDecorator -> Maybe HsDocStringDecorator
    forall a. a -> Maybe a
    Just HsDocStringDecorator
    t
                -- should not occur
                GeneratedDocString HsDocStringChunk
    _ -> Maybe HsDocStringDecorator
    forall a. Maybe a
    Nothing
           in Maybe HsDocStringDecorator -> Text -> Maybe (RealLocated Text)
    haddock Maybe HsDocStringDecorator
    trigger (String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ HsDocString -> String
    renderHsDocString HsDocString
    s)
        GHC.EpaDocOptions String
    s -> Text -> Maybe (RealLocated Text)
    forall {a}. a -> Maybe (GenLocated RealSrcSpan a)
    mkL (String -> Text
    T.pack String
    s)
        GHC.EpaLineComment (String -> Text
    T.pack -> Text
    s) -> Text -> Maybe (RealLocated Text)
    forall {a}. a -> Maybe (GenLocated RealSrcSpan a)
    mkL (Text -> Maybe (RealLocated Text))
    -> Text -> Maybe (RealLocated Text)
    forall a b. (a -> b) -> a -> b
    $
          case Int -> Text -> Text
    T.take Int
    3 Text
    s of
            Text
    "-- " -> Text
    s
            Text
    "---" -> Text
    s
            Text
    _ -> Text -> Text -> Int -> Text
    insertAt Text
    " " Text
    s Int
    3
        GHC.EpaBlockComment String
    s -> Text -> Maybe (RealLocated Text)
    forall {a}. a -> Maybe (GenLocated RealSrcSpan a)
    mkL (String -> Text
    T.pack String
    s)
      where
        mkL :: a -> Maybe (GenLocated RealSrcSpan a)
    mkL = case NoCommentsLocation
    epaLoc of
          GHC.EpaSpan (RealSrcSpan RealSrcSpan
    s Maybe BufSpan
    _) -> GenLocated RealSrcSpan a -> Maybe (GenLocated RealSrcSpan a)
    forall a. a -> Maybe a
    Just (GenLocated RealSrcSpan a -> Maybe (GenLocated RealSrcSpan a))
    -> (a -> GenLocated RealSrcSpan a)
    -> a
    -> Maybe (GenLocated RealSrcSpan a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RealSrcSpan -> a -> GenLocated RealSrcSpan a
    forall l e. l -> e -> GenLocated l e
    L RealSrcSpan
    s
          NoCommentsLocation
    _ -> Maybe (GenLocated RealSrcSpan a)
    -> a -> Maybe (GenLocated RealSrcSpan a)
    forall a b. a -> b -> a
    const Maybe (GenLocated RealSrcSpan a)
    forall a. Maybe a
    Nothing
        insertAt :: Text -> Text -> Int -> Text
    insertAt Text
    x Text
    xs Int
    n = Int -> Text -> Text
    T.take (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Text
    xs Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    x Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text -> Text
    T.drop (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Text
    xs
        haddock :: Maybe HsDocStringDecorator -> Text -> Maybe (RealLocated Text)
    haddock Maybe HsDocStringDecorator
    mtrigger =
          Text -> Maybe (RealLocated Text)
    forall {a}. a -> Maybe (GenLocated RealSrcSpan a)
    mkL (Text -> Maybe (RealLocated Text))
    -> (Text -> Text) -> Text -> Maybe (RealLocated Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    dashPrefix (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    escapeHaddockTriggers (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    trigger Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>) (Text -> Maybe (RealLocated Text))
    -> (Text -> Maybe Text) -> Text -> Maybe (RealLocated Text)
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> Maybe Text
    dropBlank
          where
            trigger :: Text
    trigger = case Maybe HsDocStringDecorator
    mtrigger of
              Just HsDocStringDecorator
    HsDocStringNext -> Text
    "|"
              Just HsDocStringDecorator
    HsDocStringPrevious -> Text
    "^"
              Just (HsDocStringNamed String
    n) -> Text
    "$" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack String
    n
              Just (HsDocStringGroup Int
    k) -> Int -> Text -> Text
    T.replicate Int
    k Text
    "*"
              Maybe HsDocStringDecorator
    Nothing -> Text
    ""
            dashPrefix :: Text -> Text
    dashPrefix Text
    s = Text
    "--" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    spaceIfNecessary Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s
              where
                spaceIfNecessary :: Text
    spaceIfNecessary = case Text -> Maybe (Char, Text)
    T.uncons Text
    s of
                  Just (Char
    c, Text
    _) | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ' -> Text
    " "
                  Maybe (Char, Text)
    _ -> Text
    ""
            dropBlank :: Text -> Maybe Text
            dropBlank :: Text -> Maybe Text
    dropBlank Text
    s = if (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    isSpace Text
    s then Maybe Text
    forall a. Maybe a
    Nothing else Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    s

    -- | Remove consecutive blank lines.
    removeConseqBlanks :: NonEmpty Text -> NonEmpty Text
    removeConseqBlanks :: NonEmpty Text -> NonEmpty Text
    removeConseqBlanks (Text
    x :| [Text]
    xs) = Text
    x Text -> [Text] -> NonEmpty Text
    forall a. a -> [a] -> NonEmpty a
    :| Bool -> ([Text] -> [Text]) -> [Text] -> [Text]
    forall {t}. Bool -> ([Text] -> t) -> [Text] -> t
    go (Text -> Bool
    T.null Text
    x) [Text] -> [Text]
    forall a. a -> a
    id [Text]
    xs
      where
        go :: Bool -> ([Text] -> t) -> [Text] -> t
    go Bool
    seenBlank [Text] -> t
    acc = \case
          [] -> [Text] -> t
    acc []
          (Text
    y : [Text]
    ys) ->
            if Bool
    seenBlank Bool -> Bool -> Bool
    && Text -> Bool
    T.null Text
    y
              then Bool -> ([Text] -> t) -> [Text] -> t
    go Bool
    True [Text] -> t
    acc [Text]
    ys
              else Bool -> ([Text] -> t) -> [Text] -> t
    go (Text -> Bool
    T.null Text
    y) ([Text] -> t
    acc ([Text] -> t) -> ([Text] -> [Text]) -> [Text] -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    y Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :)) [Text]
    ys

    -- | Escape characters that can turn a line into a Haddock.
    escapeHaddockTriggers :: Text -> Text
    escapeHaddockTriggers :: Text -> Text
    escapeHaddockTriggers Text
    string
      | Just (Char
    h, Text
    _) <- Text -> Maybe (Char, Text)
    T.uncons Text
    string, Char
    h Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (String
    "|^*$" :: [Char]) = Char -> Text -> Text
    T.cons Char
    '\\' Text
    string
      | Bool
    otherwise = Text
    string