{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.GHC.ExactPrint.Print
(
exactPrint
, exactPrintWithOptions
, PrintOptions(epRigidity, epAstPrint, epTokenPrint, epWhitespacePrint)
, stringOptions
, printOptions
) where
import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Utils
import Language.Haskell.GHC.ExactPrint.Annotate
import Language.Haskell.GHC.ExactPrint.Lookup
import Control.Monad.Identity
import Control.Monad.RWS
import Control.Monad.Trans.Free
import Data.Data (Data)
import Data.List (sortBy, elemIndex)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import qualified Data.Set as Set
import qualified GHC
{-# ANN module "HLint: ignore Eta reduce" #-}
{-# ANN module "HLint: ignore Redundant do" #-}
{-# ANN module "HLint: ignore Reduce duplication" #-}
exactPrint :: Annotate ast
=> GHC.Located ast
-> Anns
-> String
exactPrint :: Located ast -> Anns -> String
exactPrint Located ast
ast Anns
as = Identity String -> String
forall a. Identity a -> a
runIdentity (PrintOptions Identity String
-> Located ast -> Anns -> Identity String
forall ast b (m :: * -> *).
(Annotate ast, Monoid b, Monad m) =>
PrintOptions m b -> Located ast -> Anns -> m b
exactPrintWithOptions PrintOptions Identity String
stringOptions Located ast
ast Anns
as)
exactPrintWithOptions :: (Annotate ast, Monoid b, Monad m)
=> PrintOptions m b
-> GHC.Located ast
-> Anns
-> m b
exactPrintWithOptions :: PrintOptions m b -> Located ast -> Anns -> m b
exactPrintWithOptions PrintOptions m b
r Located ast
ast Anns
as =
PrintOptions m b -> Annotated () -> Anns -> m b
forall (m :: * -> *) a.
(Monad m, Monoid a) =>
PrintOptions m a -> Annotated () -> Anns -> m a
runEP PrintOptions m b
r (Located ast -> Annotated ()
forall ast.
(Annotate ast, Data (SrcSpanLess ast), HasSrcSpan ast) =>
ast -> Annotated ()
annotate Located ast
ast) Anns
as
data PrintOptions m a = PrintOptions
{
PrintOptions m a -> Annotation
epAnn :: !Annotation
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
, PrintOptions m a
-> forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a
epAstPrint :: forall ast . (Data ast, GHC.HasSrcSpan ast) => ast -> a -> m a
#else
, epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a
#endif
, PrintOptions m a -> String -> m a
epTokenPrint :: String -> m a
, PrintOptions m a -> String -> m a
epWhitespacePrint :: String -> m a
, PrintOptions m a -> Rigidity
epRigidity :: Rigidity
, PrintOptions m a -> AstContextSet
epContext :: !AstContextSet
}
printOptions ::
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
(forall ast . (Data ast, GHC.HasSrcSpan ast) => ast -> a -> m a)
#else
(forall ast . Data ast => GHC.Located ast -> a -> m a)
#endif
-> (String -> m a)
-> (String -> m a)
-> Rigidity
-> PrintOptions m a
printOptions :: (forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a)
-> (String -> m a)
-> (String -> m a)
-> Rigidity
-> PrintOptions m a
printOptions forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a
astPrint String -> m a
tokenPrint String -> m a
wsPrint Rigidity
rigidity = PrintOptions :: forall (m :: * -> *) a.
Annotation
-> (forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a)
-> (String -> m a)
-> (String -> m a)
-> Rigidity
-> AstContextSet
-> PrintOptions m a
PrintOptions
{
epAnn :: Annotation
epAnn = Annotation
annNone
, epAstPrint :: forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a
epAstPrint = forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a
astPrint
, epWhitespacePrint :: String -> m a
epWhitespacePrint = String -> m a
wsPrint
, epTokenPrint :: String -> m a
epTokenPrint = String -> m a
tokenPrint
, epRigidity :: Rigidity
epRigidity = Rigidity
rigidity
, epContext :: AstContextSet
epContext = AstContextSet
defaultACS
}
stringOptions :: PrintOptions Identity String
stringOptions :: PrintOptions Identity String
stringOptions = (forall ast.
(Data ast, HasSrcSpan ast) =>
ast -> String -> Identity String)
-> (String -> Identity String)
-> (String -> Identity String)
-> Rigidity
-> PrintOptions Identity String
forall a (m :: * -> *).
(forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a)
-> (String -> m a)
-> (String -> m a)
-> Rigidity
-> PrintOptions m a
printOptions (\ast
_ String
b -> String -> Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
b) String -> Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String -> Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return Rigidity
NormalLayout
data EPWriter a = EPWriter
{ EPWriter a -> a
output :: !a }
#if __GLASGOW_HASKELL__ >= 804
instance Monoid w => Semigroup (EPWriter w) where
<> :: EPWriter w -> EPWriter w -> EPWriter w
(<>) = EPWriter w -> EPWriter w -> EPWriter w
forall a. Monoid a => a -> a -> a
mappend
#endif
instance Monoid w => Monoid (EPWriter w) where
mempty :: EPWriter w
mempty = w -> EPWriter w
forall a. a -> EPWriter a
EPWriter w
forall a. Monoid a => a
mempty
(EPWriter w
a) mappend :: EPWriter w -> EPWriter w -> EPWriter w
`mappend` (EPWriter w
b) = w -> EPWriter w
forall a. a -> EPWriter a
EPWriter (w
a w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
b)
data EPState = EPState
{ EPState -> Pos
epPos :: !Pos
, EPState -> Anns
epAnns :: !Anns
, EPState -> [[(KeywordId, DeltaPos)]]
epAnnKds :: ![[(KeywordId, DeltaPos)]]
, EPState -> Bool
epMarkLayout :: Bool
, EPState -> LayoutStartCol
epLHS :: LayoutStartCol
}
type EP w m a = RWST (PrintOptions m w) (EPWriter w) EPState m a
runEP :: (Monad m, Monoid a)
=> PrintOptions m a
-> Annotated () -> Anns -> m a
runEP :: PrintOptions m a -> Annotated () -> Anns -> m a
runEP PrintOptions m a
epReader Annotated ()
action Anns
ans =
((EPState, EPWriter a) -> a) -> m (EPState, EPWriter a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EPWriter a -> a
forall a. EPWriter a -> a
output (EPWriter a -> a)
-> ((EPState, EPWriter a) -> EPWriter a)
-> (EPState, EPWriter a)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EPState, EPWriter a) -> EPWriter a
forall a b. (a, b) -> b
snd) (m (EPState, EPWriter a) -> m a)
-> (Annotated () -> m (EPState, EPWriter a)) -> Annotated () -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\RWST (PrintOptions m a) (EPWriter a) EPState m ()
next -> RWST (PrintOptions m a) (EPWriter a) EPState m ()
-> PrintOptions m a -> EPState -> m (EPState, EPWriter a)
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> r -> s -> m (s, w)
execRWST RWST (PrintOptions m a) (EPWriter a) EPState m ()
next PrintOptions m a
epReader
(Anns -> EPState
defaultEPState Anns
ans))
(RWST (PrintOptions m a) (EPWriter a) EPState m ()
-> m (EPState, EPWriter a))
-> (Annotated ()
-> RWST (PrintOptions m a) (EPWriter a) EPState m ())
-> Annotated ()
-> m (EPState, EPWriter a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated () -> RWST (PrintOptions m a) (EPWriter a) EPState m ()
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret (Annotated () -> m a) -> Annotated () -> m a
forall a b. (a -> b) -> a -> b
$ Annotated ()
action
defaultEPState :: Anns -> EPState
defaultEPState :: Anns -> EPState
defaultEPState Anns
as = EPState :: Pos
-> Anns
-> [[(KeywordId, DeltaPos)]]
-> Bool
-> LayoutStartCol
-> EPState
EPState
{ epPos :: Pos
epPos = (Int
1,Int
1)
, epAnns :: Anns
epAnns = Anns
as
, epAnnKds :: [[(KeywordId, DeltaPos)]]
epAnnKds = []
, epLHS :: LayoutStartCol
epLHS = LayoutStartCol
1
, epMarkLayout :: Bool
epMarkLayout = Bool
False
}
printInterpret :: forall w m a . (Monad m, Monoid w)
=> Annotated a -> EP w m a
printInterpret :: Annotated a -> EP w m a
printInterpret Annotated a
m = (AnnotationF (EP w m a) -> EP w m a)
-> FreeT AnnotationF m a -> EP w m 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 (EP w m a) -> EP w m a
go ((forall a. Identity a -> m a)
-> Annotated a -> FreeT AnnotationF m a
forall (m :: * -> *) (f :: * -> *) (n :: * -> *) b.
(Monad m, Functor f) =>
(forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Identity a -> a) -> Identity a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity) Annotated a
m)
where
go :: AnnotationF (EP w m a) -> EP w m a
go :: AnnotationF (EP w m a) -> EP w m a
go (MarkEOF EP w m a
next) =
#if __GLASGOW_HASKELL__ >= 900
printStringAtMaybeAnn AnnEofPos (Just "") >> next
#else
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnn (AnnKeywordId -> KeywordId
G AnnKeywordId
GHC.AnnEofPos) (String -> Maybe String
forall a. a -> Maybe a
Just String
"") EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
#endif
go (MarkPrim AnnKeywordId
kwid Maybe String
mstr EP w m a
next) =
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
markPrim (AnnKeywordId -> KeywordId
G AnnKeywordId
kwid) Maybe String
mstr EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (MarkPPOptional AnnKeywordId
kwid Maybe String
mstr EP w m a
next) =
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
markPrim (AnnKeywordId -> KeywordId
G AnnKeywordId
kwid) Maybe String
mstr EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
#if __GLASGOW_HASKELL__ >= 800
go (MarkInstead AnnKeywordId
_ KeywordId
kwid EP w m a
next) =
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnnAll KeywordId
kwid Maybe String
forall a. Maybe a
Nothing EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
#endif
go (MarkOutside AnnKeywordId
_ KeywordId
kwid EP w m a
next) =
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnnAll KeywordId
kwid Maybe String
forall a. Maybe a
Nothing EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (MarkInside AnnKeywordId
akwid EP w m a
next) =
AnnKeywordId -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> EP w m ()
allAnns AnnKeywordId
akwid EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (MarkMany AnnKeywordId
akwid EP w m a
next) =
AnnKeywordId -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> EP w m ()
allAnns AnnKeywordId
akwid EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (MarkManyOptional AnnKeywordId
akwid EP w m a
next) =
AnnKeywordId -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> EP w m ()
allAnns AnnKeywordId
akwid EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (MarkOffsetPrim AnnKeywordId
kwid Int
_ Maybe String
mstr EP w m a
next) =
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnn (AnnKeywordId -> KeywordId
G AnnKeywordId
kwid) Maybe String
mstr EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (MarkOffsetPrimOptional AnnKeywordId
kwid Int
_ Maybe String
mstr EP w m a
next) =
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnn (AnnKeywordId -> KeywordId
G AnnKeywordId
kwid) Maybe String
mstr EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (WithAST a
lss Annotated b
action EP w m a
next) =
a -> EP w m b -> EP w m b
forall ast (m :: * -> *) w a.
(Data ast, Data (SrcSpanLess ast), HasSrcSpan ast, Monad m,
Monoid w) =>
ast -> EP w m a -> EP w m a
exactPC a
lss (Annotated b -> EP w m b
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret Annotated b
action) EP w m b -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (CountAnns AnnKeywordId
kwid Int -> EP w m a
next) =
KeywordId -> EP w m Int
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> EP w m Int
countAnnsEP (AnnKeywordId -> KeywordId
G AnnKeywordId
kwid) EP w m Int -> (Int -> EP w m a) -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> EP w m a
next
go (SetLayoutFlag Rigidity
r Annotated ()
action EP w m a
next) = do
Rigidity
rigidity <- (PrintOptions m w -> Rigidity)
-> RWST (PrintOptions m w) (EPWriter w) EPState m Rigidity
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrintOptions m w -> Rigidity
forall (m :: * -> *) a. PrintOptions m a -> Rigidity
epRigidity
(if Rigidity
r Rigidity -> Rigidity -> Bool
forall a. Ord a => a -> a -> Bool
<= Rigidity
rigidity then EP w m () -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayout else EP w m () -> EP w m ()
forall a. a -> a
id) (Annotated () -> EP w m ()
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret Annotated ()
action)
EP w m a
next
go (MarkAnnBeforeAnn AnnKeywordId
ann1 AnnKeywordId
ann2 EP w m a
next) = KeywordId -> KeywordId -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> KeywordId -> EP w m ()
printMarkAnnBeforeAnn (AnnKeywordId -> KeywordId
G AnnKeywordId
ann1) (AnnKeywordId -> KeywordId
G AnnKeywordId
ann2) EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (MarkExternal SrcSpan
_ AnnKeywordId
akwid String
s EP w m a
next) =
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnn (AnnKeywordId -> KeywordId
G AnnKeywordId
akwid) (String -> Maybe String
forall a. a -> Maybe a
Just String
s) EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (StoreOriginalSrcSpan SrcSpan
_ AnnKey
_ AnnKey -> EP w m a
next) = EP w m AnnKey
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m AnnKey
storeOriginalSrcSpanPrint EP w m AnnKey -> (AnnKey -> EP w m a) -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnnKey -> EP w m a
next
go (GetSrcSpanForKw SrcSpan
_ AnnKeywordId
_ SrcSpan -> EP w m a
next) = SrcSpan -> RWST (PrintOptions m w) (EPWriter w) EPState m SrcSpan
forall (m :: * -> *) a. Monad m => a -> m a
return SrcSpan
GHC.noSrcSpan RWST (PrintOptions m w) (EPWriter w) EPState m SrcSpan
-> (SrcSpan -> EP w m a) -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SrcSpan -> EP w m a
next
#if __GLASGOW_HASKELL__ <= 710
go (StoreString _ _ next) =
printStoredString >> next
#endif
go (AnnotationsToComments [AnnKeywordId]
_ EP w m a
next) = EP w m a
next
#if __GLASGOW_HASKELL__ <= 710
go (AnnotationsToCommentsBF _ _ next) = next
go (FinalizeBF _ next) = next
#endif
go (WithSortKey [(SrcSpan, Annotated ())]
ks EP w m a
next) = [(SrcSpan, Annotated ())] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[(SrcSpan, Annotated ())] -> EP w m ()
withSortKey [(SrcSpan, Annotated ())]
ks EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (WithSortKeyContexts ListContexts
ctx [(SrcSpan, Annotated ())]
ks EP w m a
next) = ListContexts -> [(SrcSpan, Annotated ())] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ListContexts -> [(SrcSpan, Annotated ())] -> EP w m ()
withSortKeyContexts ListContexts
ctx [(SrcSpan, Annotated ())]
ks EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (SetContextLevel Set AstContext
ctxt Int
lvl Annotated ()
action EP w m a
next) = Set AstContext -> Int -> EP w m () -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Set AstContext -> Int -> EP w m () -> EP w m ()
setContextPrint Set AstContext
ctxt Int
lvl (Annotated () -> EP w m ()
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret Annotated ()
action) EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (UnsetContext AstContext
_ctxt Annotated ()
action EP w m a
next) = Annotated () -> EP w m ()
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret Annotated ()
action EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (IfInContext Set AstContext
ctxt Annotated ()
ifAction Annotated ()
elseAction EP w m a
next) = Set AstContext -> Annotated () -> Annotated () -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Set AstContext -> Annotated () -> Annotated () -> EP w m ()
ifInContextPrint Set AstContext
ctxt Annotated ()
ifAction Annotated ()
elseAction EP w m () -> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m a
next
go (TellContext Set AstContext
_ EP w m a
next) = EP w m a
next
storeOriginalSrcSpanPrint :: (Monad m, Monoid w) => EP w m AnnKey
storeOriginalSrcSpanPrint :: EP w m AnnKey
storeOriginalSrcSpanPrint = do
Ann{[(KeywordId, DeltaPos)]
[(Comment, DeltaPos)]
Maybe [SrcSpan]
Maybe AnnKey
DeltaPos
annCapturedSpan :: Annotation -> Maybe AnnKey
annSortKey :: Annotation -> Maybe [SrcSpan]
annsDP :: Annotation -> [(KeywordId, DeltaPos)]
annFollowingComments :: Annotation -> [(Comment, DeltaPos)]
annPriorComments :: Annotation -> [(Comment, DeltaPos)]
annEntryDelta :: Annotation -> DeltaPos
annCapturedSpan :: Maybe AnnKey
annSortKey :: Maybe [SrcSpan]
annsDP :: [(KeywordId, DeltaPos)]
annFollowingComments :: [(Comment, DeltaPos)]
annPriorComments :: [(Comment, DeltaPos)]
annEntryDelta :: DeltaPos
..} <- (PrintOptions m w -> Annotation)
-> RWST (PrintOptions m w) (EPWriter w) EPState m Annotation
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrintOptions m w -> Annotation
forall (m :: * -> *) a. PrintOptions m a -> Annotation
epAnn
case Maybe AnnKey
annCapturedSpan of
Maybe AnnKey
Nothing -> String -> EP w m AnnKey
forall a. HasCallStack => String -> a
error String
"Missing captured SrcSpan"
Just AnnKey
v -> AnnKey -> EP w m AnnKey
forall (m :: * -> *) a. Monad m => a -> m a
return AnnKey
v
#if __GLASGOW_HASKELL__ <= 710
printStoredString :: (Monad m, Monoid w) => EP w m ()
printStoredString = do
kd <- gets epAnnKds
let
isAnnString (AnnString _,_) = True
isAnnString _ = False
case filter isAnnString (ghead "printStoredString" kd) of
((AnnString ss,_):_) -> printStringAtMaybeAnn (AnnString ss) (Just ss)
_ -> return ()
#endif
withSortKey :: (Monad m, Monoid w) => [(AnnSpan, Annotated ())] -> EP w m ()
withSortKey :: [(SrcSpan, Annotated ())] -> EP w m ()
withSortKey [(SrcSpan, Annotated ())]
xs = do
Ann{[(KeywordId, DeltaPos)]
[(Comment, DeltaPos)]
Maybe [SrcSpan]
Maybe AnnKey
DeltaPos
annCapturedSpan :: Maybe AnnKey
annSortKey :: Maybe [SrcSpan]
annsDP :: [(KeywordId, DeltaPos)]
annFollowingComments :: [(Comment, DeltaPos)]
annPriorComments :: [(Comment, DeltaPos)]
annEntryDelta :: DeltaPos
annCapturedSpan :: Annotation -> Maybe AnnKey
annSortKey :: Annotation -> Maybe [SrcSpan]
annsDP :: Annotation -> [(KeywordId, DeltaPos)]
annFollowingComments :: Annotation -> [(Comment, DeltaPos)]
annPriorComments :: Annotation -> [(Comment, DeltaPos)]
annEntryDelta :: Annotation -> DeltaPos
..} <- (PrintOptions m w -> Annotation)
-> RWST (PrintOptions m w) (EPWriter w) EPState m Annotation
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrintOptions m w -> Annotation
forall (m :: * -> *) a. PrintOptions m a -> Annotation
epAnn
let ordered :: [(SrcSpan, Annotated ())]
ordered = case Maybe [SrcSpan]
annSortKey of
Maybe [SrcSpan]
Nothing -> [(SrcSpan, Annotated ())]
xs
Just [SrcSpan]
keys -> [(SrcSpan, Annotated ())] -> [SrcSpan] -> [(SrcSpan, Annotated ())]
forall o a. Eq o => [(o, a)] -> [o] -> [(o, a)]
orderByKey [(SrcSpan, Annotated ())]
xs [SrcSpan]
keys
[(SrcSpan, Annotated ())] -> String -> [(SrcSpan, Annotated ())]
forall c. c -> String -> c
`debug` (String
"withSortKey:" String -> String -> String
forall a. [a] -> [a] -> [a]
++
([SrcSpan], [SrcSpan], [SrcSpan]) -> String
forall a. Outputable a => a -> String
showGhc (((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 ()) -> (SrcSpan, Annotated ()) -> Ordering)
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((SrcSpan, Annotated ()) -> Maybe Int)
-> (SrcSpan, Annotated ()) -> (SrcSpan, Annotated ()) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((SrcSpan -> [SrcSpan] -> Maybe Int)
-> [SrcSpan] -> SrcSpan -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip SrcSpan -> [SrcSpan] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [SrcSpan]
keys (SrcSpan -> Maybe Int)
-> ((SrcSpan, Annotated ()) -> SrcSpan)
-> (SrcSpan, Annotated ())
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan, Annotated ()) -> SrcSpan
forall a b. (a, b) -> a
fst)) [(SrcSpan, Annotated ())]
xs),
((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 ())]
xs,
[SrcSpan]
keys)
)
((SrcSpan, Annotated ()) -> EP w m ())
-> [(SrcSpan, Annotated ())] -> EP w m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Annotated () -> EP w m ()
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret (Annotated () -> EP w m ())
-> ((SrcSpan, Annotated ()) -> Annotated ())
-> (SrcSpan, Annotated ())
-> EP w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan, Annotated ()) -> Annotated ()
forall a b. (a, b) -> b
snd) [(SrcSpan, Annotated ())]
ordered
withSortKeyContexts :: (Monad m, Monoid w) => ListContexts -> [(AnnSpan, Annotated ())] -> EP w m ()
withSortKeyContexts :: ListContexts -> [(SrcSpan, Annotated ())] -> EP w m ()
withSortKeyContexts ListContexts
ctxts [(SrcSpan, Annotated ())]
xs = do
Ann{[(KeywordId, DeltaPos)]
[(Comment, DeltaPos)]
Maybe [SrcSpan]
Maybe AnnKey
DeltaPos
annCapturedSpan :: Maybe AnnKey
annSortKey :: Maybe [SrcSpan]
annsDP :: [(KeywordId, DeltaPos)]
annFollowingComments :: [(Comment, DeltaPos)]
annPriorComments :: [(Comment, DeltaPos)]
annEntryDelta :: DeltaPos
annCapturedSpan :: Annotation -> Maybe AnnKey
annSortKey :: Annotation -> Maybe [SrcSpan]
annsDP :: Annotation -> [(KeywordId, DeltaPos)]
annFollowingComments :: Annotation -> [(Comment, DeltaPos)]
annPriorComments :: Annotation -> [(Comment, DeltaPos)]
annEntryDelta :: Annotation -> DeltaPos
..} <- (PrintOptions m w -> Annotation)
-> RWST (PrintOptions m w) (EPWriter w) EPState m Annotation
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrintOptions m w -> Annotation
forall (m :: * -> *) a. PrintOptions m a -> Annotation
epAnn
let ordered :: [(SrcSpan, Annotated ())]
ordered = case Maybe [SrcSpan]
annSortKey of
Maybe [SrcSpan]
Nothing -> [(SrcSpan, Annotated ())]
xs
Just [SrcSpan]
keys -> [(SrcSpan, Annotated ())] -> [SrcSpan] -> [(SrcSpan, Annotated ())]
forall o a. Eq o => [(o, a)] -> [o] -> [(o, a)]
orderByKey [(SrcSpan, Annotated ())]
xs [SrcSpan]
keys
[(SrcSpan, Annotated ())] -> String -> [(SrcSpan, Annotated ())]
forall c. c -> String -> c
`debug` (String
"withSortKey:" String -> String -> String
forall a. [a] -> [a] -> [a]
++
([SrcSpan], [SrcSpan], [SrcSpan]) -> String
forall a. Outputable a => a -> String
showGhc (((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 ()) -> (SrcSpan, Annotated ()) -> Ordering)
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((SrcSpan, Annotated ()) -> Maybe Int)
-> (SrcSpan, Annotated ()) -> (SrcSpan, Annotated ()) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((SrcSpan -> [SrcSpan] -> Maybe Int)
-> [SrcSpan] -> SrcSpan -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip SrcSpan -> [SrcSpan] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [SrcSpan]
keys (SrcSpan -> Maybe Int)
-> ((SrcSpan, Annotated ()) -> SrcSpan)
-> (SrcSpan, Annotated ())
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan, Annotated ()) -> SrcSpan
forall a b. (a, b) -> a
fst)) [(SrcSpan, Annotated ())]
xs),
((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 ())]
xs,
[SrcSpan]
keys)
)
(Annotated () -> EP w m ())
-> ListContexts -> [(SrcSpan, Annotated ())] -> EP w m ()
forall (m :: * -> *).
Monad m =>
(Annotated () -> m ())
-> ListContexts -> [(SrcSpan, Annotated ())] -> m ()
withSortKeyContextsHelper Annotated () -> EP w m ()
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret ListContexts
ctxts [(SrcSpan, Annotated ())]
ordered
setContextPrint :: (Monad m, Monoid w) => Set.Set AstContext -> Int -> EP w m () -> EP w m ()
setContextPrint :: Set AstContext -> Int -> EP w m () -> EP w m ()
setContextPrint Set AstContext
ctxt Int
lvl =
(PrintOptions m w -> PrintOptions m w) -> EP w m () -> EP w m ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\PrintOptions m w
s -> PrintOptions m w
s { epContext :: AstContextSet
epContext = Set AstContext -> Int -> AstContextSet -> AstContextSet
forall a. Ord a => Set a -> Int -> ACS' a -> ACS' a
setAcsWithLevel Set AstContext
ctxt Int
lvl (PrintOptions m w -> AstContextSet
forall (m :: * -> *) a. PrintOptions m a -> AstContextSet
epContext PrintOptions m w
s) } )
ifInContextPrint :: (Monad m, Monoid w) => Set.Set AstContext -> Annotated () -> Annotated () -> EP w m ()
ifInContextPrint :: Set AstContext -> Annotated () -> Annotated () -> EP w m ()
ifInContextPrint Set AstContext
ctxt Annotated ()
ifAction Annotated ()
elseAction = do
AstContextSet
cur <- (PrintOptions m w -> AstContextSet)
-> RWST (PrintOptions m w) (EPWriter w) EPState m AstContextSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrintOptions m w -> AstContextSet
forall (m :: * -> *) a. PrintOptions m a -> AstContextSet
epContext
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 () -> EP w m ()
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret Annotated ()
ifAction
else Annotated () -> EP w m ()
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Annotated a -> EP w m a
printInterpret Annotated ()
elseAction
allAnns :: (Monad m, Monoid w) => GHC.AnnKeywordId -> EP w m ()
allAnns :: AnnKeywordId -> EP w m ()
allAnns AnnKeywordId
kwid = KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnnAll (AnnKeywordId -> KeywordId
G AnnKeywordId
kwid) Maybe String
forall a. Maybe a
Nothing
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
exactPC :: (Data ast, Data (GHC.SrcSpanLess ast), GHC.HasSrcSpan ast, Monad m, Monoid w)
=> ast -> EP w m a -> EP w m a
#else
exactPC :: (Data ast, Monad m, Monoid w) => GHC.Located ast -> EP w m a -> EP w m a
#endif
exactPC :: ast -> EP w m a -> EP w m a
exactPC ast
ast EP w m a
action =
do
() -> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () RWST (PrintOptions m w) (EPWriter w) EPState m ()
-> String -> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall c. c -> String -> c
`debug` (String
"exactPC entered for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnnKey -> String
forall a. Show a => a -> String
show (ast -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey ast
ast))
Maybe Annotation
ma <- ast -> EP w m (Maybe Annotation)
forall (m :: * -> *) w a.
(Monad m, Monoid w, Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> EP w m (Maybe Annotation)
getAndRemoveAnnotation ast
ast
let an :: Annotation
an@Ann{ annEntryDelta :: Annotation -> DeltaPos
annEntryDelta=DeltaPos
edp
, annPriorComments :: Annotation -> [(Comment, DeltaPos)]
annPriorComments=[(Comment, DeltaPos)]
comments
, annFollowingComments :: Annotation -> [(Comment, DeltaPos)]
annFollowingComments=[(Comment, DeltaPos)]
fcomments
, annsDP :: Annotation -> [(KeywordId, DeltaPos)]
annsDP=[(KeywordId, DeltaPos)]
kds
} = Annotation -> Maybe Annotation -> Annotation
forall a. a -> Maybe a -> a
fromMaybe Annotation
annNone Maybe Annotation
ma
PrintOptions{forall ast. (Data ast, HasSrcSpan ast) => ast -> w -> m w
epAstPrint :: forall ast. (Data ast, HasSrcSpan ast) => ast -> w -> m w
epAstPrint :: forall (m :: * -> *) a.
PrintOptions m a
-> forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a
epAstPrint} <- RWST (PrintOptions m w) (EPWriter w) EPState m (PrintOptions m w)
forall r (m :: * -> *). MonadReader r m => m r
ask
a
r <- [(KeywordId, DeltaPos)] -> Annotation -> EP w m a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
[(KeywordId, DeltaPos)] -> Annotation -> EP w m a -> EP w m a
withContext [(KeywordId, DeltaPos)]
kds Annotation
an
(((Comment, DeltaPos)
-> RWST (PrintOptions m w) (EPWriter w) EPState m ())
-> [(Comment, DeltaPos)]
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Comment
-> DeltaPos -> RWST (PrintOptions m w) (EPWriter w) EPState m ())
-> (Comment, DeltaPos)
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Comment
-> DeltaPos -> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Comment -> DeltaPos -> EP w m ()
printQueuedComment) [(Comment, DeltaPos)]
comments
RWST (PrintOptions m w) (EPWriter w) EPState m ()
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DeltaPos -> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> EP w m ()
advance DeltaPos
edp
RWST (PrintOptions m w) (EPWriter w) EPState m ()
-> EP w m a -> EP w m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (w -> m w) -> EP w m a -> EP w m a
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(w -> m w) -> EP w m a -> EP w m a
censorM (ast -> w -> m w
forall ast. (Data ast, HasSrcSpan ast) => ast -> w -> m w
epAstPrint ast
ast) EP w m a
action
EP w m a
-> RWST (PrintOptions m w) (EPWriter w) EPState m () -> EP w m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Comment, DeltaPos)
-> RWST (PrintOptions m w) (EPWriter w) EPState m ())
-> [(Comment, DeltaPos)]
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Comment
-> DeltaPos -> RWST (PrintOptions m w) (EPWriter w) EPState m ())
-> (Comment, DeltaPos)
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Comment
-> DeltaPos -> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Comment -> DeltaPos -> EP w m ()
printQueuedComment) [(Comment, DeltaPos)]
fcomments)
a -> EP w m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r EP w m a -> String -> EP w m a
forall c. c -> String -> c
`debug` (String
"leaving exactPCfor:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnnKey -> String
forall a. Show a => a -> String
show (ast -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey ast
ast))
censorM :: (Monoid w, Monad m) => (w -> m w) -> EP w m a -> EP w m a
censorM :: (w -> m w) -> EP w m a -> EP w m a
censorM w -> m w
f EP w m a
m = EP w m (a, w -> m w) -> EP w m a
forall (m :: * -> *) w a.
Monad m =>
EP w m (a, w -> m w) -> EP w m a
passM ((a -> (a, w -> m w)) -> EP w m a -> EP w m (a, w -> m w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
x -> (a
x,w -> m w
f)) EP w m a
m)
passM :: (Monad m) => EP w m (a, w -> m w) -> EP w m a
passM :: EP w m (a, w -> m w) -> EP w m a
passM EP w m (a, w -> m w)
m = (PrintOptions m w -> EPState -> m (a, EPState, EPWriter w))
-> EP w m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((PrintOptions m w -> EPState -> m (a, EPState, EPWriter w))
-> EP w m a)
-> (PrintOptions m w -> EPState -> m (a, EPState, EPWriter w))
-> EP w m a
forall a b. (a -> b) -> a -> b
$ \PrintOptions m w
r EPState
s -> do
~((a
a, w -> m w
f),EPState
s', EPWriter w
w) <- EP w m (a, w -> m w)
-> PrintOptions m w
-> EPState
-> m ((a, w -> m w), EPState, EPWriter w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST EP w m (a, w -> m w)
m PrintOptions m w
r EPState
s
w
w' <- w -> m w
f w
w
(a, EPState, EPWriter w) -> m (a, EPState, EPWriter w)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, EPState
s', w -> EPWriter w
forall a. a -> EPWriter a
EPWriter w
w')
advance :: (Monad m, Monoid w) => DeltaPos -> EP w m ()
advance :: DeltaPos -> EP w m ()
advance DeltaPos
cl = do
Pos
p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPos
LayoutStartCol
colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffset
Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
cl LayoutStartCol
colOffset)
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
getAndRemoveAnnotation :: (Monad m, Monoid w, Data a, Data (GHC.SrcSpanLess a), GHC.HasSrcSpan a)
=> a -> EP w m (Maybe Annotation)
#else
getAndRemoveAnnotation :: (Monad m, Monoid w, Data a) => GHC.Located a -> EP w m (Maybe Annotation)
#endif
getAndRemoveAnnotation :: a -> EP w m (Maybe Annotation)
getAndRemoveAnnotation a
a = (EPState -> Maybe Annotation) -> EP w m (Maybe Annotation)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (a -> Anns -> Maybe Annotation
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Anns -> Maybe Annotation
getAnnotationEP a
a (Anns -> Maybe Annotation)
-> (EPState -> Anns) -> EPState -> Maybe Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPState -> Anns
epAnns)
markPrim :: (Monad m, Monoid w) => KeywordId -> Maybe String -> EP w m ()
markPrim :: KeywordId -> Maybe String -> EP w m ()
markPrim KeywordId
kwid Maybe String
mstr =
KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnn KeywordId
kwid Maybe String
mstr
withContext :: (Monad m, Monoid w)
=> [(KeywordId, DeltaPos)]
-> Annotation
-> EP w m a -> EP w m a
withContext :: [(KeywordId, DeltaPos)] -> Annotation -> EP w m a -> EP w m a
withContext [(KeywordId, DeltaPos)]
kds Annotation
an EP w m a
x = [(KeywordId, DeltaPos)] -> EP w m a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
[(KeywordId, DeltaPos)] -> EP w m a -> EP w m a
withKds [(KeywordId, DeltaPos)]
kds (Annotation -> EP w m a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
Annotation -> EP w m a -> EP w m a
withOffset Annotation
an EP w m a
x)
withOffset :: (Monad m, Monoid w) => Annotation -> (EP w m a -> EP w m a)
withOffset :: Annotation -> EP w m a -> EP w m a
withOffset Annotation
a =
(PrintOptions m w -> PrintOptions m w) -> EP w m a -> EP w m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\PrintOptions m w
s -> PrintOptions m w
s { epAnn :: Annotation
epAnn = Annotation
a, epContext :: AstContextSet
epContext = AstContextSet -> AstContextSet
forall a. ACS' a -> ACS' a
pushAcs (PrintOptions m w -> AstContextSet
forall (m :: * -> *) a. PrintOptions m a -> AstContextSet
epContext PrintOptions m w
s) })
withKds :: (Monad m, Monoid w) => [(KeywordId, DeltaPos)] -> EP w m a -> EP w m a
withKds :: [(KeywordId, DeltaPos)] -> EP w m a -> EP w m a
withKds [(KeywordId, DeltaPos)]
kd EP w m a
action = do
(EPState -> EPState)
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epAnnKds :: [[(KeywordId, DeltaPos)]]
epAnnKds = [(KeywordId, DeltaPos)]
kd [(KeywordId, DeltaPos)]
-> [[(KeywordId, DeltaPos)]] -> [[(KeywordId, DeltaPos)]]
forall a. a -> [a] -> [a]
: EPState -> [[(KeywordId, DeltaPos)]]
epAnnKds EPState
s })
a
r <- EP w m a
action
(EPState -> EPState)
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epAnnKds :: [[(KeywordId, DeltaPos)]]
epAnnKds = [[(KeywordId, DeltaPos)]] -> [[(KeywordId, DeltaPos)]]
forall a. [a] -> [a]
tail (EPState -> [[(KeywordId, DeltaPos)]]
epAnnKds EPState
s) })
a -> EP w m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
setLayout :: (Monad m, Monoid w) => EP w m () -> EP w m ()
setLayout :: EP w m () -> EP w m ()
setLayout EP w m ()
k = do
LayoutStartCol
oldLHS <- (EPState -> LayoutStartCol)
-> RWST (PrintOptions m w) (EPWriter w) EPState m LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> LayoutStartCol
epLHS
(EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
a -> EPState
a { epMarkLayout :: Bool
epMarkLayout = Bool
True } )
let reset :: EP w m ()
reset = (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
a -> EPState
a { epMarkLayout :: Bool
epMarkLayout = Bool
False
, epLHS :: LayoutStartCol
epLHS = LayoutStartCol
oldLHS } )
EP w m ()
k EP w m () -> EP w m () -> EP w m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* EP w m ()
reset
getPos :: (Monad m, Monoid w) => EP w m Pos
getPos :: EP w m Pos
getPos = (EPState -> Pos) -> EP w m Pos
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> Pos
epPos
setPos :: (Monad m, Monoid w) => Pos -> EP w m ()
setPos :: Pos -> EP w m ()
setPos Pos
l = (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s {epPos :: Pos
epPos = Pos
l})
getLayoutOffset :: (Monad m, Monoid w) => EP w m LayoutStartCol
getLayoutOffset :: EP w m LayoutStartCol
getLayoutOffset = (EPState -> LayoutStartCol) -> EP w m LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> LayoutStartCol
epLHS
printMarkAnnBeforeAnn :: (Monad m, Monoid w) => KeywordId -> KeywordId -> EP w m ()
printMarkAnnBeforeAnn :: KeywordId -> KeywordId -> EP w m ()
printMarkAnnBeforeAnn KeywordId
annBefore KeywordId
annAfter = do
[[(KeywordId, DeltaPos)]]
kd <- (EPState -> [[(KeywordId, DeltaPos)]])
-> RWST
(PrintOptions m w) (EPWriter w) EPState m [[(KeywordId, DeltaPos)]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> [[(KeywordId, DeltaPos)]]
epAnnKds
case [[(KeywordId, DeltaPos)]]
kd of
[] -> () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
([(KeywordId, DeltaPos)]
k:[[(KeywordId, DeltaPos)]]
_kds) -> do
let find :: a -> (a, b) -> Bool
find a
a = (\(a
kw,b
_) -> a
kw a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a)
case ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)]
-> ([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (KeywordId -> (KeywordId, DeltaPos) -> Bool
forall a b. Eq a => a -> (a, b) -> Bool
find KeywordId
annBefore) [(KeywordId, DeltaPos)]
k of
([(KeywordId, DeltaPos)]
_,[]) -> () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
([(KeywordId, DeltaPos)]
_,[(KeywordId, DeltaPos)]
rest) -> if [(KeywordId, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
-> [(KeywordId, DeltaPos)]
forall a b. (a, b) -> b
snd (([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
-> [(KeywordId, DeltaPos)])
-> ([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
-> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> a -> b
$ ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)]
-> ([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (KeywordId -> (KeywordId, DeltaPos) -> Bool
forall a b. Eq a => a -> (a, b) -> Bool
find KeywordId
annAfter) [(KeywordId, DeltaPos)]
rest)
then () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else KeywordId -> Maybe String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m ()
markPrim KeywordId
annBefore (Maybe String
forall a. Maybe a
Nothing)
printStringAtMaybeAnn :: (Monad m, Monoid w) => KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnn :: KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnn KeywordId
an Maybe String
mstr = KeywordId -> Maybe String -> EP w m () -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m () -> EP w m ()
printStringAtMaybeAnnThen KeywordId
an Maybe String
mstr (() -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
printStringAtMaybeAnnAll :: (Monad m, Monoid w) => KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnnAll :: KeywordId -> Maybe String -> EP w m ()
printStringAtMaybeAnnAll KeywordId
an Maybe String
mstr = EP w m ()
go
where
go :: EP w m ()
go = KeywordId -> Maybe String -> EP w m () -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> Maybe String -> EP w m () -> EP w m ()
printStringAtMaybeAnnThen KeywordId
an Maybe String
mstr EP w m ()
go
printStringAtMaybeAnnThen :: (Monad m, Monoid w) => KeywordId -> Maybe String -> EP w m () -> EP w m ()
printStringAtMaybeAnnThen :: KeywordId -> Maybe String -> EP w m () -> EP w m ()
printStringAtMaybeAnnThen KeywordId
an Maybe String
mstr EP w m ()
next = do
let str :: String
str = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (KeywordId -> String
keywordToString KeywordId
an) Maybe String
mstr
Maybe ([(Comment, DeltaPos)], DeltaPos)
annFinal <- KeywordId -> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
getAnnFinal KeywordId
an
case (Maybe ([(Comment, DeltaPos)], DeltaPos)
annFinal, KeywordId
an) of
#if __GLASGOW_HASKELL__ <= 710
(Nothing, G kw) -> do
res <- getAnnFinal (AnnUnicode kw)
return () `debug` ("printStringAtMaybeAnn:missed:Unicode:(an,res)" ++ show (an,res))
unless (null res) $ do
forM_
res
(\(comments, ma) -> printStringAtLsDelta comments ma (unicodeString (G kw)))
next
#else
(Maybe ([(Comment, DeltaPos)], DeltaPos)
Nothing, G AnnKeywordId
kw') -> do
let kw :: AnnKeywordId
kw = AnnKeywordId -> AnnKeywordId
GHC.unicodeAnn AnnKeywordId
kw'
let str' :: String
str' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (KeywordId -> String
keywordToString (AnnKeywordId -> KeywordId
G AnnKeywordId
kw)) Maybe String
mstr
Maybe ([(Comment, DeltaPos)], DeltaPos)
res <- KeywordId -> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
getAnnFinal (AnnKeywordId -> KeywordId
G AnnKeywordId
kw)
() -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () EP w m () -> String -> EP w m ()
forall c. c -> String -> c
`debug` (String
"printStringAtMaybeAnn:missed:Unicode:(an,res)" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (KeywordId, Maybe ([(Comment, DeltaPos)], DeltaPos)) -> String
forall a. Show a => a -> String
show (KeywordId
an,Maybe ([(Comment, DeltaPos)], DeltaPos)
res))
Bool -> EP w m () -> EP w m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe ([(Comment, DeltaPos)], DeltaPos) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe ([(Comment, DeltaPos)], DeltaPos)
res) (EP w m () -> EP w m ()) -> EP w m () -> EP w m ()
forall a b. (a -> b) -> a -> b
$ do
Maybe ([(Comment, DeltaPos)], DeltaPos)
-> (([(Comment, DeltaPos)], DeltaPos) -> EP w m ()) -> EP w m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
Maybe ([(Comment, DeltaPos)], DeltaPos)
res
(\([(Comment, DeltaPos)]
comments, DeltaPos
ma) -> [(Comment, DeltaPos)] -> DeltaPos -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[(Comment, DeltaPos)] -> DeltaPos -> String -> EP w m ()
printStringAtLsDelta [(Comment, DeltaPos)]
comments DeltaPos
ma String
str')
EP w m ()
next
#endif
(Just ([(Comment, DeltaPos)]
comments, DeltaPos
ma),KeywordId
_) -> [(Comment, DeltaPos)] -> DeltaPos -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[(Comment, DeltaPos)] -> DeltaPos -> String -> EP w m ()
printStringAtLsDelta [(Comment, DeltaPos)]
comments DeltaPos
ma String
str EP w m () -> EP w m () -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m ()
next
(Maybe ([(Comment, DeltaPos)], DeltaPos)
Nothing, KeywordId
_) -> () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () EP w m () -> String -> EP w m ()
forall c. c -> String -> c
`debug` (String
"printStringAtMaybeAnn:missed:(an)" String -> String -> String
forall a. [a] -> [a] -> [a]
++ KeywordId -> String
forall a. Show a => a -> String
show KeywordId
an)
getAnnFinal :: (Monad m, Monoid w) => KeywordId -> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
getAnnFinal :: KeywordId -> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
getAnnFinal KeywordId
kw = do
[[(KeywordId, DeltaPos)]]
kd <- (EPState -> [[(KeywordId, DeltaPos)]])
-> RWST
(PrintOptions m w) (EPWriter w) EPState m [[(KeywordId, DeltaPos)]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> [[(KeywordId, DeltaPos)]]
epAnnKds
case [[(KeywordId, DeltaPos)]]
kd of
[] -> Maybe ([(Comment, DeltaPos)], DeltaPos)
-> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([(Comment, DeltaPos)], DeltaPos)
forall a. Maybe a
Nothing
([(KeywordId, DeltaPos)]
k:[[(KeywordId, DeltaPos)]]
kds) -> do
let (Maybe ([(Comment, DeltaPos)], DeltaPos)
res, [(KeywordId, DeltaPos)]
kd') = KeywordId
-> ([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
-> (Maybe ([(Comment, DeltaPos)], DeltaPos),
[(KeywordId, DeltaPos)])
forall v.
KeywordId
-> ([(KeywordId, v)], [(KeywordId, v)])
-> (Maybe ([(Comment, v)], v), [(KeywordId, v)])
destructiveGetFirst KeywordId
kw ([],[(KeywordId, DeltaPos)]
k)
(EPState -> EPState)
-> RWST (PrintOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epAnnKds :: [[(KeywordId, DeltaPos)]]
epAnnKds = [(KeywordId, DeltaPos)]
kd' [(KeywordId, DeltaPos)]
-> [[(KeywordId, DeltaPos)]] -> [[(KeywordId, DeltaPos)]]
forall a. a -> [a] -> [a]
: [[(KeywordId, DeltaPos)]]
kds })
Maybe ([(Comment, DeltaPos)], DeltaPos)
-> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([(Comment, DeltaPos)], DeltaPos)
res
destructiveGetFirst :: KeywordId
-> ([(KeywordId, v)],[(KeywordId,v)])
-> (Maybe ([(Comment, v)], v),[(KeywordId,v)])
destructiveGetFirst :: KeywordId
-> ([(KeywordId, v)], [(KeywordId, v)])
-> (Maybe ([(Comment, v)], v), [(KeywordId, v)])
destructiveGetFirst KeywordId
_key ([(KeywordId, v)]
acc,[]) = (Maybe ([(Comment, v)], v)
forall a. Maybe a
Nothing, [(KeywordId, v)]
acc)
destructiveGetFirst KeywordId
key ([(KeywordId, v)]
acc, (KeywordId
k,v
v):[(KeywordId, v)]
kvs )
| KeywordId
k KeywordId -> KeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== KeywordId
key = (([(Comment, v)], v) -> Maybe ([(Comment, v)], v)
forall a. a -> Maybe a
Just ([(Comment, v)]
skippedComments, v
v), [(KeywordId, v)]
others [(KeywordId, v)] -> [(KeywordId, v)] -> [(KeywordId, v)]
forall a. [a] -> [a] -> [a]
++ [(KeywordId, v)]
kvs)
| Bool
otherwise = KeywordId
-> ([(KeywordId, v)], [(KeywordId, v)])
-> (Maybe ([(Comment, v)], v), [(KeywordId, v)])
forall v.
KeywordId
-> ([(KeywordId, v)], [(KeywordId, v)])
-> (Maybe ([(Comment, v)], v), [(KeywordId, v)])
destructiveGetFirst KeywordId
key ([(KeywordId, v)]
acc [(KeywordId, v)] -> [(KeywordId, v)] -> [(KeywordId, v)]
forall a. [a] -> [a] -> [a]
++ [(KeywordId
k,v
v)], [(KeywordId, v)]
kvs)
where
([(Comment, v)]
skippedComments, [(KeywordId, v)]
others) = ((KeywordId, v)
-> ([(Comment, v)], [(KeywordId, v)])
-> ([(Comment, v)], [(KeywordId, v)]))
-> ([(Comment, v)], [(KeywordId, v)])
-> [(KeywordId, v)]
-> ([(Comment, v)], [(KeywordId, v)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (KeywordId, v)
-> ([(Comment, v)], [(KeywordId, v)])
-> ([(Comment, v)], [(KeywordId, v)])
forall b.
(KeywordId, b)
-> ([(Comment, b)], [(KeywordId, b)])
-> ([(Comment, b)], [(KeywordId, b)])
comments ([], []) [(KeywordId, v)]
acc
comments :: (KeywordId, b)
-> ([(Comment, b)], [(KeywordId, b)])
-> ([(Comment, b)], [(KeywordId, b)])
comments (AnnComment Comment
comment , b
dp ) ([(Comment, b)]
cs, [(KeywordId, b)]
kws) = ((Comment
comment, b
dp) (Comment, b) -> [(Comment, b)] -> [(Comment, b)]
forall a. a -> [a] -> [a]
: [(Comment, b)]
cs, [(KeywordId, b)]
kws)
comments (KeywordId, b)
kw ([(Comment, b)]
cs, [(KeywordId, b)]
kws) = ([(Comment, b)]
cs, (KeywordId, b)
kw (KeywordId, b) -> [(KeywordId, b)] -> [(KeywordId, b)]
forall a. a -> [a] -> [a]
: [(KeywordId, b)]
kws)
printStringAtLsDelta :: (Monad m, Monoid w) => [(Comment, DeltaPos)] -> DeltaPos -> String -> EP w m ()
printStringAtLsDelta :: [(Comment, DeltaPos)] -> DeltaPos -> String -> EP w m ()
printStringAtLsDelta [(Comment, DeltaPos)]
cs DeltaPos
cl String
s = do
Pos
p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPos
LayoutStartCol
colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffset
if DeltaPos -> LayoutStartCol -> Bool
isGoodDeltaWithOffset DeltaPos
cl LayoutStartCol
colOffset
then do
((Comment, DeltaPos) -> EP w m ())
-> [(Comment, DeltaPos)] -> EP w m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Comment -> DeltaPos -> EP w m ())
-> (Comment, DeltaPos) -> EP w m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Comment -> DeltaPos -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Comment -> DeltaPos -> EP w m ()
printQueuedComment) [(Comment, DeltaPos)]
cs
Pos -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Pos -> String -> EP w m ()
printStringAt (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
cl LayoutStartCol
colOffset) String
s
EP w m () -> String -> EP w m ()
forall c. c -> String -> c
`debug` (String
"printStringAtLsDelta:(pos,s):" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Pos, String) -> String
forall a. Show a => a -> String
show (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
cl LayoutStartCol
colOffset,String
s))
else () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () EP w m () -> String -> EP w m ()
forall c. c -> String -> c
`debug` (String
"printStringAtLsDelta:bad delta for (mc,s):" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (DeltaPos, String) -> String
forall a. Show a => a -> String
show (DeltaPos
cl,String
s))
isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool
isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool
isGoodDeltaWithOffset DeltaPos
dp LayoutStartCol
colOffset = DeltaPos -> Bool
isGoodDelta (Pos -> DeltaPos
DP (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta (Int
0,Int
0) DeltaPos
dp LayoutStartCol
colOffset))
printQueuedComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()
Comment{String
commentContents :: Comment -> String
commentContents :: String
commentContents} DeltaPos
dp = do
Pos
p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPos
LayoutStartCol
colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffset
let (Int
dr,Int
dc) = Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta (Int
0,Int
0) DeltaPos
dp LayoutStartCol
colOffset
Bool -> EP w m () -> EP w m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DeltaPos -> Bool
isGoodDelta (Pos -> DeltaPos
DP (Int
dr,Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
dc))) (EP w m () -> EP w m ()) -> EP w m () -> EP w m ()
forall a b. (a -> b) -> a -> b
$
Pos -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Pos -> String -> EP w m ()
printCommentAt (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
dp LayoutStartCol
colOffset) String
commentContents
peekAnnFinal :: (Monad m, Monoid w) => KeywordId -> EP w m (Maybe DeltaPos)
peekAnnFinal :: KeywordId -> EP w m (Maybe DeltaPos)
peekAnnFinal KeywordId
kw = do
(Maybe ([(Comment, DeltaPos)], DeltaPos)
r, [(KeywordId, DeltaPos)]
_) <- (\[(KeywordId, DeltaPos)]
kd -> KeywordId
-> ([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
-> (Maybe ([(Comment, DeltaPos)], DeltaPos),
[(KeywordId, DeltaPos)])
forall v.
KeywordId
-> ([(KeywordId, v)], [(KeywordId, v)])
-> (Maybe ([(Comment, v)], v), [(KeywordId, v)])
destructiveGetFirst KeywordId
kw ([], [(KeywordId, DeltaPos)]
kd)) ([(KeywordId, DeltaPos)]
-> (Maybe ([(Comment, DeltaPos)], DeltaPos),
[(KeywordId, DeltaPos)]))
-> RWST
(PrintOptions m w) (EPWriter w) EPState m [(KeywordId, DeltaPos)]
-> RWST
(PrintOptions m w)
(EPWriter w)
EPState
m
(Maybe ([(Comment, DeltaPos)], DeltaPos), [(KeywordId, DeltaPos)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EPState -> [(KeywordId, DeltaPos)])
-> RWST
(PrintOptions m w) (EPWriter w) EPState m [(KeywordId, DeltaPos)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (String -> [[(KeywordId, DeltaPos)]] -> [(KeywordId, DeltaPos)]
forall a. String -> [a] -> a
ghead String
"peekAnnFinal" ([[(KeywordId, DeltaPos)]] -> [(KeywordId, DeltaPos)])
-> (EPState -> [[(KeywordId, DeltaPos)]])
-> EPState
-> [(KeywordId, DeltaPos)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPState -> [[(KeywordId, DeltaPos)]]
epAnnKds)
Maybe DeltaPos -> EP w m (Maybe DeltaPos)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Comment, DeltaPos)], DeltaPos) -> DeltaPos
forall a b. (a, b) -> b
snd (([(Comment, DeltaPos)], DeltaPos) -> DeltaPos)
-> Maybe ([(Comment, DeltaPos)], DeltaPos) -> Maybe DeltaPos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([(Comment, DeltaPos)], DeltaPos)
r)
countAnnsEP :: (Monad m, Monoid w) => KeywordId -> EP w m Int
countAnnsEP :: KeywordId -> EP w m Int
countAnnsEP KeywordId
an = Maybe DeltaPos -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe DeltaPos -> Int)
-> RWST (PrintOptions m w) (EPWriter w) EPState m (Maybe DeltaPos)
-> EP w m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeywordId
-> RWST (PrintOptions m w) (EPWriter w) EPState m (Maybe DeltaPos)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
KeywordId -> EP w m (Maybe DeltaPos)
peekAnnFinal KeywordId
an
printString :: (Monad m, Monoid w) => Bool -> String -> EP w m ()
printString :: Bool -> String -> EP w m ()
printString Bool
layout String
str = do
EPState{epPos :: EPState -> Pos
epPos = (Int
_,Int
c), Bool
epMarkLayout :: Bool
epMarkLayout :: EPState -> Bool
epMarkLayout} <- RWST (PrintOptions m w) (EPWriter w) EPState m EPState
forall s (m :: * -> *). MonadState s m => m s
get
PrintOptions{String -> m w
epTokenPrint :: String -> m w
epTokenPrint :: forall (m :: * -> *) a. PrintOptions m a -> String -> m a
epTokenPrint, String -> m w
epWhitespacePrint :: String -> m w
epWhitespacePrint :: forall (m :: * -> *) a. PrintOptions m a -> String -> m a
epWhitespacePrint} <- RWST (PrintOptions m w) (EPWriter w) EPState m (PrintOptions m w)
forall r (m :: * -> *). MonadReader r m => m r
ask
Bool -> EP w m () -> EP w m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
epMarkLayout Bool -> Bool -> Bool
&& Bool
layout) (EP w m () -> EP w m ()) -> EP w m () -> EP w m ()
forall a b. (a -> b) -> a -> b
$
(EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epLHS :: LayoutStartCol
epLHS = Int -> LayoutStartCol
LayoutStartCol Int
c, epMarkLayout :: Bool
epMarkLayout = Bool
False } )
let strDP :: DeltaPos
strDP@(DP (Int
cr,Int
_cc)) = String -> DeltaPos
dpFromString String
str
Pos
p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPos
LayoutStartCol
colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffset
if Int
cr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPos (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
strDP LayoutStartCol
colOffset)
else Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPos (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
strDP LayoutStartCol
1)
if Bool -> Bool
not Bool
layout Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then m w -> RWST (PrintOptions m w) (EPWriter w) EPState m w
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m w
epWhitespacePrint String
str) RWST (PrintOptions m w) (EPWriter w) EPState m w
-> (w -> EP w m ()) -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \w
s -> EPWriter w -> EP w m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell EPWriter :: forall a. a -> EPWriter a
EPWriter { output :: w
output = w
s}
else m w -> RWST (PrintOptions m w) (EPWriter w) EPState m w
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m w
epTokenPrint String
str) RWST (PrintOptions m w) (EPWriter w) EPState m w
-> (w -> EP w m ()) -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \w
s -> EPWriter w -> EP w m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell EPWriter :: forall a. a -> EPWriter a
EPWriter { output :: w
output = w
s}
newLine :: (Monad m, Monoid w) => EP w m ()
newLine :: EP w m ()
newLine = do
(Int
l,Int
_) <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPos
Bool -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
False String
"\n"
Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPos (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
1)
padUntil :: (Monad m, Monoid w) => Pos -> EP w m ()
padUntil :: Pos -> EP w m ()
padUntil (Int
l,Int
c) = do
(Int
l1,Int
c1) <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPos
if | Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c -> Bool -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
False (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c1) Char
' '
| Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m ()
newLine EP w m () -> EP w m () -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
padUntil (Int
l,Int
c)
| Bool
otherwise -> () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printWhitespace :: (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace :: Pos -> EP w m ()
printWhitespace = Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
padUntil
printCommentAt :: (Monad m, Monoid w) => Pos -> String -> EP w m ()
Pos
p String
str = Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace Pos
p EP w m () -> EP w m () -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
False String
str
printStringAt :: (Monad m, Monoid w) => Pos -> String -> EP w m ()
printStringAt :: Pos -> String -> EP w m ()
printStringAt Pos
p String
str = Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace Pos
p EP w m () -> EP w m () -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
True String
str