{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.GHC.ExactPrint.Delta
( relativiseApiAnns
, relativiseApiAnnsWithComments
, relativiseApiAnnsWithOptions
, DeltaOptions(drRigidity)
, deltaOptions
, normalLayout
) where
import Control.Monad.RWS
import Control.Monad.Trans.Free
import Data.Data (Data)
import Data.List (sort, nub, partition, sortBy, sortOn)
import Data.Ord
import Language.Haskell.GHC.ExactPrint.Utils
#if __GLASGOW_HASKELL__ <= 710
import Language.Haskell.GHC.ExactPrint.Lookup
#endif
import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Annotate
import qualified GHC
#if __GLASGOW_HASKELL__ >= 900
#endif
import qualified Data.Map as Map
import qualified Data.Set as Set
{-# ANN module "HLint: ignore Eta reduce" #-}
{-# ANN module "HLint: ignore Redundant do" #-}
{-# ANN module "HLint: ignore Reduce duplication" #-}
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
relativiseApiAnns :: (Data (GHC.SrcSpanLess ast), Annotate ast, GHC.HasSrcSpan ast)
=> ast
#else
relativiseApiAnns :: Annotate ast
=> GHC.Located ast
#endif
-> GHC.ApiAnns
-> Anns
relativiseApiAnns :: ast -> ApiAnns -> Anns
relativiseApiAnns = [Comment] -> ast -> ApiAnns -> Anns
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[Comment] -> ast -> ApiAnns -> Anns
relativiseApiAnnsWithComments []
relativiseApiAnnsWithComments ::
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
(Data (GHC.SrcSpanLess ast), Annotate ast, GHC.HasSrcSpan ast)
=> [Comment]
-> ast
#else
Annotate ast
=> [Comment]
-> GHC.Located ast
#endif
-> GHC.ApiAnns
-> Anns
=
DeltaOptions -> [Comment] -> ast -> ApiAnns -> Anns
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
DeltaOptions -> [Comment] -> ast -> ApiAnns -> Anns
relativiseApiAnnsWithOptions DeltaOptions
normalLayout
relativiseApiAnnsWithOptions ::
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
(Data (GHC.SrcSpanLess ast), Annotate ast, GHC.HasSrcSpan ast)
=> DeltaOptions
-> [Comment]
-> ast
#else
Annotate ast
=> DeltaOptions
-> [Comment]
-> GHC.Located ast
#endif
-> GHC.ApiAnns
-> Anns
relativiseApiAnnsWithOptions :: DeltaOptions -> [Comment] -> ast -> ApiAnns -> Anns
relativiseApiAnnsWithOptions DeltaOptions
opts [Comment]
cs ast
modu ApiAnns
ghcAnns
= DeltaOptions -> [Comment] -> Annotated () -> ApiAnns -> Pos -> Anns
runDeltaWithComments
DeltaOptions
opts [Comment]
cs (ast -> Annotated ()
forall ast.
(Annotate ast, Data (SrcSpanLess ast), HasSrcSpan ast) =>
ast -> Annotated ()
annotate ast
modu) ApiAnns
ghcAnns
(SrcSpan -> Pos
ss2pos (SrcSpan -> Pos) -> SrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ ast -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc ast
modu)
type Delta a = RWS DeltaOptions DeltaWriter DeltaState a
runDeltaWithComments :: DeltaOptions -> [Comment] -> Annotated () -> GHC.ApiAnns -> Pos -> Anns
DeltaOptions
opts [Comment]
cs Annotated ()
action ApiAnns
ga Pos
priorEnd =
DeltaWriter -> Anns
mkAnns (DeltaWriter -> Anns)
-> (Annotated () -> DeltaWriter) -> Annotated () -> Anns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeltaState, DeltaWriter) -> DeltaWriter
forall a b. (a, b) -> b
snd
((DeltaState, DeltaWriter) -> DeltaWriter)
-> (Annotated () -> (DeltaState, DeltaWriter))
-> Annotated ()
-> DeltaWriter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\RWS DeltaOptions DeltaWriter DeltaState ()
next -> RWS DeltaOptions DeltaWriter DeltaState ()
-> DeltaOptions -> DeltaState -> (DeltaState, DeltaWriter)
forall r w s a. RWS r w s a -> r -> s -> (s, w)
execRWS RWS DeltaOptions DeltaWriter DeltaState ()
next DeltaOptions
opts ([Comment] -> Pos -> ApiAnns -> DeltaState
defaultDeltaState [Comment]
cs Pos
priorEnd ApiAnns
ga))
(RWS DeltaOptions DeltaWriter DeltaState ()
-> (DeltaState, DeltaWriter))
-> (Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ())
-> Annotated ()
-> (DeltaState, DeltaWriter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall a. Annotated a -> Delta a
deltaInterpret (Annotated () -> Anns) -> Annotated () -> Anns
forall a b. (a -> b) -> a -> b
$ Annotated ()
action
where
mkAnns :: DeltaWriter -> Anns
mkAnns :: DeltaWriter -> Anns
mkAnns = Endo Anns -> Anns
forall a. Monoid a => Endo a -> a
f (Endo Anns -> Anns)
-> (DeltaWriter -> Endo Anns) -> DeltaWriter -> Anns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltaWriter -> Endo Anns
dwAnns
f :: Monoid a => Endo a -> a
f :: Endo a -> a
f = ((a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
forall a. Monoid a => a
mempty) ((a -> a) -> a) -> (Endo a -> a -> a) -> Endo a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo a -> a -> a
forall a. Endo a -> a -> a
appEndo
data DeltaOptions = DeltaOptions
{
DeltaOptions -> SrcSpan
curSrcSpan :: !GHC.SrcSpan
, DeltaOptions -> AnnConName
annConName :: !AnnConName
, DeltaOptions -> Rigidity
drRigidity :: !Rigidity
, DeltaOptions -> AstContextSet
drContext :: !AstContextSet
}
data DeltaWriter = DeltaWriter
{
DeltaWriter -> Endo Anns
dwAnns :: Endo (Map.Map AnnKey Annotation)
, DeltaWriter -> [(KeywordId, DeltaPos)]
annKds :: ![(KeywordId, DeltaPos)]
, DeltaWriter -> Maybe [SrcSpan]
sortKeys :: !(Maybe [AnnSpan])
, DeltaWriter -> First AnnKey
dwCapturedSpan :: !(First AnnKey)
}
data DeltaState = DeltaState
{
DeltaState -> Pos
priorEndPosition :: !Pos
, :: ![Comment]
, DeltaState -> ApiAnns
apAnns :: !GHC.ApiAnns
, DeltaState -> Bool
apMarkLayout :: Bool
, DeltaState -> LayoutStartCol
apLayoutStart :: LayoutStartCol
}
deltaOptions :: Rigidity -> DeltaOptions
deltaOptions :: Rigidity -> DeltaOptions
deltaOptions Rigidity
ridigity =
DeltaOptions :: SrcSpan -> AnnConName -> Rigidity -> AstContextSet -> DeltaOptions
DeltaOptions
{ curSrcSpan :: SrcSpan
curSrcSpan = SrcSpan
GHC.noSrcSpan
, annConName :: AnnConName
annConName = () -> AnnConName
forall a. Data a => a -> AnnConName
annGetConstr ()
, drRigidity :: Rigidity
drRigidity = Rigidity
ridigity
, drContext :: AstContextSet
drContext = AstContextSet
defaultACS
}
normalLayout :: DeltaOptions
normalLayout :: DeltaOptions
normalLayout = Rigidity -> DeltaOptions
deltaOptions Rigidity
NormalLayout
defaultDeltaState :: [Comment] -> Pos -> GHC.ApiAnns -> DeltaState
defaultDeltaState :: [Comment] -> Pos -> ApiAnns -> DeltaState
defaultDeltaState [Comment]
injectedComments Pos
priorEnd ApiAnns
ga =
DeltaState :: Pos -> [Comment] -> ApiAnns -> Bool -> LayoutStartCol -> DeltaState
DeltaState
{ priorEndPosition :: Pos
priorEndPosition = Pos
priorEnd
, apComments :: [Comment]
apComments = [Comment]
cs [Comment] -> [Comment] -> [Comment]
forall a. [a] -> [a] -> [a]
++ [Comment]
injectedComments
, apAnns :: ApiAnns
apAnns = ApiAnns
ga
, apLayoutStart :: LayoutStartCol
apLayoutStart = LayoutStartCol
1
, apMarkLayout :: Bool
apMarkLayout = Bool
False
}
where
cs :: [Comment]
cs :: [Comment]
cs = ApiAnns -> [Comment]
extractComments ApiAnns
ga
tellFinalAnn :: (AnnKey, Annotation) -> Delta ()
tellFinalAnn :: (AnnKey, Annotation) -> RWS DeltaOptions DeltaWriter DeltaState ()
tellFinalAnn (AnnKey
k, Annotation
v) =
DeltaWriter -> RWS DeltaOptions DeltaWriter DeltaState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (DeltaWriter
forall a. Monoid a => a
mempty { dwAnns :: Endo Anns
dwAnns = (Anns -> Anns) -> Endo Anns
forall a. (a -> a) -> Endo a
Endo (AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
k Annotation
v) })
tellSortKey :: [AnnSpan] -> Delta ()
tellSortKey :: [SrcSpan] -> RWS DeltaOptions DeltaWriter DeltaState ()
tellSortKey [SrcSpan]
xs = DeltaWriter -> RWS DeltaOptions DeltaWriter DeltaState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (DeltaWriter
forall a. Monoid a => a
mempty { sortKeys :: Maybe [SrcSpan]
sortKeys = [SrcSpan] -> Maybe [SrcSpan]
forall a. a -> Maybe a
Just [SrcSpan]
xs } )
tellCapturedSpan :: AnnKey -> Delta ()
tellCapturedSpan :: AnnKey -> RWS DeltaOptions DeltaWriter DeltaState ()
tellCapturedSpan AnnKey
key = DeltaWriter -> RWS DeltaOptions DeltaWriter DeltaState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ( DeltaWriter
forall a. Monoid a => a
mempty { dwCapturedSpan :: First AnnKey
dwCapturedSpan = Maybe AnnKey -> First AnnKey
forall a. Maybe a -> First a
First (Maybe AnnKey -> First AnnKey) -> Maybe AnnKey -> First AnnKey
forall a b. (a -> b) -> a -> b
$ AnnKey -> Maybe AnnKey
forall a. a -> Maybe a
Just AnnKey
key })
tellKd :: (KeywordId, DeltaPos) -> Delta ()
tellKd :: (KeywordId, DeltaPos) -> RWS DeltaOptions DeltaWriter DeltaState ()
tellKd (KeywordId, DeltaPos)
kd = DeltaWriter -> RWS DeltaOptions DeltaWriter DeltaState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (DeltaWriter
forall a. Monoid a => a
mempty { annKds :: [(KeywordId, DeltaPos)]
annKds = [(KeywordId, DeltaPos)
kd] })
#if __GLASGOW_HASKELL__ >= 804
instance Semigroup DeltaWriter where
<> :: DeltaWriter -> DeltaWriter -> DeltaWriter
(<>) = DeltaWriter -> DeltaWriter -> DeltaWriter
forall a. Monoid a => a -> a -> a
mappend
#endif
instance Monoid DeltaWriter where
mempty :: DeltaWriter
mempty = Endo Anns
-> [(KeywordId, DeltaPos)]
-> Maybe [SrcSpan]
-> First AnnKey
-> DeltaWriter
DeltaWriter Endo Anns
forall a. Monoid a => a
mempty [(KeywordId, DeltaPos)]
forall a. Monoid a => a
mempty Maybe [SrcSpan]
forall a. Monoid a => a
mempty First AnnKey
forall a. Monoid a => a
mempty
(DeltaWriter Endo Anns
a [(KeywordId, DeltaPos)]
b Maybe [SrcSpan]
e First AnnKey
g) mappend :: DeltaWriter -> DeltaWriter -> DeltaWriter
`mappend` (DeltaWriter Endo Anns
c [(KeywordId, DeltaPos)]
d Maybe [SrcSpan]
f First AnnKey
h)
= Endo Anns
-> [(KeywordId, DeltaPos)]
-> Maybe [SrcSpan]
-> First AnnKey
-> DeltaWriter
DeltaWriter (Endo Anns
a Endo Anns -> Endo Anns -> Endo Anns
forall a. Semigroup a => a -> a -> a
<> Endo Anns
c) ([(KeywordId, DeltaPos)]
b [(KeywordId, DeltaPos)]
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. Semigroup a => a -> a -> a
<> [(KeywordId, DeltaPos)]
d) (Maybe [SrcSpan]
e Maybe [SrcSpan] -> Maybe [SrcSpan] -> Maybe [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> Maybe [SrcSpan]
f) (First AnnKey
g First AnnKey -> First AnnKey -> First AnnKey
forall a. Semigroup a => a -> a -> a
<> First AnnKey
h)
deltaInterpret :: Annotated a -> Delta a
deltaInterpret :: Annotated a -> Delta a
deltaInterpret = (AnnotationF (Delta a) -> Delta a) -> Annotated a -> Delta a
forall (f :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Functor f, Monad m, MonadTrans t, Monad (t m)) =>
(f (t m a) -> t m a) -> FreeT f m a -> t m a
iterTM AnnotationF (Delta a) -> Delta a
forall a. AnnotationF (Delta a) -> Delta a
go
where
go :: AnnotationF (Delta a) -> Delta a
go :: AnnotationF (Delta a) -> Delta a
go (MarkEOF Delta a
next) = RWS DeltaOptions DeltaWriter DeltaState ()
addEofAnnotation RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (MarkPrim AnnKeywordId
kwid Maybe String
_ Delta a
next) = AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotation AnnKeywordId
kwid RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (MarkPPOptional AnnKeywordId
kwid Maybe String
_ Delta a
next) = AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotation AnnKeywordId
kwid RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
#if __GLASGOW_HASKELL__ >= 800
go (MarkInstead AnnKeywordId
akwid KeywordId
kwid Delta a
next) = AnnKeywordId
-> KeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationInstead AnnKeywordId
akwid KeywordId
kwid RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
#endif
go (MarkOutside AnnKeywordId
akwid KeywordId
kwid Delta a
next) = AnnKeywordId
-> KeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationsOutside AnnKeywordId
akwid KeywordId
kwid RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (MarkInside AnnKeywordId
akwid Delta a
next) = AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationsInside AnnKeywordId
akwid RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (MarkMany AnnKeywordId
akwid Delta a
next) = AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotations AnnKeywordId
akwid RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (MarkManyOptional AnnKeywordId
akwid Delta a
next) = AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotations AnnKeywordId
akwid RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (MarkOffsetPrim AnnKeywordId
akwid Int
n Maybe String
_ Delta a
next) = AnnKeywordId -> Int -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationLs AnnKeywordId
akwid Int
n RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (MarkOffsetPrimOptional AnnKeywordId
akwid Int
n Maybe String
_ Delta a
next) = AnnKeywordId -> Int -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationLs AnnKeywordId
akwid Int
n RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (WithAST a
lss Annotated b
prog Delta a
next) = a -> Delta b -> Delta b
forall a b.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Delta b -> Delta b
withAST a
lss (Annotated b -> Delta b
forall a. Annotated a -> Delta a
deltaInterpret Annotated b
prog) Delta b -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (CountAnns AnnKeywordId
kwid Int -> Delta a
next) = AnnKeywordId -> Delta Int
countAnnsDelta AnnKeywordId
kwid Delta Int -> (Int -> Delta a) -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Delta a
next
go (SetLayoutFlag Rigidity
r Annotated ()
action Delta a
next) = do
Rigidity
rigidity <- (DeltaOptions -> Rigidity)
-> RWST DeltaOptions DeltaWriter DeltaState Identity Rigidity
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DeltaOptions -> Rigidity
drRigidity
(if Rigidity
r Rigidity -> Rigidity -> Bool
forall a. Ord a => a -> a -> Bool
<= Rigidity
rigidity then RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
setLayoutFlag else RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall a. a -> a
id) (Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall a. Annotated a -> Delta a
deltaInterpret Annotated ()
action)
Delta a
next
go (MarkAnnBeforeAnn AnnKeywordId
ann1 AnnKeywordId
ann2 Delta a
next) = AnnKeywordId
-> AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
deltaMarkAnnBeforeAnn AnnKeywordId
ann1 AnnKeywordId
ann2 RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (MarkExternal SrcSpan
ss AnnKeywordId
akwid String
_ Delta a
next) = SrcSpan
-> AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationExt (SrcSpan -> SrcSpan
rs SrcSpan
ss) AnnKeywordId
akwid RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (StoreOriginalSrcSpan SrcSpan
_ AnnKey
key AnnKey -> Delta a
next) = AnnKey -> Delta AnnKey
storeOriginalSrcSpanDelta AnnKey
key Delta AnnKey -> (AnnKey -> Delta a) -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnnKey -> Delta a
next
go (GetSrcSpanForKw SrcSpan
ss AnnKeywordId
kw SrcSpan -> Delta a
next) = SrcSpan -> AnnKeywordId -> Delta SrcSpan
getSrcSpanForKw SrcSpan
ss AnnKeywordId
kw Delta SrcSpan -> (SrcSpan -> Delta a) -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SrcSpan -> Delta a
next
#if __GLASGOW_HASKELL__ <= 710
go (StoreString s ss next) = storeString s ss >> next
#endif
go (AnnotationsToComments [AnnKeywordId]
kws Delta a
next) = [AnnKeywordId] -> RWS DeltaOptions DeltaWriter DeltaState ()
annotationsToCommentsDelta [AnnKeywordId]
kws RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
#if __GLASGOW_HASKELL__ <= 710
go (AnnotationsToCommentsBF _ kws next) = annotationsToCommentsDelta kws >> next
go (FinalizeBF _ next) = next
#endif
go (WithSortKey [(SrcSpan, Annotated ())]
kws Delta a
next) = [(SrcSpan, Annotated ())]
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall b.
[(SrcSpan, Annotated b)]
-> RWS DeltaOptions DeltaWriter DeltaState ()
withSortKey [(SrcSpan, Annotated ())]
kws RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (WithSortKeyContexts ListContexts
ctx [(SrcSpan, Annotated ())]
kws Delta a
next) = ListContexts
-> [(SrcSpan, Annotated ())]
-> RWS DeltaOptions DeltaWriter DeltaState ()
withSortKeyContexts ListContexts
ctx [(SrcSpan, Annotated ())]
kws RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (SetContextLevel Set AstContext
ctxt Int
lvl Annotated ()
action Delta a
next) = Set AstContext
-> Int
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
setContextDelta Set AstContext
ctxt Int
lvl (Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall a. Annotated a -> Delta a
deltaInterpret Annotated ()
action) RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (UnsetContext AstContext
_ctxt Annotated ()
action Delta a
next) = Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall a. Annotated a -> Delta a
deltaInterpret Annotated ()
action RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (IfInContext Set AstContext
ctxt Annotated ()
ifAction Annotated ()
elseAction Delta a
next) = Set AstContext
-> Annotated ()
-> Annotated ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
ifInContextDelta Set AstContext
ctxt Annotated ()
ifAction Annotated ()
elseAction RWS DeltaOptions DeltaWriter DeltaState () -> Delta a -> Delta a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Delta a
next
go (TellContext Set AstContext
_ Delta a
next) = Delta a
next
withSortKey :: [(AnnSpan, Annotated b)] -> Delta ()
withSortKey :: [(SrcSpan, Annotated b)]
-> RWS DeltaOptions DeltaWriter DeltaState ()
withSortKey [(SrcSpan, Annotated b)]
kws =
let order :: [(SrcSpan, Annotated b)]
order = ((SrcSpan, Annotated b) -> (SrcSpan, Annotated b) -> Ordering)
-> [(SrcSpan, Annotated b)] -> [(SrcSpan, Annotated b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((SrcSpan, Annotated b) -> SrcSpan)
-> (SrcSpan, Annotated b) -> (SrcSpan, Annotated b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (SrcSpan, Annotated b) -> SrcSpan
forall a b. (a, b) -> a
fst) [(SrcSpan, Annotated b)]
kws
in do
[SrcSpan] -> RWS DeltaOptions DeltaWriter DeltaState ()
tellSortKey (((SrcSpan, Annotated b) -> SrcSpan)
-> [(SrcSpan, Annotated b)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan, Annotated b) -> SrcSpan
forall a b. (a, b) -> a
fst [(SrcSpan, Annotated b)]
order)
((SrcSpan, Annotated b)
-> RWST DeltaOptions DeltaWriter DeltaState Identity b)
-> [(SrcSpan, Annotated b)]
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Annotated b -> RWST DeltaOptions DeltaWriter DeltaState Identity b
forall a. Annotated a -> Delta a
deltaInterpret (Annotated b
-> RWST DeltaOptions DeltaWriter DeltaState Identity b)
-> ((SrcSpan, Annotated b) -> Annotated b)
-> (SrcSpan, Annotated b)
-> RWST DeltaOptions DeltaWriter DeltaState Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan, Annotated b) -> Annotated b
forall a b. (a, b) -> b
snd) [(SrcSpan, Annotated b)]
order
withSortKeyContexts :: ListContexts -> [(AnnSpan, Annotated ())] -> Delta ()
withSortKeyContexts :: ListContexts
-> [(SrcSpan, Annotated ())]
-> RWS DeltaOptions DeltaWriter DeltaState ()
withSortKeyContexts ListContexts
ctxts [(SrcSpan, Annotated ())]
kws = do
[SrcSpan] -> RWS DeltaOptions DeltaWriter DeltaState ()
tellSortKey (((SrcSpan, Annotated ()) -> SrcSpan)
-> [(SrcSpan, Annotated ())] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan, Annotated ()) -> SrcSpan
forall a b. (a, b) -> a
fst [(SrcSpan, Annotated ())]
order)
(Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ())
-> ListContexts
-> [(SrcSpan, Annotated ())]
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *).
Monad m =>
(Annotated () -> m ())
-> ListContexts -> [(SrcSpan, Annotated ())] -> m ()
withSortKeyContextsHelper Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall a. Annotated a -> Delta a
deltaInterpret ListContexts
ctxts [(SrcSpan, Annotated ())]
order
where
order :: [(SrcSpan, Annotated ())]
order = ((SrcSpan, Annotated ()) -> (SrcSpan, Annotated ()) -> Ordering)
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((SrcSpan, Annotated ()) -> SrcSpan)
-> (SrcSpan, Annotated ()) -> (SrcSpan, Annotated ()) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (SrcSpan, Annotated ()) -> SrcSpan
forall a b. (a, b) -> a
fst) [(SrcSpan, Annotated ())]
kws
setLayoutFlag :: Delta () -> Delta ()
setLayoutFlag :: RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
setLayoutFlag RWS DeltaOptions DeltaWriter DeltaState ()
action = do
LayoutStartCol
oldLay <- (DeltaState -> LayoutStartCol)
-> RWST DeltaOptions DeltaWriter DeltaState Identity LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> LayoutStartCol
apLayoutStart
(DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { apMarkLayout :: Bool
apMarkLayout = Bool
True } )
let reset :: RWS DeltaOptions DeltaWriter DeltaState ()
reset = do
(DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { apMarkLayout :: Bool
apMarkLayout = Bool
False
, apLayoutStart :: LayoutStartCol
apLayoutStart = LayoutStartCol
oldLay })
RWS DeltaOptions DeltaWriter DeltaState ()
action RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RWS DeltaOptions DeltaWriter DeltaState ()
reset
setContextDelta :: Set.Set AstContext -> Int -> Delta () -> Delta ()
setContextDelta :: Set AstContext
-> Int
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
setContextDelta Set AstContext
ctxt Int
lvl =
(DeltaOptions -> DeltaOptions)
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\DeltaOptions
s -> DeltaOptions
s { drContext :: AstContextSet
drContext = Set AstContext -> Int -> AstContextSet -> AstContextSet
forall a. Ord a => Set a -> Int -> ACS' a -> ACS' a
setAcsWithLevel Set AstContext
ctxt Int
lvl (DeltaOptions -> AstContextSet
drContext DeltaOptions
s) } )
ifInContextDelta :: Set.Set AstContext -> Annotated () -> Annotated () -> Delta ()
ifInContextDelta :: Set AstContext
-> Annotated ()
-> Annotated ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
ifInContextDelta Set AstContext
ctxt Annotated ()
ifAction Annotated ()
elseAction = do
AstContextSet
cur <- (DeltaOptions -> AstContextSet)
-> RWST DeltaOptions DeltaWriter DeltaState Identity AstContextSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DeltaOptions -> AstContextSet
drContext
let inContext :: Bool
inContext = Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs Set AstContext
ctxt AstContextSet
cur
if Bool
inContext
then Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall a. Annotated a -> Delta a
deltaInterpret Annotated ()
ifAction
else Annotated () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall a. Annotated a -> Delta a
deltaInterpret Annotated ()
elseAction
storeOriginalSrcSpanDelta :: AnnKey -> Delta AnnKey
storeOriginalSrcSpanDelta :: AnnKey -> Delta AnnKey
storeOriginalSrcSpanDelta AnnKey
key = do
AnnKey -> RWS DeltaOptions DeltaWriter DeltaState ()
tellCapturedSpan AnnKey
key
AnnKey -> Delta AnnKey
forall (m :: * -> *) a. Monad m => a -> m a
return AnnKey
key
#if __GLASGOW_HASKELL__ <= 710
storeString :: String -> GHC.SrcSpan -> Delta ()
storeString s ss = addAnnotationWorker (AnnString s) ss
#endif
annotationsToCommentsDelta :: [GHC.AnnKeywordId] -> Delta ()
[AnnKeywordId]
kws = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
[Comment]
cs <- (DeltaState -> [Comment])
-> RWST DeltaOptions DeltaWriter DeltaState Identity [Comment]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> [Comment]
apComments
let
doOne :: GHC.AnnKeywordId -> Delta [Comment]
doOne :: AnnKeywordId
-> RWST DeltaOptions DeltaWriter DeltaState Identity [Comment]
doOne AnnKeywordId
kw = do
([SrcSpan]
spans,AnnKeywordId
_) <- SrcSpan -> AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAndRemoveAnnotationDelta SrcSpan
ss AnnKeywordId
kw
[Comment]
-> RWST DeltaOptions DeltaWriter DeltaState Identity [Comment]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Comment]
-> RWST DeltaOptions DeltaWriter DeltaState Identity [Comment])
-> [Comment]
-> RWST DeltaOptions DeltaWriter DeltaState Identity [Comment]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> Comment) -> [SrcSpan] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map (AnnKeywordId -> SrcSpan -> Comment
mkKWComment AnnKeywordId
kw (SrcSpan -> Comment) -> (SrcSpan -> SrcSpan) -> SrcSpan -> Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcSpan
sr) [SrcSpan]
spans
[[Comment]]
newComments <- (AnnKeywordId
-> RWST DeltaOptions DeltaWriter DeltaState Identity [Comment])
-> [AnnKeywordId]
-> RWST DeltaOptions DeltaWriter DeltaState Identity [[Comment]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnnKeywordId
-> RWST DeltaOptions DeltaWriter DeltaState Identity [Comment]
doOne [AnnKeywordId]
kws
[Comment] -> RWS DeltaOptions DeltaWriter DeltaState ()
putUnallocatedComments ([Comment]
cs [Comment] -> [Comment] -> [Comment]
forall a. [a] -> [a] -> [a]
++ [[Comment]] -> [Comment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Comment]]
newComments)
getSrcSpanForKw :: GHC.SrcSpan -> GHC.AnnKeywordId -> Delta GHC.SrcSpan
getSrcSpanForKw :: SrcSpan -> AnnKeywordId -> Delta SrcSpan
getSrcSpanForKw SrcSpan
_ AnnKeywordId
kw = do
ApiAnns
ga <- (DeltaState -> ApiAnns)
-> RWST DeltaOptions DeltaWriter DeltaState Identity ApiAnns
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> ApiAnns
apAnns
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
case ApiAnns -> SrcSpan -> AnnKeywordId -> [SrcSpan]
GHC.getAnnotation ApiAnns
ga (SrcSpan -> SrcSpan
rs SrcSpan
ss) AnnKeywordId
kw of
[] -> SrcSpan -> Delta SrcSpan
forall (m :: * -> *) a. Monad m => a -> m a
return SrcSpan
GHC.noSrcSpan
#if __GLASGOW_HASKELL__ >= 900
(sp:_) -> return (GHC.RealSrcSpan sp Nothing)
#else
(SrcSpan
sp:[SrcSpan]
_) -> SrcSpan -> Delta SrcSpan
forall (m :: * -> *) a. Monad m => a -> m a
return SrcSpan
sp
#endif
getSrcSpan :: Delta GHC.SrcSpan
getSrcSpan :: Delta SrcSpan
getSrcSpan = (DeltaOptions -> SrcSpan) -> Delta SrcSpan
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DeltaOptions -> SrcSpan
curSrcSpan
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
withSrcSpanDelta :: (Data (GHC.SrcSpanLess a), GHC.HasSrcSpan a) => a -> Delta b -> Delta b
withSrcSpanDelta :: a -> Delta b -> Delta b
withSrcSpanDelta (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
GHC.dL->GHC.L SrcSpan
l SrcSpanLess a
a) =
#else
withSrcSpanDelta :: Data a => GHC.Located a -> Delta b -> Delta b
withSrcSpanDelta (GHC.L l a) =
#endif
(DeltaOptions -> DeltaOptions) -> Delta b -> Delta b
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\DeltaOptions
s -> DeltaOptions
s { curSrcSpan :: SrcSpan
curSrcSpan = SrcSpan
l
, annConName :: AnnConName
annConName = SrcSpanLess a -> AnnConName
forall a. Data a => a -> AnnConName
annGetConstr SrcSpanLess a
a
, drContext :: AstContextSet
drContext = AstContextSet -> AstContextSet
forall a. ACS' a -> ACS' a
pushAcs (DeltaOptions -> AstContextSet
drContext DeltaOptions
s)
AstContextSet -> String -> AstContextSet
forall c. c -> String -> c
`debug` (String
"withSrcSpanDelta: (l,annConName,drContext)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SrcSpan, AnnConName, AstContextSet) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
l,SrcSpanLess a -> AnnConName
forall a. Data a => a -> AnnConName
annGetConstr SrcSpanLess a
a, AstContextSet -> AstContextSet
forall a. ACS' a -> ACS' a
pushAcs (DeltaOptions -> AstContextSet
drContext DeltaOptions
s)))
})
getUnallocatedComments :: Delta [Comment]
= (DeltaState -> [Comment])
-> RWST DeltaOptions DeltaWriter DeltaState Identity [Comment]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> [Comment]
apComments
putUnallocatedComments :: [Comment] -> Delta ()
[Comment]
cs = (DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { apComments :: [Comment]
apComments = [Comment]
cs } )
adjustDeltaForOffsetM :: DeltaPos -> Delta DeltaPos
adjustDeltaForOffsetM :: DeltaPos -> Delta DeltaPos
adjustDeltaForOffsetM DeltaPos
dp = do
LayoutStartCol
colOffset <- (DeltaState -> LayoutStartCol)
-> RWST DeltaOptions DeltaWriter DeltaState Identity LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> LayoutStartCol
apLayoutStart
DeltaPos -> Delta DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset LayoutStartCol
colOffset DeltaPos
dp)
adjustDeltaForOffset :: LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset :: LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset LayoutStartCol
_colOffset dp :: DeltaPos
dp@(DP (Int
0,Int
_)) = DeltaPos
dp
adjustDeltaForOffset (LayoutStartCol Int
colOffset) (DP (Int
l,Int
c)) = Pos -> DeltaPos
DP (Int
l,Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colOffset)
getPriorEnd :: Delta Pos
getPriorEnd :: Delta Pos
getPriorEnd = (DeltaState -> Pos) -> Delta Pos
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> Pos
priorEndPosition
setPriorEnd :: Pos -> Delta ()
setPriorEnd :: Pos -> RWS DeltaOptions DeltaWriter DeltaState ()
setPriorEnd Pos
pe =
(DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { priorEndPosition :: Pos
priorEndPosition = Pos
pe })
setPriorEndAST :: AnnSpan -> Delta ()
setPriorEndAST :: SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
setPriorEndAST SrcSpan
pe = do
Int -> RWS DeltaOptions DeltaWriter DeltaState ()
setLayoutStart (Pos -> Int
forall a b. (a, b) -> b
snd (SrcSpan -> Pos
ss2pos (SrcSpan -> SrcSpan
sr SrcSpan
pe)))
(DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { priorEndPosition :: Pos
priorEndPosition = SrcSpan -> Pos
ss2posEnd (SrcSpan -> SrcSpan
sr SrcSpan
pe) } )
setLayoutStart :: Int -> Delta ()
setLayoutStart :: Int -> RWS DeltaOptions DeltaWriter DeltaState ()
setLayoutStart Int
p = do
DeltaState{Bool
apMarkLayout :: Bool
apMarkLayout :: DeltaState -> Bool
apMarkLayout} <- RWST DeltaOptions DeltaWriter DeltaState Identity DeltaState
forall s (m :: * -> *). MonadState s m => m s
get
Bool
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
apMarkLayout (
(DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { apMarkLayout :: Bool
apMarkLayout = Bool
False
, apLayoutStart :: LayoutStartCol
apLayoutStart = Int -> LayoutStartCol
LayoutStartCol Int
p}))
peekAnnotationDelta :: GHC.AnnKeywordId -> Delta [AnnSpan]
peekAnnotationDelta :: AnnKeywordId -> Delta [SrcSpan]
peekAnnotationDelta AnnKeywordId
an = do
ApiAnns
ga <- (DeltaState -> ApiAnns)
-> RWST DeltaOptions DeltaWriter DeltaState Identity ApiAnns
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> ApiAnns
apAnns
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
#if __GLASGOW_HASKELL__ <= 710
return $ GHC.getAnnotation ga ss an
#else
let unicodeAnns :: [SrcSpan]
unicodeAnns = case AnnKeywordId -> [AnnKeywordId]
unicodeEquivalent AnnKeywordId
an of
[] -> []
[AnnKeywordId
kw] -> ApiAnns -> SrcSpan -> AnnKeywordId -> [SrcSpan]
GHC.getAnnotation ApiAnns
ga (SrcSpan -> SrcSpan
rs SrcSpan
ss) AnnKeywordId
kw
(AnnKeywordId
kw:[AnnKeywordId]
_) -> ApiAnns -> SrcSpan -> AnnKeywordId -> [SrcSpan]
GHC.getAnnotation ApiAnns
ga (SrcSpan -> SrcSpan
rs SrcSpan
ss) AnnKeywordId
kw
[SrcSpan] -> Delta [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SrcSpan] -> Delta [SrcSpan]) -> [SrcSpan] -> Delta [SrcSpan]
forall a b. (a -> b) -> a -> b
$ [SrcSpan]
unicodeAnns [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ ApiAnns -> SrcSpan -> AnnKeywordId -> [SrcSpan]
GHC.getAnnotation ApiAnns
ga (SrcSpan -> SrcSpan
rs SrcSpan
ss) AnnKeywordId
an
#endif
getAnnotationDelta :: GHC.AnnKeywordId -> Delta ([AnnSpan],GHC.AnnKeywordId)
getAnnotationDelta :: AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAnnotationDelta AnnKeywordId
an = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
SrcSpan -> AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAndRemoveAnnotationDelta SrcSpan
ss AnnKeywordId
an
getAndRemoveAnnotationDelta :: GHC.SrcSpan -> GHC.AnnKeywordId -> Delta ([AnnSpan],GHC.AnnKeywordId)
getAndRemoveAnnotationDelta :: SrcSpan -> AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAndRemoveAnnotationDelta SrcSpan
sp AnnKeywordId
an = do
ApiAnns
ga <- (DeltaState -> ApiAnns)
-> RWST DeltaOptions DeltaWriter DeltaState Identity ApiAnns
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> ApiAnns
apAnns
#if __GLASGOW_HASKELL__ <= 710
let (r,ga') = GHC.getAndRemoveAnnotation ga sp an
kw = an
#else
let ([SrcSpan]
r,ApiAnns
ga',AnnKeywordId
kw) = case ApiAnns -> SrcSpan -> AnnKeywordId -> ([SrcSpan], ApiAnns)
GHC.getAndRemoveAnnotation ApiAnns
ga (SrcSpan -> SrcSpan
rs SrcSpan
sp) AnnKeywordId
an of
([],ApiAnns
_) -> ([SrcSpan]
ss,ApiAnns
g,AnnKeywordId
k)
where
k :: AnnKeywordId
k = AnnKeywordId -> AnnKeywordId
GHC.unicodeAnn AnnKeywordId
an
([SrcSpan]
ss,ApiAnns
g) = ApiAnns -> SrcSpan -> AnnKeywordId -> ([SrcSpan], ApiAnns)
GHC.getAndRemoveAnnotation ApiAnns
ga (SrcSpan -> SrcSpan
rs SrcSpan
sp) AnnKeywordId
k
([SrcSpan]
ss,ApiAnns
g) -> ([SrcSpan]
ss,ApiAnns
g,AnnKeywordId
an)
#endif
(DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { apAnns :: ApiAnns
apAnns = ApiAnns
ga' })
([SrcSpan], AnnKeywordId) -> Delta ([SrcSpan], AnnKeywordId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([SrcSpan]
r,AnnKeywordId
kw)
getOneAnnotationDelta :: GHC.AnnKeywordId -> Delta ([AnnSpan],GHC.AnnKeywordId)
getOneAnnotationDelta :: AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getOneAnnotationDelta AnnKeywordId
an = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
SrcSpan -> AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAndRemoveOneAnnotationDelta SrcSpan
ss AnnKeywordId
an
getAndRemoveOneAnnotationDelta :: GHC.SrcSpan -> GHC.AnnKeywordId -> Delta ([AnnSpan],GHC.AnnKeywordId)
getAndRemoveOneAnnotationDelta :: SrcSpan -> AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAndRemoveOneAnnotationDelta SrcSpan
sp AnnKeywordId
an = do
#if __GLASGOW_HASKELL__ >= 900
ann <- gets apAnns
let anns = GHC.apiAnnItems ann
let cs = GHC.apiAnnComments ann
#else
(Map ApiAnnKey [SrcSpan]
anns,Map SrcSpan [Located AnnotationComment]
cs) <- (DeltaState -> ApiAnns)
-> RWST DeltaOptions DeltaWriter DeltaState Identity ApiAnns
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> ApiAnns
apAnns
#endif
#if __GLASGOW_HASKELL__ <= 710
let (r,ga',kw) = case Map.lookup (sp,an) anns of
Nothing -> ([],(anns,cs),an)
Just [] -> ([], (Map.delete (sp,an) anns,cs),an)
Just (s:ss) -> ([s],(Map.insert (sp,an) ss anns,cs),an)
#else
let getKw :: AnnKeywordId -> ([SrcSpan], ApiAnns, AnnKeywordId)
getKw AnnKeywordId
kw =
case ApiAnnKey -> Map ApiAnnKey [SrcSpan] -> Maybe [SrcSpan]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (SrcSpan -> SrcSpan
rs SrcSpan
sp,AnnKeywordId
kw) Map ApiAnnKey [SrcSpan]
anns of
Maybe [SrcSpan]
Nothing -> ([],(Map ApiAnnKey [SrcSpan]
anns,Map SrcSpan [Located AnnotationComment]
cs),AnnKeywordId
kw)
Just [] -> ([], (ApiAnnKey -> Map ApiAnnKey [SrcSpan] -> Map ApiAnnKey [SrcSpan]
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (SrcSpan -> SrcSpan
rs SrcSpan
sp,AnnKeywordId
kw) Map ApiAnnKey [SrcSpan]
anns,Map SrcSpan [Located AnnotationComment]
cs),AnnKeywordId
kw)
Just (SrcSpan
s:[SrcSpan]
ss) -> ([SrcSpan
s],(ApiAnnKey
-> [SrcSpan] -> Map ApiAnnKey [SrcSpan] -> Map ApiAnnKey [SrcSpan]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (SrcSpan -> SrcSpan
rs SrcSpan
sp,AnnKeywordId
kw) [SrcSpan]
ss Map ApiAnnKey [SrcSpan]
anns,Map SrcSpan [Located AnnotationComment]
cs),AnnKeywordId
kw)
let ([SrcSpan]
r,(Map ApiAnnKey [SrcSpan]
a',Map SrcSpan [Located AnnotationComment]
c'),AnnKeywordId
kw) =
case AnnKeywordId -> ([SrcSpan], ApiAnns, AnnKeywordId)
getKw AnnKeywordId
an of
([],ApiAnns
_,AnnKeywordId
_) -> AnnKeywordId -> ([SrcSpan], ApiAnns, AnnKeywordId)
getKw (AnnKeywordId -> AnnKeywordId
GHC.unicodeAnn AnnKeywordId
an)
([SrcSpan], ApiAnns, AnnKeywordId)
v -> ([SrcSpan], ApiAnns, AnnKeywordId)
v
#if __GLASGOW_HASKELL__ >= 900
let ga' = ann { GHC.apiAnnItems = a', GHC.apiAnnComments = c' }
#else
let ga' :: ApiAnns
ga' = (Map ApiAnnKey [SrcSpan]
a',Map SrcSpan [Located AnnotationComment]
c')
#endif
#endif
(DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { apAnns :: ApiAnns
apAnns = ApiAnns
ga' })
([SrcSpan], AnnKeywordId) -> Delta ([SrcSpan], AnnKeywordId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([SrcSpan]
r,AnnKeywordId
kw)
addAnnotationsDelta :: Annotation -> Delta ()
addAnnotationsDelta :: Annotation -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationsDelta Annotation
ann = do
DeltaOptions
l <- RWST DeltaOptions DeltaWriter DeltaState Identity DeltaOptions
forall r (m :: * -> *). MonadReader r m => m r
ask
(AnnKey, Annotation) -> RWS DeltaOptions DeltaWriter DeltaState ()
tellFinalAnn (DeltaOptions -> AnnKey
getAnnKey DeltaOptions
l,Annotation
ann)
getAnnKey :: DeltaOptions -> AnnKey
getAnnKey :: DeltaOptions -> AnnKey
getAnnKey DeltaOptions {SrcSpan
curSrcSpan :: SrcSpan
curSrcSpan :: DeltaOptions -> SrcSpan
curSrcSpan, AnnConName
annConName :: AnnConName
annConName :: DeltaOptions -> AnnConName
annConName}
= SrcSpan -> AnnConName -> AnnKey
AnnKey (SrcSpan -> SrcSpan
rs SrcSpan
curSrcSpan) AnnConName
annConName
addAnnDeltaPos :: KeywordId -> DeltaPos -> Delta ()
addAnnDeltaPos :: KeywordId -> DeltaPos -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnDeltaPos KeywordId
kw DeltaPos
dp = (KeywordId, DeltaPos) -> RWS DeltaOptions DeltaWriter DeltaState ()
tellKd (KeywordId
kw, DeltaPos
dp)
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
withAST :: (Data a, Data (GHC.SrcSpanLess a), GHC.HasSrcSpan a)
=> a
-> Delta b -> Delta b
withAST :: a -> Delta b -> Delta b
withAST lss :: a
lss@(a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
GHC.dL->GHC.L SrcSpan
ss SrcSpanLess a
_) Delta b
action = do
#else
withAST :: Data a
=> GHC.Located a
-> Delta b -> Delta b
withAST lss@(GHC.L ss _) action = do
#endif
LayoutStartCol
off <- (DeltaState -> LayoutStartCol)
-> RWST DeltaOptions DeltaWriter DeltaState Identity LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> LayoutStartCol
apLayoutStart
(Delta b -> Delta b
forall a. Delta a -> Delta a
resetAnns (Delta b -> Delta b) -> (Delta b -> Delta b) -> Delta b -> Delta b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Delta b -> Delta b
forall a b.
(Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Delta b -> Delta b
withSrcSpanDelta a
lss) (do
let maskWriter :: DeltaWriter -> DeltaWriter
maskWriter DeltaWriter
s = DeltaWriter
s { annKds :: [(KeywordId, DeltaPos)]
annKds = []
, sortKeys :: Maybe [SrcSpan]
sortKeys = Maybe [SrcSpan]
forall a. Maybe a
Nothing
, dwCapturedSpan :: First AnnKey
dwCapturedSpan = First AnnKey
forall a. Monoid a => a
mempty }
let spanStart :: Pos
spanStart = SrcSpan -> Pos
ss2pos SrcSpan
ss
[(Comment, DeltaPos)]
cs <- do
Pos
priorEndBeforeComments <- Delta Pos
getPriorEnd
if SrcSpan -> Bool
GHC.isGoodSrcSpan SrcSpan
ss Bool -> Bool -> Bool
&& Pos
priorEndBeforeComments Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< SrcSpan -> Pos
ss2pos SrcSpan
ss
then
(Comment -> Bool)
-> ([(Comment, DeltaPos)]
-> RWST
DeltaOptions DeltaWriter DeltaState Identity [(Comment, DeltaPos)])
-> RWST
DeltaOptions DeltaWriter DeltaState Identity [(Comment, DeltaPos)]
forall a.
(Comment -> Bool) -> ([(Comment, DeltaPos)] -> Delta a) -> Delta a
commentAllocation (Pos -> Comment -> Bool
priorComment Pos
spanStart) [(Comment, DeltaPos)]
-> RWST
DeltaOptions DeltaWriter DeltaState Identity [(Comment, DeltaPos)]
forall (m :: * -> *) a. Monad m => a -> m a
return
else
[(Comment, DeltaPos)]
-> RWST
DeltaOptions DeltaWriter DeltaState Identity [(Comment, DeltaPos)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Pos
priorEndAfterComments <- Delta Pos
getPriorEnd
let edp :: DeltaPos
edp = LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset
LayoutStartCol
off (Pos -> SrcSpan -> DeltaPos
ss2delta Pos
priorEndAfterComments SrcSpan
ss)
Bool
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SrcSpan -> Bool
GHC.isGoodSrcSpan SrcSpan
ss Bool -> Bool -> Bool
&& Pos
priorEndAfterComments Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< SrcSpan -> Pos
ss2pos SrcSpan
ss) (do
(DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { priorEndPosition :: Pos
priorEndPosition = SrcSpan -> Pos
ss2pos SrcSpan
ss } ))
(b
res, DeltaWriter
w) <- (DeltaWriter -> DeltaWriter)
-> RWST
DeltaOptions DeltaWriter DeltaState Identity (b, DeltaWriter)
-> RWST
DeltaOptions DeltaWriter DeltaState Identity (b, DeltaWriter)
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor DeltaWriter -> DeltaWriter
maskWriter (Delta b
-> RWST
DeltaOptions DeltaWriter DeltaState Identity (b, DeltaWriter)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen Delta b
action)
let kds :: [(KeywordId, DeltaPos)]
kds = DeltaWriter -> [(KeywordId, DeltaPos)]
annKds DeltaWriter
w
an :: Annotation
an = Ann :: DeltaPos
-> [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> [(KeywordId, DeltaPos)]
-> Maybe [SrcSpan]
-> Maybe AnnKey
-> Annotation
Ann
{ annEntryDelta :: DeltaPos
annEntryDelta = DeltaPos
edp
, annPriorComments :: [(Comment, DeltaPos)]
annPriorComments = [(Comment, DeltaPos)]
cs
, annFollowingComments :: [(Comment, DeltaPos)]
annFollowingComments = []
, annsDP :: [(KeywordId, DeltaPos)]
annsDP = [(KeywordId, DeltaPos)]
kds
, annSortKey :: Maybe [SrcSpan]
annSortKey = DeltaWriter -> Maybe [SrcSpan]
sortKeys DeltaWriter
w
, annCapturedSpan :: Maybe AnnKey
annCapturedSpan = First AnnKey -> Maybe AnnKey
forall a. First a -> Maybe a
getFirst (First AnnKey -> Maybe AnnKey) -> First AnnKey -> Maybe AnnKey
forall a b. (a -> b) -> a -> b
$ DeltaWriter -> First AnnKey
dwCapturedSpan DeltaWriter
w }
Annotation -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationsDelta Annotation
an
RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`debug` (String
"leaveAST:(annkey,an)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (AnnKey, Annotation) -> String
forall a. Show a => a -> String
show (a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey a
lss,Annotation
an))
b -> Delta b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res)
resetAnns :: Delta a -> Delta a
resetAnns :: Delta a -> Delta a
resetAnns Delta a
action = do
ApiAnns
ans <- (DeltaState -> ApiAnns)
-> RWST DeltaOptions DeltaWriter DeltaState Identity ApiAnns
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DeltaState -> ApiAnns
apAnns
Delta a
action Delta a -> RWS DeltaOptions DeltaWriter DeltaState () -> Delta a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (DeltaState -> DeltaState)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DeltaState
s -> DeltaState
s { apAnns :: ApiAnns
apAnns = ApiAnns
ans })
priorComment :: Pos -> Comment -> Bool
Pos
start Comment
c = (SrcSpan -> Pos
ss2pos (SrcSpan -> Pos) -> (Comment -> SrcSpan) -> Comment -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcSpan
sr (SrcSpan -> SrcSpan) -> (Comment -> SrcSpan) -> Comment -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> SrcSpan
commentIdentifier (Comment -> Pos) -> Comment -> Pos
forall a b. (a -> b) -> a -> b
$ Comment
c) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
start
allocateComments :: (Comment -> Bool) -> [Comment] -> ([Comment], [Comment])
= (Comment -> Bool) -> [Comment] -> ([Comment], [Comment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition
addAnnotationWorker :: KeywordId -> AnnSpan -> Delta ()
addAnnotationWorker :: KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker KeywordId
ann SrcSpan
pa =
Bool
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SrcSpan -> Bool
isPointSrcSpan SrcSpan
pa) (RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ())
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall a b. (a -> b) -> a -> b
$
do
Pos
pe <- Delta Pos
getPriorEnd
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
let p :: DeltaPos
p = Pos -> SrcSpan -> DeltaPos
ss2delta Pos
pe (SrcSpan -> SrcSpan
sr SrcSpan
pa)
case (KeywordId
ann,DeltaPos -> Bool
isGoodDelta DeltaPos
p) of
(G AnnKeywordId
GHC.AnnComma,Bool
False) -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(G AnnKeywordId
GHC.AnnSemi, Bool
False) -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(G AnnKeywordId
GHC.AnnOpen, Bool
False) -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(G AnnKeywordId
GHC.AnnClose,Bool
False) -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(KeywordId, Bool)
_ -> do
DeltaPos
p' <- DeltaPos -> Delta DeltaPos
adjustDeltaForOffsetM DeltaPos
p
(Comment -> Bool)
-> ([(Comment, DeltaPos)]
-> RWS DeltaOptions DeltaWriter DeltaState ())
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall a.
(Comment -> Bool) -> ([(Comment, DeltaPos)] -> Delta a) -> Delta a
commentAllocation (Pos -> Comment -> Bool
priorComment (SrcSpan -> Pos
ss2pos (SrcSpan -> SrcSpan
sr SrcSpan
pa))) (((Comment, DeltaPos) -> RWS DeltaOptions DeltaWriter DeltaState ())
-> [(Comment, DeltaPos)]
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Comment -> DeltaPos -> RWS DeltaOptions DeltaWriter DeltaState ())
-> (Comment, DeltaPos)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Comment -> DeltaPos -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaComment))
#if __GLASGOW_HASKELL__ <= 710
addAnnDeltaPos (checkUnicode ann pa) p'
#else
KeywordId -> DeltaPos -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnDeltaPos KeywordId
ann DeltaPos
p'
#endif
SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
setPriorEndAST SrcSpan
pa
RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`debug` (String
"addAnnotationWorker:(ss,ss,pe,pa,p,p',ann)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String, Pos, String, DeltaPos, DeltaPos, KeywordId)
-> String
forall a. Show a => a -> String
show (SrcSpan -> String
forall a. Outputable a => a -> String
showGhc SrcSpan
ss,SrcSpan -> String
forall a. Outputable a => a -> String
showGhc SrcSpan
ss,Pos
pe,SrcSpan -> String
forall a. Outputable a => a -> String
showGhc SrcSpan
pa,DeltaPos
p,DeltaPos
p',KeywordId
ann))
#if __GLASGOW_HASKELL__ <= 710
checkUnicode :: KeywordId -> GHC.SrcSpan -> KeywordId
checkUnicode gkw@(G kw) ss =
if kw `Set.member` unicodeSyntax
then
let s = keywordToString gkw in
if length s /= spanLength ss
then AnnUnicode kw
else gkw
else
gkw
where
unicodeSyntax = Set.fromList
[ GHC.AnnDcolon
, GHC.AnnDarrow
, GHC.AnnForall
, GHC.AnnRarrow
, GHC.AnnLarrow
, GHC.Annlarrowtail
, GHC.Annrarrowtail
, GHC.AnnLarrowtail
, GHC.AnnRarrowtail]
checkUnicode kwid _ = kwid
#else
unicodeEquivalent :: GHC.AnnKeywordId -> [GHC.AnnKeywordId]
unicodeEquivalent :: AnnKeywordId -> [AnnKeywordId]
unicodeEquivalent AnnKeywordId
kw =
case AnnKeywordId -> Map AnnKeywordId AnnKeywordId -> Maybe AnnKeywordId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKeywordId
kw Map AnnKeywordId AnnKeywordId
unicodeSyntax of
Maybe AnnKeywordId
Nothing -> []
Just AnnKeywordId
kwu -> [AnnKeywordId
kwu]
where
unicodeSyntax :: Map AnnKeywordId AnnKeywordId
unicodeSyntax = [(AnnKeywordId, AnnKeywordId)] -> Map AnnKeywordId AnnKeywordId
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (AnnKeywordId
GHC.AnnDcolon, AnnKeywordId
GHC.AnnDcolonU)
, (AnnKeywordId
GHC.AnnDarrow, AnnKeywordId
GHC.AnnDarrowU)
, (AnnKeywordId
GHC.AnnForall, AnnKeywordId
GHC.AnnForallU)
, (AnnKeywordId
GHC.AnnRarrow, AnnKeywordId
GHC.AnnRarrowU)
, (AnnKeywordId
GHC.AnnLarrow, AnnKeywordId
GHC.AnnLarrowU)
, (AnnKeywordId
GHC.Annlarrowtail, AnnKeywordId
GHC.AnnlarrowtailU)
, (AnnKeywordId
GHC.Annrarrowtail, AnnKeywordId
GHC.AnnrarrowtailU)
, (AnnKeywordId
GHC.AnnLarrowtail, AnnKeywordId
GHC.AnnLarrowtailU)
, (AnnKeywordId
GHC.AnnRarrowtail, AnnKeywordId
GHC.AnnRarrowtailU)
#if __GLASGOW_HASKELL__ > 801
, (AnnKeywordId
GHC.AnnCloseB, AnnKeywordId
GHC.AnnCloseBU)
, (AnnKeywordId
GHC.AnnCloseQ, AnnKeywordId
GHC.AnnCloseQU)
, (AnnKeywordId
GHC.AnnOpenB, AnnKeywordId
GHC.AnnOpenBU)
, (AnnKeywordId
GHC.AnnOpenEQ, AnnKeywordId
GHC.AnnOpenEQU)
#endif
]
#endif
commentAllocation :: (Comment -> Bool)
-> ([(Comment, DeltaPos)] -> Delta a)
-> Delta a
Comment -> Bool
p [(Comment, DeltaPos)] -> Delta a
k = do
[Comment]
cs <- RWST DeltaOptions DeltaWriter DeltaState Identity [Comment]
getUnallocatedComments
let ([Comment]
allocated,[Comment]
cs') = (Comment -> Bool) -> [Comment] -> ([Comment], [Comment])
allocateComments Comment -> Bool
p [Comment]
cs
[Comment] -> RWS DeltaOptions DeltaWriter DeltaState ()
putUnallocatedComments [Comment]
cs'
[(Comment, DeltaPos)] -> Delta a
k ([(Comment, DeltaPos)] -> Delta a)
-> RWST
DeltaOptions DeltaWriter DeltaState Identity [(Comment, DeltaPos)]
-> Delta a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Comment
-> RWST
DeltaOptions DeltaWriter DeltaState Identity (Comment, DeltaPos))
-> [Comment]
-> RWST
DeltaOptions DeltaWriter DeltaState Identity [(Comment, DeltaPos)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Comment
-> RWST
DeltaOptions DeltaWriter DeltaState Identity (Comment, DeltaPos)
makeDeltaComment ((Comment -> Maybe (Pos, Pos)) -> [Comment] -> [Comment]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SrcSpan -> Maybe (Pos, Pos)
unpack (SrcSpan -> Maybe (Pos, Pos))
-> (Comment -> SrcSpan) -> Comment -> Maybe (Pos, Pos)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> SrcSpan
commentIdentifier) [Comment]
allocated)
where
#if __GLASGOW_HASKELL__ >= 900
unpack :: GHC.RealSrcSpan -> Maybe ((Int, Int), (Int, Int))
unpack x =
#else
unpack :: GHC.SrcSpan -> Maybe ((Int, Int), (Int, Int))
unpack :: SrcSpan -> Maybe (Pos, Pos)
unpack (GHC.RealSrcSpan RealSrcSpan
x) =
#endif
(Pos, Pos) -> Maybe (Pos, Pos)
forall a. a -> Maybe a
Just ( (RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
x, RealSrcSpan -> Int
GHC.srcSpanStartCol RealSrcSpan
x)
, (RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
x, RealSrcSpan -> Int
GHC.srcSpanEndCol RealSrcSpan
x) )
unpack SrcSpan
_ = Maybe (Pos, Pos)
forall a. Maybe a
Nothing
makeDeltaComment :: Comment -> Delta (Comment, DeltaPos)
Comment
c = do
let pa :: SrcSpan
pa = Comment -> SrcSpan
commentIdentifier Comment
c
Pos
pe <- Delta Pos
getPriorEnd
let p :: DeltaPos
p = Pos -> SrcSpan -> DeltaPos
ss2delta Pos
pe (SrcSpan -> SrcSpan
sr SrcSpan
pa)
DeltaPos
p' <- DeltaPos -> Delta DeltaPos
adjustDeltaForOffsetM DeltaPos
p
Pos -> RWS DeltaOptions DeltaWriter DeltaState ()
setPriorEnd (SrcSpan -> Pos
ss2posEnd (SrcSpan -> SrcSpan
sr SrcSpan
pa))
(Comment, DeltaPos)
-> RWST
DeltaOptions DeltaWriter DeltaState Identity (Comment, DeltaPos)
forall (m :: * -> *) a. Monad m => a -> m a
return (Comment
c, DeltaPos
p')
addDeltaComment :: Comment -> DeltaPos -> Delta ()
Comment
d DeltaPos
p = do
KeywordId -> DeltaPos -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnDeltaPos (Comment -> KeywordId
AnnComment Comment
d) DeltaPos
p
deltaMarkAnnBeforeAnn :: GHC.AnnKeywordId -> GHC.AnnKeywordId -> Delta ()
deltaMarkAnnBeforeAnn :: AnnKeywordId
-> AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
deltaMarkAnnBeforeAnn AnnKeywordId
annBefore AnnKeywordId
annAfter = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
[SrcSpan]
mb <- AnnKeywordId -> Delta [SrcSpan]
peekAnnotationDelta AnnKeywordId
annBefore
[SrcSpan]
ma <- AnnKeywordId -> Delta [SrcSpan]
peekAnnotationDelta AnnKeywordId
annAfter
let
before :: [SrcSpan]
before = [SrcSpan] -> [SrcSpan]
forall a. Ord a => [a] -> [a]
sort ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> Bool) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SrcSpan
s -> SrcSpan -> SrcSpan -> Bool
GHC.isSubspanOf (SrcSpan -> SrcSpan
sr SrcSpan
s) SrcSpan
ss) [SrcSpan]
mb
after :: [SrcSpan]
after = [SrcSpan] -> [SrcSpan]
forall a. Ord a => [a] -> [a]
sort ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> Bool) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SrcSpan
s -> SrcSpan -> SrcSpan -> Bool
GHC.isSubspanOf (SrcSpan -> SrcSpan
sr SrcSpan
s) SrcSpan
ss) [SrcSpan]
ma
case ([SrcSpan]
before,[SrcSpan]
after) of
(SrcSpan
b:[SrcSpan]
_, SrcSpan
a:[SrcSpan]
_) -> Bool
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SrcSpan
b SrcSpan -> SrcSpan -> Bool
forall a. Ord a => a -> a -> Bool
< SrcSpan
a) (RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ())
-> RWS DeltaOptions DeltaWriter DeltaState ()
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotation AnnKeywordId
annBefore
([SrcSpan], [SrcSpan])
_ -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addDeltaAnnotation :: GHC.AnnKeywordId -> Delta ()
addDeltaAnnotation :: AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotation AnnKeywordId
ann' = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
([SrcSpan]
ma,AnnKeywordId
ann) <- AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getOneAnnotationDelta AnnKeywordId
ann'
case [SrcSpan] -> [SrcSpan]
forall a. Eq a => [a] -> [a]
nub [SrcSpan]
ma of
[] -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return () RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`debug` (String
"addDeltaAnnotation empty ma for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ApiAnnKey -> String
forall a. Show a => a -> String
show (SrcSpan
ss,AnnKeywordId
ann))
[SrcSpan
pa] -> KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker (AnnKeywordId -> KeywordId
G AnnKeywordId
ann) SrcSpan
pa
(SrcSpan
pa:[SrcSpan]
_) -> KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker (AnnKeywordId -> KeywordId
G AnnKeywordId
ann) SrcSpan
pa RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`warn` (String
"addDeltaAnnotation:(ss,ann,ma)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SrcSpan, AnnKeywordId, [SrcSpan]) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
ss,AnnKeywordId
ann,[SrcSpan]
ma))
addDeltaAnnotationLs :: GHC.AnnKeywordId -> Int -> Delta ()
addDeltaAnnotationLs :: AnnKeywordId -> Int -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationLs AnnKeywordId
ann Int
off = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
[SrcSpan]
ma <- AnnKeywordId -> Delta [SrcSpan]
peekAnnotationDelta AnnKeywordId
ann
let ma' :: [SrcSpan]
ma' = (SrcSpan -> Bool) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SrcSpan
s -> SrcSpan -> SrcSpan -> Bool
GHC.isSubspanOf (SrcSpan -> SrcSpan
sr SrcSpan
s) SrcSpan
ss) [SrcSpan]
ma
case Int -> [SrcSpan] -> [SrcSpan]
forall a. Int -> [a] -> [a]
drop Int
off [SrcSpan]
ma' of
[] -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`debug` (String
"addDeltaAnnotationLs:missed:(off,ann,ma)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, SrcSpan, AnnKeywordId) -> String
forall a. Outputable a => a -> String
showGhc (Int
off,SrcSpan
ss,AnnKeywordId
ann))
(SrcSpan
pa:[SrcSpan]
_) -> KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker (AnnKeywordId -> KeywordId
G AnnKeywordId
ann) SrcSpan
pa
addDeltaAnnotations :: GHC.AnnKeywordId -> Delta ()
addDeltaAnnotations :: AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotations AnnKeywordId
ann = do
([SrcSpan]
ma,AnnKeywordId
kw) <- AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAnnotationDelta AnnKeywordId
ann
let do_one :: SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
do_one SrcSpan
ap' = KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker (AnnKeywordId -> KeywordId
G AnnKeywordId
kw) SrcSpan
ap'
RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`debug` (String
"addDeltaAnnotations:do_one:(ap',ann)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ApiAnnKey -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
ap',AnnKeywordId
ann))
(SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ())
-> [SrcSpan] -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
do_one ([SrcSpan] -> [SrcSpan]
forall a. Ord a => [a] -> [a]
sort [SrcSpan]
ma)
addDeltaAnnotationsInside :: GHC.AnnKeywordId -> Delta ()
addDeltaAnnotationsInside :: AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationsInside AnnKeywordId
ann = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
[SrcSpan]
ma <- AnnKeywordId -> Delta [SrcSpan]
peekAnnotationDelta AnnKeywordId
ann
let do_one :: SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
do_one SrcSpan
ap' = KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker (AnnKeywordId -> KeywordId
G AnnKeywordId
ann) SrcSpan
ap'
let filtered :: [SrcSpan]
filtered = [SrcSpan] -> [SrcSpan]
forall a. Ord a => [a] -> [a]
sort ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> Bool) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SrcSpan
s -> SrcSpan -> SrcSpan -> Bool
GHC.isSubspanOf (SrcSpan -> SrcSpan
sr SrcSpan
s) SrcSpan
ss) [SrcSpan]
ma
(SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ())
-> [SrcSpan] -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
do_one [SrcSpan]
filtered
#if __GLASGOW_HASKELL__ >= 800
addDeltaAnnotationInstead :: GHC.AnnKeywordId -> KeywordId -> Delta ()
addDeltaAnnotationInstead :: AnnKeywordId
-> KeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationInstead AnnKeywordId
ann' KeywordId
kw = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
([SrcSpan]
ma,AnnKeywordId
ann) <- AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getOneAnnotationDelta AnnKeywordId
ann'
case [SrcSpan] -> [SrcSpan]
forall a. Eq a => [a] -> [a]
nub [SrcSpan]
ma of
[] -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return () RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`debug` (String
"addDeltaAnnotation empty ma for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ApiAnnKey -> String
forall a. Show a => a -> String
show (SrcSpan
ss,AnnKeywordId
ann))
[SrcSpan
pa] -> KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker KeywordId
kw SrcSpan
pa
(SrcSpan
pa:[SrcSpan]
_) -> KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker KeywordId
kw SrcSpan
pa RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`warn` (String
"addDeltaAnnotationInstead:(ss,ann,kw,ma)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SrcSpan, AnnKeywordId, KeywordId, [SrcSpan]) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
ss,AnnKeywordId
ann,KeywordId
kw,[SrcSpan]
ma))
#endif
addDeltaAnnotationsOutside :: GHC.AnnKeywordId -> KeywordId -> Delta ()
addDeltaAnnotationsOutside :: AnnKeywordId
-> KeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationsOutside AnnKeywordId
gann KeywordId
ann = do
SrcSpan
ss <- Delta SrcSpan
getSrcSpan
([SrcSpan]
ma,AnnKeywordId
kw) <- SrcSpan -> AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAndRemoveAnnotationDelta SrcSpan
ss AnnKeywordId
gann
let do_one :: SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
do_one SrcSpan
ap' = if KeywordId
ann KeywordId -> KeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== KeywordId
AnnSemiSep
then KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker KeywordId
ann SrcSpan
ap'
else KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker (AnnKeywordId -> KeywordId
G AnnKeywordId
kw) SrcSpan
ap'
(SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ())
-> [SrcSpan] -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
do_one ([SrcSpan] -> [SrcSpan]
forall a. Ord a => [a] -> [a]
sort ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> Bool) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SrcSpan
s -> Bool -> Bool
not (SrcSpan -> SrcSpan -> Bool
GHC.isSubspanOf (SrcSpan -> SrcSpan
sr SrcSpan
s) SrcSpan
ss)) [SrcSpan]
ma)
addDeltaAnnotationExt :: AnnSpan -> GHC.AnnKeywordId -> Delta ()
addDeltaAnnotationExt :: SrcSpan
-> AnnKeywordId -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaAnnotationExt SrcSpan
s AnnKeywordId
ann = KeywordId -> SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnotationWorker (AnnKeywordId -> KeywordId
G AnnKeywordId
ann) SrcSpan
s
addEofAnnotation :: Delta ()
#if __GLASGOW_HASKELL__ >= 900
addEofAnnotation = do
pe <- getPriorEnd
ga <- gets apAnns
let Just pa = GHC.apiAnnEofPos ga
commentAllocation (const True) (mapM_ (uncurry addDeltaComment))
let DP (r,c) = ss2delta pe (sr pa)
addAnnDeltaPos AnnEofPos (DP (r, c - 1))
setPriorEndAST pa
#else
addEofAnnotation :: RWS DeltaOptions DeltaWriter DeltaState ()
addEofAnnotation = do
Pos
pe <- Delta Pos
getPriorEnd
([SrcSpan]
ma,AnnKeywordId
_kw) <- GenLocated SrcSpan ()
-> Delta ([SrcSpan], AnnKeywordId)
-> Delta ([SrcSpan], AnnKeywordId)
forall a b.
(Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Delta b -> Delta b
withSrcSpanDelta (SrcSpanLess (GenLocated SrcSpan ()) -> GenLocated SrcSpan ()
forall a. HasSrcSpan a => SrcSpanLess a -> a
GHC.noLoc () :: GHC.GenLocated GHC.SrcSpan ())
(AnnKeywordId -> Delta ([SrcSpan], AnnKeywordId)
getAnnotationDelta AnnKeywordId
GHC.AnnEofPos)
case [SrcSpan]
ma of
[] -> () -> RWS DeltaOptions DeltaWriter DeltaState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(SrcSpan
pa:[SrcSpan]
pss) -> do
(Comment -> Bool)
-> ([(Comment, DeltaPos)]
-> RWS DeltaOptions DeltaWriter DeltaState ())
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall a.
(Comment -> Bool) -> ([(Comment, DeltaPos)] -> Delta a) -> Delta a
commentAllocation (Bool -> Comment -> Bool
forall a b. a -> b -> a
const Bool
True) (((Comment, DeltaPos) -> RWS DeltaOptions DeltaWriter DeltaState ())
-> [(Comment, DeltaPos)]
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Comment -> DeltaPos -> RWS DeltaOptions DeltaWriter DeltaState ())
-> (Comment, DeltaPos)
-> RWS DeltaOptions DeltaWriter DeltaState ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Comment -> DeltaPos -> RWS DeltaOptions DeltaWriter DeltaState ()
addDeltaComment))
let DP (Int
r,Int
c) = Pos -> SrcSpan -> DeltaPos
ss2delta Pos
pe SrcSpan
pa
KeywordId -> DeltaPos -> RWS DeltaOptions DeltaWriter DeltaState ()
addAnnDeltaPos (AnnKeywordId -> KeywordId
G AnnKeywordId
GHC.AnnEofPos) (Pos -> DeltaPos
DP (Int
r, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
SrcSpan -> RWS DeltaOptions DeltaWriter DeltaState ()
setPriorEndAST SrcSpan
pa RWS DeltaOptions DeltaWriter DeltaState ()
-> String -> RWS DeltaOptions DeltaWriter DeltaState ()
forall c. c -> String -> c
`warn` (String
"Trailing annotations after Eof: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SrcSpan] -> String
forall a. Outputable a => a -> String
showGhc [SrcSpan]
pss)
#endif
countAnnsDelta :: GHC.AnnKeywordId -> Delta Int
countAnnsDelta :: AnnKeywordId -> Delta Int
countAnnsDelta AnnKeywordId
ann = do
[SrcSpan]
ma <- AnnKeywordId -> Delta [SrcSpan]
peekAnnotationDelta AnnKeywordId
ann
Int -> Delta Int
forall (m :: * -> *) a. Monad m => a -> m a
return ([SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
ma)