module HIndent.Comments where
import Control.Monad.State.Strict
import Data.Data
import Data.Function
import Data.Traversable
import HIndent.Types
import Language.Haskell.Exts.Annotated hiding (Style,prettyPrint,Pretty,style,parse)
annotateComments :: forall ast. (Data (ast NodeInfo),Traversable ast,Annotated ast)
=> ast SrcSpanInfo -> [Comment] -> ([ComInfo],ast NodeInfo)
annotateComments src comments =
let
reversed = reverse comments
src' = fmap (\n -> NodeInfo n []) src
(cominfos, src'') = foldr processComment ([], src') reversed
in
(cominfos, fmap (\(NodeInfo n cs) -> NodeInfo n $ reverse cs) src'')
where processComment :: Comment
-> ([ComInfo],ast NodeInfo)
-> ([ComInfo],ast NodeInfo)
processComment c@(Comment _ cspan _) (cs,ast) =
case execState (traverse (collect After c) ast) Nothing of
Nothing -> (ComInfo c Nothing : cs, ast)
Just (NodeInfo l coms)
| ownLine && alignedWithPrevious -> insertedBefore
| ownLine ->
case execState (traverse (collect Before c) ast) Nothing of
Nothing -> insertedBefore
Just (NodeInfo node _) ->
(cs, evalState (traverse (insert node (ComInfo c $ Just Before)) ast) False)
| otherwise -> insertedBefore
where
ownLine = srcSpanStartLine cspan /= srcSpanEndLine (srcInfoSpan l)
insertedBefore = (cs, evalState (traverse (insert l (ComInfo c $ Just After)) ast) False)
alignedWithPrevious
| null coms = False
| otherwise = case last coms of
ComInfo (Comment False prevSpan _) (Just After) ->
srcSpanStartLine prevSpan == srcSpanStartLine cspan 1 &&
srcSpanStartColumn prevSpan == srcSpanStartColumn cspan
_ -> False
collect :: ComInfoLocation -> Comment -> NodeInfo -> State (Maybe NodeInfo) NodeInfo
collect loc' c ni@(NodeInfo newL _) =
do when (commentLocated loc' ni c)
(modify (maybe (Just ni)
(\oldni@(NodeInfo oldL _) ->
Just (if (spanTest loc' `on` srcInfoSpan) oldL newL
then ni
else oldni))))
return ni
insert :: SrcSpanInfo -> ComInfo -> NodeInfo -> State Bool NodeInfo
insert al c ni@(NodeInfo bl cs) =
do done <- get
if not done && al == bl
then do put True
return (ni {nodeInfoComments = c : cs})
else return ni
commentLocated :: ComInfoLocation -> NodeInfo -> Comment -> Bool
commentLocated loc' (NodeInfo (SrcSpanInfo n _) _) (Comment _ c _) =
spanTest loc' n c
spanTest :: ComInfoLocation -> SrcSpan -> SrcSpan -> Bool
spanTest loc' first second =
(srcSpanStartLine after > srcSpanEndLine before) ||
((srcSpanStartLine after == srcSpanEndLine before) &&
(srcSpanStartColumn after > srcSpanEndColumn before))
where (before,after) =
case loc' of
After -> (first,second)
Before -> (second,first)