{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.Exts.Comments
-- Copyright   :  (c) JP Moresmau 2015
-- License     :  BSD-style (see the file LICENSE.txt)
--
-- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
-- Stability   :  experimental
-- Portability :  portable
--
-- This module processes comments along with an annotated AST,
-- to be able to associate Haddock comments with the actual item
-- they refer to.
--
-- Example:
--
-- @
-- let
--  parse1Result :: ParseResult (Module SrcSpanInfo,[Comment])
--  parse1Result =
--    parseFileContentsWithComments
--     (defaultParseMode { parseFilename = file })
--      contents
--  withC :: ParseResult (Module (SrcSpanInfo,[Comment]))
--  withC = case parse1Result of
--            ParseOk res         -> ParseOk $ associateHaddock res
--            ParseFailed sloc msg -> ParseFailed sloc msg
-- @
--
-- In this code sample, parse1Result is what you get when you parse a file:
-- a 'Module' annotated wth 'SrcSpanInfo', and a list of comments
-- After passing the result to 'associateHaddock', you get a 'Module'
-- annotated with both a 'SrcSpanInfo' and the list of 'Comment' related to the
-- specific AST node.
--
-----------------------------------------------------------------------------
module Language.Haskell.Exts.Comments
    ( associateHaddock
    , Comment(..), UnknownPragma(..)
    ) where

import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.SrcLoc

import Data.Char (isSpace)
import Data.Traversable
import Data.Data


-- | A Haskell comment. The 'Bool' is 'True' if the comment is multi-line, i.e. @{- -}@.
data Comment = Comment Bool SrcSpan String
  deriving (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: Comment -> Comment -> Bool
Eq,Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show,Typeable,Typeable Comment
DataType
Constr
Typeable Comment
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Comment -> c Comment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comment)
-> (Comment -> Constr)
-> (Comment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment))
-> ((forall b. Data b => b -> b) -> Comment -> Comment)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall u. (forall d. Data d => d -> u) -> Comment -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> Data Comment
Comment -> DataType
Comment -> Constr
(forall b. Data b => b -> b) -> Comment -> Comment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
forall u. (forall d. Data d => d -> u) -> Comment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cComment :: Constr
$tComment :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapMp :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapM :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapQi :: Int -> (forall d. Data d => d -> u) -> Comment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
gmapQ :: (forall d. Data d => d -> u) -> Comment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
$cgmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Comment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
dataTypeOf :: Comment -> DataType
$cdataTypeOf :: Comment -> DataType
toConstr :: Comment -> Constr
$ctoConstr :: Comment -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cp1Data :: Typeable Comment
Data)

-- | An unknown pragma.
data UnknownPragma = UnknownPragma SrcSpan String
  deriving (UnknownPragma -> UnknownPragma -> Bool
(UnknownPragma -> UnknownPragma -> Bool)
-> (UnknownPragma -> UnknownPragma -> Bool) -> Eq UnknownPragma
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnknownPragma -> UnknownPragma -> Bool
$c/= :: UnknownPragma -> UnknownPragma -> Bool
== :: UnknownPragma -> UnknownPragma -> Bool
$c== :: UnknownPragma -> UnknownPragma -> Bool
Eq,Int -> UnknownPragma -> ShowS
[UnknownPragma] -> ShowS
UnknownPragma -> String
(Int -> UnknownPragma -> ShowS)
-> (UnknownPragma -> String)
-> ([UnknownPragma] -> ShowS)
-> Show UnknownPragma
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnknownPragma] -> ShowS
$cshowList :: [UnknownPragma] -> ShowS
show :: UnknownPragma -> String
$cshow :: UnknownPragma -> String
showsPrec :: Int -> UnknownPragma -> ShowS
$cshowsPrec :: Int -> UnknownPragma -> ShowS
Show,Typeable,Typeable UnknownPragma
DataType
Constr
Typeable UnknownPragma
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UnknownPragma -> c UnknownPragma)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnknownPragma)
-> (UnknownPragma -> Constr)
-> (UnknownPragma -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnknownPragma))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c UnknownPragma))
-> ((forall b. Data b => b -> b) -> UnknownPragma -> UnknownPragma)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UnknownPragma -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UnknownPragma -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnknownPragma -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> UnknownPragma -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma)
-> Data UnknownPragma
UnknownPragma -> DataType
UnknownPragma -> Constr
(forall b. Data b => b -> b) -> UnknownPragma -> UnknownPragma
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnknownPragma -> c UnknownPragma
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnknownPragma
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UnknownPragma -> u
forall u. (forall d. Data d => d -> u) -> UnknownPragma -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownPragma -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownPragma -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnknownPragma
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnknownPragma -> c UnknownPragma
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnknownPragma)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnknownPragma)
$cUnknownPragma :: Constr
$tUnknownPragma :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma
gmapMp :: (forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma
gmapM :: (forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnknownPragma -> m UnknownPragma
gmapQi :: Int -> (forall d. Data d => d -> u) -> UnknownPragma -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnknownPragma -> u
gmapQ :: (forall d. Data d => d -> u) -> UnknownPragma -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnknownPragma -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownPragma -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownPragma -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownPragma -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnknownPragma -> r
gmapT :: (forall b. Data b => b -> b) -> UnknownPragma -> UnknownPragma
$cgmapT :: (forall b. Data b => b -> b) -> UnknownPragma -> UnknownPragma
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnknownPragma)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnknownPragma)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UnknownPragma)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnknownPragma)
dataTypeOf :: UnknownPragma -> DataType
$cdataTypeOf :: UnknownPragma -> DataType
toConstr :: UnknownPragma -> Constr
$ctoConstr :: UnknownPragma -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnknownPragma
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnknownPragma
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnknownPragma -> c UnknownPragma
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnknownPragma -> c UnknownPragma
$cp1Data :: Typeable UnknownPragma
Data)


-- | Associates an AST with Source Span Information
-- with relevant Haddock comments
associateHaddock
  ::(Annotated ast,Traversable ast)
  => (ast SrcSpanInfo,[Comment])
  -> ast (SrcSpanInfo,[Comment])
associateHaddock :: (ast SrcSpanInfo, [Comment]) -> ast (SrcSpanInfo, [Comment])
associateHaddock (ast SrcSpanInfo
ast,[]) = (SrcSpanInfo -> (SrcSpanInfo, [Comment]))
-> ast SrcSpanInfo -> ast (SrcSpanInfo, [Comment])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SrcSpanInfo
src->(SrcSpanInfo
src,[])) ast SrcSpanInfo
ast
associateHaddock (ast SrcSpanInfo
ast,[Comment]
comments) =
  let
    (CommentAccumulator
ca,ast (SrcSpanInfo, [Comment])
assocs1) = (CommentAccumulator
 -> SrcSpanInfo -> (CommentAccumulator, (SrcSpanInfo, [Comment])))
-> CommentAccumulator
-> ast SrcSpanInfo
-> (CommentAccumulator, ast (SrcSpanInfo, [Comment]))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL CommentAccumulator
-> SrcSpanInfo -> (CommentAccumulator, (SrcSpanInfo, [Comment]))
associate1 ([Comment] -> CommentAccumulator
newAccumulator [Comment]
comments) ast SrcSpanInfo
ast
  in ([(SrcSpanInfo, [Comment])], ast (SrcSpanInfo, [Comment]))
-> ast (SrcSpanInfo, [Comment])
forall a b. (a, b) -> b
snd (([(SrcSpanInfo, [Comment])], ast (SrcSpanInfo, [Comment]))
 -> ast (SrcSpanInfo, [Comment]))
-> ([(SrcSpanInfo, [Comment])], ast (SrcSpanInfo, [Comment]))
-> ast (SrcSpanInfo, [Comment])
forall a b. (a -> b) -> a -> b
$ ([(SrcSpanInfo, [Comment])]
 -> (SrcSpanInfo, [Comment])
 -> ([(SrcSpanInfo, [Comment])], (SrcSpanInfo, [Comment])))
-> [(SrcSpanInfo, [Comment])]
-> ast (SrcSpanInfo, [Comment])
-> ([(SrcSpanInfo, [Comment])], ast (SrcSpanInfo, [Comment]))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL [(SrcSpanInfo, [Comment])]
-> (SrcSpanInfo, [Comment])
-> ([(SrcSpanInfo, [Comment])], (SrcSpanInfo, [Comment]))
merge (CommentAccumulator -> [(SrcSpanInfo, [Comment])]
lastPost CommentAccumulator
ca) ast (SrcSpanInfo, [Comment])
assocs1


-- | Merge existing association with post comment associations
merge
  :: [(SrcSpanInfo,[Comment])]
  -> (SrcSpanInfo,[Comment])
  -> ([(SrcSpanInfo,[Comment])], (SrcSpanInfo,[Comment]))
merge :: [(SrcSpanInfo, [Comment])]
-> (SrcSpanInfo, [Comment])
-> ([(SrcSpanInfo, [Comment])], (SrcSpanInfo, [Comment]))
merge [] (SrcSpanInfo, [Comment])
ret = ([],(SrcSpanInfo, [Comment])
ret)
merge ((SrcSpanInfo, [Comment])
x:[(SrcSpanInfo, [Comment])]
xs) (SrcSpanInfo
src,[Comment]
cmts) =
  if (SrcSpanInfo, [Comment]) -> SrcSpanInfo
forall a b. (a, b) -> a
fst (SrcSpanInfo, [Comment])
x SrcSpanInfo -> SrcSpanInfo -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpanInfo
src
    then ([(SrcSpanInfo, [Comment])]
xs,(SrcSpanInfo
src,[Comment]
cmts [Comment] -> [Comment] -> [Comment]
forall a. [a] -> [a] -> [a]
++ (SrcSpanInfo, [Comment]) -> [Comment]
forall a b. (a, b) -> b
snd (SrcSpanInfo, [Comment])
x))
    else ((SrcSpanInfo, [Comment])
x(SrcSpanInfo, [Comment])
-> [(SrcSpanInfo, [Comment])] -> [(SrcSpanInfo, [Comment])]
forall a. a -> [a] -> [a]
:[(SrcSpanInfo, [Comment])]
xs,(SrcSpanInfo
src,[Comment]
cmts))


-- | Ensure that if file ends with comment we process it
lastPost :: CommentAccumulator -> [(SrcSpanInfo, [Comment])]
lastPost :: CommentAccumulator -> [(SrcSpanInfo, [Comment])]
lastPost (CommentAccumulator (Post Comment
cmt : [HaddockComment]
rest) [SrcSpanInfo]
past [(SrcSpanInfo, [Comment])]
assocs) =
  let ([HaddockComment]
toMerge, [HaddockComment]
_) = (HaddockComment -> Bool)
-> [HaddockComment] -> ([HaddockComment], [HaddockComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span HaddockComment -> Bool
isNone [HaddockComment]
rest
      psrc :: SrcSpanInfo
psrc = [SrcSpanInfo] -> SrcSpanInfo
matchPreviousSrc [SrcSpanInfo]
past
  in ([(SrcSpanInfo, [Comment])]
assocs [(SrcSpanInfo, [Comment])]
-> [(SrcSpanInfo, [Comment])] -> [(SrcSpanInfo, [Comment])]
forall a. [a] -> [a] -> [a]
++ [(SrcSpanInfo
psrc, Comment
cmt Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
: (HaddockComment -> Comment) -> [HaddockComment] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map HaddockComment -> Comment
hcComment [HaddockComment]
toMerge)])
lastPost (CommentAccumulator [HaddockComment]
_ [SrcSpanInfo]
_ [(SrcSpanInfo, [Comment])]
assocs) = [(SrcSpanInfo, [Comment])]
assocs


-- | Accumulate comments mappings, either directly with the source
-- or in another association list for later processing
associate1
  :: CommentAccumulator
  -> SrcSpanInfo
  -> (CommentAccumulator,(SrcSpanInfo,[Comment]))
associate1 :: CommentAccumulator
-> SrcSpanInfo -> (CommentAccumulator, (SrcSpanInfo, [Comment]))
associate1 ca :: CommentAccumulator
ca@(CommentAccumulator [] [SrcSpanInfo]
_ [(SrcSpanInfo, [Comment])]
_) SrcSpanInfo
src = (CommentAccumulator
ca,(SrcSpanInfo
src,[]))
associate1 (CommentAccumulator (hc :: HaddockComment
hc@(Pre Comment
cmt):[HaddockComment]
rest) [SrcSpanInfo]
_ [(SrcSpanInfo, [Comment])]
assocs) SrcSpanInfo
src =
  if HaddockComment -> SrcSpanInfo -> Bool
isBefore HaddockComment
hc SrcSpanInfo
src
    then
      let ([HaddockComment]
toMerge,[HaddockComment]
next) = SrcSpanInfo
-> [HaddockComment] -> ([HaddockComment], [HaddockComment])
getToMerge SrcSpanInfo
src [HaddockComment]
rest
          newAssoc :: (SrcSpanInfo, [Comment])
newAssoc = (SrcSpanInfo
src,Comment
cmt Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
: (HaddockComment -> Comment) -> [HaddockComment] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map HaddockComment -> Comment
hcComment [HaddockComment]
toMerge)
      in ([HaddockComment]
-> [SrcSpanInfo]
-> [(SrcSpanInfo, [Comment])]
-> CommentAccumulator
CommentAccumulator [HaddockComment]
next [] [(SrcSpanInfo, [Comment])]
assocs,(SrcSpanInfo, [Comment])
newAssoc)
    else ([HaddockComment]
-> [SrcSpanInfo]
-> [(SrcSpanInfo, [Comment])]
-> CommentAccumulator
CommentAccumulator (HaddockComment
hcHaddockComment -> [HaddockComment] -> [HaddockComment]
forall a. a -> [a] -> [a]
:[HaddockComment]
rest) [] [(SrcSpanInfo, [Comment])]
assocs,(SrcSpanInfo
src,[]))
associate1 (CommentAccumulator (hc :: HaddockComment
hc@(Post Comment
cmt):[HaddockComment]
rest) [SrcSpanInfo]
past [(SrcSpanInfo, [Comment])]
assocs) SrcSpanInfo
src =
  if HaddockComment -> SrcSpanInfo -> Bool
isBefore HaddockComment
hc SrcSpanInfo
src
    then
      let ([HaddockComment]
toMerge,[HaddockComment]
next) = SrcSpanInfo
-> [HaddockComment] -> ([HaddockComment], [HaddockComment])
getToMerge SrcSpanInfo
src [HaddockComment]
rest
          newAssocs :: [(SrcSpanInfo, [Comment])]
newAssocs =
            if [SrcSpanInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SrcSpanInfo]
past
              then [(SrcSpanInfo, [Comment])]
assocs
              else [(SrcSpanInfo, [Comment])]
assocs[(SrcSpanInfo, [Comment])]
-> [(SrcSpanInfo, [Comment])] -> [(SrcSpanInfo, [Comment])]
forall a. [a] -> [a] -> [a]
++[([SrcSpanInfo] -> SrcSpanInfo
matchPreviousSrc [SrcSpanInfo]
past,Comment
cmt Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
: (HaddockComment -> Comment) -> [HaddockComment] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map HaddockComment -> Comment
hcComment [HaddockComment]
toMerge)]
      in CommentAccumulator
-> SrcSpanInfo -> (CommentAccumulator, (SrcSpanInfo, [Comment]))
associate1 ([HaddockComment]
-> [SrcSpanInfo]
-> [(SrcSpanInfo, [Comment])]
-> CommentAccumulator
CommentAccumulator [HaddockComment]
next [] [(SrcSpanInfo, [Comment])]
newAssocs) SrcSpanInfo
src
    else ([HaddockComment]
-> [SrcSpanInfo]
-> [(SrcSpanInfo, [Comment])]
-> CommentAccumulator
CommentAccumulator (HaddockComment
hcHaddockComment -> [HaddockComment] -> [HaddockComment]
forall a. a -> [a] -> [a]
:[HaddockComment]
rest) (SrcSpanInfo
srcSrcSpanInfo -> [SrcSpanInfo] -> [SrcSpanInfo]
forall a. a -> [a] -> [a]
:[SrcSpanInfo]
past) [(SrcSpanInfo, [Comment])]
assocs,(SrcSpanInfo
src,[]))
associate1 (CommentAccumulator (HaddockComment
_:[HaddockComment]
rest) [SrcSpanInfo]
past [(SrcSpanInfo, [Comment])]
assocs) SrcSpanInfo
src =
  ([HaddockComment]
-> [SrcSpanInfo]
-> [(SrcSpanInfo, [Comment])]
-> CommentAccumulator
CommentAccumulator [HaddockComment]
rest (SrcSpanInfo
srcSrcSpanInfo -> [SrcSpanInfo] -> [SrcSpanInfo]
forall a. a -> [a] -> [a]
:[SrcSpanInfo]
past) [(SrcSpanInfo, [Comment])]
assocs,(SrcSpanInfo
src,[]))


-- | The comment accumulator
data CommentAccumulator = CommentAccumulator
  [HaddockComment]          -- The Haddock comments to process
  [SrcSpanInfo]             -- The past src infos to resolve post comments
  [(SrcSpanInfo,[Comment])] -- The additional associations between src and comments


-- | Create a new accumulator
newAccumulator :: [Comment] -> CommentAccumulator
newAccumulator :: [Comment] -> CommentAccumulator
newAccumulator [Comment]
comments = [HaddockComment]
-> [SrcSpanInfo]
-> [(SrcSpanInfo, [Comment])]
-> CommentAccumulator
CommentAccumulator ([Comment] -> [HaddockComment]
commentsToHaddock [Comment]
comments) [] []

-- | Get comments to merge
getToMerge
  :: SrcSpanInfo                         -- ^ Stop before src
  -> [HaddockComment]                    -- ^ All remaining comments
  -> ([HaddockComment],[HaddockComment]) -- ^ Comments to merge, left overs
getToMerge :: SrcSpanInfo
-> [HaddockComment] -> ([HaddockComment], [HaddockComment])
getToMerge SrcSpanInfo
src = (HaddockComment -> Bool)
-> [HaddockComment] -> ([HaddockComment], [HaddockComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\HaddockComment
hc-> HaddockComment -> Bool
isNone HaddockComment
hc Bool -> Bool -> Bool
&& HaddockComment -> SrcSpanInfo -> Bool
isBefore HaddockComment
hc SrcSpanInfo
src)


-- | Get the biggest src that ends where the first one does
matchPreviousSrc :: [SrcSpanInfo] -> SrcSpanInfo
matchPreviousSrc :: [SrcSpanInfo] -> SrcSpanInfo
matchPreviousSrc [] =
  String -> SrcSpanInfo
forall a. HasCallStack => String -> a
error String
"Language.Haskell.Exts.Annotated.Comments.matchPreviousSrc: empty list"
matchPreviousSrc [SrcSpanInfo]
srcs =
  let end :: (Int, Int)
end = SrcSpan -> (Int, Int)
srcSpanEnd (SrcSpan -> (Int, Int)) -> SrcSpan -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> SrcSpan
srcInfoSpan (SrcSpanInfo -> SrcSpan) -> SrcSpanInfo -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [SrcSpanInfo] -> SrcSpanInfo
forall a. [a] -> a
head [SrcSpanInfo]
srcs
  in [SrcSpanInfo] -> SrcSpanInfo
forall a. [a] -> a
last ([SrcSpanInfo] -> SrcSpanInfo) -> [SrcSpanInfo] -> SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ (SrcSpanInfo -> Bool) -> [SrcSpanInfo] -> [SrcSpanInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (((Int, Int)
end (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
==) ((Int, Int) -> Bool)
-> (SrcSpanInfo -> (Int, Int)) -> SrcSpanInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> (Int, Int)
srcSpanEnd (SrcSpan -> (Int, Int))
-> (SrcSpanInfo -> SrcSpan) -> SrcSpanInfo -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanInfo -> SrcSpan
srcInfoSpan) [SrcSpanInfo]
srcs

-- | Is a Haddock comment before a given location
isBefore :: HaddockComment -> SrcSpanInfo -> Bool
isBefore :: HaddockComment -> SrcSpanInfo -> Bool
isBefore HaddockComment
hc SrcSpanInfo
src=
  let
    (Comment Bool
_ SrcSpan
csrc String
_) = HaddockComment -> Comment
hcComment HaddockComment
hc
  in SrcSpan
csrc SrcSpan -> SrcSpan -> Bool
forall a. Ord a => a -> a -> Bool
< SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
src

-- | Represents a Haddock Comment
data HaddockComment =
  -- | Comment before declaration
  Pre
   {
     HaddockComment -> Comment
hcComment::Comment
   }
  -- | Comment after declaration
  | Post  {
     hcComment::Comment
    }
  -- | Non Haddock comment
  | None  {
     hcComment::Comment
    }

-- | Is a comment not haddock?
isNone :: HaddockComment -> Bool
isNone :: HaddockComment -> Bool
isNone (None Comment
_) = Bool
True
isNone HaddockComment
_ = Bool
False


-- | Comments to Haddock Comments
commentsToHaddock :: [Comment] -> [HaddockComment]
commentsToHaddock :: [Comment] -> [HaddockComment]
commentsToHaddock = (Comment -> HaddockComment) -> [Comment] -> [HaddockComment]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> HaddockComment
commentToHaddock

-- | Comment to Haddock Comment
commentToHaddock :: Comment -> HaddockComment
commentToHaddock :: Comment -> HaddockComment
commentToHaddock c :: Comment
c@(Comment Bool
_ SrcSpan
_ String
txt) =
  case (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
txt of
    (Char
'|':String
_) -> Comment -> HaddockComment
Pre Comment
c
    (Char
'^':String
_) -> Comment -> HaddockComment
Post Comment
c
    String
_       -> Comment -> HaddockComment
None Comment
c