{-|
Description : Attaching comments to the annotations of the syntax tree

This is the first part of the process.
-}
module Language.Haskell.Formatter.Process.AttachComments (attachComments) where
import qualified Data.Foldable as Foldable
import qualified Data.Function as Function
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Monoid as Monoid
import qualified Data.Semigroup as Semigroup
import qualified Data.Traversable as Traversable
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

newtype Assignment = Assignment (Map.Map Location.SrcSpan Note.CommentNote)
                       deriving (Assignment -> Assignment -> Bool
(Assignment -> Assignment -> Bool)
-> (Assignment -> Assignment -> Bool) -> Eq Assignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assignment -> Assignment -> Bool
$c/= :: Assignment -> Assignment -> Bool
== :: Assignment -> Assignment -> Bool
$c== :: Assignment -> Assignment -> Bool
Eq, Eq Assignment
Eq Assignment
-> (Assignment -> Assignment -> Ordering)
-> (Assignment -> Assignment -> Bool)
-> (Assignment -> Assignment -> Bool)
-> (Assignment -> Assignment -> Bool)
-> (Assignment -> Assignment -> Bool)
-> (Assignment -> Assignment -> Assignment)
-> (Assignment -> Assignment -> Assignment)
-> Ord Assignment
Assignment -> Assignment -> Bool
Assignment -> Assignment -> Ordering
Assignment -> Assignment -> Assignment
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 :: Assignment -> Assignment -> Assignment
$cmin :: Assignment -> Assignment -> Assignment
max :: Assignment -> Assignment -> Assignment
$cmax :: Assignment -> Assignment -> Assignment
>= :: Assignment -> Assignment -> Bool
$c>= :: Assignment -> Assignment -> Bool
> :: Assignment -> Assignment -> Bool
$c> :: Assignment -> Assignment -> Bool
<= :: Assignment -> Assignment -> Bool
$c<= :: Assignment -> Assignment -> Bool
< :: Assignment -> Assignment -> Bool
$c< :: Assignment -> Assignment -> Bool
compare :: Assignment -> Assignment -> Ordering
$ccompare :: Assignment -> Assignment -> Ordering
$cp1Ord :: Eq Assignment
Ord, Int -> Assignment -> ShowS
[Assignment] -> ShowS
Assignment -> String
(Int -> Assignment -> ShowS)
-> (Assignment -> String)
-> ([Assignment] -> ShowS)
-> Show Assignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assignment] -> ShowS
$cshowList :: [Assignment] -> ShowS
show :: Assignment -> String
$cshow :: Assignment -> String
showsPrec :: Int -> Assignment -> ShowS
$cshowsPrec :: Int -> Assignment -> ShowS
Show)

data CodeGap = InfiniteLower Location.SrcSpan
             | FiniteGap Location.SrcSpan Location.SrcSpan
             | InfiniteUpper Location.SrcSpan
                 deriving (CodeGap -> CodeGap -> Bool
(CodeGap -> CodeGap -> Bool)
-> (CodeGap -> CodeGap -> Bool) -> Eq CodeGap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeGap -> CodeGap -> Bool
$c/= :: CodeGap -> CodeGap -> Bool
== :: CodeGap -> CodeGap -> Bool
$c== :: CodeGap -> CodeGap -> Bool
Eq, Eq CodeGap
Eq CodeGap
-> (CodeGap -> CodeGap -> Ordering)
-> (CodeGap -> CodeGap -> Bool)
-> (CodeGap -> CodeGap -> Bool)
-> (CodeGap -> CodeGap -> Bool)
-> (CodeGap -> CodeGap -> Bool)
-> (CodeGap -> CodeGap -> CodeGap)
-> (CodeGap -> CodeGap -> CodeGap)
-> Ord CodeGap
CodeGap -> CodeGap -> Bool
CodeGap -> CodeGap -> Ordering
CodeGap -> CodeGap -> CodeGap
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 :: CodeGap -> CodeGap -> CodeGap
$cmin :: CodeGap -> CodeGap -> CodeGap
max :: CodeGap -> CodeGap -> CodeGap
$cmax :: CodeGap -> CodeGap -> CodeGap
>= :: CodeGap -> CodeGap -> Bool
$c>= :: CodeGap -> CodeGap -> Bool
> :: CodeGap -> CodeGap -> Bool
$c> :: CodeGap -> CodeGap -> Bool
<= :: CodeGap -> CodeGap -> Bool
$c<= :: CodeGap -> CodeGap -> Bool
< :: CodeGap -> CodeGap -> Bool
$c< :: CodeGap -> CodeGap -> Bool
compare :: CodeGap -> CodeGap -> Ordering
$ccompare :: CodeGap -> CodeGap -> Ordering
$cp1Ord :: Eq CodeGap
Ord, Int -> CodeGap -> ShowS
[CodeGap] -> ShowS
CodeGap -> String
(Int -> CodeGap -> ShowS)
-> (CodeGap -> String) -> ([CodeGap] -> ShowS) -> Show CodeGap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeGap] -> ShowS
$cshowList :: [CodeGap] -> ShowS
show :: CodeGap -> String
$cshow :: CodeGap -> String
showsPrec :: Int -> CodeGap -> ShowS
$cshowsPrec :: Int -> CodeGap -> ShowS
Show)

instance Semigroup.Semigroup Assignment where
        (Assignment Map SrcSpan CommentNote
left) <> :: Assignment -> Assignment -> Assignment
<> (Assignment Map SrcSpan CommentNote
right) = Map SrcSpan CommentNote -> Assignment
Assignment Map SrcSpan CommentNote
merged
          where merged :: Map SrcSpan CommentNote
merged = (CommentNote -> CommentNote -> CommentNote)
-> Map SrcSpan CommentNote
-> Map SrcSpan CommentNote
-> Map SrcSpan CommentNote
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith CommentNote -> CommentNote -> CommentNote
forall a. Monoid a => a -> a -> a
Monoid.mappend Map SrcSpan CommentNote
left Map SrcSpan CommentNote
right

instance Monoid.Monoid Assignment where
        mempty :: Assignment
mempty = Map SrcSpan CommentNote -> Assignment
Assignment Map SrcSpan CommentNote
forall k a. Map k a
Map.empty

attachComments ::
               Style.Style ->
                 ExactCode.ExactCode -> Result.Result Code.CommentableCode
attachComments :: Style -> ExactCode -> Result CommentableCode
attachComments Style
_ ExactCode
exact
  = do Assignment
assignment <- ExactCode -> Result Assignment
assignForCode ExactCode
exact
       let (Assignment Map SrcSpan CommentNote
unassigned, CommentableCode
commentable) = Assignment -> LocatableCode -> (Assignment, CommentableCode)
spread Assignment
assignment LocatableCode
locatable
       if Map SrcSpan CommentNote -> Bool
forall k a. Map k a -> Bool
Map.null Map SrcSpan CommentNote
unassigned then CommentableCode -> Result CommentableCode
forall (m :: * -> *) a. Monad m => a -> m a
return CommentableCode
commentable else
         String -> Result CommentableCode
forall a. String -> Result a
Result.fatalAssertionError String
message
  where locatable :: LocatableCode
locatable = ExactCode -> LocatableCode
ExactCode.actualCode ExactCode
exact
        message :: String
message = String
"Attaching the comments failed with an unassigned rest."

assignForCode :: ExactCode.ExactCode -> Result.Result Assignment
assignForCode :: ExactCode -> Result Assignment
assignForCode ExactCode
exact
  = case [Comment]
unassigned of
        [] -> Assignment -> Result Assignment
forall (m :: * -> *) a. Monad m => a -> m a
return (Assignment -> Result Assignment)
-> Assignment -> Result Assignment
forall a b. (a -> b) -> a -> b
$ [Assignment] -> Assignment
forall a. Monoid a => [a] -> a
Monoid.mconcat [Assignment]
assignments
        (Comment
_ : [Comment]
_) -> String -> Result Assignment
forall a. String -> Result a
Result.fatalAssertionError String
message
  where ((Maybe SrcSpan
_, [Comment]
unassigned), [Assignment]
assignments)
          = ((Maybe SrcSpan, [Comment])
 -> Maybe SrcSpan -> ((Maybe SrcSpan, [Comment]), Assignment))
-> (Maybe SrcSpan, [Comment])
-> [Maybe SrcSpan]
-> ((Maybe SrcSpan, [Comment]), [Assignment])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Traversable.mapAccumL (Maybe SrcSpan, [Comment])
-> Maybe SrcSpan -> ((Maybe SrcSpan, [Comment]), Assignment)
move (Maybe SrcSpan, [Comment])
forall a. (Maybe a, [Comment])
base [Maybe SrcSpan]
maybeOrderedPortions
        move :: (Maybe SrcSpan, [Comment])
-> Maybe SrcSpan -> ((Maybe SrcSpan, [Comment]), Assignment)
move (Maybe SrcSpan
maybeLower, [Comment]
rest) Maybe SrcSpan
maybeUpper = ((Maybe SrcSpan
maybeUpper, [Comment]
rest'), Assignment
assignment)
          where ([Comment]
rest', Assignment
assignment)
                  = case Maybe SrcSpan
maybeUpper of
                        Maybe SrcSpan
Nothing -> case Maybe SrcSpan
maybeLower of
                                       Maybe SrcSpan
Nothing -> ([Comment]
rest, Assignment
forall a. Monoid a => a
Monoid.mempty)
                                       Just lower -> ([],
                                                      CodeGap -> [Comment] -> Assignment
assign
                                                        (SrcSpan -> CodeGap
InfiniteUpper SrcSpan
lower)
                                                        [Comment]
rest)
                        Just upper -> ([Comment]
greaterUpper, CodeGap -> [Comment] -> Assignment
assign CodeGap
gap [Comment]
lessEqualUpper)
                          where ([Comment]
lessEqualUpper, [Comment]
greaterUpper)
                                  = (Comment -> Bool) -> [Comment] -> ([Comment], [Comment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((SrcSpan -> SrcSpan -> Bool
forall a. Ord a => a -> a -> Bool
<= SrcSpan
upper) (SrcSpan -> Bool) -> (Comment -> SrcSpan) -> Comment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion) [Comment]
rest
                                gap :: CodeGap
gap
                                  = case Maybe SrcSpan
maybeLower of
                                        Maybe SrcSpan
Nothing -> SrcSpan -> CodeGap
InfiniteLower SrcSpan
upper
                                        Just lower -> SrcSpan -> SrcSpan -> CodeGap
FiniteGap SrcSpan
lower SrcSpan
upper
        assign :: CodeGap -> [Comment] -> Assignment
assign CodeGap
gap = CodeGap -> [CommentBox] -> Assignment
assignComments CodeGap
gap ([CommentBox] -> Assignment)
-> ([Comment] -> [CommentBox]) -> [Comment] -> Assignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Line -> [Comment] -> [CommentBox]
createComments Line
startLine Line
endLine
          where (Line
startLine, Line
endLine)
                  = case CodeGap
gap of
                        InfiniteLower upper -> (Line -> Line
forall a. Enum a => a -> a
pred Line
forall a. Natural a => a
Location.base,
                                                SrcSpan -> Line
forall a. SrcInfo a => a -> Line
Location.getStartLine SrcSpan
upper)
                        FiniteGap lower upper -> (SrcSpan -> Line
Location.getEndLine SrcSpan
lower,
                                                  SrcSpan -> Line
forall a. SrcInfo a => a -> Line
Location.getStartLine SrcSpan
upper)
                        InfiniteUpper lower -> (SrcSpan -> Line
Location.getEndLine SrcSpan
lower,
                                                Line
codeEndLine)
        codeEndLine :: Line
codeEndLine = SrcSpan -> Line
Location.getEndLine (SrcSpan -> Line) -> SrcSpan -> Line
forall a b. (a -> b) -> a -> b
$ ExactCode -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion ExactCode
exact
        base :: (Maybe a, [Comment])
base = (Maybe a
forall a. Maybe a
Nothing, [Comment]
orderedComments)
        ([SrcSpan]
orderedPortions, [Comment]
orderedComments) = ExactCode -> ([SrcSpan], [Comment])
orderByStartEnd ExactCode
exact
        maybeOrderedPortions :: [Maybe SrcSpan]
maybeOrderedPortions
          = [Maybe SrcSpan] -> [Maybe SrcSpan] -> [Maybe SrcSpan]
forall a. Monoid a => a -> a -> a
Monoid.mappend ((SrcSpan -> Maybe SrcSpan) -> [SrcSpan] -> [Maybe SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just [SrcSpan]
orderedPortions) [Maybe SrcSpan
forall a. Maybe a
Nothing]
        message :: String
message = String
"Assigning the comments failed with an unexpected rest."

assignComments :: CodeGap -> [Note.CommentBox] -> Assignment
assignComments :: CodeGap -> [CommentBox] -> Assignment
assignComments (InfiniteLower SrcSpan
upper) [CommentBox]
comments = SrcSpan -> [CommentBox] -> Assignment
assignBefore SrcSpan
upper [CommentBox]
comments
assignComments (FiniteGap SrcSpan
lower SrcSpan
upper) [CommentBox]
comments
  = Assignment -> Assignment -> Assignment
forall a. Monoid a => a -> a -> a
Monoid.mappend Assignment
assignedAfter Assignment
assignedBefore
  where assignedAfter :: Assignment
assignedAfter = SrcSpan -> [CommentBox] -> Assignment
assignAfter SrcSpan
lower [CommentBox]
after
        ([CommentBox]
after, [CommentBox]
spaces, [CommentBox]
before) = [CommentBox] -> ([CommentBox], [CommentBox], [CommentBox])
divideComments [CommentBox]
comments
        assignedBefore :: Assignment
assignedBefore = SrcSpan -> [CommentBox] -> Assignment
assignBefore SrcSpan
upper ([CommentBox] -> Assignment) -> [CommentBox] -> Assignment
forall a b. (a -> b) -> a -> b
$ [CommentBox] -> [CommentBox] -> [CommentBox]
forall a. Monoid a => a -> a -> a
Monoid.mappend [CommentBox]
spaces [CommentBox]
before
assignComments (InfiniteUpper SrcSpan
lower) [CommentBox]
comments = SrcSpan -> [CommentBox] -> Assignment
assignAfter SrcSpan
lower [CommentBox]
comments

assignBefore :: Location.SrcSpan -> [Note.CommentBox] -> Assignment
assignBefore :: SrcSpan -> [CommentBox] -> Assignment
assignBefore SrcSpan
portion = ([CommentBox] -> [CommentBox] -> Assignment)
-> [CommentBox] -> [CommentBox] -> Assignment
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SrcSpan -> [CommentBox] -> [CommentBox] -> Assignment
assignSingleton SrcSpan
portion) []

assignSingleton ::
                Location.SrcSpan ->
                  [Note.CommentBox] -> [Note.CommentBox] -> Assignment
assignSingleton :: SrcSpan -> [CommentBox] -> [CommentBox] -> Assignment
assignSingleton SrcSpan
portion [CommentBox]
before [CommentBox]
after = Map SrcSpan CommentNote -> Assignment
Assignment (Map SrcSpan CommentNote -> Assignment)
-> Map SrcSpan CommentNote -> Assignment
forall a b. (a -> b) -> a -> b
$ SrcSpan -> CommentNote -> Map SrcSpan CommentNote
forall k a. k -> a -> Map k a
Map.singleton SrcSpan
portion CommentNote
note
  where note :: CommentNote
note = [CommentBox] -> [CommentBox] -> CommentNote
Note.createCommentNote [CommentBox]
before [CommentBox]
after

assignAfter :: Location.SrcSpan -> [Note.CommentBox] -> Assignment
assignAfter :: SrcSpan -> [CommentBox] -> Assignment
assignAfter SrcSpan
portion = SrcSpan -> [CommentBox] -> [CommentBox] -> Assignment
assignSingleton SrcSpan
portion []

divideComments ::
               [Note.CommentBox] ->
                 ([Note.CommentBox], [Note.CommentBox], [Note.CommentBox])
divideComments :: [CommentBox] -> ([CommentBox], [CommentBox], [CommentBox])
divideComments = [CommentBox]
-> [CommentBox]
-> [CommentBox]
-> ([CommentBox], [CommentBox], [CommentBox])
divide [] []
  where divide :: [CommentBox]
-> [CommentBox]
-> [CommentBox]
-> ([CommentBox], [CommentBox], [CommentBox])
divide [CommentBox]
after [CommentBox]
spaces [] = ([CommentBox]
after, [CommentBox]
spaces, [])
        divide [CommentBox]
after [CommentBox]
spaces rest :: [CommentBox]
rest@(box :: CommentBox
box@(Note.ActualComment IndentedComment
comment) : [CommentBox]
unwrapped)
          = case ([CommentBox]
after, [CommentBox]
spaces) of
                (CommentBox
_ : [CommentBox]
_, []) -> ([CommentBox], [CommentBox], [CommentBox])
ifAfter
                ([CommentBox], [CommentBox])
_ -> case DocumentationDisplacement
displacement of
                         DocumentationDisplacement
CommentCore.BeforeActualCode -> ([CommentBox], [CommentBox], [CommentBox])
ifBefore
                         DocumentationDisplacement
CommentCore.AfterActualCode -> ([CommentBox], [CommentBox], [CommentBox])
ifAfter
                         DocumentationDisplacement
CommentCore.None -> ([CommentBox], [CommentBox], [CommentBox])
ifBefore
          where ifAfter :: ([CommentBox], [CommentBox], [CommentBox])
ifAfter = [CommentBox]
-> [CommentBox]
-> [CommentBox]
-> ([CommentBox], [CommentBox], [CommentBox])
divide ([[CommentBox]] -> [CommentBox]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CommentBox]
after, [CommentBox]
spaces, [CommentBox
box]]) [] [CommentBox]
unwrapped
                displacement :: DocumentationDisplacement
displacement = CommentCore -> DocumentationDisplacement
CommentCore.documentationDisplacement CommentCore
core
                core :: CommentCore
core = IndentedComment -> CommentCore
Note.commentCore IndentedComment
comment
                ifBefore :: ([CommentBox], [CommentBox], [CommentBox])
ifBefore = ([CommentBox]
after, [CommentBox]
spaces, [CommentBox]
rest)
        divide [CommentBox]
after [CommentBox]
spaces (CommentBox
Note.EmptyLine : [CommentBox]
unwrapped)
          = [CommentBox]
-> [CommentBox]
-> [CommentBox]
-> ([CommentBox], [CommentBox], [CommentBox])
divide [CommentBox]
after ([CommentBox] -> [CommentBox] -> [CommentBox]
forall a. Monoid a => a -> a -> a
Monoid.mappend [CommentBox]
spaces [CommentBox
Note.EmptyLine]) [CommentBox]
unwrapped

createComments ::
               Location.Line ->
                 Location.Line -> [Source.Comment] -> [Note.CommentBox]
createComments :: Line -> Line -> [Comment] -> [CommentBox]
createComments Line
gapStartLine Line
gapEndLine [Comment]
comments
  = [CommentBox] -> [CommentBox] -> [CommentBox]
forall a. Monoid a => a -> a -> a
Monoid.mappend ([[CommentBox]] -> [CommentBox]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CommentBox]]
untilLast) [CommentBox]
lastBoxes
  where (Line
lastEndLine, [[CommentBox]]
untilLast)
          = (Line -> Comment -> (Line, [CommentBox]))
-> Line -> [Comment] -> (Line, [[CommentBox]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Traversable.mapAccumL Line -> Comment -> (Line, [CommentBox])
create Line
gapStartLine [Comment]
comments
        create :: Line -> Comment -> (Line, [CommentBox])
create Line
endLine Comment
comment = (Line
endLine', [CommentBox]
boxes)
          where endLine' :: Line
endLine' = SrcSpan -> Line
Location.getEndLine SrcSpan
portion
                portion :: SrcSpan
portion = Comment -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion Comment
comment
                boxes :: [CommentBox]
boxes = [CommentBox] -> [CommentBox] -> [CommentBox]
forall a. Monoid a => a -> a -> a
Monoid.mappend [CommentBox]
emptyLines [CommentBox]
actualComments
                emptyLines :: [CommentBox]
emptyLines = Line -> Line -> [CommentBox]
createEmptyLines Line
endLine Line
startLine
                startLine :: Line
startLine = SrcSpan -> Line
forall a. SrcInfo a => a -> Line
Location.getStartLine SrcSpan
portion
                actualComments :: [CommentBox]
actualComments = [IndentedComment -> CommentBox
Note.ActualComment IndentedComment
indentedComment]
                indentedComment :: IndentedComment
indentedComment = CommentCore -> Column -> IndentedComment
Note.createIndentedComment CommentCore
core Column
forall a. Natural a => a
Location.base
                core :: CommentCore
core = Comment -> CommentCore
Source.commentCore Comment
comment
        lastBoxes :: [CommentBox]
lastBoxes = Line -> Line -> [CommentBox]
createEmptyLines Line
lastEndLine Line
gapEndLine

createEmptyLines :: Location.Line -> Location.Line -> [Note.CommentBox]
createEmptyLines :: Line -> Line -> [CommentBox]
createEmptyLines Line
endLine Line
startLine = Int -> CommentBox -> [CommentBox]
forall a. Int -> a -> [a]
replicate Int
emptyLineCount CommentBox
Note.EmptyLine
  where emptyLineCount :: Int
emptyLineCount = Line -> Line -> Int
LineTool.countEmptyLines Line
endLine Line
startLine

orderByStartEnd :: ExactCode.ExactCode -> ([Location.SrcSpan], [Source.Comment])
orderByStartEnd :: ExactCode -> ([SrcSpan], [Comment])
orderByStartEnd ExactCode
exact = ([SrcSpan]
orderedPortions, [Comment]
orderedComments)
  where orderedPortions :: [SrcSpan]
orderedPortions = (SrcSpanInfo -> SrcSpan) -> [SrcSpanInfo] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SrcSpanInfo -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion [SrcSpanInfo]
nestedPortions
        nestedPortions :: [SrcSpanInfo]
nestedPortions = [SrcSpanInfo] -> [SrcSpanInfo]
forall a. Ord a => [a] -> [a]
List.sort ([SrcSpanInfo] -> [SrcSpanInfo]) -> [SrcSpanInfo] -> [SrcSpanInfo]
forall a b. (a -> b) -> a -> b
$ LocatableCode -> [SrcSpanInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList LocatableCode
actualCode
        actualCode :: LocatableCode
actualCode = ExactCode -> LocatableCode
ExactCode.actualCode ExactCode
exact
        orderedComments :: [Comment]
orderedComments
          = (Comment -> Comment -> Ordering) -> [Comment] -> [Comment]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((SrcSpan -> SrcSpan -> Ordering)
-> (Comment -> SrcSpan) -> Comment -> Comment -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on SrcSpan -> SrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Comment -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion) [Comment]
comments
        comments :: [Comment]
comments = ExactCode -> [Comment]
ExactCode.comments ExactCode
exact

spread :: Assignment -> Code.LocatableCode -> (Assignment, Code.CommentableCode)
spread :: Assignment -> LocatableCode -> (Assignment, CommentableCode)
spread (Assignment Map SrcSpan CommentNote
assignment) LocatableCode
locatable = (Map SrcSpan CommentNote -> Assignment
Assignment Map SrcSpan CommentNote
unassigned, CommentableCode
commentable)
  where (Map SrcSpan CommentNote
unassigned, CommentableCode
commentable)
          = (Map SrcSpan CommentNote
 -> SrcSpanInfo -> (Map SrcSpan CommentNote, CommentNote))
-> Map SrcSpan CommentNote
-> LocatableCode
-> (Map SrcSpan CommentNote, CommentableCode)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Traversable.mapAccumL Map SrcSpan CommentNote
-> SrcSpanInfo -> (Map SrcSpan CommentNote, CommentNote)
forall a b.
(Portioned a, Monoid b) =>
Map SrcSpan b -> a -> (Map SrcSpan b, b)
move Map SrcSpan CommentNote
assignment LocatableCode
locatable
        move :: Map SrcSpan b -> a -> (Map SrcSpan b, b)
move Map SrcSpan b
rest a
nestedPortion = (Map SrcSpan b
rest', b
note)
          where (Maybe b
maybeNote, Map SrcSpan b
rest') = (SrcSpan -> b -> Maybe b)
-> SrcSpan -> Map SrcSpan b -> (Maybe b, Map SrcSpan b)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey SrcSpan -> b -> Maybe b
forall b b a. b -> b -> Maybe a
remove SrcSpan
portion Map SrcSpan b
rest
                remove :: b -> b -> Maybe a
remove = Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const (Maybe a -> b -> Maybe a) -> (b -> Maybe a) -> b -> b -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
                portion :: SrcSpan
portion = a -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion a
nestedPortion
                note :: b
note = Maybe b -> b
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold Maybe b
maybeNote