{-|
Description : Annotations of syntax trees
-}
module Language.Haskell.Formatter.Process.Note
       (CommentNote, commentsBefore, commentsAfter, CommentBox(..),
        IndentedComment, commentCore, commentStartColumn, LocationCommentNote,
        locationNote, commentNote, createCommentNote, createIndentedComment,
        createLocationCommentNote, replaceCommentBoxes,
        replaceCommentStartColumn, replaceCommentNote)
       where
import qualified Data.Function as Function
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.Location as Location

data CommentNote = CommentNote{CommentNote -> [CommentBox]
commentsBefore :: [CommentBox],
                               CommentNote -> [CommentBox]
commentsAfter :: [CommentBox]}
                     deriving (CommentNote -> CommentNote -> Bool
(CommentNote -> CommentNote -> Bool)
-> (CommentNote -> CommentNote -> Bool) -> Eq CommentNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentNote -> CommentNote -> Bool
$c/= :: CommentNote -> CommentNote -> Bool
== :: CommentNote -> CommentNote -> Bool
$c== :: CommentNote -> CommentNote -> Bool
Eq, Eq CommentNote
Eq CommentNote
-> (CommentNote -> CommentNote -> Ordering)
-> (CommentNote -> CommentNote -> Bool)
-> (CommentNote -> CommentNote -> Bool)
-> (CommentNote -> CommentNote -> Bool)
-> (CommentNote -> CommentNote -> Bool)
-> (CommentNote -> CommentNote -> CommentNote)
-> (CommentNote -> CommentNote -> CommentNote)
-> Ord CommentNote
CommentNote -> CommentNote -> Bool
CommentNote -> CommentNote -> Ordering
CommentNote -> CommentNote -> CommentNote
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 :: CommentNote -> CommentNote -> CommentNote
$cmin :: CommentNote -> CommentNote -> CommentNote
max :: CommentNote -> CommentNote -> CommentNote
$cmax :: CommentNote -> CommentNote -> CommentNote
>= :: CommentNote -> CommentNote -> Bool
$c>= :: CommentNote -> CommentNote -> Bool
> :: CommentNote -> CommentNote -> Bool
$c> :: CommentNote -> CommentNote -> Bool
<= :: CommentNote -> CommentNote -> Bool
$c<= :: CommentNote -> CommentNote -> Bool
< :: CommentNote -> CommentNote -> Bool
$c< :: CommentNote -> CommentNote -> Bool
compare :: CommentNote -> CommentNote -> Ordering
$ccompare :: CommentNote -> CommentNote -> Ordering
$cp1Ord :: Eq CommentNote
Ord, Int -> CommentNote -> ShowS
[CommentNote] -> ShowS
CommentNote -> String
(Int -> CommentNote -> ShowS)
-> (CommentNote -> String)
-> ([CommentNote] -> ShowS)
-> Show CommentNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentNote] -> ShowS
$cshowList :: [CommentNote] -> ShowS
show :: CommentNote -> String
$cshow :: CommentNote -> String
showsPrec :: Int -> CommentNote -> ShowS
$cshowsPrec :: Int -> CommentNote -> ShowS
Show)

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

data IndentedComment = IndentedComment{IndentedComment -> CommentCore
commentCore :: CommentCore.CommentCore,
                                       IndentedComment -> Column
commentStartColumn :: Location.Column}
                         deriving (IndentedComment -> IndentedComment -> Bool
(IndentedComment -> IndentedComment -> Bool)
-> (IndentedComment -> IndentedComment -> Bool)
-> Eq IndentedComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndentedComment -> IndentedComment -> Bool
$c/= :: IndentedComment -> IndentedComment -> Bool
== :: IndentedComment -> IndentedComment -> Bool
$c== :: IndentedComment -> IndentedComment -> Bool
Eq, Eq IndentedComment
Eq IndentedComment
-> (IndentedComment -> IndentedComment -> Ordering)
-> (IndentedComment -> IndentedComment -> Bool)
-> (IndentedComment -> IndentedComment -> Bool)
-> (IndentedComment -> IndentedComment -> Bool)
-> (IndentedComment -> IndentedComment -> Bool)
-> (IndentedComment -> IndentedComment -> IndentedComment)
-> (IndentedComment -> IndentedComment -> IndentedComment)
-> Ord IndentedComment
IndentedComment -> IndentedComment -> Bool
IndentedComment -> IndentedComment -> Ordering
IndentedComment -> IndentedComment -> IndentedComment
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 :: IndentedComment -> IndentedComment -> IndentedComment
$cmin :: IndentedComment -> IndentedComment -> IndentedComment
max :: IndentedComment -> IndentedComment -> IndentedComment
$cmax :: IndentedComment -> IndentedComment -> IndentedComment
>= :: IndentedComment -> IndentedComment -> Bool
$c>= :: IndentedComment -> IndentedComment -> Bool
> :: IndentedComment -> IndentedComment -> Bool
$c> :: IndentedComment -> IndentedComment -> Bool
<= :: IndentedComment -> IndentedComment -> Bool
$c<= :: IndentedComment -> IndentedComment -> Bool
< :: IndentedComment -> IndentedComment -> Bool
$c< :: IndentedComment -> IndentedComment -> Bool
compare :: IndentedComment -> IndentedComment -> Ordering
$ccompare :: IndentedComment -> IndentedComment -> Ordering
$cp1Ord :: Eq IndentedComment
Ord, Int -> IndentedComment -> ShowS
[IndentedComment] -> ShowS
IndentedComment -> String
(Int -> IndentedComment -> ShowS)
-> (IndentedComment -> String)
-> ([IndentedComment] -> ShowS)
-> Show IndentedComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndentedComment] -> ShowS
$cshowList :: [IndentedComment] -> ShowS
show :: IndentedComment -> String
$cshow :: IndentedComment -> String
showsPrec :: Int -> IndentedComment -> ShowS
$cshowsPrec :: Int -> IndentedComment -> ShowS
Show)

data LocationCommentNote = LocationCommentNote{LocationCommentNote -> SrcSpanInfo
locationNote ::
                                               Location.SrcSpanInfo,
                                               LocationCommentNote -> CommentNote
commentNote :: CommentNote}
                             deriving (LocationCommentNote -> LocationCommentNote -> Bool
(LocationCommentNote -> LocationCommentNote -> Bool)
-> (LocationCommentNote -> LocationCommentNote -> Bool)
-> Eq LocationCommentNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocationCommentNote -> LocationCommentNote -> Bool
$c/= :: LocationCommentNote -> LocationCommentNote -> Bool
== :: LocationCommentNote -> LocationCommentNote -> Bool
$c== :: LocationCommentNote -> LocationCommentNote -> Bool
Eq, Eq LocationCommentNote
Eq LocationCommentNote
-> (LocationCommentNote -> LocationCommentNote -> Ordering)
-> (LocationCommentNote -> LocationCommentNote -> Bool)
-> (LocationCommentNote -> LocationCommentNote -> Bool)
-> (LocationCommentNote -> LocationCommentNote -> Bool)
-> (LocationCommentNote -> LocationCommentNote -> Bool)
-> (LocationCommentNote
    -> LocationCommentNote -> LocationCommentNote)
-> (LocationCommentNote
    -> LocationCommentNote -> LocationCommentNote)
-> Ord LocationCommentNote
LocationCommentNote -> LocationCommentNote -> Bool
LocationCommentNote -> LocationCommentNote -> Ordering
LocationCommentNote -> LocationCommentNote -> LocationCommentNote
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 :: LocationCommentNote -> LocationCommentNote -> LocationCommentNote
$cmin :: LocationCommentNote -> LocationCommentNote -> LocationCommentNote
max :: LocationCommentNote -> LocationCommentNote -> LocationCommentNote
$cmax :: LocationCommentNote -> LocationCommentNote -> LocationCommentNote
>= :: LocationCommentNote -> LocationCommentNote -> Bool
$c>= :: LocationCommentNote -> LocationCommentNote -> Bool
> :: LocationCommentNote -> LocationCommentNote -> Bool
$c> :: LocationCommentNote -> LocationCommentNote -> Bool
<= :: LocationCommentNote -> LocationCommentNote -> Bool
$c<= :: LocationCommentNote -> LocationCommentNote -> Bool
< :: LocationCommentNote -> LocationCommentNote -> Bool
$c< :: LocationCommentNote -> LocationCommentNote -> Bool
compare :: LocationCommentNote -> LocationCommentNote -> Ordering
$ccompare :: LocationCommentNote -> LocationCommentNote -> Ordering
$cp1Ord :: Eq LocationCommentNote
Ord, Int -> LocationCommentNote -> ShowS
[LocationCommentNote] -> ShowS
LocationCommentNote -> String
(Int -> LocationCommentNote -> ShowS)
-> (LocationCommentNote -> String)
-> ([LocationCommentNote] -> ShowS)
-> Show LocationCommentNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocationCommentNote] -> ShowS
$cshowList :: [LocationCommentNote] -> ShowS
show :: LocationCommentNote -> String
$cshow :: LocationCommentNote -> String
showsPrec :: Int -> LocationCommentNote -> ShowS
$cshowsPrec :: Int -> LocationCommentNote -> ShowS
Show)

instance Semigroup.Semigroup CommentNote where
        CommentNote
left <> :: CommentNote -> CommentNote -> CommentNote
<> CommentNote
right = [CommentBox] -> [CommentBox] -> CommentNote
createCommentNote [CommentBox]
before [CommentBox]
after
          where before :: [CommentBox]
before = (CommentNote -> [CommentBox]) -> [CommentBox]
forall a. (CommentNote -> [a]) -> [a]
merge CommentNote -> [CommentBox]
commentsBefore
                merge :: (CommentNote -> [a]) -> [a]
merge CommentNote -> [a]
getComments = ([a] -> [a] -> [a])
-> (CommentNote -> [a]) -> CommentNote -> CommentNote -> [a]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) CommentNote -> [a]
getComments CommentNote
left CommentNote
right
                after :: [CommentBox]
after = (CommentNote -> [CommentBox]) -> [CommentBox]
forall a. (CommentNote -> [a]) -> [a]
merge CommentNote -> [CommentBox]
commentsAfter

instance Monoid.Monoid CommentNote where
        mempty :: CommentNote
mempty = [CommentBox] -> [CommentBox] -> CommentNote
createCommentNote [] []

instance Location.Portioned LocationCommentNote where
        getPortion :: LocationCommentNote -> SrcSpan
getPortion = SrcSpanInfo -> SrcSpan
forall a. Portioned a => a -> SrcSpan
Location.getPortion (SrcSpanInfo -> SrcSpan)
-> (LocationCommentNote -> SrcSpanInfo)
-> LocationCommentNote
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationCommentNote -> SrcSpanInfo
locationNote

createCommentNote :: [CommentBox] -> [CommentBox] -> CommentNote
createCommentNote :: [CommentBox] -> [CommentBox] -> CommentNote
createCommentNote [CommentBox]
rawCommentsBefore [CommentBox]
rawCommentsAfter
  = CommentNote :: [CommentBox] -> [CommentBox] -> CommentNote
CommentNote{commentsBefore :: [CommentBox]
commentsBefore = [CommentBox]
rawCommentsBefore,
                commentsAfter :: [CommentBox]
commentsAfter = [CommentBox]
rawCommentsAfter}

createIndentedComment ::
                      CommentCore.CommentCore ->
                        Location.Column -> IndentedComment
createIndentedComment :: CommentCore -> Column -> IndentedComment
createIndentedComment CommentCore
rawCommentCore Column
rawCommentStartColumn
  = IndentedComment :: CommentCore -> Column -> IndentedComment
IndentedComment{commentCore :: CommentCore
commentCore = CommentCore
rawCommentCore,
                    commentStartColumn :: Column
commentStartColumn = Column
rawCommentStartColumn}

createLocationCommentNote ::
                          Location.SrcSpanInfo ->
                            CommentNote -> LocationCommentNote
createLocationCommentNote :: SrcSpanInfo -> CommentNote -> LocationCommentNote
createLocationCommentNote SrcSpanInfo
rawLocationNote CommentNote
rawCommentNote
  = LocationCommentNote :: SrcSpanInfo -> CommentNote -> LocationCommentNote
LocationCommentNote{locationNote :: SrcSpanInfo
locationNote = SrcSpanInfo
rawLocationNote,
                        commentNote :: CommentNote
commentNote = CommentNote
rawCommentNote}

replaceCommentBoxes ::
                    ([CommentBox] -> [CommentBox]) -> CommentNote -> CommentNote
replaceCommentBoxes :: ([CommentBox] -> [CommentBox]) -> CommentNote -> CommentNote
replaceCommentBoxes [CommentBox] -> [CommentBox]
function CommentNote
note
  = CommentNote
note{commentsBefore :: [CommentBox]
commentsBefore = (CommentNote -> [CommentBox]) -> [CommentBox]
replace CommentNote -> [CommentBox]
commentsBefore,
         commentsAfter :: [CommentBox]
commentsAfter = (CommentNote -> [CommentBox]) -> [CommentBox]
replace CommentNote -> [CommentBox]
commentsAfter}
  where replace :: (CommentNote -> [CommentBox]) -> [CommentBox]
replace CommentNote -> [CommentBox]
getComments = [CommentBox] -> [CommentBox]
function ([CommentBox] -> [CommentBox]) -> [CommentBox] -> [CommentBox]
forall a b. (a -> b) -> a -> b
$ CommentNote -> [CommentBox]
getComments CommentNote
note

replaceCommentBox :: (CommentBox -> CommentBox) -> CommentNote -> CommentNote
replaceCommentBox :: (CommentBox -> CommentBox) -> CommentNote -> CommentNote
replaceCommentBox CommentBox -> CommentBox
function = ([CommentBox] -> [CommentBox]) -> CommentNote -> CommentNote
replaceCommentBoxes (([CommentBox] -> [CommentBox]) -> CommentNote -> CommentNote)
-> ([CommentBox] -> [CommentBox]) -> CommentNote -> CommentNote
forall a b. (a -> b) -> a -> b
$ (CommentBox -> CommentBox) -> [CommentBox] -> [CommentBox]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CommentBox -> CommentBox
function

replaceIndentedComment ::
                       (IndentedComment -> IndentedComment) ->
                         CommentNote -> CommentNote
replaceIndentedComment :: (IndentedComment -> IndentedComment) -> CommentNote -> CommentNote
replaceIndentedComment IndentedComment -> IndentedComment
function = (CommentBox -> CommentBox) -> CommentNote -> CommentNote
replaceCommentBox CommentBox -> CommentBox
partFunction
  where partFunction :: CommentBox -> CommentBox
partFunction (ActualComment IndentedComment
comment) = IndentedComment -> CommentBox
ActualComment (IndentedComment -> CommentBox) -> IndentedComment -> CommentBox
forall a b. (a -> b) -> a -> b
$ IndentedComment -> IndentedComment
function IndentedComment
comment
        partFunction CommentBox
EmptyLine = CommentBox
EmptyLine

replaceCommentStartColumn ::
                          (Location.Column -> Location.Column) ->
                            CommentNote -> CommentNote
replaceCommentStartColumn :: (Column -> Column) -> CommentNote -> CommentNote
replaceCommentStartColumn Column -> Column
function = (IndentedComment -> IndentedComment) -> CommentNote -> CommentNote
replaceIndentedComment IndentedComment -> IndentedComment
partFunction
  where partFunction :: IndentedComment -> IndentedComment
partFunction IndentedComment
comment
          = IndentedComment
comment{commentStartColumn :: Column
commentStartColumn = Column -> Column
function (Column -> Column) -> Column -> Column
forall a b. (a -> b) -> a -> b
$ IndentedComment -> Column
commentStartColumn IndentedComment
comment}

replaceCommentNote ::
                   (CommentNote -> CommentNote) ->
                     LocationCommentNote -> LocationCommentNote
replaceCommentNote :: (CommentNote -> CommentNote)
-> LocationCommentNote -> LocationCommentNote
replaceCommentNote CommentNote -> CommentNote
function LocationCommentNote
note
  = LocationCommentNote
note{commentNote :: CommentNote
commentNote = CommentNote -> CommentNote
function (CommentNote -> CommentNote) -> CommentNote -> CommentNote
forall a b. (a -> b) -> a -> b
$ LocationCommentNote -> CommentNote
commentNote LocationCommentNote
note}