{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}

-- | Functions for working with comment stream.
module Ormolu.Parser.CommentStream
  ( CommentStream (..),
    Comment (..),
    mkCommentStream,
    isShebang,
    isPrevHaddock,
    isMultilineComment,
    showCommentStream,
  )
where

import Data.Char (isSpace)
import Data.Data (Data)
import Data.Either (partitionEithers)
import Data.List (dropWhileEnd, isPrefixOf, sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (mapMaybe)
import qualified GHC
import qualified Lexer as GHC
import Ormolu.Parser.Pragma
import Ormolu.Utils (showOutputable)
import SrcLoc

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

-- | A wrapper for a single comment. The 'NonEmpty' list inside contains
-- lines of multiline comment @{- … -}@ or just single item\/line otherwise.
newtype Comment = Comment (NonEmpty String)
  deriving (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: 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
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show, Typeable Comment
DataType
Constr
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 -> DataType
Comment -> Constr
(forall b. Data b => b -> b) -> Comment -> Comment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cComment :: Constr
$tComment :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapQi :: Int -> (forall d. Data d => d -> u) -> Comment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
gmapQ :: (forall d. Data d => d -> u) -> Comment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
$cgmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Comment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
dataTypeOf :: Comment -> DataType
$cdataTypeOf :: Comment -> DataType
toConstr :: Comment -> Constr
$ctoConstr :: Comment -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cp1Data :: Typeable Comment
Data)

-- | Create 'CommentStream' from 'GHC.PState'. The pragmas and shebangs are
-- removed from the 'CommentStream'. Shebangs are only extracted from the
-- comments that come from the first argument.
mkCommentStream ::
  -- | Extra comments to include
  [Located String] ->
  -- | Parser state to use for comment extraction
  GHC.PState ->
  -- | Comment stream, a set of extracted pragmas, and extracted shebangs
  (CommentStream, [Pragma], [Located String])
mkCommentStream :: [Located String]
-> PState -> (CommentStream, [Pragma], [Located String])
mkCommentStream extraComments :: [Located String]
extraComments pstate :: PState
pstate =
  ( [RealLocated Comment] -> CommentStream
CommentStream ([RealLocated Comment] -> CommentStream)
-> [RealLocated Comment] -> CommentStream
forall a b. (a -> b) -> a -> b
$
      RealLocated String -> RealLocated Comment
mkComment (RealLocated String -> RealLocated Comment)
-> [RealLocated String] -> [RealLocated Comment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RealLocated String -> RealSrcLoc)
-> [RealLocated String] -> [RealLocated String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (RealSrcSpan -> RealSrcLoc
realSrcSpanStart (RealSrcSpan -> RealSrcLoc)
-> (RealLocated String -> RealSrcSpan)
-> RealLocated String
-> RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealLocated String -> RealSrcSpan
forall a. RealLocated a -> RealSrcSpan
getRealSrcSpan) [RealLocated String]
comments,
    [Pragma]
pragmas,
    [Located String]
shebangs
  )
  where
    (comments :: [RealLocated String]
comments, pragmas :: [Pragma]
pragmas) = [Either (RealLocated String) Pragma]
-> ([RealLocated String], [Pragma])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (RealLocated String -> Either (RealLocated String) Pragma
partitionComments (RealLocated String -> Either (RealLocated String) Pragma)
-> [RealLocated String] -> [Either (RealLocated String) Pragma]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RealLocated String]
rawComments)
    rawComments :: [RealLocated String]
rawComments =
      (Located String -> Maybe (RealLocated String))
-> [Located String] -> [RealLocated String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located String -> Maybe (RealLocated String)
forall a. Located a -> Maybe (RealLocated a)
toRealSpan ([Located String] -> [RealLocated String])
-> [Located String] -> [RealLocated String]
forall a b. (a -> b) -> a -> b
$
        [Located String]
otherExtraComments
          [Located String] -> [Located String] -> [Located String]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpan AnnotationComment -> Maybe (Located String))
-> [GenLocated SrcSpan AnnotationComment] -> [Located String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Located (Maybe String) -> Maybe (Located String)
forall a. Located (Maybe a) -> Maybe (Located a)
liftMaybe (Located (Maybe String) -> Maybe (Located String))
-> (GenLocated SrcSpan AnnotationComment -> Located (Maybe String))
-> GenLocated SrcSpan AnnotationComment
-> Maybe (Located String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnotationComment -> Maybe String)
-> GenLocated SrcSpan AnnotationComment -> Located (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnnotationComment -> Maybe String
unAnnotationComment) (PState -> [GenLocated SrcSpan AnnotationComment]
GHC.comment_q PState
pstate)
          [Located String] -> [Located String] -> [Located String]
forall a. [a] -> [a] -> [a]
++ ((SrcSpan, [GenLocated SrcSpan AnnotationComment])
 -> [Located String])
-> [(SrcSpan, [GenLocated SrcSpan AnnotationComment])]
-> [Located String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            ((GenLocated SrcSpan AnnotationComment -> Maybe (Located String))
-> [GenLocated SrcSpan AnnotationComment] -> [Located String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Located (Maybe String) -> Maybe (Located String)
forall a. Located (Maybe a) -> Maybe (Located a)
liftMaybe (Located (Maybe String) -> Maybe (Located String))
-> (GenLocated SrcSpan AnnotationComment -> Located (Maybe String))
-> GenLocated SrcSpan AnnotationComment
-> Maybe (Located String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnotationComment -> Maybe String)
-> GenLocated SrcSpan AnnotationComment -> Located (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnnotationComment -> Maybe String
unAnnotationComment) ([GenLocated SrcSpan AnnotationComment] -> [Located String])
-> ((SrcSpan, [GenLocated SrcSpan AnnotationComment])
    -> [GenLocated SrcSpan AnnotationComment])
-> (SrcSpan, [GenLocated SrcSpan AnnotationComment])
-> [Located String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan, [GenLocated SrcSpan AnnotationComment])
-> [GenLocated SrcSpan AnnotationComment]
forall a b. (a, b) -> b
snd)
            (PState -> [(SrcSpan, [GenLocated SrcSpan AnnotationComment])]
GHC.annotations_comments PState
pstate)
    (shebangs :: [Located String]
shebangs, otherExtraComments :: [Located String]
otherExtraComments) = (Located String -> Bool)
-> [Located String] -> ([Located String], [Located String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (String -> Bool
isShebang (String -> Bool)
-> (Located String -> String) -> Located String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> String
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located String]
extraComments

-- | Return 'True' if given 'String' is a shebang.
isShebang :: String -> Bool
isShebang :: String -> Bool
isShebang str :: String
str = "#!" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str

-- | Test whether a 'Comment' looks like a Haddock following a definition,
-- i.e. something starting with @-- ^@.
isPrevHaddock :: Comment -> Bool
isPrevHaddock :: Comment -> Bool
isPrevHaddock (Comment (x :: String
x :| _)) = "-- ^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x

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

-- | Pretty-print a 'CommentStream'.
showCommentStream :: CommentStream -> String
showCommentStream :: CommentStream -> String
showCommentStream (CommentStream xs :: [RealLocated Comment]
xs) =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    RealLocated Comment -> String
forall o a. (Outputable o, Show a) => GenLocated o a -> String
showComment (RealLocated Comment -> String)
-> [RealLocated Comment] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RealLocated Comment]
xs
  where
    showComment :: GenLocated o a -> String
showComment (GHC.L l :: o
l str :: a
str) = o -> String
forall o. Outputable o => o -> String
showOutputable o
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
str

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

-- | Normalize comment string. Sometimes one multi-line comment is turned
-- into several lines for subsequent outputting with correct indentation for
-- each line.
mkComment :: RealLocated String -> RealLocated Comment
mkComment :: RealLocated String -> RealLocated Comment
mkComment (L l :: RealSrcSpan
l s :: String
s) =
  RealSrcSpan -> Comment -> RealLocated Comment
forall l e. l -> e -> GenLocated l e
L RealSrcSpan
l (Comment -> RealLocated Comment)
-> (NonEmpty String -> Comment)
-> NonEmpty String
-> RealLocated Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> Comment
Comment (NonEmpty String -> Comment)
-> (NonEmpty String -> NonEmpty String)
-> NonEmpty String
-> Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> NonEmpty String -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
dropTrailing (NonEmpty String -> RealLocated Comment)
-> NonEmpty String -> RealLocated Comment
forall a b. (a -> b) -> a -> b
$
    if "{-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s
      then case [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (String -> [String]
lines String
s) of
        Nothing -> String
s String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| []
        Just (x :: String
x :| xs :: [String]
xs) ->
          let getIndent :: String -> Int
getIndent y :: String
y =
                if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
y
                  then Int
startIndent
                  else String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isSpace String
y)
              n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Int
startIndent Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (String -> Int) -> [String] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Int
getIndent [String]
xs)
           in String
x String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
n ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
xs)
      else String
s String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| []
  where
    dropTrailing :: ShowS
dropTrailing = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace
    startIndent :: Int
startIndent = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1

-- | Get a 'String' from 'GHC.AnnotationComment'.
unAnnotationComment :: GHC.AnnotationComment -> Maybe String
unAnnotationComment :: AnnotationComment -> Maybe String
unAnnotationComment = \case
  GHC.AnnDocCommentNext _ -> Maybe String
forall a. Maybe a
Nothing -- @-- |@
  GHC.AnnDocCommentPrev _ -> Maybe String
forall a. Maybe a
Nothing -- @-- ^@
  GHC.AnnDocCommentNamed _ -> Maybe String
forall a. Maybe a
Nothing -- @-- $@
  GHC.AnnDocSection _ _ -> Maybe String
forall a. Maybe a
Nothing -- @-- *@
  GHC.AnnDocOptions s :: String
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
  GHC.AnnLineComment s :: String
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
  GHC.AnnBlockComment s :: String
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
s

liftMaybe :: Located (Maybe a) -> Maybe (Located a)
liftMaybe :: Located (Maybe a) -> Maybe (Located a)
liftMaybe = \case
  L _ Nothing -> Maybe (Located a)
forall a. Maybe a
Nothing
  L l :: SrcSpan
l (Just a :: a
a) -> Located a -> Maybe (Located a)
forall a. a -> Maybe a
Just (SrcSpan -> a -> Located a
forall l e. l -> e -> GenLocated l e
L SrcSpan
l a
a)

toRealSpan :: Located a -> Maybe (RealLocated a)
toRealSpan :: Located a -> Maybe (RealLocated a)
toRealSpan (L (RealSrcSpan l :: RealSrcSpan
l) a :: a
a) = RealLocated a -> Maybe (RealLocated a)
forall a. a -> Maybe a
Just (RealSrcSpan -> a -> RealLocated a
forall l e. l -> e -> GenLocated l e
L RealSrcSpan
l a
a)
toRealSpan _ = Maybe (RealLocated a)
forall a. Maybe a
Nothing

-- | If a given comment is a pragma, return it in parsed form in 'Right'.
-- Otherwise return the original comment unchanged.
partitionComments ::
  RealLocated String ->
  Either (RealLocated String) Pragma
partitionComments :: RealLocated String -> Either (RealLocated String) Pragma
partitionComments input :: RealLocated String
input =
  case String -> Maybe Pragma
parsePragma (RealLocated String -> String
forall a. RealLocated a -> a
unRealSrcSpan RealLocated String
input) of
    Nothing -> RealLocated String -> Either (RealLocated String) Pragma
forall a b. a -> Either a b
Left RealLocated String
input
    Just pragma :: Pragma
pragma -> Pragma -> Either (RealLocated String) Pragma
forall a b. b -> Either a b
Right Pragma
pragma