module HIndent.Comments where
import Control.Arrow (first, second)
import Control.Monad.State.Strict
import Data.Data
import qualified Data.Foldable
import qualified Data.Map.Strict as M
import Data.Monoid
import Data.Traversable
import HIndent.Types
import Language.Haskell.Exts hiding (Style,prettyPrint,Pretty,style,parse)
import Prelude
newtype OrderByStart =
OrderByStart SrcSpan
deriving (Eq)
instance Ord OrderByStart where
compare (OrderByStart l) (OrderByStart r) =
compare (srcSpanStartLine l)
(srcSpanStartLine r) `mappend`
compare (srcSpanStartColumn l)
(srcSpanStartColumn r) `mappend`
compare (srcSpanEndLine r)
(srcSpanEndLine l) `mappend`
compare (srcSpanEndColumn r)
(srcSpanEndColumn l)
newtype OrderByEnd =
OrderByEnd SrcSpan
deriving (Eq)
instance Ord OrderByEnd where
compare (OrderByEnd l) (OrderByEnd r) =
compare (srcSpanEndLine l)
(srcSpanEndLine r) `mappend`
compare (srcSpanEndColumn l)
(srcSpanEndColumn r) `mappend`
compare (srcSpanStartLine r)
(srcSpanStartLine l) `mappend`
compare (srcSpanStartColumn r)
(srcSpanStartColumn l)
annotateComments :: forall ast. (Data (ast NodeInfo),Traversable ast,Annotated ast,Show (ast NodeInfo))
=> ast SrcSpanInfo -> [Comment] -> ([ComInfo],ast NodeInfo)
annotateComments src comments =
evalState (do _ <- traverse assignComment comments
cis <- gets fst
ast <- traverse transferComments src
return (cis,ast))
([],nodeinfos)
where
nodeinfos :: M.Map SrcSpanInfo NodeInfo
nodeinfos = Data.Foldable.foldr (\ssi -> M.insert ssi (NodeInfo ssi [])) M.empty src
assignComment :: Comment -> State ([ComInfo],M.Map SrcSpanInfo NodeInfo) ()
assignComment comment@(Comment _ cspan _) =
case nodeBefore comment of
Nothing -> modify $ first $ (:) (ComInfo comment Nothing)
Just ssi ->
if sameline (srcInfoSpan ssi) cspan
then insertComment After ssi
else do nodeinfo <- gets ((M.! ssi) . snd)
case nodeinfo of
NodeInfo _ ((ComInfo c' _):_)
| aligned c' comment -> insertComment After ssi
_ ->
case nodeAfter comment of
Nothing -> insertComment After ssi
Just ssi' -> insertComment Before ssi'
where
sameline :: SrcSpan -> SrcSpan -> Bool
sameline before after = srcSpanEndLine before == srcSpanStartLine after
aligned :: Comment -> Comment -> Bool
aligned (Comment _ before _) (Comment _ after _) =
srcSpanEndLine before == srcSpanStartLine after 1 &&
srcSpanStartColumn before == srcSpanStartColumn after
insertComment :: ComInfoLocation -> SrcSpanInfo -> State ([ComInfo],M.Map SrcSpanInfo NodeInfo) ()
insertComment l ssi = modify $ second $ M.adjust (addComment (ComInfo comment (Just l))) ssi
addComment :: ComInfo -> NodeInfo -> NodeInfo
addComment x (NodeInfo s xs) = NodeInfo s (x : xs)
transferComments :: SrcSpanInfo -> State ([ComInfo],M.Map SrcSpanInfo NodeInfo) NodeInfo
transferComments ssi =
do ni <- gets ((M.! ssi) . snd)
modify $ second $ M.adjust (\(NodeInfo s _) -> NodeInfo s []) ssi
return ni { nodeInfoComments = reverse $ nodeInfoComments ni }
nodeBefore (Comment _ ss _) = fmap snd $ (OrderByEnd ss) `M.lookupLT` spansByEnd
nodeAfter (Comment _ ss _) = fmap snd $ (OrderByStart ss) `M.lookupGT` spansByStart
spansByStart = Data.Foldable.foldr (\ssi -> M.insert (OrderByStart $ srcInfoSpan ssi) ssi) M.empty src
spansByEnd = Data.Foldable.foldr (\ssi -> M.insert (OrderByEnd $ srcInfoSpan ssi) ssi) M.empty src