{-# 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 cs :: [Comment]
cs ast :: Located a
ast ans :: 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 (0,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
opts :: PrettyOptions
opts cs :: [Comment]
cs action :: Annotated ()
action ans :: Anns
ans priorEnd :: 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
. (\next :: 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 [GHC.SrcSpan])
, 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 a :: Endo Anns
a b :: [(KeywordId, DeltaPos)]
b e :: Maybe [SrcSpan]
e g :: First AnnKey
g i :: AstContextSet
i) mappend :: PrettyWriter -> PrettyWriter -> PrettyWriter
`mappend` (PrettyWriter c :: Endo Anns
c d :: [(KeywordId, DeltaPos)]
d f :: Maybe [SrcSpan]
f h :: First AnnKey
h j :: 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 ridigity :: Rigidity
ridigity =
$WPrettyOptions :: 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 injectedComments :: [Comment]
injectedComments priorEnd :: Pos
priorEnd _ans :: Anns
_ans =
$WPrettyState :: 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 = 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 kwid :: AnnKeywordId
kwid _ next :: 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 _kwid :: AnnKeywordId
_kwid _ next :: Pretty a
next) = Pretty a
next
go (MarkEOF next :: 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 _ss :: SrcSpan
_ss akwid :: AnnKeywordId
akwid _ next :: 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 akwid :: AnnKeywordId
akwid kwid :: KeywordId
kwid next :: 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 akwid :: AnnKeywordId
akwid kwid :: KeywordId
kwid next :: 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 akwid :: AnnKeywordId
akwid next :: 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 akwid :: AnnKeywordId
akwid next :: 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 _akwid :: AnnKeywordId
_akwid next :: Pretty a
next) = Pretty a
next
go (MarkOffsetPrim akwid :: AnnKeywordId
akwid n :: Int
n _ next :: 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 _akwid :: AnnKeywordId
_akwid _n :: Int
_n _ next :: Pretty a
next) = Pretty a
next
go (WithAST lss :: a
lss prog :: Annotated b
prog next :: 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 kwid :: AnnKeywordId
kwid next :: 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 kws :: [(SrcSpan, Annotated ())]
kws next :: 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 ctx :: ListContexts
ctx kws :: [(SrcSpan, Annotated ())]
kws next :: 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 r :: Rigidity
r action :: Annotated ()
action next :: 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 l :: SrcSpan
l key :: AnnKey
key next :: 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 _ann1 :: AnnKeywordId
_ann1 _ann2 :: AnnKeywordId
_ann2 next :: Pretty a
next) = Pretty a
next
go (GetSrcSpanForKw ss :: SrcSpan
ss kw :: AnnKeywordId
kw next :: 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 kws :: [AnnKeywordId]
kws next :: 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 ctxt :: Set AstContext
ctxt lvl :: Int
lvl action :: Annotated ()
action next :: 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 ctxt :: AstContext
ctxt action :: Annotated ()
action next :: 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 ctxt :: Set AstContext
ctxt ia :: Annotated ()
ia ea :: Annotated ()
ea next :: 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 c :: Set AstContext
c next :: 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
(KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (AnnKeywordId -> KeywordId
G AnnKeywordId
GHC.AnnEofPos, Pos -> DeltaPos
DP (1,0))
addPrettyAnnotation :: KeywordId -> Pretty ()
addPrettyAnnotation :: KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation ann :: 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 ("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 GHC.AnnAs) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnAt) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,0))
#if __GLASGOW_HASKELL__ >= 806
(G GHC.AnnAnyclass) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
#endif
(G GHC.AnnBackquote) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnBang) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnBy) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnCase ) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnClass) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnClose) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnCloseC) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,0))
#if __GLASGOW_HASKELL__ >= 802
(G GHC.AnnCloseQ) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
#endif
(G GHC.AnnDcolon) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnDeriving) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnDo) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnDotdot) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnElse) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (1,2))
(G GHC.AnnEqual) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnExport) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnFamily) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnForall) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnGroup) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnHiding) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnIf) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnImport) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnIn) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (1,0))
(G GHC.AnnInstance) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnLam) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnLet) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnMinus) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnModule) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnNewtype) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnOf) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnOpenC) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,0))
(G GHC.AnnOpenPE) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnOpenPTE) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnQualified) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnRarrow) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnRole) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnSafe) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
#if __GLASGOW_HASKELL__ >= 806
(G GHC.AnnStock) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
#endif
(G GHC.AnnSimpleQuote) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnThIdSplice) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnThIdTySplice) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnThTyQuote) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnThen) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (1,2))
(G GHC.AnnTilde) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnType) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnUsing) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnVal) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnValStr) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
(G GHC.AnnVbar) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
#if __GLASGOW_HASKELL__ >= 806
(G GHC.AnnVia) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
#endif
(G GHC.AnnWhere) -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (1,2))
#if __GLASGOW_HASKELL__ >= 800
AnnTypeApp -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,1))
#endif
_ -> (KeywordId, DeltaPos)
-> RWS PrettyOptions PrettyWriter PrettyState ()
tellKd (KeywordId
ann,Pos -> DeltaPos
DP (0,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 (0,0))) RWS PrettyOptions PrettyWriter PrettyState ()
dp
#if __GLASGOW_HASKELL__ >= 800
addPrettyAnnotationsInstead :: GHC.AnnKeywordId -> KeywordId -> Pretty ()
addPrettyAnnotationsInstead :: AnnKeywordId
-> KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsInstead _akwid :: AnnKeywordId
_akwid AnnSemiSep = () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addPrettyAnnotationsInstead _akwid :: AnnKeywordId
_akwid kwid :: KeywordId
kwid = KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation KeywordId
kwid
#endif
addPrettyAnnotationsOutside :: GHC.AnnKeywordId -> KeywordId -> Pretty ()
addPrettyAnnotationsOutside :: AnnKeywordId
-> KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsOutside _akwid :: AnnKeywordId
_akwid AnnSemiSep = () -> RWS PrettyOptions PrettyWriter PrettyState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addPrettyAnnotationsOutside _akwid :: AnnKeywordId
_akwid kwid :: KeywordId
kwid = KeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotation KeywordId
kwid
addPrettyAnnotationsInside :: GHC.AnnKeywordId -> Pretty ()
addPrettyAnnotationsInside :: AnnKeywordId -> RWS PrettyOptions PrettyWriter PrettyState ()
addPrettyAnnotationsInside _ann :: 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 ann :: AnnKeywordId
ann _off :: 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
withSrcSpanPretty :: (Data a, 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 l :: SrcSpan
l a :: SrcSpanLess a
a) action :: Pretty b
action = do
#else
withSrcSpanPretty :: Data a => GHC.Located a -> Pretty b -> Pretty b
withSrcSpanPretty (GHC.L l a) action = do
#endif
(_,w :: 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 ("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 (\s :: 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
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 ss :: SrcSpan
ss t :: SrcSpanLess a
t) action :: 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` ("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 a, 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` ("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 s :: 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 ("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 ("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
(res :: b
res, w :: 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]) 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 = $WAnn :: 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` ("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 ctx :: AstContextSet
ctx a :: 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 1 else 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 _ =
String -> Pretty DeltaPos -> Pretty DeltaPos
forall c. String -> c -> c
debugP ("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 DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (0,1))
else
if Bool
listStart
then DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (1,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 (2,0)) else DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (1,0))
else if Bool
topLevel then DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (2,0)) else DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (Int
lineDefault,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
grhs :: GHC.GRHS GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> Pretty DeltaPos
grhs :: GRHS RdrName (LHsExpr RdrName) -> Pretty DeltaPos
grhs _ = do
if Bool
inLambda
then DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (0,1))
else DeltaPos -> Pretty DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> DeltaPos
DP (1,2))
fromNoPrecedingSpace :: Pretty a -> Pretty a -> Pretty a
fromNoPrecedingSpace :: Pretty a -> Pretty a -> Pretty a
fromNoPrecedingSpace def :: Pretty a
def lay :: 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 (\s :: PrettyState
s -> PrettyState
s { apNoPrecedingSpace :: Bool
apNoPrecedingSpace = Bool
False
})
String -> Pretty a -> Pretty a
forall c. String -> c -> c
debugP ("fromNoPrecedingSpace:def") Pretty a
def
else
String -> Pretty a -> Pretty a
forall c. String -> c -> c
debugP ("fromNoPrecedingSpace:lay") Pretty a
lay
addAnnotationsPretty :: Annotation -> Pretty ()
addAnnotationsPretty :: Annotation -> RWS PrettyOptions PrettyWriter PrettyState ()
addAnnotationsPretty ann :: 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` ("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
curSrcSpan AnnConName
annConName
countAnnsPretty :: GHC.AnnKeywordId -> Pretty Int
countAnnsPretty :: AnnKeywordId -> Pretty Int
countAnnsPretty _ann :: AnnKeywordId
_ann = Int -> Pretty Int
forall (m :: * -> *) a. Monad m => a -> m a
return 0
withSortKey :: [(GHC.SrcSpan, Annotated b)] -> Pretty ()
withSortKey :: [(SrcSpan, Annotated b)]
-> RWS PrettyOptions PrettyWriter PrettyState ()
withSortKey kws :: [(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 -> [(GHC.SrcSpan, Annotated ())] -> Pretty ()
withSortKeyContexts :: ListContexts
-> [(SrcSpan, Annotated ())]
-> RWS PrettyOptions PrettyWriter PrettyState ()
withSortKeyContexts ctxts :: ListContexts
ctxts kws :: [(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 _s :: SrcSpan
_s key :: 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 ss :: SrcSpan
ss _kw :: 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 action :: 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 (\s :: 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 (\s :: 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 action :: 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 (\s :: 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 (\s :: 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 ctxt :: Set AstContext
ctxt lvl :: 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 (\s :: 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 ctxt :: 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 (\s :: 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 ctxt :: Set AstContext
ctxt ifAction :: Annotated ()
ifAction elseAction :: 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 ()
_kws :: [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 (k :: AnnKey
k, v :: 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 key :: 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 kd :: (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 :: [GHC.SrcSpan] -> Pretty ()
tellSortKey :: [SrcSpan] -> RWS PrettyOptions PrettyWriter PrettyState ()
tellSortKey xs :: [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 lc :: 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 2 AstContextSet
forall a. Monoid a => a
mempty} )