{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
module Ormolu.Parser.CommentStream
(
CommentStream (..),
mkCommentStream,
showCommentStream,
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
newtype = [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, , 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)
mkCommentStream ::
String ->
[Located String] ->
GHC.PState ->
( Maybe (RealLocated Comment),
[Shebang],
[([RealLocated Comment], Pragma)],
CommentStream
)
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
showCommentStream :: CommentStream -> String
(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
data = 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, )
mkComment ::
[(Int, String)] ->
RealLocated String ->
([(Int, String)], RealLocated Comment)
[(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 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 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
:| []
(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
unComment :: Comment -> NonEmpty String
(Comment Bool
_ NonEmpty String
xs) = NonEmpty String
xs
hasAtomsBefore :: Comment -> Bool
hasAtomsBefore :: Comment -> Bool
hasAtomsBefore (Comment Bool
atomsBefore NonEmpty String
_) = Bool
atomsBefore
isMultilineComment :: Comment -> Bool
(Comment Bool
_ (String
x :| [String]
_)) = String
"{-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
x
extractStackHeader ::
[RealLocated String] ->
([RealLocated String], Maybe (RealLocated Comment))
= \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)
extractPragmas ::
String ->
[RealLocated String] ->
([RealLocated Comment], [([RealLocated Comment], Pragma)])
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 [Int
1 ..] (String -> [String]
lines String
input)
go :: [(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], Pragma)] -> b
pragmasSoFar = \case
[] -> ([RealLocated Comment] -> [RealLocated Comment]
csSoFar [], [([RealLocated Comment], Pragma)] -> b
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)] -> 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 ->
let combined :: [RealLocated Comment] -> ([RealLocated Comment], Pragma)
combined [RealLocated Comment]
ys = ([RealLocated Comment] -> [RealLocated Comment]
csSoFar [RealLocated Comment]
ys, Pragma
pragma)
go' :: [(Int, String)]
-> [RealLocated Comment]
-> [RealLocated String]
-> ([RealLocated Comment], b)
go' [(Int, String)]
ls' [RealLocated Comment]
ys [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
(RealLocated String
y : [RealLocated String]
ys) ->
let ([(Int, String)]
ls', 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
unAnnotationComment :: GHC.AnnotationComment -> Maybe String
= \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
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