{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.Stylish.Comments
( CommentGroup (..)
, commentGroups
, commentGroupHasComments
, commentGroupSort
) where
import Data.Function (on)
import Data.List (sortBy, sortOn)
import Data.Maybe (isNothing, maybeToList)
import qualified GHC.Hs as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Utils.Outputable as GHC
import Language.Haskell.Stylish.Block
import Language.Haskell.Stylish.GHC
data a =
{ CommentGroup a -> LineBlock
cgBlock :: LineBlock
, CommentGroup a -> [LEpaComment]
cgPrior :: [GHC.LEpaComment]
, CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems :: [(a, Maybe GHC.LEpaComment)]
, CommentGroup a -> [LEpaComment]
cgFollowing :: [GHC.LEpaComment]
}
instance GHC.Outputable a => Show (CommentGroup a) where
show :: CommentGroup a -> String
show CommentGroup {[(a, Maybe LEpaComment)]
[LEpaComment]
LineBlock
cgFollowing :: [LEpaComment]
cgItems :: [(a, Maybe LEpaComment)]
cgPrior :: [LEpaComment]
cgBlock :: LineBlock
cgFollowing :: forall a. CommentGroup a -> [LEpaComment]
cgItems :: forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgPrior :: forall a. CommentGroup a -> [LEpaComment]
cgBlock :: forall a. CommentGroup a -> LineBlock
..} = String
"(CommentGroup (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
LineBlock -> String
forall a. Show a => a -> String
show LineBlock
cgBlock String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
[LEpaComment] -> String
forall a. Outputable a => a -> String
showOutputable [LEpaComment]
cgPrior String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
[(a, Maybe LEpaComment)] -> String
forall a. Outputable a => a -> String
showOutputable [(a, Maybe LEpaComment)]
cgItems String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
[LEpaComment] -> String
forall a. Outputable a => a -> String
showOutputable [LEpaComment]
cgFollowing String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"))"
commentGroups
:: forall a.
(a -> Maybe GHC.RealSrcSpan)
-> [a]
-> [GHC.LEpaComment]
-> [CommentGroup a]
a -> Maybe RealSrcSpan
getSpan [a]
allItems [LEpaComment]
allComments =
Maybe (CommentGroup a)
-> [(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> [CommentGroup a]
work Maybe (CommentGroup a)
forall a. Maybe a
Nothing (((LineBlock, a) -> LineBlock)
-> [(LineBlock, a)] -> [(LineBlock, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (LineBlock, a) -> LineBlock
forall a b. (a, b) -> a
fst [(LineBlock, a)]
allItemsWithLines) (((LineBlock, LEpaComment) -> LineBlock)
-> [(LineBlock, LEpaComment)] -> [(LineBlock, LEpaComment)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (LineBlock, LEpaComment) -> LineBlock
forall a b. (a, b) -> a
fst [(LineBlock, LEpaComment)]
commentsWithLines)
where
allItemsWithLines :: [(LineBlock, a)]
allItemsWithLines :: [(LineBlock, a)]
allItemsWithLines = do
a
item <- [a]
allItems
RealSrcSpan
s <- Maybe RealSrcSpan -> [RealSrcSpan]
forall a. Maybe a -> [a]
maybeToList (Maybe RealSrcSpan -> [RealSrcSpan])
-> Maybe RealSrcSpan -> [RealSrcSpan]
forall a b. (a -> b) -> a -> b
$ a -> Maybe RealSrcSpan
getSpan a
item
(LineBlock, a) -> [(LineBlock, a)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RealSrcSpan -> LineBlock
realSrcSpanToLineBlock RealSrcSpan
s, a
item)
commentsWithLines :: [(LineBlock, GHC.LEpaComment)]
commentsWithLines :: [(LineBlock, LEpaComment)]
commentsWithLines = do
LEpaComment
comment <- [LEpaComment]
allComments
let s :: RealSrcSpan
s = Anchor -> RealSrcSpan
GHC.anchor (Anchor -> RealSrcSpan) -> Anchor -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> Anchor
forall l e. GenLocated l e -> l
GHC.getLoc LEpaComment
comment
(LineBlock, LEpaComment) -> [(LineBlock, LEpaComment)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RealSrcSpan -> LineBlock
realSrcSpanToLineBlock RealSrcSpan
s, LEpaComment
comment)
work
:: Maybe (CommentGroup a)
-> [(LineBlock, a)]
-> [(LineBlock, GHC.LEpaComment)]
-> [CommentGroup a]
work :: Maybe (CommentGroup a)
-> [(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> [CommentGroup a]
work Maybe (CommentGroup a)
mbCurrent [(LineBlock, a)]
items [(LineBlock, LEpaComment)]
comments = case [(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
forall a.
[(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
takeNext [(LineBlock, a)]
items [(LineBlock, LEpaComment)]
comments of
Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
Nothing -> Maybe (CommentGroup a) -> [CommentGroup a]
forall a. Maybe a -> [a]
maybeToList Maybe (CommentGroup a)
mbCurrent
Just (LineBlock
b, NextThing a
next, [(LineBlock, a)]
items', [(LineBlock, LEpaComment)]
comments') ->
let ([CommentGroup a]
flush, CommentGroup a
current) = case Maybe (CommentGroup a)
mbCurrent of
Just CommentGroup a
c | LineBlock -> LineBlock -> Bool
forall a. Block a -> Block a -> Bool
adjacent (CommentGroup a -> LineBlock
forall a. CommentGroup a -> LineBlock
cgBlock CommentGroup a
c) LineBlock
b
, NextThing a -> Bool
forall a. NextThing a -> Bool
nextThingItem NextThing a
next
, following :: [LEpaComment]
following@(LEpaComment
_ : [LEpaComment]
_) <- CommentGroup a -> [LEpaComment]
forall a. CommentGroup a -> [LEpaComment]
cgFollowing CommentGroup a
c ->
([CommentGroup a
c {cgFollowing :: [LEpaComment]
cgFollowing = []}], LineBlock
-> [LEpaComment]
-> [(a, Maybe LEpaComment)]
-> [LEpaComment]
-> CommentGroup a
forall a.
LineBlock
-> [LEpaComment]
-> [(a, Maybe LEpaComment)]
-> [LEpaComment]
-> CommentGroup a
CommentGroup LineBlock
b [LEpaComment]
following [] [])
Just CommentGroup a
c | LineBlock -> LineBlock -> Bool
forall a. Block a -> Block a -> Bool
adjacent (CommentGroup a -> LineBlock
forall a. CommentGroup a -> LineBlock
cgBlock CommentGroup a
c) LineBlock
b ->
([], CommentGroup a
c {cgBlock :: LineBlock
cgBlock = CommentGroup a -> LineBlock
forall a. CommentGroup a -> LineBlock
cgBlock CommentGroup a
c LineBlock -> LineBlock -> LineBlock
forall a. Semigroup a => a -> a -> a
<> LineBlock
b})
Maybe (CommentGroup a)
_ -> (Maybe (CommentGroup a) -> [CommentGroup a]
forall a. Maybe a -> [a]
maybeToList Maybe (CommentGroup a)
mbCurrent, LineBlock
-> [LEpaComment]
-> [(a, Maybe LEpaComment)]
-> [LEpaComment]
-> CommentGroup a
forall a.
LineBlock
-> [LEpaComment]
-> [(a, Maybe LEpaComment)]
-> [LEpaComment]
-> CommentGroup a
CommentGroup LineBlock
b [] [] [])
current' :: CommentGroup a
current' = case NextThing a
next of
NextItem a
i -> CommentGroup a
current {cgItems :: [(a, Maybe LEpaComment)]
cgItems = CommentGroup a -> [(a, Maybe LEpaComment)]
forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup a
current [(a, Maybe LEpaComment)]
-> [(a, Maybe LEpaComment)] -> [(a, Maybe LEpaComment)]
forall a. Semigroup a => a -> a -> a
<> [(a
i, Maybe LEpaComment
forall a. Maybe a
Nothing)]}
NextComment LEpaComment
c
| [(a, Maybe LEpaComment)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CommentGroup a -> [(a, Maybe LEpaComment)]
forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup a
current) -> CommentGroup a
current {cgPrior :: [LEpaComment]
cgPrior = CommentGroup a -> [LEpaComment]
forall a. CommentGroup a -> [LEpaComment]
cgPrior CommentGroup a
current [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. Semigroup a => a -> a -> a
<> [LEpaComment
c]}
| Bool
otherwise -> CommentGroup a
current {cgFollowing :: [LEpaComment]
cgFollowing = CommentGroup a -> [LEpaComment]
forall a. CommentGroup a -> [LEpaComment]
cgFollowing CommentGroup a
current [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. Semigroup a => a -> a -> a
<> [LEpaComment
c]}
NextItemWithComment a
i LEpaComment
c ->
CommentGroup a
current {cgItems :: [(a, Maybe LEpaComment)]
cgItems = CommentGroup a -> [(a, Maybe LEpaComment)]
forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup a
current [(a, Maybe LEpaComment)]
-> [(a, Maybe LEpaComment)] -> [(a, Maybe LEpaComment)]
forall a. Semigroup a => a -> a -> a
<> [(a
i, LEpaComment -> Maybe LEpaComment
forall a. a -> Maybe a
Just LEpaComment
c)]} in
[CommentGroup a]
flush [CommentGroup a] -> [CommentGroup a] -> [CommentGroup a]
forall a. [a] -> [a] -> [a]
++ Maybe (CommentGroup a)
-> [(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> [CommentGroup a]
work (CommentGroup a -> Maybe (CommentGroup a)
forall a. a -> Maybe a
Just CommentGroup a
current') [(LineBlock, a)]
items' [(LineBlock, LEpaComment)]
comments'
takeNext
:: [(LineBlock, a)]
-> [(LineBlock, GHC.LEpaComment)]
-> Maybe (LineBlock, NextThing a, [(LineBlock, a)], [(LineBlock, GHC.LEpaComment)])
takeNext :: [(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
takeNext [] [] = Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
forall a. Maybe a
Nothing
takeNext [] ((LineBlock
cb, LEpaComment
c) : [(LineBlock, LEpaComment)]
comments) =
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
-> Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
forall a. a -> Maybe a
Just (LineBlock
cb, LEpaComment -> NextThing a
forall a. LEpaComment -> NextThing a
NextComment LEpaComment
c, [], [(LineBlock, LEpaComment)]
comments)
takeNext ((LineBlock
ib, a
i) : [(LineBlock, a)]
items) [] =
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
-> Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
forall a. a -> Maybe a
Just (LineBlock
ib, a -> NextThing a
forall a. a -> NextThing a
NextItem a
i, [(LineBlock, a)]
items, [])
takeNext ((LineBlock
ib, a
i) : [(LineBlock, a)]
items) ((LineBlock
cb, LEpaComment
c) : [(LineBlock, LEpaComment)]
comments)
| LineBlock -> Int
forall a. Block a -> Int
blockStart LineBlock
ib Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== LineBlock -> Int
forall a. Block a -> Int
blockStart LineBlock
cb =
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
-> Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
forall a. a -> Maybe a
Just (LineBlock
ib LineBlock -> LineBlock -> LineBlock
forall a. Semigroup a => a -> a -> a
<> LineBlock
cb, a -> LEpaComment -> NextThing a
forall a. a -> LEpaComment -> NextThing a
NextItemWithComment a
i LEpaComment
c, [(LineBlock, a)]
items, [(LineBlock, LEpaComment)]
comments)
| LineBlock -> Int
forall a. Block a -> Int
blockStart LineBlock
ib Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< LineBlock -> Int
forall a. Block a -> Int
blockStart LineBlock
cb =
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
-> Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
forall a. a -> Maybe a
Just (LineBlock
ib, a -> NextThing a
forall a. a -> NextThing a
NextItem a
i, [(LineBlock, a)]
items, (LineBlock
cb, LEpaComment
c) (LineBlock, LEpaComment)
-> [(LineBlock, LEpaComment)] -> [(LineBlock, LEpaComment)]
forall a. a -> [a] -> [a]
: [(LineBlock, LEpaComment)]
comments)
| Bool
otherwise =
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
-> Maybe
(LineBlock, NextThing a, [(LineBlock, a)],
[(LineBlock, LEpaComment)])
forall a. a -> Maybe a
Just (LineBlock
cb, LEpaComment -> NextThing a
forall a. LEpaComment -> NextThing a
NextComment LEpaComment
c, (LineBlock
ib, a
i) (LineBlock, a) -> [(LineBlock, a)] -> [(LineBlock, a)]
forall a. a -> [a] -> [a]
: [(LineBlock, a)]
items, [(LineBlock, LEpaComment)]
comments)
data NextThing a
= GHC.LEpaComment
| NextItem a
| a GHC.LEpaComment
instance GHC.Outputable a => Show (NextThing a) where
show :: NextThing a -> String
show (NextComment LEpaComment
c) = String
"NextComment " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LEpaComment -> String
forall a. Outputable a => a -> String
showOutputable LEpaComment
c
show (NextItem a
i) = String
"NextItem " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Outputable a => a -> String
showOutputable a
i
show (NextItemWithComment a
i LEpaComment
c) =
String
"NextItemWithComment " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Outputable a => a -> String
showOutputable a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LEpaComment -> String
forall a. Outputable a => a -> String
showOutputable LEpaComment
c
nextThingItem :: NextThing a -> Bool
nextThingItem :: NextThing a -> Bool
nextThingItem (NextComment LEpaComment
_) = Bool
False
nextThingItem (NextItem a
_) = Bool
True
nextThingItem (NextItemWithComment a
_ LEpaComment
_) = Bool
True
commentGroupHasComments :: CommentGroup a -> Bool
CommentGroup {[(a, Maybe LEpaComment)]
[LEpaComment]
LineBlock
cgFollowing :: [LEpaComment]
cgItems :: [(a, Maybe LEpaComment)]
cgPrior :: [LEpaComment]
cgBlock :: LineBlock
cgFollowing :: forall a. CommentGroup a -> [LEpaComment]
cgItems :: forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgPrior :: forall a. CommentGroup a -> [LEpaComment]
cgBlock :: forall a. CommentGroup a -> LineBlock
..} = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
[LEpaComment] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEpaComment]
cgPrior Bool -> Bool -> Bool
&& ((a, Maybe LEpaComment) -> Bool)
-> [(a, Maybe LEpaComment)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe LEpaComment -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe LEpaComment -> Bool)
-> ((a, Maybe LEpaComment) -> Maybe LEpaComment)
-> (a, Maybe LEpaComment)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Maybe LEpaComment) -> Maybe LEpaComment
forall a b. (a, b) -> b
snd) [(a, Maybe LEpaComment)]
cgItems Bool -> Bool -> Bool
&& [LEpaComment] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEpaComment]
cgFollowing
commentGroupSort :: (a -> a -> Ordering) -> CommentGroup a -> CommentGroup a
a -> a -> Ordering
cmp CommentGroup a
cg = CommentGroup a
cg
{ cgItems :: [(a, Maybe LEpaComment)]
cgItems = ((a, Maybe LEpaComment) -> (a, Maybe LEpaComment) -> Ordering)
-> [(a, Maybe LEpaComment)] -> [(a, Maybe LEpaComment)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (a -> a -> Ordering
cmp (a -> a -> Ordering)
-> ((a, Maybe LEpaComment) -> a)
-> (a, Maybe LEpaComment)
-> (a, Maybe LEpaComment)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, Maybe LEpaComment) -> a
forall a b. (a, b) -> a
fst) (CommentGroup a -> [(a, Maybe LEpaComment)]
forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup a
cg)
}