module Language.Haskell.Homplexity.Comments (
CommentLink (..)
, CommentType (..)
, classifyComments
, findCommentType
, CommentSite (..)
, commentable
, orderCommentsAndCommentables
) where
import Data.Char
import Data.Data
import Data.Function
import Data.Functor
import Data.List
import qualified Data.Map.Strict as Map
import qualified Data.PQueue.Max as Prio
import Language.Haskell.Homplexity.CodeFragment
import Language.Haskell.Homplexity.SrcSlice
import Language.Haskell.Exts.SrcLoc
import Language.Haskell.Exts
data CommentLink = CommentLink { commentSpan :: SrcSpan
, commentType :: CommentType
}
deriving(Eq, Ord, Show)
data CommentType = CommentsBefore
| CommentsInside
| CommentsAfter
deriving (Eq, Ord, Enum, Show)
classifyComments :: [Comment] -> [CommentLink]
classifyComments = map classifyComment
where
classifyComment (Comment _ commentSpan (findCommentType -> commentType)) = CommentLink {..}
findCommentType :: String -> CommentType
findCommentType txt = case (not . isSpace) `find` txt of
Just '^' -> CommentsBefore
Just '|' -> CommentsAfter
Just '*' -> CommentsInside
_ -> CommentsInside
data CommentSite = CommentSite { siteName :: String
, siteSlice :: SrcSlice
}
deriving (Eq, Show)
newtype Ends = End { siteEnded :: CommentSite }
deriving (Eq, Show)
compareStarts :: CommentSite -> CommentSite -> Ordering
compareStarts = compare `on` start . siteSlice
instance Ord Ends where
compare = compareEnds `on` siteEnded
compareEnds :: CommentSite -> CommentSite -> Ordering
compareEnds = compare `on` end . siteSlice
start, end :: SrcSlice -> (Int, Int)
start slice = (srcSpanStartColumn slice, srcSpanStartLine slice)
end slice = (srcSpanEndColumn slice, srcSpanEndLine slice)
commentable :: Data from => from -> [CommentSite]
commentable code = ($ code) `concatMap` [slicesOf functionT
,slicesOf typeSignatureT
,slicesOf moduleT ]
where
commentSite :: CodeFragment c => (c -> SrcSlice) -> c -> CommentSite
commentSite with frag = CommentSite (fragmentName frag)
(with frag)
commentSites :: (CodeFragment c, Data from) => (c -> SrcSlice) -> Proxy c -> from -> [CommentSite]
commentSites with fragType = map (commentSite with) . occursOf fragType
slicesOf :: (CodeFragment c, Data from) => Proxy c -> from -> [CommentSite]
slicesOf = commentSites fragmentSlice
orderCommentsAndCommentables :: [CommentSite] -> [CommentLink] -> [Either CommentLink CommentSite]
orderCommentsAndCommentables sites comments = sortBy (compare `on` loc) elts
where
loc :: Either CommentLink CommentSite -> (SrcSpan, Bool)
loc (Left (commentSpan -> srcSpan)) = (srcSpan, True )
loc (Right (siteSlice -> srcSpan)) = (srcSpan, False)
elts = (Left <$> comments) ++ (Right <$> sites)
type Assignment = Map.Map CommentSite [CommentLink]