{-# 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.Utils (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
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)

-- | 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 String
input [Located String]
extraComments PState
pstate =
  ( Maybe (RealLocated Comment)
mstackHeader,
    [Shebang]
shebangs,
    [([RealLocated Comment], Pragma)]
pragmas,
    [RealLocated Comment] -> CommentStream
CommentStream [RealLocated Comment]
comments
  )
  where
    ([RealLocated Comment]
comments, [([RealLocated Comment], Pragma)]
pragmas) = String
-> [RealLocated String]
-> ([RealLocated Comment], [([RealLocated Comment], Pragma)])
extractPragmas String
input [RealLocated String]
rawComments1
    ([RealLocated String]
rawComments1, 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)
    ([Shebang]
shebangs, [Located String]
otherExtraComments) = [Located String] -> ([Shebang], [Located String])
extractShebangs [Located String]
extraComments

-- | Pretty-print a 'CommentStream'.
showCommentStream :: CommentStream -> String
showCommentStream :: CommentStream -> String
showCommentStream (CommentStream [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 o
l a
str) = o -> String
forall o. Outputable o => o -> String
showOutputable o
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " 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
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)

-- | 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 [(Int, String)]
ls (L RealSrcSpan
l 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 -> 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
            Maybe (NonEmpty String)
Nothing -> String
s String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| []
            Just (String
x :| [String]
xs) ->
              let getIndent :: String -> Int
getIndent 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) -> 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)
               in String
x String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
n (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
:| []
    (Bool
atomsBefore, [(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, [])
        ((Int
_, String
i) : [(Int, String)]
ls'') ->
          case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
i) of
            String
"--" -> (Bool
False, [(Int, String)]
ls'')
            String
"{-" -> (Bool
False, [(Int, String)]
ls'')
            String
_ -> (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
- Int
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 Bool
_ 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 Bool
atomsBefore NonEmpty String
_) = Bool
atomsBefore

-- | Is this comment multiline-style?
isMultilineComment :: Comment -> Bool
isMultilineComment :: Comment -> Bool
isMultilineComment (Comment Bool
_ (String
x :| [String]
_)) = String
"{-" 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 ::
  [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)
  (RealLocated String
x : [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 Bool
_ (String
x :| [String]
_)) =
      String
"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 Int
2 String
x)

-- | Extract pragmas and their associated comments.
extractPragmas ::
  String ->
  [RealLocated String] ->
  ([RealLocated Comment], [([RealLocated Comment], Pragma)])
extractPragmas :: String
-> [RealLocated String]
-> ([RealLocated Comment], [([RealLocated Comment], Pragma)])
extractPragmas String
input = [(Int, String)]
-> ([RealLocated Comment] -> [RealLocated Comment])
-> ([([RealLocated Comment], Pragma)]
    -> [([RealLocated Comment], Pragma)])
-> [RealLocated String]
-> ([RealLocated Comment], [([RealLocated Comment], Pragma)])
forall c.
[(Int, String)]
-> ([RealLocated Comment] -> [RealLocated Comment])
-> ([([RealLocated Comment], Pragma)] -> c)
-> [RealLocated String]
-> ([RealLocated Comment], c)
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 [Int
1 ..] (String -> [String]
lines String
input)
    go :: [(Int, String)]
-> ([RealLocated Comment] -> [RealLocated Comment])
-> ([([RealLocated Comment], Pragma)] -> c)
-> [RealLocated String]
-> ([RealLocated Comment], c)
go [(Int, String)]
ls [RealLocated Comment] -> [RealLocated Comment]
csSoFar [([RealLocated Comment], Pragma)] -> c
pragmasSoFar = \case
      [] -> ([RealLocated Comment] -> [RealLocated Comment]
csSoFar [], [([RealLocated Comment], Pragma)] -> c
pragmasSoFar [])
      (RealLocated String
x : [RealLocated String]
xs) ->
        case String -> Maybe Pragma
parsePragma (RealLocated String -> String
forall a. RealLocated a -> a
unRealSrcSpan RealLocated String
x) of
          Maybe Pragma
Nothing ->
            let ([(Int, String)]
ls', 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)] -> c)
-> [RealLocated String]
-> ([RealLocated Comment], c)
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)] -> c
pragmasSoFar [RealLocated String]
xs
          Just Pragma
pragma ->
            let combined :: ([RealLocated Comment], Pragma)
combined = ([RealLocated Comment] -> [RealLocated Comment]
csSoFar [], Pragma
pragma)
             in [(Int, String)]
-> ([RealLocated Comment] -> [RealLocated Comment])
-> ([([RealLocated Comment], Pragma)] -> c)
-> [RealLocated String]
-> ([RealLocated Comment], c)
go [(Int, String)]
ls [RealLocated Comment] -> [RealLocated Comment]
forall a. a -> a
id ([([RealLocated Comment], Pragma)] -> c
pragmasSoFar ([([RealLocated Comment], Pragma)] -> c)
-> ([([RealLocated Comment], Pragma)]
    -> [([RealLocated Comment], Pragma)])
-> [([RealLocated Comment], Pragma)]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([RealLocated Comment], Pragma)
combined ([RealLocated Comment], Pragma)
-> [([RealLocated Comment], Pragma)]
-> [([RealLocated Comment], Pragma)]
forall a. a -> [a] -> [a]
:)) [RealLocated String]
xs

-- | Get a 'String' from 'GHC.AnnotationComment'.
unAnnotationComment :: GHC.AnnotationComment -> Maybe String
unAnnotationComment :: AnnotationComment -> Maybe String
unAnnotationComment = \case
  GHC.AnnDocCommentNext String
_ -> Maybe String
forall a. Maybe a
Nothing -- @-- |@
  GHC.AnnDocCommentPrev String
_ -> Maybe String
forall a. Maybe a
Nothing -- @-- ^@
  GHC.AnnDocCommentNamed String
_ -> Maybe String
forall a. Maybe a
Nothing -- @-- $@
  GHC.AnnDocSection Int
_ String
_ -> Maybe String
forall a. Maybe a
Nothing -- @-- *@
  GHC.AnnDocOptions String
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
  GHC.AnnLineComment String
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
  GHC.AnnBlockComment 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 SrcSpan
_ Maybe a
Nothing -> Maybe (Located a)
forall a. Maybe a
Nothing
  L SrcSpan
l (Just 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 RealSrcSpan
l) 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 Located a
_ = Maybe (RealLocated a)
forall a. Maybe a
Nothing

-- | Remove consecutive blank lines.
removeConseqBlanks :: NonEmpty String -> NonEmpty String
removeConseqBlanks :: NonEmpty String -> NonEmpty String
removeConseqBlanks (String
x :| [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 Bool
seenBlank [t a] -> c
acc = \case
      [] -> [t a] -> c
acc []
      (t a
y : [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