content: {-# 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 { commentSpan :: SrcSpan
                                 , commentType :: CommentType
                                 }
    deriving(Eq, Ord, 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 (Eq, Ord, Enum, Show)
  
  -- | Classifies all comments in list, so they can be assigned to declarations later.
  classifyComments :: [Comment] -> [CommentLink]
  classifyComments  = map classifyComment
    where
      classifyComment (Comment _ commentSpan (findCommentType -> commentType)) = CommentLink {..}
  
  -- | Finds Haddock markers of which declarations the comment pertains to.
  findCommentType :: String -> CommentType
  findCommentType txt = case (not . isSpace) `find` txt of
    Just '^' -> CommentsBefore
    Just '|' -> CommentsAfter
    Just '*' -> CommentsInside -- since it comments the group of declarations, it belongs to the containing object
    _        -> CommentsInside
  
  -- * Finding ranges of all commentable entities.
  -- | Tagging of source range for each commentable object.
  data CommentSite = CommentSite { siteName  :: String
                                 , siteSlice :: SrcSlice
                                 }
    deriving (Eq, Show)
  
  newtype Ends   = End   { siteEnded   :: CommentSite }
    deriving (Eq, Show)
  
  compareStarts :: CommentSite -> CommentSite -> Ordering
  compareStarts = on compare (start . siteSlice)
  
  instance Ord Ends   where
    compare = on compareEnds siteEnded
  
  compareEnds :: CommentSite -> CommentSite -> Ordering
  compareEnds  = on compare (end   . siteSlice)
  
  start, end :: SrcSlice -> (Int, Int)
  start slice = (srcSpanStartColumn slice, srcSpanStartLine slice)
  end   slice = (srcSpanEndColumn   slice, srcSpanEndLine   slice)
  
  -- | Find comment sites for entire program.
  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 
      --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 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]
  {-
  -- | 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)
   -}
  