Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
Functions for working with comment stream.
Synopsis
- newtype CommentStream = CommentStream [LComment]
- mkCommentStream :: Text -> HsModule GhcPs -> (Maybe LComment, [([LComment], Pragma)], CommentStream)
- showCommentStream :: CommentStream -> String
- type LComment = RealLocated Comment
- data Comment = Comment Bool (NonEmpty Text)
- unComment :: Comment -> NonEmpty Text
- hasAtomsBefore :: Comment -> Bool
- isMultilineComment :: Comment -> Bool
Comment stream
newtype CommentStream Source #
A stream of RealLocated
Comment
s in ascending order with respect to
beginning of corresponding spans.
Instances
:: Text | Original input |
-> HsModule GhcPs | Module to use for comment extraction |
-> (Maybe LComment, [([LComment], Pragma)], CommentStream) | Stack header, pragmas, and comment stream |
Create CommentStream
from HsModule
. The pragmas are
removed from the CommentStream
.
showCommentStream :: CommentStream -> String Source #
Pretty-print a CommentStream
.
Comment
type LComment = RealLocated Comment Source #
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.
Instances
Data Comment Source # | |
Defined in Ormolu.Parser.CommentStream gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Comment -> c Comment # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Comment # toConstr :: Comment -> Constr # dataTypeOf :: Comment -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Comment) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment) # gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Comment -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Comment -> r # gmapQ :: (forall d. Data d => d -> u) -> Comment -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Comment -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Comment -> m Comment # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Comment -> m Comment # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Comment -> m Comment # | |
Show Comment Source # | |
Eq Comment Source # | |
hasAtomsBefore :: Comment -> Bool Source #
Check whether the Comment
had some non-whitespace atoms in front of
it in the original input.
isMultilineComment :: Comment -> Bool Source #
Is this comment multiline-style?