{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.GHC.ExactPrint.Pretty
(
addAnnotationsForPretty
) where
import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Utils
import Language.Haskell.GHC.ExactPrint.Annotate
import Control.Monad.RWS
import Control.Monad.Trans.Free
import Data.Generics
import Data.List
import Data.Ord (comparing)
#if __GLASGOW_HASKELL__ <= 710
import qualified BooleanFormula as GHC
import qualified Outputable as GHC
#endif
import qualified GHC
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" #-}
addAnnotationsForPretty :: (Annotate a) => [Comment] -> GHC.Located a -> Anns -> Anns
addAnnotationsForPretty :: [Comment] -> Located a -> Anns -> Anns
addAnnotationsForPretty [Comment]
cs Located a
ast Anns
ans
= PrettyOptions -> [Comment] -> Annotated () -> Anns -> Pos -> Anns
runPrettyWithComments PrettyOptions
opts [Comment]
cs (Located a -> Annotated ()
forall ast.
(Annotate ast, Data (SrcSpanLess ast), HasSrcSpan ast) =>
ast -> Annotated ()
annotate Located a
ast) Anns
ans (Int
0,Int
0)
where
opts :: PrettyOptions
opts = Rigidity -> PrettyOptions
prettyOptions Rigidity
NormalLayout
type Pretty a = RWS PrettyOptions PrettyWriter PrettyState a
runPrettyWithComments :: PrettyOptions -> [Comment] -> Annotated () -> Anns -> Pos -> Anns
PrettyOptions
opts [Comment]
cs Annotated ()
action Anns
ans Pos
priorEnd =
PrettyWriter -> Anns
mkAnns (PrettyWriter -> Anns)
-> (Annotated () -> PrettyWriter) -> Annotated () -> Anns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrettyState, PrettyWriter) -> PrettyWriter
forall a b. (a, b) -> b
snd
((PrettyState, PrettyWriter) -> PrettyWriter)
-> (Annotated () -> (PrettyState, PrettyWriter))
-> Annotated ()
-> PrettyWriter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\RWS PrettyOptions PrettyWriter PrettyState ()
next -> RWS PrettyOptions PrettyWriter PrettyState ()
-> PrettyOptions -> PrettyState -> (PrettyState, PrettyWriter)
forall r w s a. RWS r w s a -> r -> s -> (s, w)
execRWS RWS PrettyOptions PrettyWriter PrettyState ()
next PrettyOptions
opts ([Comment] -> Pos -> Anns -> PrettyState
defaultPrettyState [Comment]
cs Pos
priorEnd Anns
ans))
(RWS PrettyOptions PrettyWriter PrettyState ()
-> (PrettyState, PrettyWriter))
-> (Annotated () -> RWS PrettyOptions PrettyWriter PrettyState ())
-> Annotated ()
-> (PrettyState, PrettyWriter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall a. Annotated a -> Pretty a
prettyInterpret (Annotated () -> Anns) -> Annotated () -> Anns
forall a b. (a -> b) -> a -> b
$ Annotated ()
action
where
mkAnns :: PrettyWriter -> Anns
mkAnns :: PrettyWriter -> Anns
mkAnns = Endo Anns -> Anns
forall a. Monoid a => Endo a -> a
f (Endo Anns -> Anns)
-> (PrettyWriter -> Endo Anns) -> PrettyWriter -> Anns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyWriter -> 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 PrettyOptions = PrettyOptions
{
PrettyOptions -> SrcSpan
curSrcSpan :: !GHC.SrcSpan
, PrettyOptions -> AnnConName
annConName :: !AnnConName
, PrettyOptions -> Rigidity
drRigidity :: !Rigidity
, PrettyOptions -> AstContextSet
prContext :: !AstContextSet
} deriving Int -> PrettyOptions -> ShowS
[PrettyOptions] -> ShowS
PrettyOptions -> String
(Int -> PrettyOptions -> ShowS)
-> (PrettyOptions -> String)
-> ([PrettyOptions] -> ShowS)
-> Show PrettyOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrettyOptions] -> ShowS
$cshowList :: [PrettyOptions] -> ShowS
show :: PrettyOptions -> String
$cshow :: PrettyOptions -> String
showsPrec :: Int -> PrettyOptions -> ShowS
$cshowsPrec :: Int -> PrettyOptions -> ShowS
Show
data PrettyWriter = PrettyWriter
{
PrettyWriter -> Endo Anns
dwAnns :: Endo (Map.Map AnnKey Annotation)
, PrettyWriter -> [(KeywordId, DeltaPos)]
annKds :: ![(KeywordId, DeltaPos)]
, PrettyWriter -> Maybe [SrcSpan]
sortKeys :: !(Maybe [AnnSpan])
, PrettyWriter -> First AnnKey
dwCapturedSpan :: !(First AnnKey)
, PrettyWriter -> AstContextSet
prLayoutContext :: !(ACS' AstContext)
}
data PrettyState = PrettyState
{
PrettyState -> Pos
priorEndPosition :: !Pos
, :: ![Comment]
, PrettyState -> Bool
apMarkLayout :: Bool
, PrettyState -> LayoutStartCol
apLayoutStart :: LayoutStartCol
, PrettyState -> Bool
apNoPrecedingSpace :: Bool
}
#if __GLASGOW_HASKELL__ >= 804
instance Semigroup PrettyWriter where
<> :: PrettyWriter -> PrettyWriter -> PrettyWriter
(<>) = PrettyWriter -> PrettyWriter -> PrettyWriter
forall a. Monoid a => a -> a -> a
mappend
#endif
instance Monoid PrettyWriter where
mempty :: PrettyWriter
mempty = Endo Anns
-> [(KeywordId, DeltaPos)]
-> Maybe [SrcSpan]
-> First AnnKey
-> AstContextSet
-> PrettyWriter
PrettyWriter 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 AstContextSet
forall a. Monoid a => a
mempty
(PrettyWriter Endo Anns
a [(KeywordId, DeltaPos)]
b Maybe [SrcSpan]
e First AnnKey
g AstContextSet
i) mappend :: PrettyWriter -> PrettyWriter -> PrettyWriter
`mappend` (PrettyWriter Endo Anns
c [(KeywordId, DeltaPos)]
d Maybe [SrcSpan]
f First AnnKey
h AstContextSet
j)
= Endo Anns
-> [(KeywordId, DeltaPos)]
-> Maybe [SrcSpan]
-> First AnnKey
-> AstContextSet
-> PrettyWriter
PrettyWriter (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) (AstContextSet
i AstContextSet -> AstContextSet -> AstContextSet
forall a. Semigroup a => a -> a -> a
<> AstContextSet
j)
prettyOptions :: Rigidity -> PrettyOptions
prettyOptions :: Rigidity -> PrettyOptions
prettyOptions Rigidity
ridigity =
PrettyOptions :: SrcSpan -> AnnConName -> Rigidity -> AstContextSet -> PrettyOptions
PrettyOptions
{ curSrcSpan :: SrcSpan
curSrcSpan = SrcSpan
GHC.noSrcSpan
, annConName :: AnnConName
annConName = () -> AnnConName
forall a. Data a => a -> AnnConName
annGetConstr ()
, drRigidity :: Rigidity
drRigidity = Rigidity
ridigity
, prContext :: AstContextSet
prContext = AstContextSet
defaultACS
}
defaultPrettyState :: [Comment] -> Pos -> Anns -> PrettyState
defaultPrettyState :: [Comment] -> Pos -> Anns -> PrettyState
defaultPrettyState [Comment]
injectedComments Pos
priorEnd Anns
_ans =
PrettyState :: Pos -> [Comment] -> Bool -> LayoutStartCol -> Bool -> PrettyState
PrettyState
{ priorEndPosition :: Pos
priorEndPosition = Pos
priorEnd
, apComments :: [Comment]
apComments = [Comment]
cs [Comment] -> [Comment] -> [Comment]
forall a. [a] -> [a] -> [a]
++ [Comment]
injectedComments
, apLayoutStart :: LayoutStartCol
apLayoutStart = LayoutStartCol
1
, apMarkLayout :: Bool
apMarkLayout = Bool
False
, apNoPrecedingSpace :: Bool
apNoPrecedingSpace = Bool
False
}
where
cs :: [Comment]
cs :: [Comment]
cs = []
prettyInterpret :: Annotated a -> Pretty a
prettyInterpret :: Annotated a -> Pretty a
prettyInterpret = (AnnotationF (Pretty a) -> Pretty a) -> Annotated a -> Pretty 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 (Pretty a) -> Pretty a
forall a. AnnotationF (Pretty a) -> Pretty a
go
where
go :: AnnotationF (Pretty a) -> Pretty a
go :: AnnotationF (Pretty a) -> Pretty a
go (MarkPrim AnnKeywordId
kwid Maybe String
_ Pretty a
next) = KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation (AnnKeywordId -> KeywordId
G AnnKeywordId
kwid) RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (MarkPPOptional AnnKeywordId
_kwid Maybe String
_ Pretty a
next) = Pretty a
next
go (MarkEOF Pretty a
next) = RWS PrettyOptions PrettyWriter PrettyState ()
addEofAnnotation RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (MarkExternal SrcSpan
_ss AnnKeywordId
akwid String
_ Pretty a
next) = KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation (AnnKeywordId -> KeywordId
G AnnKeywordId
akwid) RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
#if __GLASGOW_HASKELL__ >= 800
go (MarkInstead AnnKeywordId
akwid KeywordId
kwid Pretty a
next) = AnnKeywordId
-> KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsInstead AnnKeywordId
akwid KeywordId
kwid RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
#endif
go (MarkOutside AnnKeywordId
akwid KeywordId
kwid Pretty a
next) = AnnKeywordId
-> KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsOutside AnnKeywordId
akwid KeywordId
kwid RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (MarkInside AnnKeywordId
akwid Pretty a
next) = AnnKeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsInside AnnKeywordId
akwid RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (MarkMany AnnKeywordId
akwid Pretty a
next) = KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation (AnnKeywordId -> KeywordId
G AnnKeywordId
akwid) RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (MarkManyOptional AnnKeywordId
_akwid Pretty a
next) = Pretty a
next
go (MarkOffsetPrim AnnKeywordId
akwid Int
n Maybe String
_ Pretty a
next) = AnnKeywordId
-> Int -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationLs AnnKeywordId
akwid Int
n RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (MarkOffsetPrimOptional AnnKeywordId
_akwid Int
_n Maybe String
_ Pretty a
next) = Pretty a
next
go (WithAST a
lss Annotated b
prog Pretty a
next) = a -> Pretty b -> Pretty b
forall a b.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Pretty b -> Pretty b
withAST a
lss (Annotated b -> Pretty b
forall a. Annotated a -> Pretty a
prettyInterpret Annotated b
prog) Pretty b -> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (CountAnns AnnKeywordId
kwid Int -> Pretty a
next) = AnnKeywordId -> Pretty Int
countAnnsPretty AnnKeywordId
kwid Pretty Int -> (Int -> Pretty a) -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Pretty a
next
go (WithSortKey [(SrcSpan, Annotated ())]
kws Pretty a
next) = [(SrcSpan, Annotated ())]
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall b.
[(SrcSpan, Annotated b)]
-> RWS PrettyOptions PrettyWriter PrettyState ()
withSortKey [(SrcSpan, Annotated ())]
kws RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (WithSortKeyContexts ListContexts
ctx [(SrcSpan, Annotated ())]
kws Pretty a
next) = ListContexts
-> [(SrcSpan, Annotated ())]
-> RWS PrettyOptions PrettyWriter PrettyState ()
withSortKeyContexts ListContexts
ctx [(SrcSpan, Annotated ())]
kws RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (SetLayoutFlag Rigidity
r Annotated ()
action Pretty a
next) = do
Rigidity
rigidity <- (PrettyOptions -> Rigidity)
-> RWST PrettyOptions PrettyWriter PrettyState Identity Rigidity
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrettyOptions -> Rigidity
drRigidity
(if Rigidity
r Rigidity -> Rigidity -> Bool
forall a. Ord a => a -> a -> Bool
<= Rigidity
rigidity then RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
setLayoutFlag else RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall a. a -> a
id) (Annotated () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall a. Annotated a -> Pretty a
prettyInterpret Annotated ()
action)
Pretty a
next
go (StoreOriginalSrcSpan SrcSpan
l AnnKey
key AnnKey -> Pretty a
next) = SrcSpan -> AnnKey -> Pretty AnnKey
storeOriginalSrcSpanPretty SrcSpan
l AnnKey
key Pretty AnnKey -> (AnnKey -> Pretty a) -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnnKey -> Pretty a
next
go (MarkAnnBeforeAnn AnnKeywordId
_ann1 AnnKeywordId
_ann2 Pretty a
next) = Pretty a
next
go (GetSrcSpanForKw SrcSpan
ss AnnKeywordId
kw SrcSpan -> Pretty a
next) = SrcSpan -> AnnKeywordId -> Pretty SrcSpan
getSrcSpanForKw SrcSpan
ss AnnKeywordId
kw Pretty SrcSpan -> (SrcSpan -> Pretty a) -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SrcSpan -> Pretty a
next
#if __GLASGOW_HASKELL__ <= 710
go (StoreString s ss next) = storeString s ss >> next
#endif
go (AnnotationsToComments [AnnKeywordId]
kws Pretty a
next) = [AnnKeywordId] -> RWS PrettyOptions PrettyWriter PrettyState ()
annotationsToCommentsPretty [AnnKeywordId]
kws RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
#if __GLASGOW_HASKELL__ <= 710
go (AnnotationsToCommentsBF bf kws next) = annotationsToCommentsBFPretty bf kws >> next
go (FinalizeBF l next) = finalizeBFPretty l >> next
#endif
go (SetContextLevel Set AstContext
ctxt Int
lvl Annotated ()
action Pretty a
next) = Set AstContext
-> Int
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
setContextPretty Set AstContext
ctxt Int
lvl (Annotated () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall a. Annotated a -> Pretty a
prettyInterpret Annotated ()
action) RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (UnsetContext AstContext
ctxt Annotated ()
action Pretty a
next) = AstContext
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
unsetContextPretty AstContext
ctxt (Annotated () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall a. Annotated a -> Pretty a
prettyInterpret Annotated ()
action) RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (IfInContext Set AstContext
ctxt Annotated ()
ia Annotated ()
ea Pretty a
next) = Set AstContext
-> Annotated ()
-> Annotated ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
ifInContextPretty Set AstContext
ctxt Annotated ()
ia Annotated ()
ea RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
go (TellContext Set AstContext
c Pretty a
next) = Set AstContext -> RWS PrettyOptions PrettyWriter PrettyState ()
tellContext Set AstContext
c RWS PrettyOptions PrettyWriter PrettyState ()
-> Pretty a -> Pretty a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pretty a
next
addEofAnnotation :: Pretty ()
addEofAnnotation :: RWS PrettyOptions PrettyWriter PrettyState ()
addEofAnnotation = do
#if __GLASGOW_HASKELL__ >= 900
tellKd (AnnEofPos, DP (1,0))
#else
(KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (AnnKeywordId -> KeywordId
G AnnKeywordId
GHC.AnnEofPos, Pos -> DeltaPos
DP (Int
1,Int
0))
#endif
addPrettyAnnotation :: KeywordId -> Pretty ()
addPrettyAnnotation :: KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation KeywordId
ann = do
Bool
noPrec <- (PrettyState -> Bool)
-> RWST PrettyOptions PrettyWriter PrettyState Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrettyState -> Bool
apNoPrecedingSpace
AstContextSet
ctx <- (PrettyOptions -> AstContextSet)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrettyOptions -> AstContextSet
prContext
AstContextSet
_ <- String
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet
forall c. String -> c -> c
debugP (String
"Pretty.addPrettyAnnotation:=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (KeywordId, Bool, AstContextSet) -> String
forall a. Outputable a => a -> String
showGhc (KeywordId
ann,Bool
noPrec,AstContextSet
ctx)) (RWST PrettyOptions PrettyWriter PrettyState Identity AstContextSet
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet
forall a b. (a -> b) -> a -> b
$ (PrettyOptions -> AstContextSet)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrettyOptions -> AstContextSet
prContext
let
dp :: RWS PrettyOptions PrettyWriter PrettyState ()
dp = case KeywordId
ann of
(G AnnKeywordId
GHC.AnnAs) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnAt) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
0))
#if __GLASGOW_HASKELL__ >= 806
(G AnnKeywordId
GHC.AnnAnyclass) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#endif
(G AnnKeywordId
GHC.AnnBackquote) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnBang) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnBy) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnCase ) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnClass) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnClose) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnCloseC) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
0))
#if __GLASGOW_HASKELL__ >= 802
(G AnnKeywordId
GHC.AnnCloseQ) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#endif
(G AnnKeywordId
GHC.AnnDcolon) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnDeriving) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnDo) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#if __GLASGOW_HASKELL__ >= 900
(G GHC.AnnDollar) -> tellKd (ann,DP (0,1))
(G GHC.AnnDollarDollar) -> tellKd (ann,DP (0,1))
#endif
(G AnnKeywordId
GHC.AnnDotdot) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnElse) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
1,Int
2))
(G AnnKeywordId
GHC.AnnEqual) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnExport) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnFamily) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnForall) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnGroup) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnHiding) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnIf) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnImport) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnIn) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
1,Int
0))
(G AnnKeywordId
GHC.AnnInstance) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnLam) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnLet) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#if __GLASGOW_HASKELL__ >= 900
(G GHC.AnnLollyU) -> tellKd (ann,DP (0,1))
(G GHC.AnnPercentOne) -> tellKd (ann,DP (0,1))
(G GHC.AnnPercent) -> tellKd (ann,DP (0,1))
#endif
(G AnnKeywordId
GHC.AnnMinus) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnModule) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnNewtype) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnOf) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnOpenC) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
0))
(G AnnKeywordId
GHC.AnnOpenP) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnOpenS) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#if __GLASGOW_HASKELL__ < 900
(G AnnKeywordId
GHC.AnnOpenPE) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnOpenPTE) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#endif
(G AnnKeywordId
GHC.AnnQualified) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnRarrow) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#if __GLASGOW_HASKELL__ > 710
(G AnnKeywordId
GHC.AnnRarrowU) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#endif
(G AnnKeywordId
GHC.AnnRole) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnSafe) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#if __GLASGOW_HASKELL__ >= 806
(G AnnKeywordId
GHC.AnnStock) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#endif
(G AnnKeywordId
GHC.AnnSimpleQuote) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#if __GLASGOW_HASKELL__ < 900
(G AnnKeywordId
GHC.AnnThIdSplice) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnThIdTySplice) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#endif
(G AnnKeywordId
GHC.AnnThTyQuote) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnThen) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
1,Int
2))
(G AnnKeywordId
GHC.AnnTilde) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnType) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnUsing) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnVal) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnValStr) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
(G AnnKeywordId
GHC.AnnVbar) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#if __GLASGOW_HASKELL__ >= 806
(G AnnKeywordId
GHC.AnnVia) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#endif
(G AnnKeywordId
GHC.AnnWhere) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
1,Int
2))
#if __GLASGOW_HASKELL__ >= 800
KeywordId
AnnTypeApp -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
1))
#endif
KeywordId
_ -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
0))
RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall a. Pretty a -> Pretty a -> Pretty a
fromNoPrecedingSpace ((KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (Int
0,Int
0))) RWS PrettyOptions PrettyWriter PrettyState ()
dp
#if __GLASGOW_HASKELL__ >= 800
addPrettyAnnotationsInstead :: GHC.AnnKeywordId -> KeywordId -> Pretty ()
addPrettyAnnotationsInstead :: AnnKeywordId
-> KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsInstead AnnKeywordId
_akwid KeywordId
AnnSemiSep = () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addPrettyAnnotationsInstead AnnKeywordId
_akwid KeywordId
kwid = KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation KeywordId
kwid
#endif
addPrettyAnnotationsOutside :: GHC.AnnKeywordId -> KeywordId -> Pretty ()
addPrettyAnnotationsOutside :: AnnKeywordId
-> KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsOutside AnnKeywordId
_akwid KeywordId
AnnSemiSep = () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addPrettyAnnotationsOutside AnnKeywordId
_akwid KeywordId
kwid = KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation KeywordId
kwid
addPrettyAnnotationsInside :: GHC.AnnKeywordId -> Pretty ()
addPrettyAnnotationsInside :: AnnKeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsInside AnnKeywordId
_ann = () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addPrettyAnnotationLs :: GHC.AnnKeywordId -> Int -> Pretty ()
addPrettyAnnotationLs :: AnnKeywordId
-> Int -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationLs AnnKeywordId
ann Int
_off = KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation (AnnKeywordId -> KeywordId
G AnnKeywordId
ann)
#if __GLASGOW_HASKELL__ <= 710
getUnallocatedComments :: Pretty [Comment]
getUnallocatedComments = gets apComments
putUnallocatedComments :: [Comment] -> Pretty ()
putUnallocatedComments cs = modify (\s -> s { apComments = cs } )
#endif
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
withSrcSpanPretty :: (Data (GHC.SrcSpanLess a), GHC.HasSrcSpan a) => a -> Pretty b -> Pretty b
withSrcSpanPretty :: a -> Pretty b -> Pretty b
withSrcSpanPretty (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
GHC.dL->GHC.L SrcSpan
l SrcSpanLess a
a) Pretty b
action = do
#else
withSrcSpanPretty :: Data a => GHC.Located a -> Pretty b -> Pretty b
withSrcSpanPretty (GHC.L l a) action = do
#endif
(()
_,PrettyWriter
w) <- RWS PrettyOptions PrettyWriter PrettyState ()
-> RWST
PrettyOptions PrettyWriter PrettyState Identity ((), PrettyWriter)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (() -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return () :: Pretty ())
()
_ <- String
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall c. String -> c -> c
debugP (String
"withSrcSpanPretty: prLayoutContext w=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ AstContextSet -> String
forall a. Show a => a -> String
show (PrettyWriter -> AstContextSet
prLayoutContext PrettyWriter
w) ) (() -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(PrettyOptions -> PrettyOptions) -> Pretty b -> Pretty b
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\PrettyOptions
s -> PrettyOptions
s { curSrcSpan :: SrcSpan
curSrcSpan = SrcSpan
l
, annConName :: AnnConName
annConName = SrcSpanLess a -> AnnConName
forall a. Data a => a -> AnnConName
annGetConstr SrcSpanLess a
a
, prContext :: AstContextSet
prContext = (AstContextSet -> AstContextSet
forall a. ACS' a -> ACS' a
pushAcs (PrettyOptions -> AstContextSet
prContext PrettyOptions
s)) AstContextSet -> AstContextSet -> AstContextSet
forall a. Semigroup a => a -> a -> a
<> (PrettyWriter -> AstContextSet
prLayoutContext PrettyWriter
w)
})
Pretty b
action
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
withAST :: (Data a, Data (GHC.SrcSpanLess a), GHC.HasSrcSpan a)
=> a
-> Pretty b -> Pretty b
withAST :: a -> Pretty b -> Pretty 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
t) Pretty b
action = do
#else
withAST :: Data a
=> GHC.Located a
-> Pretty b -> Pretty b
withAST lss@(GHC.L ss t) action = do
#endif
() -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return () RWS PrettyOptions PrettyWriter PrettyState ()
-> String -> RWS PrettyOptions PrettyWriter PrettyState ()
forall c. c -> String -> c
`debug` (String
"Pretty.withAST:enter 1:(ss)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SrcSpan, String) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
ss,Constr -> String
showConstr (SrcSpanLess a -> Constr
forall a. Data a => a -> Constr
toConstr SrcSpanLess a
t)))
a -> Pretty b -> Pretty b
forall a b.
(Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Pretty b -> Pretty b
withSrcSpanPretty a
lss (Pretty b -> Pretty b) -> Pretty b -> Pretty b
forall a b. (a -> b) -> a -> b
$ do
() -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return () RWS PrettyOptions PrettyWriter PrettyState ()
-> String -> RWS PrettyOptions PrettyWriter PrettyState ()
forall c. c -> String -> c
`debug` (String
"Pretty.withAST:enter:(ss)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SrcSpan, String) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
ss,Constr -> String
showConstr (SrcSpanLess a -> Constr
forall a. Data a => a -> Constr
toConstr SrcSpanLess a
t)))
let maskWriter :: PrettyWriter -> PrettyWriter
maskWriter PrettyWriter
s = PrettyWriter
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
}
#if __GLASGOW_HASKELL__ <= 710
let spanStart = ss2pos ss
cs <- do
if GHC.isGoodSrcSpan ss
then
commentAllocation (priorComment spanStart) return
else
return []
#else
let cs :: [a]
cs = []
#endif
AstContextSet
ctx <- (PrettyOptions -> AstContextSet)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrettyOptions -> AstContextSet
prContext
Bool
noPrec <- (PrettyState -> Bool)
-> RWST PrettyOptions PrettyWriter PrettyState Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrettyState -> Bool
apNoPrecedingSpace
DeltaPos
edp <- String -> Pretty DeltaPos -> Pretty DeltaPos
forall c. String -> c -> c
debugP (String
"Pretty.withAST:enter:(ss,constr,noPrec,ctx)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SrcSpan, String, Bool, AstContextSet) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
ss,Constr -> String
showConstr (SrcSpanLess a -> Constr
forall a. Data a => a -> Constr
toConstr SrcSpanLess a
t),Bool
noPrec,AstContextSet
ctx)) (Pretty DeltaPos -> Pretty DeltaPos)
-> Pretty DeltaPos -> Pretty DeltaPos
forall a b. (a -> b) -> a -> b
$ AstContextSet -> SrcSpanLess a -> Pretty DeltaPos
forall a. Typeable a => AstContextSet -> a -> Pretty DeltaPos
entryDpFor AstContextSet
ctx SrcSpanLess a
t
let ctx1 :: AstContextSet
ctx1 = String -> AstContextSet -> AstContextSet
forall c. String -> c -> c
debugP (String
"Pretty.withAST:edp:(ss,constr,edp)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SrcSpan, String, DeltaPos) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
ss,Constr -> String
showConstr (SrcSpanLess a -> Constr
forall a. Data a => a -> Constr
toConstr SrcSpanLess a
t),DeltaPos
edp)) AstContextSet
ctx
(b
res, PrettyWriter
w) <- if Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
ListItem,AstContext
TopLevel,AstContext
InTypeApp]) AstContextSet
ctx1
then
(PrettyWriter -> PrettyWriter)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity (b, PrettyWriter)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity (b, PrettyWriter)
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor PrettyWriter -> PrettyWriter
maskWriter (Pretty b
-> RWST
PrettyOptions PrettyWriter PrettyState Identity (b, PrettyWriter)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (Pretty b -> Pretty b
forall a. Pretty a -> Pretty a
setNoPrecedingSpace Pretty b
action))
else
(PrettyWriter -> PrettyWriter)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity (b, PrettyWriter)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity (b, PrettyWriter)
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor PrettyWriter -> PrettyWriter
maskWriter (Pretty b
-> RWST
PrettyOptions PrettyWriter PrettyState Identity (b, PrettyWriter)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen Pretty b
action)
let kds :: [(KeywordId, DeltaPos)]
kds = PrettyWriter -> [(KeywordId, DeltaPos)]
annKds PrettyWriter
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)]
forall a. [a]
cs
, annFollowingComments :: [(Comment, DeltaPos)]
annFollowingComments = []
, annsDP :: [(KeywordId, DeltaPos)]
annsDP = [(KeywordId, DeltaPos)]
kds
, annSortKey :: Maybe [SrcSpan]
annSortKey = PrettyWriter -> Maybe [SrcSpan]
sortKeys PrettyWriter
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
$ PrettyWriter -> First AnnKey
dwCapturedSpan PrettyWriter
w
}
Annotation -> RWS PrettyOptions PrettyWriter PrettyState ()
addAnnotationsPretty Annotation
an
RWS PrettyOptions PrettyWriter PrettyState ()
-> String -> RWS PrettyOptions PrettyWriter PrettyState ()
forall c. c -> String -> c
`debug` (String
"Pretty.withAST:(annkey,an)=" String -> ShowS
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 -> Pretty b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
entryDpFor :: Typeable a => AstContextSet -> a -> Pretty DeltaPos
entryDpFor :: AstContextSet -> a -> Pretty DeltaPos
entryDpFor AstContextSet
ctx a
a = (a -> Pretty DeltaPos
forall a. a -> Pretty DeltaPos
def (a -> Pretty DeltaPos)
-> (GRHS RdrName (LHsExpr RdrName) -> Pretty DeltaPos)
-> a
-> Pretty DeltaPos
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` GRHS RdrName (LHsExpr RdrName) -> Pretty DeltaPos
grhs) a
a
where
lineDefault :: Int
lineDefault = if Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
AdvanceLine) AstContextSet
ctx
then Int
1 else Int
0
noAdvanceLine :: Bool
noAdvanceLine = Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
NoAdvanceLine) AstContextSet
ctx Bool -> Bool -> Bool
&&
Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
ListStart) AstContextSet
ctx
def :: a -> Pretty DeltaPos
def :: a -> Pretty DeltaPos
def a
_ =
String -> Pretty DeltaPos -> Pretty DeltaPos
forall c. String -> c -> c
debugP (String
"entryDpFor:(topLevel,listStart,inList,noAdvanceLine,ctx)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Bool, Bool, Bool, Bool, AstContextSet) -> String
forall a. Show a => a -> String
show (Bool
topLevel,Bool
listStart,Bool
inList,Bool
noAdvanceLine,AstContextSet
ctx)) (Pretty DeltaPos -> Pretty DeltaPos)
-> Pretty DeltaPos -> Pretty DeltaPos
forall a b. (a -> b) -> a -> b
$
if Bool
noAdvanceLine
then (if Bool
inTypeApp then DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
0,Int
0)) else DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
0,Int
1)))
else
if Bool
listStart
then DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
1,Int
2))
else if Bool
inList
then if Bool
topLevel then DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
2,Int
0)) else DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
1,Int
0))
else if Bool
topLevel then DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
2,Int
0)) else DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
lineDefault,Int
0))
topLevel :: Bool
topLevel = Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
TopLevel) AstContextSet
ctx
listStart :: Bool
listStart = Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
ListStart) AstContextSet
ctx
Bool -> Bool -> Bool
&& Bool -> Bool
not (Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
TopLevel) AstContextSet
ctx)
inList :: Bool
inList = Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
ListItem) AstContextSet
ctx
inLambda :: Bool
inLambda = Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
LambdaExpr) AstContextSet
ctx
inTypeApp :: Bool
inTypeApp = Set AstContext -> AstContextSet -> Bool
forall a. Ord a => Set a -> ACS' a -> Bool
inAcs (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InTypeApp) AstContextSet
ctx
grhs :: GHC.GRHS GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> Pretty DeltaPos
grhs :: GRHS RdrName (LHsExpr RdrName) -> Pretty DeltaPos
grhs GRHS RdrName (LHsExpr RdrName)
_ = do
if Bool
inLambda
then DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
0,Int
1))
else DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
1,Int
2))
fromNoPrecedingSpace :: Pretty a -> Pretty a -> Pretty a
fromNoPrecedingSpace :: Pretty a -> Pretty a -> Pretty a
fromNoPrecedingSpace Pretty a
def Pretty a
lay = do
PrettyState{Bool
apNoPrecedingSpace :: Bool
apNoPrecedingSpace :: PrettyState -> Bool
apNoPrecedingSpace} <- RWST PrettyOptions PrettyWriter PrettyState Identity PrettyState
forall s (m :: * -> *). MonadState s m => m s
get
if Bool
apNoPrecedingSpace
then do
(PrettyState -> PrettyState)
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrettyState
s -> PrettyState
s { apNoPrecedingSpace :: Bool
apNoPrecedingSpace = Bool
False
})
String -> Pretty a -> Pretty a
forall c. String -> c -> c
debugP (String
"fromNoPrecedingSpace:def") Pretty a
def
else
String -> Pretty a -> Pretty a
forall c. String -> c -> c
debugP (String
"fromNoPrecedingSpace:lay") Pretty a
lay
addAnnotationsPretty :: Annotation -> Pretty ()
addAnnotationsPretty :: Annotation -> RWS PrettyOptions PrettyWriter PrettyState ()
addAnnotationsPretty Annotation
ann = do
PrettyOptions
l <- RWST PrettyOptions PrettyWriter PrettyState Identity PrettyOptions
forall r (m :: * -> *). MonadReader r m => m r
ask
() -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return () RWS PrettyOptions PrettyWriter PrettyState ()
-> String -> RWS PrettyOptions PrettyWriter PrettyState ()
forall c. c -> String -> c
`debug` (String
"addAnnotationsPretty:=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SrcSpan, AstContextSet) -> String
forall a. Outputable a => a -> String
showGhc (PrettyOptions -> SrcSpan
curSrcSpan PrettyOptions
l,PrettyOptions -> AstContextSet
prContext PrettyOptions
l))
(AnnKey, Annotation)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellFinalAnn (PrettyOptions -> AnnKey
getAnnKey PrettyOptions
l,Annotation
ann)
getAnnKey :: PrettyOptions -> AnnKey
getAnnKey :: PrettyOptions -> AnnKey
getAnnKey PrettyOptions {SrcSpan
curSrcSpan :: SrcSpan
curSrcSpan :: PrettyOptions -> SrcSpan
curSrcSpan, AnnConName
annConName :: AnnConName
annConName :: PrettyOptions -> AnnConName
annConName}
= SrcSpan -> AnnConName -> AnnKey
AnnKey (SrcSpan -> SrcSpan
rs SrcSpan
curSrcSpan) AnnConName
annConName
countAnnsPretty :: GHC.AnnKeywordId -> Pretty Int
countAnnsPretty :: AnnKeywordId -> Pretty Int
countAnnsPretty AnnKeywordId
_ann = Int -> Pretty Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
withSortKey :: [(AnnSpan, Annotated b)] -> Pretty ()
withSortKey :: [(SrcSpan, Annotated b)]
-> RWS PrettyOptions PrettyWriter PrettyState ()
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 PrettyOptions PrettyWriter PrettyState ()
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 PrettyOptions PrettyWriter PrettyState Identity b)
-> [(SrcSpan, Annotated b)]
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Annotated b
-> RWST PrettyOptions PrettyWriter PrettyState Identity b
forall a. Annotated a -> Pretty a
prettyInterpret (Annotated b
-> RWST PrettyOptions PrettyWriter PrettyState Identity b)
-> ((SrcSpan, Annotated b) -> Annotated b)
-> (SrcSpan, Annotated b)
-> RWST PrettyOptions PrettyWriter PrettyState 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 ())] -> Pretty ()
withSortKeyContexts :: ListContexts
-> [(SrcSpan, Annotated ())]
-> RWS PrettyOptions PrettyWriter PrettyState ()
withSortKeyContexts ListContexts
ctxts [(SrcSpan, Annotated ())]
kws =
let 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
in do
[SrcSpan] -> RWS PrettyOptions PrettyWriter PrettyState ()
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 PrettyOptions PrettyWriter PrettyState ())
-> ListContexts
-> [(SrcSpan, Annotated ())]
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *).
Monad m =>
(Annotated () -> m ())
-> ListContexts -> [(SrcSpan, Annotated ())] -> m ()
withSortKeyContextsHelper Annotated () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall a. Annotated a -> Pretty a
prettyInterpret ListContexts
ctxts [(SrcSpan, Annotated ())]
order
storeOriginalSrcSpanPretty :: GHC.SrcSpan -> AnnKey -> Pretty AnnKey
storeOriginalSrcSpanPretty :: SrcSpan -> AnnKey -> Pretty AnnKey
storeOriginalSrcSpanPretty SrcSpan
_s AnnKey
key = do
AnnKey -> RWS PrettyOptions PrettyWriter PrettyState ()
tellCapturedSpan AnnKey
key
AnnKey -> Pretty AnnKey
forall (m :: * -> *) a. Monad m => a -> m a
return AnnKey
key
getSrcSpanForKw :: GHC.SrcSpan -> GHC.AnnKeywordId -> Pretty GHC.SrcSpan
getSrcSpanForKw :: SrcSpan -> AnnKeywordId -> Pretty SrcSpan
getSrcSpanForKw SrcSpan
ss AnnKeywordId
_kw = SrcSpan -> Pretty SrcSpan
forall (m :: * -> *) a. Monad m => a -> m a
return SrcSpan
ss
#if __GLASGOW_HASKELL__ <= 710
storeString :: String -> GHC.SrcSpan -> Pretty ()
storeString s _ss = addPrettyAnnotation (AnnString s)
#endif
setLayoutFlag :: Pretty () -> Pretty ()
setLayoutFlag :: RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
setLayoutFlag RWS PrettyOptions PrettyWriter PrettyState ()
action = do
LayoutStartCol
oldLay <- (PrettyState -> LayoutStartCol)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrettyState -> LayoutStartCol
apLayoutStart
(PrettyState -> PrettyState)
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrettyState
s -> PrettyState
s { apMarkLayout :: Bool
apMarkLayout = Bool
True } )
let reset :: RWS PrettyOptions PrettyWriter PrettyState ()
reset = (PrettyState -> PrettyState)
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrettyState
s -> PrettyState
s { apMarkLayout :: Bool
apMarkLayout = Bool
False
, apLayoutStart :: LayoutStartCol
apLayoutStart = LayoutStartCol
oldLay })
RWS PrettyOptions PrettyWriter PrettyState ()
action RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RWS PrettyOptions PrettyWriter PrettyState ()
reset
setNoPrecedingSpace :: Pretty a -> Pretty a
setNoPrecedingSpace :: Pretty a -> Pretty a
setNoPrecedingSpace Pretty a
action = do
Bool
oldVal <- (PrettyState -> Bool)
-> RWST PrettyOptions PrettyWriter PrettyState Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrettyState -> Bool
apNoPrecedingSpace
(PrettyState -> PrettyState)
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrettyState
s -> PrettyState
s { apNoPrecedingSpace :: Bool
apNoPrecedingSpace = Bool
True } )
let reset :: RWS PrettyOptions PrettyWriter PrettyState ()
reset = (PrettyState -> PrettyState)
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrettyState
s -> PrettyState
s { apNoPrecedingSpace :: Bool
apNoPrecedingSpace = Bool
oldVal })
Pretty a
action Pretty a
-> RWS PrettyOptions PrettyWriter PrettyState () -> Pretty a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RWS PrettyOptions PrettyWriter PrettyState ()
reset
setContextPretty :: Set.Set AstContext -> Int -> Pretty () -> Pretty ()
setContextPretty :: Set AstContext
-> Int
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
setContextPretty Set AstContext
ctxt Int
lvl =
(PrettyOptions -> PrettyOptions)
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\PrettyOptions
s -> PrettyOptions
s { prContext :: AstContextSet
prContext = Set AstContext -> Int -> AstContextSet -> AstContextSet
forall a. Ord a => Set a -> Int -> ACS' a -> ACS' a
setAcsWithLevel Set AstContext
ctxt Int
lvl (PrettyOptions -> AstContextSet
prContext PrettyOptions
s) } )
unsetContextPretty :: AstContext -> Pretty () -> Pretty ()
unsetContextPretty :: AstContext
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
unsetContextPretty AstContext
ctxt =
(PrettyOptions -> PrettyOptions)
-> RWS PrettyOptions PrettyWriter PrettyState ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\PrettyOptions
s -> PrettyOptions
s { prContext :: AstContextSet
prContext = AstContext -> AstContextSet -> AstContextSet
forall a. Ord a => a -> ACS' a -> ACS' a
unsetAcs AstContext
ctxt (PrettyOptions -> AstContextSet
prContext PrettyOptions
s) } )
ifInContextPretty :: Set.Set AstContext -> Annotated () -> Annotated () -> Pretty ()
ifInContextPretty :: Set AstContext
-> Annotated ()
-> Annotated ()
-> RWS PrettyOptions PrettyWriter PrettyState ()
ifInContextPretty Set AstContext
ctxt Annotated ()
ifAction Annotated ()
elseAction = do
AstContextSet
cur <- (PrettyOptions -> AstContextSet)
-> RWST
PrettyOptions PrettyWriter PrettyState Identity AstContextSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrettyOptions -> AstContextSet
prContext
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 PrettyOptions PrettyWriter PrettyState ()
forall a. Annotated a -> Pretty a
prettyInterpret Annotated ()
ifAction
else Annotated () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall a. Annotated a -> Pretty a
prettyInterpret Annotated ()
elseAction
annotationsToCommentsPretty :: [GHC.AnnKeywordId] -> Pretty ()
[AnnKeywordId]
_kws = () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if __GLASGOW_HASKELL__ <= 710
annotationsToCommentsBFPretty :: (GHC.Outputable a) => GHC.BooleanFormula (GHC.Located a) -> [GHC.AnnKeywordId] -> Pretty ()
annotationsToCommentsBFPretty bf _kws = do
cs <- debugP ("annotationsToCommentsBFPretty:" ++ showGhc (bf,makeBooleanFormulaAnns bf)) $ gets apComments
let
kws = makeBooleanFormulaAnns bf
newComments = map (uncurry mkKWComment ) kws
putUnallocatedComments (cs ++ newComments)
finalizeBFPretty :: GHC.SrcSpan -> Pretty ()
finalizeBFPretty _ss = do
commentAllocation (const True) (mapM_ (uncurry addPrettyComment))
return ()
#endif
#if __GLASGOW_HASKELL__ <= 710
priorComment :: Pos -> Comment -> Bool
priorComment start c = (ss2pos . commentIdentifier $ c) < start
allocateComments :: (Comment -> Bool) -> [Comment] -> ([Comment], [Comment])
allocateComments = partition
#endif
#if __GLASGOW_HASKELL__ <= 710
commentAllocation :: (Comment -> Bool)
-> ([(Comment, DeltaPos)] -> Pretty a)
-> Pretty a
commentAllocation p k = do
cs <- getUnallocatedComments
let (allocated,cs') = allocateComments p cs
putUnallocatedComments cs'
k =<< mapM makeDeltaComment (sortBy (comparing commentIdentifier) allocated)
makeDeltaComment :: Comment -> Pretty (Comment, DeltaPos)
makeDeltaComment c = do
return (c, DP (0,1))
addPrettyComment :: Comment -> DeltaPos -> Pretty ()
addPrettyComment d p = do
tellKd (AnnComment d, p)
#endif
tellFinalAnn :: (AnnKey, Annotation) -> Pretty ()
tellFinalAnn :: (AnnKey, Annotation)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellFinalAnn (AnnKey
k, Annotation
v) =
PrettyWriter -> RWS PrettyOptions PrettyWriter PrettyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (PrettyWriter
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) })
tellCapturedSpan :: AnnKey -> Pretty ()
tellCapturedSpan :: AnnKey -> RWS PrettyOptions PrettyWriter PrettyState ()
tellCapturedSpan AnnKey
key = PrettyWriter -> RWS PrettyOptions PrettyWriter PrettyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ( PrettyWriter
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) -> Pretty ()
tellKd :: (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId, DeltaPos)
kd = PrettyWriter -> RWS PrettyOptions PrettyWriter PrettyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (PrettyWriter
forall a. Monoid a => a
mempty { annKds :: [(KeywordId, DeltaPos)]
annKds = [(KeywordId, DeltaPos)
kd] })
tellSortKey :: [AnnSpan] -> Pretty ()
tellSortKey :: [SrcSpan] -> RWS PrettyOptions PrettyWriter PrettyState ()
tellSortKey [SrcSpan]
xs = PrettyWriter -> RWS PrettyOptions PrettyWriter PrettyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (PrettyWriter
forall a. Monoid a => a
mempty { sortKeys :: Maybe [SrcSpan]
sortKeys = [SrcSpan] -> Maybe [SrcSpan]
forall a. a -> Maybe a
Just [SrcSpan]
xs } )
tellContext :: Set.Set AstContext -> Pretty ()
tellContext :: Set AstContext -> RWS PrettyOptions PrettyWriter PrettyState ()
tellContext Set AstContext
lc = PrettyWriter -> RWS PrettyOptions PrettyWriter PrettyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (PrettyWriter
forall a. Monoid a => a
mempty { prLayoutContext :: AstContextSet
prLayoutContext = Set AstContext -> Int -> AstContextSet -> AstContextSet
forall a. Ord a => Set a -> Int -> ACS' a -> ACS' a
setAcsWithLevel Set AstContext
lc Int
2 AstContextSet
forall a. Monoid a => a
mempty} )