--------------------------------------------------------------------------------
-- | Utilities for assocgating comments with things in a list.
{-# 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 CommentGroup a = CommentGroup
    { forall a. CommentGroup a -> LineBlock
cgBlock     :: LineBlock
    , forall a. CommentGroup a -> [LEpaComment]
cgPrior     :: [GHC.LEpaComment]
    , forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems     :: [(a, Maybe GHC.LEpaComment)]
    , forall a. 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 (" forall a. [a] -> [a] -> [a]
++
        forall a. Show a => a -> String
show LineBlock
cgBlock forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++
        forall a. Outputable a => a -> String
showOutputable [LEpaComment]
cgPrior forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++
        forall a. Outputable a => a -> String
showOutputable [(a, Maybe LEpaComment)]
cgItems forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++
        forall a. Outputable a => a -> String
showOutputable [LEpaComment]
cgFollowing forall a. [a] -> [a] -> [a]
++ String
"))"


--------------------------------------------------------------------------------
commentGroups
    :: forall a.
       (a -> Maybe GHC.RealSrcSpan)
    -> [a]
    -> [GHC.LEpaComment]
    -> [CommentGroup a]
commentGroups :: forall a.
(a -> Maybe RealSrcSpan)
-> [a] -> [LEpaComment] -> [CommentGroup a]
commentGroups a -> Maybe RealSrcSpan
getSpan [a]
allItems [LEpaComment]
allComments =
    Maybe (CommentGroup a)
-> [(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> [CommentGroup a]
work forall a. Maybe a
Nothing (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [(LineBlock, a)]
allItemsWithLines) (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn 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 <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ a -> Maybe RealSrcSpan
getSpan a
item
        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 forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> l
GHC.getLoc LEpaComment
comment
        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 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 -> 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  | forall a. Block a -> Block a -> Bool
adjacent (forall a. CommentGroup a -> LineBlock
cgBlock CommentGroup a
c) LineBlock
b
                            , forall a. NextThing a -> Bool
nextThingItem NextThing a
next
                            , following :: [LEpaComment]
following@(LEpaComment
_ : [LEpaComment]
_) <- forall a. CommentGroup a -> [LEpaComment]
cgFollowing CommentGroup a
c ->
                        ([CommentGroup a
c {cgFollowing :: [LEpaComment]
cgFollowing = []}], forall a.
LineBlock
-> [LEpaComment]
-> [(a, Maybe LEpaComment)]
-> [LEpaComment]
-> CommentGroup a
CommentGroup LineBlock
b [LEpaComment]
following [] [])
                    Just CommentGroup a
c  | forall a. Block a -> Block a -> Bool
adjacent (forall a. CommentGroup a -> LineBlock
cgBlock CommentGroup a
c) LineBlock
b ->
                        ([], CommentGroup a
c {cgBlock :: LineBlock
cgBlock = forall a. CommentGroup a -> LineBlock
cgBlock CommentGroup a
c forall a. Semigroup a => a -> a -> a
<> LineBlock
b})
                    Maybe (CommentGroup a)
_ -> (forall a. Maybe a -> [a]
maybeToList Maybe (CommentGroup a)
mbCurrent, 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 = forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup a
current forall a. Semigroup a => a -> a -> a
<> [(a
i, forall a. Maybe a
Nothing)]}
                    NextComment LEpaComment
c
                        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup a
current) -> CommentGroup a
current {cgPrior :: [LEpaComment]
cgPrior = forall a. CommentGroup a -> [LEpaComment]
cgPrior CommentGroup a
current forall a. Semigroup a => a -> a -> a
<> [LEpaComment
c]}
                        | Bool
otherwise -> CommentGroup a
current {cgFollowing :: [LEpaComment]
cgFollowing = forall a. CommentGroup a -> [LEpaComment]
cgFollowing CommentGroup a
current forall a. Semigroup a => a -> a -> a
<> [LEpaComment
c]}
                    NextItemWithComment a
i LEpaComment
c ->
                        CommentGroup a
current {cgItems :: [(a, Maybe LEpaComment)]
cgItems = forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup a
current forall a. Semigroup a => a -> a -> a
<> [(a
i, forall a. a -> Maybe a
Just LEpaComment
c)]} in
            [CommentGroup a]
flush forall a. [a] -> [a] -> [a]
++ Maybe (CommentGroup a)
-> [(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> [CommentGroup a]
work (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 :: forall a.
[(LineBlock, a)]
-> [(LineBlock, LEpaComment)]
-> Maybe
     (LineBlock, NextThing a, [(LineBlock, a)],
      [(LineBlock, LEpaComment)])
takeNext [] [] = forall a. Maybe a
Nothing
takeNext [] ((LineBlock
cb, LEpaComment
c) : [(LineBlock, LEpaComment)]
comments) =
    forall a. a -> Maybe a
Just (LineBlock
cb, forall a. LEpaComment -> NextThing a
NextComment LEpaComment
c, [], [(LineBlock, LEpaComment)]
comments)
takeNext ((LineBlock
ib, a
i) : [(LineBlock, a)]
items) [] =
    forall a. a -> Maybe a
Just (LineBlock
ib, 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)
    | forall a. Block a -> Int
blockStart LineBlock
ib forall a. Eq a => a -> a -> Bool
== forall a. Block a -> Int
blockStart LineBlock
cb =
        forall a. a -> Maybe a
Just (LineBlock
ib forall a. Semigroup a => a -> a -> a
<> LineBlock
cb, forall a. a -> LEpaComment -> NextThing a
NextItemWithComment a
i LEpaComment
c, [(LineBlock, a)]
items, [(LineBlock, LEpaComment)]
comments)
    | forall a. Block a -> Int
blockStart LineBlock
ib forall a. Ord a => a -> a -> Bool
< forall a. Block a -> Int
blockStart LineBlock
cb =
        forall a. a -> Maybe a
Just (LineBlock
ib, forall a. a -> NextThing a
NextItem a
i, [(LineBlock, a)]
items, (LineBlock
cb, LEpaComment
c) forall a. a -> [a] -> [a]
: [(LineBlock, LEpaComment)]
comments)
    | Bool
otherwise =
        forall a. a -> Maybe a
Just (LineBlock
cb, forall a. LEpaComment -> NextThing a
NextComment LEpaComment
c, (LineBlock
ib, a
i) forall a. a -> [a] -> [a]
: [(LineBlock, a)]
items, [(LineBlock, LEpaComment)]
comments)


--------------------------------------------------------------------------------
data NextThing a
    = NextComment GHC.LEpaComment
    | NextItem a
    | NextItemWithComment a GHC.LEpaComment


--------------------------------------------------------------------------------
instance GHC.Outputable a => Show (NextThing a) where
    show :: NextThing a -> String
show (NextComment LEpaComment
c) = String
"NextComment " forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> String
showOutputable LEpaComment
c
    show (NextItem a
i) = String
"NextItem " forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> String
showOutputable a
i
    show (NextItemWithComment a
i LEpaComment
c) =
        String
"NextItemWithComment " forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> String
showOutputable a
i forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> String
showOutputable LEpaComment
c


--------------------------------------------------------------------------------
nextThingItem :: NextThing a -> Bool
nextThingItem :: forall a. NextThing a -> Bool
nextThingItem (NextComment LEpaComment
_)           = Bool
False
nextThingItem (NextItem a
_)              = Bool
True
nextThingItem (NextItemWithComment a
_ LEpaComment
_) = Bool
True


--------------------------------------------------------------------------------
commentGroupHasComments :: CommentGroup a -> Bool
commentGroupHasComments :: forall a. CommentGroup a -> Bool
commentGroupHasComments 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 forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEpaComment]
cgPrior Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(a, Maybe LEpaComment)]
cgItems Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEpaComment]
cgFollowing


--------------------------------------------------------------------------------
commentGroupSort :: (a -> a -> Ordering) -> CommentGroup a -> CommentGroup a
commentGroupSort :: forall a. (a -> a -> Ordering) -> CommentGroup a -> CommentGroup a
commentGroupSort a -> a -> Ordering
cmp CommentGroup a
cg = CommentGroup a
cg
    { cgItems :: [(a, Maybe LEpaComment)]
cgItems = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (a -> a -> Ordering
cmp forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) (forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup a
cg)
    }