{-# 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 ast :: Located ast
ast as :: 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 r :: PrintOptions m b
r ast :: Located ast
ast as :: 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
, 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
(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 astPrint :: forall ast. (Data ast, HasSrcSpan ast) => ast -> a -> m a
astPrint tokenPrint :: String -> m a
tokenPrint wsPrint :: String -> m a
wsPrint rigidity :: Rigidity
rigidity = $WPrintOptions :: 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 (\_ b :: 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 a :: w
a) mappend :: EPWriter w -> EPWriter w -> EPWriter w
`mappend` (EPWriter b :: 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 epReader :: PrintOptions m a
epReader action :: Annotated ()
action ans :: 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
.
(\next :: 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 as :: Anns
as = $WEPState :: Pos
-> Anns
-> [[(KeywordId, DeltaPos)]]
-> Bool
-> LayoutStartCol
-> EPState
EPState
{ epPos :: Pos
epPos = (1,1)
, epAnns :: Anns
epAnns = Anns
as
, epAnnKds :: [[(KeywordId, DeltaPos)]]
epAnnKds = []
, epLHS :: LayoutStartCol
epLHS = 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 m :: 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 next :: 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
GHC.AnnEofPos) (String -> Maybe String
forall a. a -> Maybe a
Just "") 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 (MarkPrim kwid :: AnnKeywordId
kwid mstr :: Maybe String
mstr next :: 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 kwid :: AnnKeywordId
kwid mstr :: Maybe String
mstr next :: 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 _ kwid :: KeywordId
kwid next :: 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 _ kwid :: KeywordId
kwid next :: 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 akwid :: AnnKeywordId
akwid next :: 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 akwid :: AnnKeywordId
akwid next :: 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 akwid :: AnnKeywordId
akwid next :: 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 kwid :: AnnKeywordId
kwid _ mstr :: Maybe String
mstr next :: 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 kwid :: AnnKeywordId
kwid _ mstr :: Maybe String
mstr next :: 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 lss :: a
lss action :: Annotated b
action next :: 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 kwid :: AnnKeywordId
kwid next :: 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 r :: Rigidity
r action :: Annotated ()
action next :: 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 ann1 :: AnnKeywordId
ann1 ann2 :: AnnKeywordId
ann2 next :: 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 _ akwid :: AnnKeywordId
akwid s :: String
s next :: 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 _ _ next :: 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 _ _ next :: 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 _ next :: 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 ks :: [(SrcSpan, Annotated ())]
ks next :: 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 ctx :: ListContexts
ctx ks :: [(SrcSpan, Annotated ())]
ks next :: 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 ctxt :: Set AstContext
ctxt lvl :: Int
lvl action :: Annotated ()
action next :: 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 _ctxt :: AstContext
_ctxt action :: Annotated ()
action next :: 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 ctxt :: Set AstContext
ctxt ifAction :: Annotated ()
ifAction elseAction :: Annotated ()
elseAction next :: 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 _ next :: 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{..} <- (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
Nothing -> String -> EP w m AnnKey
forall a. HasCallStack => String -> a
error "Missing captured SrcSpan"
Just v :: 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) => [(GHC.SrcSpan, Annotated ())] -> EP w m ()
withSortKey :: [(SrcSpan, Annotated ())] -> EP w m ()
withSortKey xs :: [(SrcSpan, Annotated ())]
xs = do
Ann{..} <- (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
Nothing -> [(SrcSpan, Annotated ())]
xs
Just keys :: [SrcSpan]
keys -> [(SrcSpan, Annotated ())] -> [SrcSpan] -> [(SrcSpan, Annotated ())]
forall a. [(SrcSpan, a)] -> [SrcSpan] -> [(SrcSpan, a)]
orderByKey [(SrcSpan, Annotated ())]
xs [SrcSpan]
keys
[(SrcSpan, Annotated ())] -> String -> [(SrcSpan, Annotated ())]
forall c. c -> String -> c
`debug` ("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 -> [(GHC.SrcSpan, Annotated ())] -> EP w m ()
withSortKeyContexts :: ListContexts -> [(SrcSpan, Annotated ())] -> EP w m ()
withSortKeyContexts ctxts :: ListContexts
ctxts xs :: [(SrcSpan, Annotated ())]
xs = do
Ann{..} <- (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
Nothing -> [(SrcSpan, Annotated ())]
xs
Just keys :: [SrcSpan]
keys -> [(SrcSpan, Annotated ())] -> [SrcSpan] -> [(SrcSpan, Annotated ())]
forall a. [(SrcSpan, a)] -> [SrcSpan] -> [(SrcSpan, a)]
orderByKey [(SrcSpan, Annotated ())]
xs [SrcSpan]
keys
[(SrcSpan, Annotated ())] -> String -> [(SrcSpan, Annotated ())]
forall c. c -> String -> c
`debug` ("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 ctxt :: Set AstContext
ctxt lvl :: 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 (\s :: 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 ctxt :: Set AstContext
ctxt ifAction :: Annotated ()
ifAction elseAction :: 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 kwid :: 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
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
ast action :: 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` ("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` ("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 f :: w -> m w
f m :: 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 (\x :: 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 m :: 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
$ \r :: PrintOptions m w
r s :: EPState
s -> do
~((a :: a
a, f :: w -> m w
f),s' :: EPState
s', EPWriter w :: 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 cl :: 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
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
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 kwid :: KeywordId
kwid mstr :: 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 kds :: [(KeywordId, DeltaPos)]
kds an :: Annotation
an x :: 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 a :: 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 (\s :: 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 kd :: [(KeywordId, DeltaPos)]
kd action :: 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 (\s :: 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 (\s :: 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 k :: 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 (\a :: 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 (\a :: 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 l :: Pos
l = (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: 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 annBefore :: KeywordId
annBefore annAfter :: 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 ()
(k :: [(KeywordId, DeltaPos)]
k:_kds :: [[(KeywordId, DeltaPos)]]
_kds) -> do
let find :: a -> (a, b) -> Bool
find a :: a
a = (\(kw :: a
kw,_) -> 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
(_,[]) -> () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(_,rest :: [(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 an :: KeywordId
an mstr :: 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 an :: KeywordId
an mstr :: 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 an :: KeywordId
an mstr :: Maybe String
mstr next :: 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
(Nothing, G kw' :: 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` ("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
(\(comments :: [(Comment, DeltaPos)]
comments, ma :: 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 (comments :: [(Comment, DeltaPos)]
comments, ma :: 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 () -> EP w m () -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP w m ()
next
(Nothing, _) -> () -> 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` ("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 kw :: 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
(k :: [(KeywordId, DeltaPos)]
k:kds :: [[(KeywordId, DeltaPos)]]
kds) -> do
let (res :: Maybe ([(Comment, DeltaPos)], DeltaPos)
res, kd' :: [(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 (\s :: 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 _key :: KeywordId
_key (acc :: [(KeywordId, v)]
acc,[]) = (Maybe ([(Comment, v)], v)
forall a. Maybe a
Nothing, [(KeywordId, v)]
acc)
destructiveGetFirst key :: KeywordId
key (acc :: [(KeywordId, v)]
acc, (k :: KeywordId
k,v :: v
v):kvs :: [(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
(skippedComments :: [(Comment, v)]
skippedComments, others :: [(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
comment , dp :: b
dp ) (cs :: [(Comment, b)]
cs, kws :: [(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 kw :: (KeywordId, b)
kw (cs :: [(Comment, b)]
cs, kws :: [(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 cs :: [(Comment, DeltaPos)]
cs cl :: DeltaPos
cl s :: 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` ("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` ("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 dp :: DeltaPos
dp colOffset :: LayoutStartCol
colOffset = DeltaPos -> Bool
isGoodDelta (Pos -> DeltaPos
DP (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta (0,0) DeltaPos
dp LayoutStartCol
colOffset))
printQueuedComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()
Comment{String
commentContents :: Comment -> String
commentContents :: String
commentContents} dp :: 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 (dr :: Int
dr,dc :: Int
dc) = Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta (0,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 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 kw :: KeywordId
kw = do
(r :: Maybe ([(Comment, DeltaPos)], DeltaPos)
r, _) <- (\kd :: [(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 "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 an :: 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 layout :: Bool
layout str :: String
str = do
EPState{epPos :: EPState -> Pos
epPos = (_,c :: 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 (\s :: EPState
s -> EPState
s { epLHS :: LayoutStartCol
epLHS = Int -> LayoutStartCol
LayoutStartCol Int
c, epMarkLayout :: Bool
epMarkLayout = Bool
False } )
let strDP :: DeltaPos
strDP@(DP (cr :: Int
cr,_cc :: 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
== 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 1)
if Bool -> Bool
not Bool
layout Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
>>= \s :: w
s -> EPWriter w -> EP w m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell $WEPWriter :: 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
>>= \s :: w
s -> EPWriter w -> EP w m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell $WEPWriter :: 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
(l :: Int
l,_) <- 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 "\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
+1,1)
padUntil :: (Monad m, Monoid w) => Pos -> EP w m ()
padUntil :: Pos -> EP w m ()
padUntil (l :: Int
l,c :: Int
c) = do
(l1 :: Int
l1,c1 :: 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) ' '
| 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 ()
p :: Pos
p str :: 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 p :: Pos
p str :: 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