{-|
Description : Rearranging the comments
-}
module Language.Haskell.Formatter.Process.FormatComments (formatComments) where
import qualified Data.Function as Function
import qualified Data.Monoid as Monoid
import qualified Language.Haskell.Formatter.ExactCode as ExactCode
import qualified Language.Haskell.Formatter.Location as Location
import qualified Language.Haskell.Formatter.Process.AttachComments
       as AttachComments
import qualified Language.Haskell.Formatter.Process.Code as Code
import qualified Language.Haskell.Formatter.Process.Note as Note
import qualified Language.Haskell.Formatter.Result as Result
import qualified Language.Haskell.Formatter.Style as Style
import qualified Language.Haskell.Formatter.Toolkit.ListTool as ListTool
import qualified Language.Haskell.Formatter.Toolkit.Visit as Visit

formatComments ::
               Style.Style ->
                 Code.LocatableCommentableCode ->
                   Result.Result Code.LocatableCommentableCode
formatComments :: Style
-> LocatableCommentableCode -> Result LocatableCommentableCode
formatComments Style
style LocatableCommentableCode
locatableCommentable
  = do LocatableCommentableCode
locatableCommentable' <- Style
-> LocatableCommentableCode -> Result LocatableCommentableCode
mergeImpliedComments Style
style LocatableCommentableCode
locatableCommentable
       LocatableCommentableCode -> Result LocatableCommentableCode
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatableCommentableCode -> Result LocatableCommentableCode)
-> (LocatableCommentableCode -> LocatableCommentableCode)
-> LocatableCommentableCode
-> Result LocatableCommentableCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatableCommentableCode -> LocatableCommentableCode
indentToLineStart (LocatableCommentableCode -> Result LocatableCommentableCode)
-> LocatableCommentableCode -> Result LocatableCommentableCode
forall a b. (a -> b) -> a -> b
$
         Style -> LocatableCommentableCode -> LocatableCommentableCode
mergeSuccessiveEmptyLines Style
style LocatableCommentableCode
locatableCommentable'

mergeImpliedComments ::
                     Style.Style ->
                       Code.LocatableCommentableCode ->
                         Result.Result Code.LocatableCommentableCode
mergeImpliedComments :: Style
-> LocatableCommentableCode -> Result LocatableCommentableCode
mergeImpliedComments Style
style LocatableCommentableCode
locatableCommentable
  = do CommentableCode
impliedCommentable <- Style -> LocatableCode -> Result CommentableCode
commentsImpliedByLocations Style
style LocatableCode
locatable
       CommentableCode
commentable' <- Style
-> CommentableCode -> CommentableCode -> Result CommentableCode
commentsDifference Style
style CommentableCode
commentable CommentableCode
impliedCommentable
       LocatableCode -> CommentableCode -> Result LocatableCommentableCode
Code.tryZipLocationsComments LocatableCode
locatable CommentableCode
commentable'
  where locatable :: LocatableCode
locatable = LocatableCommentableCode -> LocatableCode
Code.dropComments LocatableCommentableCode
locatableCommentable
        commentable :: CommentableCode
commentable = LocatableCommentableCode -> CommentableCode
Code.dropLocations LocatableCommentableCode
locatableCommentable

commentsImpliedByLocations ::
                           Style.Style ->
                             Code.LocatableCode ->
                               Result.Result Code.CommentableCode
commentsImpliedByLocations :: Style -> LocatableCode -> Result CommentableCode
commentsImpliedByLocations Style
style LocatableCode
locatable
  = Style -> ExactCode -> Result CommentableCode
AttachComments.attachComments Style
style ExactCode
exact
  where exact :: ExactCode
exact = LocatableCode -> [Comment] -> ExactCode
ExactCode.create LocatableCode
locatable [Comment]
forall a. [a]
comments
        comments :: [a]
comments = []

commentsDifference ::
                   Style.Style ->
                     Code.CommentableCode ->
                       Code.CommentableCode ->
                         Result.Result Code.CommentableCode
commentsDifference :: Style
-> CommentableCode -> CommentableCode -> Result CommentableCode
commentsDifference Style
style = (CommentNote -> CommentNote -> CommentNote)
-> CommentableCode -> CommentableCode -> Result CommentableCode
forall a b c.
(a -> b -> c) -> Module a -> Module b -> Result (Module c)
Code.tryZipCode CommentNote -> CommentNote -> CommentNote
minus
  where minus :: CommentNote -> CommentNote -> CommentNote
minus CommentNote
mixed CommentNote
implied
          = [CommentBox] -> [CommentBox] -> CommentNote
Note.createCommentNote [CommentBox]
commentsBefore [CommentBox]
commentsAfter
          where commentsBefore :: [CommentBox]
commentsBefore = (CommentNote -> [CommentBox]) -> [CommentBox]
difference CommentNote -> [CommentBox]
Note.commentsBefore
                difference :: (CommentNote -> [CommentBox]) -> [CommentBox]
difference CommentNote -> [CommentBox]
getComments
                  = ([CommentBox] -> [CommentBox] -> [CommentBox])
-> (CommentNote -> [CommentBox])
-> CommentNote
-> CommentNote
-> [CommentBox]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on (Style -> [CommentBox] -> [CommentBox] -> [CommentBox]
boxesDifference Style
style) CommentNote -> [CommentBox]
getComments CommentNote
mixed
                      CommentNote
implied
                commentsAfter :: [CommentBox]
commentsAfter
                  = [CommentBox] -> [CommentBox]
forall a. [a] -> [a]
reverse ([CommentBox] -> [CommentBox])
-> ((CommentNote -> [CommentBox]) -> [CommentBox])
-> (CommentNote -> [CommentBox])
-> [CommentBox]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommentNote -> [CommentBox]) -> [CommentBox]
difference ((CommentNote -> [CommentBox]) -> [CommentBox])
-> (CommentNote -> [CommentBox]) -> [CommentBox]
forall a b. (a -> b) -> a -> b
$ [CommentBox] -> [CommentBox]
forall a. [a] -> [a]
reverse ([CommentBox] -> [CommentBox])
-> (CommentNote -> [CommentBox]) -> CommentNote -> [CommentBox]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentNote -> [CommentBox]
Note.commentsAfter

boxesDifference ::
                Style.Style ->
                  [Note.CommentBox] -> [Note.CommentBox] -> [Note.CommentBox]
boxesDifference :: Style -> [CommentBox] -> [CommentBox] -> [CommentBox]
boxesDifference Style
style [CommentBox]
mixed [CommentBox]
implied = [CommentBox] -> [CommentBox] -> [CommentBox]
forall a. Monoid a => a -> a -> a
Monoid.mappend [CommentBox]
difference [CommentBox]
mixedRest
  where difference :: [CommentBox]
difference = Int -> CommentBox -> [CommentBox]
forall a. Int -> a -> [a]
replicate Int
differenceCount CommentBox
Note.EmptyLine
        differenceCount :: Int
differenceCount
          = if Int
mixedCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
impliedCount then Int
0 else
              Int -> Int
clip Int
mixedCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
impliedCount
        mixedCount :: Int
mixedCount = [CommentBox] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CommentBox]
mixedEmptyLines
        ([CommentBox]
mixedEmptyLines, [CommentBox]
mixedRest) = (CommentBox -> Bool)
-> [CommentBox] -> ([CommentBox], [CommentBox])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span CommentBox -> Bool
isEmptyLine [CommentBox]
mixed
        impliedCount :: Int
impliedCount = [CommentBox] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CommentBox]
implied
        clip :: Int -> Int
clip = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
successiveEmptyLinesLimit
        successiveEmptyLinesLimit :: Int
successiveEmptyLinesLimit = Style -> Int
Style.successiveEmptyLinesLimit Style
style

isEmptyLine :: Note.CommentBox -> Bool
isEmptyLine :: CommentBox -> Bool
isEmptyLine (Note.ActualComment IndentedComment
_) = Bool
False
isEmptyLine CommentBox
Note.EmptyLine = Bool
True

indentToLineStart ::
                  Code.LocatableCommentableCode -> Code.LocatableCommentableCode
indentToLineStart :: LocatableCommentableCode -> LocatableCommentableCode
indentToLineStart LocatableCommentableCode
locatableCommentable = LocatableCommentableCode
locatableCommentable'
  where (Maybe SrcLoc
_, LocatableCommentableCode
locatableCommentable')
          = (SrcLoc -> LocationCommentNote -> (SrcLoc, LocationCommentNote))
-> (LocationCommentNote -> SrcLoc)
-> LocatableCommentableCode
-> (Maybe SrcLoc, LocatableCommentableCode)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> (b -> a) -> t b -> (Maybe a, t c)
Visit.mapAccumulateLeftWithCreation SrcLoc -> LocationCommentNote -> (SrcLoc, LocationCommentNote)
move LocationCommentNote -> SrcLoc
startPosition
              LocatableCommentableCode
locatableCommentable
        move :: SrcLoc -> LocationCommentNote -> (SrcLoc, LocationCommentNote)
move SrcLoc
lineStart LocationCommentNote
note = (SrcLoc
lineStart', (CommentNote -> CommentNote)
-> LocationCommentNote -> LocationCommentNote
Note.replaceCommentNote CommentNote -> CommentNote
replace LocationCommentNote
note)
          where lineStart' :: SrcLoc
lineStart'
                  = if
                      (Line -> Line -> Bool)
-> (SrcLoc -> Line) -> SrcLoc -> SrcLoc -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
(==) SrcLoc -> Line
forall a. SrcInfo a => a -> Line
Location.getStartLine SrcLoc
noteStart SrcLoc
lineStart
                      then SrcLoc
lineStart else SrcLoc
noteStart
                noteStart :: SrcLoc
noteStart = LocationCommentNote -> SrcLoc
startPosition LocationCommentNote
note
                replace :: CommentNote -> CommentNote
replace = (Column -> Column) -> CommentNote -> CommentNote
Note.replaceCommentStartColumn Column -> Column
forall b. b -> Column
indent
                indent :: b -> Column
indent = Column -> b -> Column
forall a b. a -> b -> a
const (Column -> b -> Column) -> Column -> b -> Column
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Column
forall a. SrcInfo a => a -> Column
Location.getStartColumn SrcLoc
lineStart'
        startPosition :: LocationCommentNote -> SrcLoc
startPosition = SrcSpan -> SrcLoc
forall si. SrcInfo si => si -> SrcLoc
Location.getPointLoc (SrcSpan -> SrcLoc)
-> (LocationCommentNote -> SrcSpan)
-> LocationCommentNote
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationCommentNote -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion

mergeSuccessiveEmptyLines ::
                          Style.Style ->
                            Code.LocatableCommentableCode ->
                              Code.LocatableCommentableCode
mergeSuccessiveEmptyLines :: Style -> LocatableCommentableCode -> LocatableCommentableCode
mergeSuccessiveEmptyLines Style
style
  = (LocationCommentNote -> LocationCommentNote)
-> LocatableCommentableCode -> LocatableCommentableCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LocationCommentNote -> LocationCommentNote)
 -> LocatableCommentableCode -> LocatableCommentableCode)
-> ((CommentNote -> CommentNote)
    -> LocationCommentNote -> LocationCommentNote)
-> (CommentNote -> CommentNote)
-> LocatableCommentableCode
-> LocatableCommentableCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommentNote -> CommentNote)
-> LocationCommentNote -> LocationCommentNote
Note.replaceCommentNote ((CommentNote -> CommentNote)
 -> LocatableCommentableCode -> LocatableCommentableCode)
-> (CommentNote -> CommentNote)
-> LocatableCommentableCode
-> LocatableCommentableCode
forall a b. (a -> b) -> a -> b
$ ([CommentBox] -> [CommentBox]) -> CommentNote -> CommentNote
Note.replaceCommentBoxes [CommentBox] -> [CommentBox]
merge
  where merge :: [CommentBox] -> [CommentBox]
merge
          = (CommentBox -> Bool) -> Int -> [CommentBox] -> [CommentBox]
forall a. (a -> Bool) -> Int -> [a] -> [a]
ListTool.mergeLongerSuccessions CommentBox -> Bool
isEmptyLine
              Int
successiveEmptyLinesLimit
        successiveEmptyLinesLimit :: Int
successiveEmptyLinesLimit = Style -> Int
Style.successiveEmptyLinesLimit Style
style