{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}
module Language.Haskell.Homplexity.Comments (
    CommentLink      (..)
  , CommentType      (..)
  , classifyComments
  , findCommentType  -- exposed for testing only
  , 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 Language.Haskell.Homplexity.CodeFragment
import Language.Haskell.Homplexity.SrcSlice
import Language.Haskell.Exts.SrcLoc
import Language.Haskell.Exts

-- | Describes the comment span, and the way it may be connected to the
-- source code
data CommentLink = CommentLink { CommentLink -> SrcSpan
commentSpan :: SrcSpan
                               , CommentLink -> CommentType
commentType :: CommentType
                               }
  deriving(CommentLink -> CommentLink -> Bool
(CommentLink -> CommentLink -> Bool)
-> (CommentLink -> CommentLink -> Bool) -> Eq CommentLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentLink -> CommentLink -> Bool
== :: CommentLink -> CommentLink -> Bool
$c/= :: CommentLink -> CommentLink -> Bool
/= :: CommentLink -> CommentLink -> Bool
Eq, Eq CommentLink
Eq CommentLink
-> (CommentLink -> CommentLink -> Ordering)
-> (CommentLink -> CommentLink -> Bool)
-> (CommentLink -> CommentLink -> Bool)
-> (CommentLink -> CommentLink -> Bool)
-> (CommentLink -> CommentLink -> Bool)
-> (CommentLink -> CommentLink -> CommentLink)
-> (CommentLink -> CommentLink -> CommentLink)
-> Ord CommentLink
CommentLink -> CommentLink -> Bool
CommentLink -> CommentLink -> Ordering
CommentLink -> CommentLink -> CommentLink
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
$ccompare :: CommentLink -> CommentLink -> Ordering
compare :: CommentLink -> CommentLink -> Ordering
$c< :: CommentLink -> CommentLink -> Bool
< :: CommentLink -> CommentLink -> Bool
$c<= :: CommentLink -> CommentLink -> Bool
<= :: CommentLink -> CommentLink -> Bool
$c> :: CommentLink -> CommentLink -> Bool
> :: CommentLink -> CommentLink -> Bool
$c>= :: CommentLink -> CommentLink -> Bool
>= :: CommentLink -> CommentLink -> Bool
$cmax :: CommentLink -> CommentLink -> CommentLink
max :: CommentLink -> CommentLink -> CommentLink
$cmin :: CommentLink -> CommentLink -> CommentLink
min :: CommentLink -> CommentLink -> CommentLink
Ord, Int -> CommentLink -> ShowS
[CommentLink] -> ShowS
CommentLink -> String
(Int -> CommentLink -> ShowS)
-> (CommentLink -> String)
-> ([CommentLink] -> ShowS)
-> Show CommentLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommentLink -> ShowS
showsPrec :: Int -> CommentLink -> ShowS
$cshow :: CommentLink -> String
show :: CommentLink -> String
$cshowList :: [CommentLink] -> ShowS
showList :: [CommentLink] -> ShowS
Show)

-- | Possible link between comment and commented entity.
data CommentType = CommentsBefore -- ^ May be counted as commenting object that starts just before.
                 | CommentsInside -- ^ May be counted as commenting object within which it exists.
                 | CommentsAfter  -- ^ May be counted as commenting object that starts just after.
  deriving (CommentType -> CommentType -> Bool
(CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> Bool) -> Eq CommentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentType -> CommentType -> Bool
== :: CommentType -> CommentType -> Bool
$c/= :: CommentType -> CommentType -> Bool
/= :: CommentType -> CommentType -> Bool
Eq, Eq CommentType
Eq CommentType
-> (CommentType -> CommentType -> Ordering)
-> (CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> CommentType)
-> (CommentType -> CommentType -> CommentType)
-> Ord CommentType
CommentType -> CommentType -> Bool
CommentType -> CommentType -> Ordering
CommentType -> CommentType -> CommentType
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
$ccompare :: CommentType -> CommentType -> Ordering
compare :: CommentType -> CommentType -> Ordering
$c< :: CommentType -> CommentType -> Bool
< :: CommentType -> CommentType -> Bool
$c<= :: CommentType -> CommentType -> Bool
<= :: CommentType -> CommentType -> Bool
$c> :: CommentType -> CommentType -> Bool
> :: CommentType -> CommentType -> Bool
$c>= :: CommentType -> CommentType -> Bool
>= :: CommentType -> CommentType -> Bool
$cmax :: CommentType -> CommentType -> CommentType
max :: CommentType -> CommentType -> CommentType
$cmin :: CommentType -> CommentType -> CommentType
min :: CommentType -> CommentType -> CommentType
Ord, Int -> CommentType
CommentType -> Int
CommentType -> [CommentType]
CommentType -> CommentType
CommentType -> CommentType -> [CommentType]
CommentType -> CommentType -> CommentType -> [CommentType]
(CommentType -> CommentType)
-> (CommentType -> CommentType)
-> (Int -> CommentType)
-> (CommentType -> Int)
-> (CommentType -> [CommentType])
-> (CommentType -> CommentType -> [CommentType])
-> (CommentType -> CommentType -> [CommentType])
-> (CommentType -> CommentType -> CommentType -> [CommentType])
-> Enum CommentType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CommentType -> CommentType
succ :: CommentType -> CommentType
$cpred :: CommentType -> CommentType
pred :: CommentType -> CommentType
$ctoEnum :: Int -> CommentType
toEnum :: Int -> CommentType
$cfromEnum :: CommentType -> Int
fromEnum :: CommentType -> Int
$cenumFrom :: CommentType -> [CommentType]
enumFrom :: CommentType -> [CommentType]
$cenumFromThen :: CommentType -> CommentType -> [CommentType]
enumFromThen :: CommentType -> CommentType -> [CommentType]
$cenumFromTo :: CommentType -> CommentType -> [CommentType]
enumFromTo :: CommentType -> CommentType -> [CommentType]
$cenumFromThenTo :: CommentType -> CommentType -> CommentType -> [CommentType]
enumFromThenTo :: CommentType -> CommentType -> CommentType -> [CommentType]
Enum, Int -> CommentType -> ShowS
[CommentType] -> ShowS
CommentType -> String
(Int -> CommentType -> ShowS)
-> (CommentType -> String)
-> ([CommentType] -> ShowS)
-> Show CommentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommentType -> ShowS
showsPrec :: Int -> CommentType -> ShowS
$cshow :: CommentType -> String
show :: CommentType -> String
$cshowList :: [CommentType] -> ShowS
showList :: [CommentType] -> ShowS
Show)

-- | Classifies all comments in list, so they can be assigned to declarations later.
classifyComments :: [Comment] -> [CommentLink]
classifyComments :: [Comment] -> [CommentLink]
classifyComments  = (Comment -> CommentLink) -> [Comment] -> [CommentLink]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> CommentLink
classifyComment
  where
    classifyComment :: Comment -> CommentLink
classifyComment (Comment Bool
_ SrcSpan
commentSpan (String -> CommentType
findCommentType -> CommentType
commentType)) = CommentLink {SrcSpan
CommentType
commentSpan :: SrcSpan
commentType :: CommentType
commentSpan :: SrcSpan
commentType :: CommentType
..}

-- | Finds Haddock markers of which declarations the comment pertains to.
findCommentType :: String -> CommentType
findCommentType :: String -> CommentType
findCommentType String
txt = case (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (Char -> Bool) -> String -> Maybe Char
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
`find` String
txt of
  Just Char
'^' -> CommentType
CommentsBefore
  Just Char
'|' -> CommentType
CommentsAfter
  Just Char
'*' -> CommentType
CommentsInside -- since it comments the group of declarations, it belongs to the containing object
  Maybe Char
_        -> CommentType
CommentsInside

-- * Finding ranges of all commentable entities.
-- | Tagging of source range for each commentable object.
data CommentSite = CommentSite { CommentSite -> String
siteName  :: String
                               , CommentSite -> SrcSpan
siteSlice :: SrcSlice
                               }
  deriving (CommentSite -> CommentSite -> Bool
(CommentSite -> CommentSite -> Bool)
-> (CommentSite -> CommentSite -> Bool) -> Eq CommentSite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentSite -> CommentSite -> Bool
== :: CommentSite -> CommentSite -> Bool
$c/= :: CommentSite -> CommentSite -> Bool
/= :: CommentSite -> CommentSite -> Bool
Eq, Int -> CommentSite -> ShowS
[CommentSite] -> ShowS
CommentSite -> String
(Int -> CommentSite -> ShowS)
-> (CommentSite -> String)
-> ([CommentSite] -> ShowS)
-> Show CommentSite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommentSite -> ShowS
showsPrec :: Int -> CommentSite -> ShowS
$cshow :: CommentSite -> String
show :: CommentSite -> String
$cshowList :: [CommentSite] -> ShowS
showList :: [CommentSite] -> ShowS
Show)

newtype Ends   = End   { Ends -> CommentSite
siteEnded   :: CommentSite }
  deriving (Ends -> Ends -> Bool
(Ends -> Ends -> Bool) -> (Ends -> Ends -> Bool) -> Eq Ends
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ends -> Ends -> Bool
== :: Ends -> Ends -> Bool
$c/= :: Ends -> Ends -> Bool
/= :: Ends -> Ends -> Bool
Eq, Int -> Ends -> ShowS
[Ends] -> ShowS
Ends -> String
(Int -> Ends -> ShowS)
-> (Ends -> String) -> ([Ends] -> ShowS) -> Show Ends
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ends -> ShowS
showsPrec :: Int -> Ends -> ShowS
$cshow :: Ends -> String
show :: Ends -> String
$cshowList :: [Ends] -> ShowS
showList :: [Ends] -> ShowS
Show)

compareStarts :: CommentSite -> CommentSite -> Ordering
compareStarts :: CommentSite -> CommentSite -> Ordering
compareStarts = ((Int, Int) -> (Int, Int) -> Ordering)
-> (CommentSite -> (Int, Int))
-> CommentSite
-> CommentSite
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (Int, Int) -> (Int, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> (Int, Int)
start (SrcSpan -> (Int, Int))
-> (CommentSite -> SrcSpan) -> CommentSite -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentSite -> SrcSpan
siteSlice)

instance Ord Ends   where
  compare :: Ends -> Ends -> Ordering
compare = (CommentSite -> CommentSite -> Ordering)
-> (Ends -> CommentSite) -> Ends -> Ends -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on CommentSite -> CommentSite -> Ordering
compareEnds Ends -> CommentSite
siteEnded

compareEnds :: CommentSite -> CommentSite -> Ordering
compareEnds :: CommentSite -> CommentSite -> Ordering
compareEnds  = ((Int, Int) -> (Int, Int) -> Ordering)
-> (CommentSite -> (Int, Int))
-> CommentSite
-> CommentSite
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (Int, Int) -> (Int, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> (Int, Int)
end   (SrcSpan -> (Int, Int))
-> (CommentSite -> SrcSpan) -> CommentSite -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentSite -> SrcSpan
siteSlice)

start, end :: SrcSlice -> (Int, Int)
start :: SrcSpan -> (Int, Int)
start SrcSpan
slice = (SrcSpan -> Int
srcSpanStartColumn SrcSpan
slice, SrcSpan -> Int
srcSpanStartLine SrcSpan
slice)
end :: SrcSpan -> (Int, Int)
end   SrcSpan
slice = (SrcSpan -> Int
srcSpanEndColumn   SrcSpan
slice, SrcSpan -> Int
srcSpanEndLine   SrcSpan
slice)

-- | Find comment sites for entire program.
commentable     :: Data from => from -> [CommentSite]
commentable :: forall from. Data from => from -> [CommentSite]
commentable from
code = ((from -> [CommentSite]) -> from -> [CommentSite]
forall a b. (a -> b) -> a -> b
$ from
code) ((from -> [CommentSite]) -> [CommentSite])
-> [from -> [CommentSite]] -> [CommentSite]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [Proxy Function -> from -> [CommentSite]
forall c from.
(CodeFragment c, Data from) =>
Proxy c -> from -> [CommentSite]
slicesOf Proxy Function
functionT
                                        ,Proxy TypeSignature -> from -> [CommentSite]
forall c from.
(CodeFragment c, Data from) =>
Proxy c -> from -> [CommentSite]
slicesOf Proxy TypeSignature
typeSignatureT
                                        ,Proxy (Module SrcLoc) -> from -> [CommentSite]
forall c from.
(CodeFragment c, Data from) =>
Proxy c -> from -> [CommentSite]
slicesOf Proxy (Module SrcLoc)
moduleT       ]
  where
    commentSite  ::  CodeFragment c => (c -> SrcSlice) -> c -> CommentSite
    commentSite :: forall c. CodeFragment c => (c -> SrcSpan) -> c -> CommentSite
commentSite c -> SrcSpan
with c
frag = String -> SrcSpan -> CommentSite
CommentSite (c -> String
forall c. CodeFragment c => c -> String
fragmentName c
frag)
                                        (c -> SrcSpan
with         c
frag)
    commentSites :: (CodeFragment c, Data from) => (c -> SrcSlice) -> Proxy c -> from -> [CommentSite]
    commentSites :: forall c from.
(CodeFragment c, Data from) =>
(c -> SrcSpan) -> Proxy c -> from -> [CommentSite]
commentSites c -> SrcSpan
with Proxy c
fragType = (c -> CommentSite) -> [c] -> [CommentSite]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> SrcSpan) -> c -> CommentSite
forall c. CodeFragment c => (c -> SrcSpan) -> c -> CommentSite
commentSite c -> SrcSpan
with) ([c] -> [CommentSite]) -> (from -> [c]) -> from -> [CommentSite]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy c -> from -> [c]
forall from c.
(Data from, CodeFragment c) =>
Proxy c -> from -> [c]
occursOf Proxy c
fragType
    slicesOf :: (CodeFragment c, Data from) => Proxy c -> from -> [CommentSite]
    slicesOf :: forall c from.
(CodeFragment c, Data from) =>
Proxy c -> from -> [CommentSite]
slicesOf = (c -> SrcSpan) -> Proxy c -> from -> [CommentSite]
forall c from.
(CodeFragment c, Data from) =>
(c -> SrcSpan) -> Proxy c -> from -> [CommentSite]
commentSites              c -> SrcSpan
forall c. CodeFragment c => c -> SrcSpan
fragmentSlice 
    --locsOf   = commentSites (locAsSpan . fragmentLoc)

-- | Take together are commentable elements, and all comments, and order them by source location.
orderCommentsAndCommentables :: [CommentSite] -> [CommentLink] -> [Either CommentLink CommentSite]
orderCommentsAndCommentables :: [CommentSite] -> [CommentLink] -> [Either CommentLink CommentSite]
orderCommentsAndCommentables [CommentSite]
sites [CommentLink]
comments  = (Either CommentLink CommentSite
 -> Either CommentLink CommentSite -> Ordering)
-> [Either CommentLink CommentSite]
-> [Either CommentLink CommentSite]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((SrcSpan, Bool) -> (SrcSpan, Bool) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((SrcSpan, Bool) -> (SrcSpan, Bool) -> Ordering)
-> (Either CommentLink CommentSite -> (SrcSpan, Bool))
-> Either CommentLink CommentSite
-> Either CommentLink CommentSite
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Either CommentLink CommentSite -> (SrcSpan, Bool)
loc) [Either CommentLink CommentSite]
elts
  where
    loc :: Either CommentLink CommentSite -> (SrcSpan, Bool)
    loc :: Either CommentLink CommentSite -> (SrcSpan, Bool)
loc (Left  (CommentLink -> SrcSpan
commentSpan -> SrcSpan
srcSpan)) = (SrcSpan
srcSpan, Bool
True )
    loc (Right (CommentSite -> SrcSpan
siteSlice   -> SrcSpan
srcSpan)) = (SrcSpan
srcSpan, Bool
False)
    elts :: [Either CommentLink CommentSite]
elts = (CommentLink -> Either CommentLink CommentSite
forall a b. a -> Either a b
Left (CommentLink -> Either CommentLink CommentSite)
-> [CommentLink] -> [Either CommentLink CommentSite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CommentLink]
comments) [Either CommentLink CommentSite]
-> [Either CommentLink CommentSite]
-> [Either CommentLink CommentSite]
forall a. [a] -> [a] -> [a]
++ (CommentSite -> Either CommentLink CommentSite
forall a b. b -> Either a b
Right (CommentSite -> Either CommentLink CommentSite)
-> [CommentSite] -> [Either CommentLink CommentSite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CommentSite]
sites)

type Assignment = Map.Map CommentSite [CommentLink]
{-
-- | Assign comments to the commentable elements.
assignComments :: [Either CommentLink CommentSite]
               -> [Assignment]
assignComments  = foldr assign ([], [], [], [])
  where
    assign :: (Assignment, [Assignment], [CommentLink]
    assign (assigned, unclosed, commentingAfter) nextElt = case nextElt of
      Left  (s@(CommentSite {}))                            ->
        (assigned, (s,commentingAfter):unclosed, [])
      Right (c@(CommentLink {commentType=CommentAfter,  ..}) -> 
        (assigned,                     unclosed, c:commentingAfter)
      Right (c@(CommentLink {commentType=CommentBefore, ..}) -> 
        (assigned,                     unclosed, c:commentingAfter)
      Right (c@(CommentLink {commentType=CommentInside, ..}) -> 
        (assigned,                     unclosed, c:commentingAfter)
 -}