{-|
Description : Detaching comments from the annotations of the syntax tree

This is the last part of the process.
-}
module Language.Haskell.Formatter.Process.DetachComments (detachComments) where
import qualified Data.Foldable as Foldable
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import qualified Data.Monoid as Monoid
import qualified Data.Semigroup as Semigroup
import qualified Language.Haskell.Formatter.CommentCore as CommentCore
import qualified Language.Haskell.Formatter.ExactCode as ExactCode
import qualified Language.Haskell.Formatter.Location as Location
import qualified Language.Haskell.Formatter.Process.Code as Code
import qualified Language.Haskell.Formatter.Process.LineTool as LineTool
import qualified Language.Haskell.Formatter.Process.Note as Note
import qualified Language.Haskell.Formatter.Result as Result
import qualified Language.Haskell.Formatter.Source as Source
import qualified Language.Haskell.Formatter.Style as Style
import qualified Language.Haskell.Formatter.Toolkit.ListTool as ListTool
import qualified Language.Haskell.Formatter.Toolkit.StreamName as StreamName

newtype Reservation = Reservation (Map.Map Location.Line [Note.CommentBox])
                        deriving (Reservation -> Reservation -> Bool
(Reservation -> Reservation -> Bool)
-> (Reservation -> Reservation -> Bool) -> Eq Reservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reservation -> Reservation -> Bool
$c/= :: Reservation -> Reservation -> Bool
== :: Reservation -> Reservation -> Bool
$c== :: Reservation -> Reservation -> Bool
Eq, Eq Reservation
Eq Reservation
-> (Reservation -> Reservation -> Ordering)
-> (Reservation -> Reservation -> Bool)
-> (Reservation -> Reservation -> Bool)
-> (Reservation -> Reservation -> Bool)
-> (Reservation -> Reservation -> Bool)
-> (Reservation -> Reservation -> Reservation)
-> (Reservation -> Reservation -> Reservation)
-> Ord Reservation
Reservation -> Reservation -> Bool
Reservation -> Reservation -> Ordering
Reservation -> Reservation -> Reservation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Reservation -> Reservation -> Reservation
$cmin :: Reservation -> Reservation -> Reservation
max :: Reservation -> Reservation -> Reservation
$cmax :: Reservation -> Reservation -> Reservation
>= :: Reservation -> Reservation -> Bool
$c>= :: Reservation -> Reservation -> Bool
> :: Reservation -> Reservation -> Bool
$c> :: Reservation -> Reservation -> Bool
<= :: Reservation -> Reservation -> Bool
$c<= :: Reservation -> Reservation -> Bool
< :: Reservation -> Reservation -> Bool
$c< :: Reservation -> Reservation -> Bool
compare :: Reservation -> Reservation -> Ordering
$ccompare :: Reservation -> Reservation -> Ordering
$cp1Ord :: Eq Reservation
Ord, Int -> Reservation -> ShowS
[Reservation] -> ShowS
Reservation -> String
(Int -> Reservation -> ShowS)
-> (Reservation -> String)
-> ([Reservation] -> ShowS)
-> Show Reservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reservation] -> ShowS
$cshowList :: [Reservation] -> ShowS
show :: Reservation -> String
$cshow :: Reservation -> String
showsPrec :: Int -> Reservation -> ShowS
$cshowsPrec :: Int -> Reservation -> ShowS
Show)

instance Semigroup.Semigroup Reservation where
        (Reservation Map Line [CommentBox]
left) <> :: Reservation -> Reservation -> Reservation
<> (Reservation Map Line [CommentBox]
right) = Map Line [CommentBox] -> Reservation
Reservation Map Line [CommentBox]
merged
          where merged :: Map Line [CommentBox]
merged = ([CommentBox] -> [CommentBox] -> [CommentBox])
-> Map Line [CommentBox]
-> Map Line [CommentBox]
-> Map Line [CommentBox]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [CommentBox] -> [CommentBox] -> [CommentBox]
merge Map Line [CommentBox]
left Map Line [CommentBox]
right
                merge :: [CommentBox] -> [CommentBox] -> [CommentBox]
merge [CommentBox]
before [CommentBox]
after = [[CommentBox]] -> [CommentBox]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CommentBox]
before, [CommentBox]
between, [CommentBox]
after]
                  where between :: [CommentBox]
between
                          = [CommentBox
Note.EmptyLine |
                             Maybe CommentBox -> Bool
hasActualComment ([CommentBox] -> Maybe CommentBox
forall a. [a] -> Maybe a
ListTool.maybeLast [CommentBox]
before) Bool -> Bool -> Bool
&&
                               Maybe CommentBox -> Bool
hasActualComment ([CommentBox] -> Maybe CommentBox
forall a. [a] -> Maybe a
Maybe.listToMaybe [CommentBox]
after)]
                hasActualComment :: Maybe CommentBox -> Bool
hasActualComment Maybe CommentBox
maybeComment
                  = case Maybe CommentBox
maybeComment of
                        Maybe CommentBox
Nothing -> Bool
False
                        Just (Note.ActualComment IndentedComment
_) -> Bool
True
                        Just CommentBox
Note.EmptyLine -> Bool
False

instance Monoid.Monoid Reservation where
        mempty :: Reservation
mempty = Map Line [CommentBox] -> Reservation
Reservation Map Line [CommentBox]
forall k a. Map k a
Map.empty

detachComments ::
               Style.Style ->
                 Code.LocatableCommentableCode ->
                   Result.Result ExactCode.ExactCode
detachComments :: Style -> LocatableCommentableCode -> Result ExactCode
detachComments Style
_ LocatableCommentableCode
locatableCommentable
  = ExactCode -> Result ExactCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExactCode -> Result ExactCode) -> ExactCode -> Result ExactCode
forall a b. (a -> b) -> a -> b
$ Module SrcSpanInfo -> [Comment] -> ExactCode
ExactCode.create Module SrcSpanInfo
locatable' [Comment]
comments
  where locatable' :: Module SrcSpanInfo
locatable' = Shifter -> Module SrcSpanInfo -> Module SrcSpanInfo
LineTool.shiftCode Shifter
shifter Module SrcSpanInfo
locatable
        shifter :: Shifter
shifter = Reservation -> Shifter
reservationShifter Reservation
reservation
        reservation :: Reservation
reservation = LocatableCommentableCode -> Reservation
reserveForCode LocatableCommentableCode
locatableCommentable
        locatable :: Module SrcSpanInfo
locatable = LocatableCommentableCode -> Module SrcSpanInfo
Code.dropComments LocatableCommentableCode
locatableCommentable
        comments :: [Comment]
comments = StreamName -> Reservation -> [Comment]
createComments StreamName
stream Reservation
reservation
        stream :: StreamName
stream = SrcSpan -> StreamName
forall a. SrcInfo a => a -> StreamName
Location.streamName (SrcSpan -> StreamName) -> SrcSpan -> StreamName
forall a b. (a -> b) -> a -> b
$ Module SrcSpanInfo -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion Module SrcSpanInfo
locatable'

reservationShifter :: Reservation -> LineTool.Shifter
reservationShifter :: Reservation -> Shifter
reservationShifter (Reservation Map Line [CommentBox]
reservation)
  = Map Line Int -> Shifter
LineTool.createShifter (Map Line Int -> Shifter) -> Map Line Int -> Shifter
forall a b. (a -> b) -> a -> b
$ ([CommentBox] -> Int) -> Map Line [CommentBox] -> Map Line Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CommentBox] -> Int
commentsShift Map Line [CommentBox]
reservation

commentsShift :: [Note.CommentBox] -> LineTool.Shift
commentsShift :: [CommentBox] -> Int
commentsShift = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([CommentBox] -> [Int]) -> [CommentBox] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommentBox -> Int) -> [CommentBox] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CommentBox -> Int
commentShift

commentShift :: Note.CommentBox -> LineTool.Shift
commentShift :: CommentBox -> Int
commentShift (Note.ActualComment IndentedComment
comment)
  = CommentCore -> Int
CommentCore.wrappedLineCount (CommentCore -> Int) -> CommentCore -> Int
forall a b. (a -> b) -> a -> b
$ IndentedComment -> CommentCore
Note.commentCore IndentedComment
comment
commentShift CommentBox
Note.EmptyLine = Int
1

reserveForCode :: Code.LocatableCommentableCode -> Reservation
reserveForCode :: LocatableCommentableCode -> Reservation
reserveForCode = (LocationCommentNote -> Reservation)
-> LocatableCommentableCode -> Reservation
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap LocationCommentNote -> Reservation
reserveForNote

reserveForNote :: Note.LocationCommentNote -> Reservation
reserveForNote :: LocationCommentNote -> Reservation
reserveForNote LocationCommentNote
note = Reservation -> Reservation -> Reservation
forall a. Monoid a => a -> a -> a
Monoid.mappend Reservation
before Reservation
after
  where before :: Reservation
before = Line -> [CommentBox] -> Reservation
singleton Line
lineBefore ([CommentBox] -> Reservation) -> [CommentBox] -> Reservation
forall a b. (a -> b) -> a -> b
$ CommentNote -> [CommentBox]
Note.commentsBefore CommentNote
commentNote
        singleton :: Line -> [CommentBox] -> Reservation
singleton Line
line = Map Line [CommentBox] -> Reservation
Reservation (Map Line [CommentBox] -> Reservation)
-> ([CommentBox] -> Map Line [CommentBox])
-> [CommentBox]
-> Reservation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> [CommentBox] -> Map Line [CommentBox]
forall k a. k -> a -> Map k a
Map.singleton Line
line
        lineBefore :: Line
lineBefore = SrcSpan -> Line
forall a. SrcInfo a => a -> Line
Location.getStartLine SrcSpan
portion
        portion :: SrcSpan
portion = LocationCommentNote -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion LocationCommentNote
note
        commentNote :: CommentNote
commentNote = LocationCommentNote -> CommentNote
Note.commentNote LocationCommentNote
note
        after :: Reservation
after = Line -> [CommentBox] -> Reservation
singleton Line
lineAfter ([CommentBox] -> Reservation) -> [CommentBox] -> Reservation
forall a b. (a -> b) -> a -> b
$ CommentNote -> [CommentBox]
Note.commentsAfter CommentNote
commentNote
        lineAfter :: Line
lineAfter = Line -> Line
forall a. Enum a => a -> a
succ (Line -> Line) -> Line -> Line
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Line
Location.getEndLine SrcSpan
portion

createComments :: StreamName.StreamName -> Reservation -> [Source.Comment]
createComments :: StreamName -> Reservation -> [Comment]
createComments StreamName
stream = (Line -> [CommentBox] -> [Comment]) -> Reservation -> [Comment]
forall m.
Monoid m =>
(Line -> [CommentBox] -> m) -> Reservation -> m
accumulateReservation Line -> [CommentBox] -> [Comment]
forall (t :: * -> *).
Foldable t =>
Line -> t CommentBox -> [Comment]
create
  where create :: Line -> t CommentBox -> [Comment]
create Line
baseLine = (Line, [Comment]) -> [Comment]
forall a b. (a, b) -> b
snd ((Line, [Comment]) -> [Comment])
-> (t CommentBox -> (Line, [Comment])) -> t CommentBox -> [Comment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Line, [Comment]) -> CommentBox -> (Line, [Comment]))
-> (Line, [Comment]) -> t CommentBox -> (Line, [Comment])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Line, [Comment]) -> CommentBox -> (Line, [Comment])
merge (Line
baseLine, [])
        merge :: (Line, [Comment]) -> CommentBox -> (Line, [Comment])
merge (Line
startLine, [Comment]
comments) CommentBox
box = (Line
followingLine, [Comment]
comments')
          where followingLine :: Line
followingLine = Int -> Line -> Line
forall a b. (Natural a, Integral b) => b -> a -> a
Location.plus Int
shift Line
startLine
                shift :: Int
shift = CommentBox -> Int
commentShift CommentBox
box
                comments' :: [Comment]
comments' = [Comment] -> [Comment] -> [Comment]
forall a. Monoid a => a -> a -> a
Monoid.mappend [Comment]
comments [Comment]
commentsNow
                commentsNow :: [Comment]
commentsNow
                  = case CommentBox
box of
                        Note.ActualComment comment -> [StreamName -> Line -> IndentedComment -> Comment
createComment StreamName
stream
                                                         Line
startLine
                                                         IndentedComment
comment]
                        CommentBox
Note.EmptyLine -> []

accumulateReservation ::
                        Monoid.Monoid m =>
                        (Location.Line -> [Note.CommentBox] -> m) ->
                          Reservation -> m
accumulateReservation :: (Line -> [CommentBox] -> m) -> Reservation -> m
accumulateReservation Line -> [CommentBox] -> m
create (Reservation Map Line [CommentBox]
reservation) = m
accumulation
  where (Int
_, m
accumulation) = ((Int, m) -> Line -> [CommentBox] -> (Int, m))
-> (Int, m) -> Map Line [CommentBox] -> (Int, m)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Int, m) -> Line -> [CommentBox] -> (Int, m)
accumulate (Int, m)
base Map Line [CommentBox]
reservation
        accumulate :: (Int, m) -> Line -> [CommentBox] -> (Int, m)
accumulate (Int
absoluteShift, m
structure) Line
line [CommentBox]
comments
          = (Int
absoluteShift', m
structure')
          where absoluteShift' :: Int
absoluteShift' = Int
absoluteShift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
relativeShift
                relativeShift :: Int
relativeShift = [CommentBox] -> Int
commentsShift [CommentBox]
comments
                structure' :: m
structure' = m -> m -> m
forall a. Monoid a => a -> a -> a
Monoid.mappend m
structure m
part
                part :: m
part = Line -> [CommentBox] -> m
create Line
shiftedLine [CommentBox]
comments
                shiftedLine :: Line
shiftedLine = Int -> Line -> Line
forall a b. (Natural a, Integral b) => b -> a -> a
Location.plus Int
absoluteShift Line
line
        base :: (Int, m)
base = (Int
noShift, m
forall a. Monoid a => a
Monoid.mempty)
        noShift :: Int
noShift = Int
0

createComment ::
              StreamName.StreamName ->
                Location.Line -> Note.IndentedComment -> Source.Comment
createComment :: StreamName -> Line -> IndentedComment -> Comment
createComment StreamName
stream Line
startLine IndentedComment
comment = CommentCore -> SrcSpan -> Comment
Source.createComment CommentCore
core SrcSpan
portion
  where core :: CommentCore
core = IndentedComment -> CommentCore
Note.commentCore IndentedComment
comment
        portion :: SrcSpan
portion = SrcLoc -> String -> SrcSpan
Location.stringPortion SrcLoc
startPosition String
wrappedComment
        startPosition :: SrcLoc
startPosition = StreamName -> Line -> Column -> SrcLoc
Location.createPosition StreamName
stream Line
startLine Column
startColumn
        startColumn :: Column
startColumn = IndentedComment -> Column
Note.commentStartColumn IndentedComment
comment
        wrappedComment :: String
wrappedComment = CommentCore -> String
forall a. Show a => a -> String
show CommentCore
core