--------------------------------------------------------------------------------
-- | 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
cgBlock :: forall a. CommentGroup a -> LineBlock
cgPrior :: forall a. CommentGroup a -> [LEpaComment]
cgItems :: forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgFollowing :: forall a. CommentGroup a -> [LEpaComment]
cgBlock :: LineBlock
cgPrior :: [LEpaComment]
cgItems :: [(a, Maybe LEpaComment)]
cgFollowing :: [LEpaComment]
..} = 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]
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 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 a. a -> [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 a. a -> [a]
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 = []}], 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 = cgBlock c <> 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 = cgItems current <> [(i, Nothing)]}
                    NextComment LEpaComment
c
                        | [(a, Maybe LEpaComment)] -> Bool
forall a. [a] -> 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 = cgPrior current <> [c]}
                        | Bool
otherwise -> CommentGroup a
current {cgFollowing = cgFollowing current <> [c]}
                    NextItemWithComment a
i LEpaComment
c ->
                        CommentGroup a
current {cgItems = cgItems current <> [(i, Just 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 :: forall a.
[(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
    = 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 " 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 :: 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
cgBlock :: forall a. CommentGroup a -> LineBlock
cgPrior :: forall a. CommentGroup a -> [LEpaComment]
cgItems :: forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgFollowing :: forall a. CommentGroup a -> [LEpaComment]
cgBlock :: LineBlock
cgPrior :: [LEpaComment]
cgItems :: [(a, Maybe LEpaComment)]
cgFollowing :: [LEpaComment]
..} = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    [LEpaComment] -> Bool
forall a. [a] -> 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 a. [a] -> 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 = sortBy (cmp `on` fst) (cgItems cg)
    }