{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.GHC.ExactPrint.Print
--
-- This module inverts the process performed by "Delta". Given 'Anns' and
-- a corresponding AST we produce a source file based on this information.
--
-----------------------------------------------------------------------------
module Language.Haskell.GHC.ExactPrint.Print
        (
        exactPrint
        , exactPrintWithOptions

        -- * Configuration
        , 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" #-}
-- ---------------------------------------------------------------------
-- Printing of source elements

-- | Print an AST with a map of potential modified `Anns`. The usual way to
-- generate such a map is by using one of the parsers in
-- "Language.Haskell.GHC.ExactPrint.Parsers".
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)

-- | The additional option to specify the rigidity and printing
-- configuration.
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

------------------------------------------------------
-- The EP monad and basic combinators

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
            }

-- | Helper to create a 'PrintOptions'
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 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
             }

-- | Options which can be used to print as a normal String.
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 -- ^ Current output position
             , EPState -> Anns
epAnns   :: !Anns
             , EPState -> [[(KeywordId, DeltaPos)]]
epAnnKds :: ![[(KeywordId, DeltaPos)]] -- MP: Could this be moved to the local statE w mith suitable refactoring?
             , 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) =
      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
    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) => [(GHC.SrcSpan, 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 a. [(SrcSpan, a)] -> [SrcSpan] -> [(SrcSpan, 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 -> [(GHC.SrcSpan, 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 a. [(SrcSpan, a)] -> [SrcSpan] -> [(SrcSpan, 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)
                                         )
  -- mapM_ printInterpret ordered
  (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

-------------------------------------------------------------------------
-- |First move to the given location, then call exactP
-- exactPC :: (Data ast, Monad m, Monoid w) => GHC.Located ast -> EP w m a -> EP w m a
-- exactPC :: (Data ast, Data (GHC.SrcSpanLess ast), GHC.HasSrcSpan ast, Monad m, Monoid w)
#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 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
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)

-- ---------------------------------------------------------------------
--
-- | Given an annotation associated with a specific SrcSpan, determines a new offset relative to the previous
-- offset
--
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) })


-- ---------------------------------------------------------------------
--
-- Necessary as there are destructive gets of Kds across scopes
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})

-- |Get the current column offset
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

-- ---------------------------------------------------------------------

-- |If the first annotation has a smaller SrcSpan than the second, then mark it.
-- In the printer this means the first appearing before the second in the list
-- of annotations remaining
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 () -- Should never be triggered
    ([(KeywordId, DeltaPos)]
k:[[(KeywordId, DeltaPos)]]
_kds) -> do
      -- find the first ann, then the second. If found in that order, annotate.
      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 () -- annBefore not present
        ([(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
    -- Could be unicode syntax
    -- TODO: This is a bit fishy, refactor
    (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
    -- Could be unicode syntax
    -- TODO: This is a bit fishy, refactor
    (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)
                    -- Note: do not call next, nothing to chain
    -- ++AZ++: Enabling the following line causes a very weird error associated with AnnPackageName. I suspect it is because it is forcing the evaluation of a non-existent an or str
    -- `debug` ("printStringAtMaybeAnn:(an,ma,str)=" ++ show (an,ma,str))

-- ---------------------------------------------------------------------

-- |destructive get, hence use an annotation once only
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 -- Should never be triggered
    ([(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

-- | Get and remove the first item in the (k,v) list for which the k matches.
-- Return the value, together with any comments skipped over to get there.
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)


-- ---------------------------------------------------------------------

-- |This should be the final point where things are mode concrete,
-- before output. Hence the point where comments can be inserted
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 ()
printQueuedComment :: Comment -> DeltaPos -> EP w m ()
printQueuedComment 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
  -- do not lose comments against the left margin
  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

-- ---------------------------------------------------------------------

-- |non-destructive get
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

-- ---------------------------------------------------------------------


-- ---------------------------------------------------------------------
-- Printing functions

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 } )

  -- Advance position, taking care of any newlines in the string
  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 ()
printCommentAt :: Pos -> String -> EP w m ()
printCommentAt 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