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

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

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

import Data.Char (isSpace)
import Data.Data (Data)
import qualified Data.List as L
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.Parser.Shebang
import Ormolu.Processing.Common
import Ormolu.Utils (onTheSameLine, showOutputable)
import SrcLoc

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

-- | 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
Constr
DataType
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 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)

-- | 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 ::
  -- | Original input
  String ->
  -- | Extra comments to include
  [Located String] ->
  -- | Parser state to use for comment extraction
  GHC.PState ->
  -- | Stack header, shebangs, pragmas, and comment stream
  ( Maybe (RealLocated Comment),
    [Shebang],
    [([RealLocated Comment], Pragma)],
    CommentStream
  )
mkCommentStream :: String
-> [Located String]
-> PState
-> (Maybe (RealLocated Comment), [Shebang],
    [([RealLocated Comment], Pragma)], CommentStream)
mkCommentStream input :: String
input extraComments :: [Located String]
extraComments pstate :: PState
pstate =
  ( Maybe (RealLocated Comment)
mstackHeader,
    [Shebang]
shebangs,
    [([RealLocated Comment], Pragma)]
pragmas,
    [RealLocated Comment] -> CommentStream
CommentStream [RealLocated Comment]
comments
  )
  where
    (comments :: [RealLocated Comment]
comments, pragmas :: [([RealLocated Comment], Pragma)]
pragmas) = String
-> [RealLocated String]
-> ([RealLocated Comment], [([RealLocated Comment], Pragma)])
extractPragmas String
input [RealLocated String]
rawComments1
    (rawComments1 :: [RealLocated String]
rawComments1, mstackHeader :: Maybe (RealLocated Comment)
mstackHeader) = [RealLocated String]
-> ([RealLocated String], Maybe (RealLocated Comment))
extractStackHeader [RealLocated String]
rawComments0
    rawComments0 :: [RealLocated String]
rawComments0 =
      (RealLocated String -> RealSrcLoc)
-> [RealLocated String] -> [RealLocated String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.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] -> [RealLocated String])
-> ([Located String] -> [RealLocated String])
-> [Located String]
-> [RealLocated String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 :: [Shebang]
shebangs, otherExtraComments :: [Located String]
otherExtraComments) = [Located String] -> ([Shebang], [Located String])
extractShebangs [Located String]
extraComments

-- | 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 -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
str

----------------------------------------------------------------------------
-- 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 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 -> String -> String
[Comment] -> String -> String
Comment -> String
(Int -> Comment -> String -> String)
-> (Comment -> String)
-> ([Comment] -> String -> String)
-> Show Comment
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Comment] -> String -> String
$cshowList :: [Comment] -> String -> String
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> String -> String
$cshowsPrec :: Int -> Comment -> String -> String
Show, Typeable Comment
Constr
DataType
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 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)

-- | 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, String)] ->
  -- | Raw comment string
  RealLocated String ->
  -- | Remaining lines of original input and the constructed 'Comment'
  ([(Int, String)], RealLocated Comment)
mkComment :: [(Int, String)]
-> RealLocated String -> ([(Int, String)], RealLocated Comment)
mkComment ls :: [(Int, String)]
ls (L l :: RealSrcSpan
l s :: String
s) = ([(Int, String)]
ls', RealLocated Comment
comment)
  where
    comment :: RealLocated Comment
comment =
      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
. Bool -> NonEmpty String -> Comment
Comment Bool
atomsBefore (NonEmpty String -> Comment)
-> (NonEmpty String -> NonEmpty String)
-> NonEmpty String
-> Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> NonEmpty String
removeConseqBlanks (NonEmpty String -> NonEmpty String)
-> (NonEmpty String -> NonEmpty String)
-> NonEmpty String
-> NonEmpty String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> NonEmpty String -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
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
`L.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 Bool -> Bool -> Bool
|| String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
forall s. IsString s => s
endDisabling
                      then Int
startIndent
                      else String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> String -> String
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)
                  removeIndent :: String -> String
removeIndent y :: String
y =
                    if String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
forall s. IsString s => s
endDisabling
                      then String
y
                      else Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
n String
y
               in String
x String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| (String -> String
removeIndent (String -> String) -> [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
:| []
    (atomsBefore :: Bool
atomsBefore, ls' :: [(Int, String)]
ls') =
      case ((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
commentLine) (Int -> Bool) -> ((Int, String) -> Int) -> (Int, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, String) -> Int
forall a b. (a, b) -> a
fst) [(Int, String)]
ls of
        [] -> (Bool
False, [])
        ((_, i :: String
i) : ls'' :: [(Int, String)]
ls'') ->
          case Int -> String -> String
forall a. Int -> [a] -> [a]
take 2 ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
i) of
            "--" -> (Bool
False, [(Int, String)]
ls'')
            "{-" -> (Bool
False, [(Int, String)]
ls'')
            _ -> (Bool
True, [(Int, String)]
ls'')
    dropTrailing :: String -> String
dropTrailing = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd Char -> Bool
isSpace
    startIndent :: Int
startIndent = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
    commentLine :: Int
commentLine = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
l

-- | Get a collection of lines from a 'Comment'.
unComment :: Comment -> NonEmpty String
unComment :: Comment -> NonEmpty String
unComment (Comment _ xs :: NonEmpty String
xs) = NonEmpty String
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 atomsBefore :: Bool
atomsBefore _) = Bool
atomsBefore

-- | 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
`L.isPrefixOf` String
x

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

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

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

-- | 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

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