{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf           #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns         #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TupleSections        #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE BlockArguments       #-}
{-# LANGUAGE UndecidableInstances  #-} -- For the (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ExactPrint instance
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-incomplete-record-updates #-}

module Language.Haskell.GHC.ExactPrint.ExactPrint
  (
    ExactPrint(..)
  , exactPrint
  , exactPrintWithOptions
  , makeDeltaAst

  -- * Configuration
  , EPOptions(epRigidity, epAstPrint, epTokenPrint, epWhitespacePrint, epUpdateAnchors)
  , stringOptions
  , epOptions
  , deltaOptions
  ) where

import GHC
import GHC.Base (NonEmpty(..))
import GHC.Core.Coercion.Axiom (Role(..))
import GHC.Data.Bag
import qualified GHC.Data.BooleanFormula as BF
import GHC.Data.FastString
import GHC.TypeLits
import GHC.Types.Basic hiding (EP)
import GHC.Types.Fixity
import GHC.Types.ForeignCall
import GHC.Types.Name.Reader
import GHC.Types.PkgQual
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Types.Var
import GHC.Unit.Module.Warnings
import GHC.Utils.Misc
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Utils.Panic

import Language.Haskell.Syntax.Basic (FieldLabelString(..))

import Control.Monad (forM, when, unless)
import Control.Monad.Identity (Identity(..))
import qualified Control.Monad.Reader as Reader
import Control.Monad.RWS (MonadReader, RWST, evalRWST, tell, modify, get, gets, ask)
import Control.Monad.Trans (lift)
import Data.Data ( Data )
import Data.Dynamic
import Data.Foldable
import Data.Functor.Const
import qualified Data.Set as Set
import Data.Typeable
import Data.List ( partition, sort, sortBy)
import qualified Data.Map.Strict as Map
import Data.Maybe ( isJust, mapMaybe )
import Data.Void

import Language.Haskell.GHC.ExactPrint.Lookup
import Language.Haskell.GHC.ExactPrint.Utils
import Language.Haskell.GHC.ExactPrint.Types

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

exactPrint :: ExactPrint ast => ast -> String
exactPrint :: forall ast. ExactPrint ast => ast -> String
exactPrint ast
ast = (ast, String) -> String
forall a b. (a, b) -> b
snd ((ast, String) -> String) -> (ast, String) -> String
forall a b. (a -> b) -> a -> b
$ Identity (ast, String) -> (ast, String)
forall a. Identity a -> a
runIdentity (EPOptions Identity String
-> EP String Identity ast -> Identity (ast, String)
forall (m :: * -> *) w a.
Monad m =>
EPOptions m w -> EP w m a -> m (a, w)
runEP EPOptions Identity String
stringOptions (ast -> EP String Identity ast
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ast
ast))

-- | The additional option to specify the rigidity and printing
-- configuration.
exactPrintWithOptions :: (ExactPrint ast, Monoid b, Monad m)
                      => EPOptions m b
                      -> ast
                      -> m (ast, b)
exactPrintWithOptions :: forall ast b (m :: * -> *).
(ExactPrint ast, Monoid b, Monad m) =>
EPOptions m b -> ast -> m (ast, b)
exactPrintWithOptions EPOptions m b
r ast
ast =
    EPOptions m b -> EP b m ast -> m (ast, b)
forall (m :: * -> *) w a.
Monad m =>
EPOptions m w -> EP w m a -> m (a, w)
runEP EPOptions m b
r (ast -> EP b m ast
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ast
ast)

-- | Transform concrete annotations into relative annotations which
-- are more useful when transforming an AST. This corresponds to the
-- earlier 'relativiseApiAnns'.
makeDeltaAst :: ExactPrint ast => ast -> ast
makeDeltaAst :: forall ast. ExactPrint ast => ast -> ast
makeDeltaAst ast
ast = (ast, ()) -> ast
forall a b. (a, b) -> a
fst ((ast, ()) -> ast) -> (ast, ()) -> ast
forall a b. (a -> b) -> a -> b
$ Identity (ast, ()) -> (ast, ())
forall a. Identity a -> a
runIdentity (EPOptions Identity () -> EP () Identity ast -> Identity (ast, ())
forall (m :: * -> *) w a.
Monad m =>
EPOptions m w -> EP w m a -> m (a, w)
runEP EPOptions Identity ()
deltaOptions (ast -> EP () Identity ast
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ast
ast))

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

type EP w m a = RWST (EPOptions m w) (EPWriter w) EPState m a

runEP :: (Monad m)
      => EPOptions m w
      -> EP w m a -> m (a, w)
runEP :: forall (m :: * -> *) w a.
Monad m =>
EPOptions m w -> EP w m a -> m (a, w)
runEP EPOptions m w
epReader EP w m a
action = do
  (ast, w) <- EP w m a -> EPOptions m w -> EPState -> m (a, EPWriter w)
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> r -> s -> m (a, w)
evalRWST EP w m a
action EPOptions m w
epReader EPState
defaultEPState
  return (ast, output w)

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

defaultEPState :: EPState
defaultEPState :: EPState
defaultEPState = EPState
             { epPos :: Pos
epPos      = (Int
1,Int
1)
             , dLHS :: LayoutStartCol
dLHS       = LayoutStartCol
0
             , pMarkLayout :: Bool
pMarkLayout = Bool
False
             , pLHS :: LayoutStartCol
pLHS = LayoutStartCol
0
             , dMarkLayout :: Bool
dMarkLayout = Bool
False
             , dPriorEndPosition :: Pos
dPriorEndPosition = (Int
1,Int
1)
             , uAnchorSpan :: RealSrcSpan
uAnchorSpan = RealSrcSpan
badRealSrcSpan
             , uExtraDP :: Maybe Anchor
uExtraDP = Maybe Anchor
forall a. Maybe a
Nothing
             , uExtraDPReturn :: Maybe DeltaPos
uExtraDPReturn = Maybe DeltaPos
forall a. Maybe a
Nothing
             , pAcceptSpan :: Bool
pAcceptSpan = Bool
False
             , epComments :: [Comment]
epComments = []
             , epCommentsApplied :: [[Comment]]
epCommentsApplied = []
             , epEof :: Maybe (RealSrcSpan, RealSrcSpan)
epEof = Maybe (RealSrcSpan, RealSrcSpan)
forall a. Maybe a
Nothing
             }


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

-- | The R part of RWS. The environment. Updated via 'local' as we
-- enter a new AST element, having a different anchor point.
data EPOptions m a = EPOptions
            {
              forall (m :: * -> *) a.
EPOptions m a -> forall ast. Data ast => Located ast -> a -> m a
epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a
            , forall (m :: * -> *) a. EPOptions m a -> String -> m a
epTokenPrint :: String -> m a
            , forall (m :: * -> *) a. EPOptions m a -> String -> m a
epWhitespacePrint :: String -> m a
            , forall (m :: * -> *) a. EPOptions m a -> Rigidity
epRigidity :: Rigidity
            , forall (m :: * -> *) a. EPOptions m a -> Bool
epUpdateAnchors :: Bool
            }

-- | Helper to create a 'EPOptions'
epOptions ::
      (forall ast . Data ast => GHC.Located ast -> a -> m a)
      -> (String -> m a)
      -> (String -> m a)
      -> Rigidity
      -> Bool
      -> EPOptions m a
epOptions :: forall a (m :: * -> *).
(forall ast. Data ast => Located ast -> a -> m a)
-> (String -> m a)
-> (String -> m a)
-> Rigidity
-> Bool
-> EPOptions m a
epOptions forall ast. Data ast => Located ast -> a -> m a
astPrint String -> m a
tokenPrint String -> m a
wsPrint Rigidity
rigidity Bool
delta = EPOptions
             {
               epAstPrint :: forall ast. Data ast => Located ast -> a -> m a
epAstPrint = Located ast -> a -> m a
forall ast. Data ast => Located 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
             , epUpdateAnchors :: Bool
epUpdateAnchors = Bool
delta
             }

-- | Options which can be used to print as a normal String.
stringOptions :: EPOptions Identity String
stringOptions :: EPOptions Identity String
stringOptions = (forall ast. Data ast => Located ast -> String -> Identity String)
-> (String -> Identity String)
-> (String -> Identity String)
-> Rigidity
-> Bool
-> EPOptions Identity String
forall a (m :: * -> *).
(forall ast. Data ast => Located ast -> a -> m a)
-> (String -> m a)
-> (String -> m a)
-> Rigidity
-> Bool
-> EPOptions m a
epOptions (\Located ast
_ String
b -> String -> Identity String
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
b) String -> Identity String
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String -> Identity String
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Rigidity
NormalLayout Bool
False

-- | Options which can be used to simply update the AST to be in delta
-- form, without generating output
deltaOptions :: EPOptions Identity ()
deltaOptions :: EPOptions Identity ()
deltaOptions = (forall ast. Data ast => Located ast -> () -> Identity ())
-> (String -> Identity ())
-> (String -> Identity ())
-> Rigidity
-> Bool
-> EPOptions Identity ()
forall a (m :: * -> *).
(forall ast. Data ast => Located ast -> a -> m a)
-> (String -> m a)
-> (String -> m a)
-> Rigidity
-> Bool
-> EPOptions m a
epOptions (\Located ast
_ ()
_ -> () -> Identity ()
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\String
_ -> () -> Identity ()
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\String
_ -> () -> Identity ()
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Rigidity
NormalLayout Bool
True

data EPWriter a = EPWriter
              { forall a. EPWriter a -> a
output :: !a }

instance Monoid w => Semigroup (EPWriter w) where
  (EPWriter w
a) <> :: EPWriter w -> EPWriter w -> EPWriter w
<> (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)

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

data EPState = EPState
             { EPState -> RealSrcSpan
uAnchorSpan :: !RealSrcSpan -- ^ in pre-changed AST
                                          -- reference frame, from
                                          -- Annotation
             , EPState -> Maybe Anchor
uExtraDP :: !(Maybe Anchor) -- ^ Used to anchor a
                                             -- list
             , EPState -> Maybe DeltaPos
uExtraDPReturn :: !(Maybe DeltaPos)
                  -- ^ Used to return Delta version of uExtraDP
             , EPState -> Bool
pAcceptSpan :: Bool -- ^ When we have processed an
                                   -- entry of EpaDelta, accept the
                                   -- next `EpaSpan` start as the
                                   -- current output position. i.e. do
                                   -- not advance epPos. Achieved by
                                   -- setting dPriorEndPosition to the
                                   -- end of the span.

             -- Print phase
             , EPState -> Pos
epPos        :: !Pos -- ^ Current output position
             , EPState -> Bool
pMarkLayout  :: !Bool
             , EPState -> LayoutStartCol
pLHS   :: !LayoutStartCol

             -- Delta phase
             , EPState -> Pos
dPriorEndPosition :: !Pos -- ^ End of Position reached
                                         -- when processing the
                                         -- preceding element
             , EPState -> Bool
dMarkLayout :: !Bool
             , EPState -> LayoutStartCol
dLHS        :: !LayoutStartCol

             -- Shared
             , EPState -> [Comment]
epComments :: ![Comment]
             , EPState -> [[Comment]]
epCommentsApplied :: ![[Comment]]
             , EPState -> Maybe (RealSrcSpan, RealSrcSpan)
epEof :: !(Maybe (RealSrcSpan, RealSrcSpan))
             }

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

-- AZ:TODO: this can just be a function :: (EpAnn a) -> Entry
class HasEntry ast where
  fromAnn :: ast -> Entry

class HasTrailing a where
  trailing :: a -> [TrailingAnn]
  setTrailing :: a -> [TrailingAnn] -> a

setAnchorEpa :: (HasTrailing an)
             => EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa :: forall an.
HasTrailing an =>
EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa (EpAnn Anchor
_ an
an EpAnnComments
_) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = Anchor -> an -> EpAnnComments -> EpAnn an
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc (an -> [TrailingAnn] -> an
forall a. HasTrailing a => a -> [TrailingAnn] -> a
setTrailing an
an [TrailingAnn]
ts)          EpAnnComments
cs

setAnchorHsModule :: HsModule GhcPs -> Anchor -> EpAnnComments -> HsModule GhcPs
setAnchorHsModule :: HsModule GhcPs -> Anchor -> EpAnnComments -> HsModule GhcPs
setAnchorHsModule HsModule GhcPs
hsmod Anchor
anc EpAnnComments
cs = HsModule GhcPs
hsmod { hsmodExt = (hsmodExt hsmod) {hsmodAnn = an'} }
  where
    anc' :: Anchor
anc' = Anchor
anc
    an' :: EpAnn AnnsModule
an' = EpAnn AnnsModule
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnsModule
forall an.
HasTrailing an =>
EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa (XModulePs -> EpAnn AnnsModule
hsmodAnn (XModulePs -> EpAnn AnnsModule) -> XModulePs -> EpAnn AnnsModule
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> XCModule GhcPs
forall p. HsModule p -> XCModule p
hsmodExt HsModule GhcPs
hsmod) Anchor
anc' [] EpAnnComments
cs

setAnchorAn :: (HasTrailing an)
             => LocatedAn an a -> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn :: forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn (L (EpAnn Anchor
_ an
an EpAnnComments
_) a
a) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = (EpAnn an -> a -> GenLocated (EpAnn an) a
forall l e. l -> e -> GenLocated l e
L (Anchor -> an -> EpAnnComments -> EpAnn an
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc (an -> [TrailingAnn] -> an
forall a. HasTrailing a => a -> [TrailingAnn] -> a
setTrailing an
an [TrailingAnn]
ts) EpAnnComments
cs) a
a)
     -- `debug` ("setAnchorAn: anc=" ++ showAst anc)

setAnchorEpaL :: EpAnn AnnList -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList
setAnchorEpaL :: EpAnn AnnList
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList
setAnchorEpaL (EpAnn Anchor
_ AnnList
an EpAnnComments
_) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc (AnnList -> [TrailingAnn] -> AnnList
forall a. HasTrailing a => a -> [TrailingAnn] -> a
setTrailing (AnnList
an {al_anchor = Nothing}) [TrailingAnn]
ts) EpAnnComments
cs

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

-- | Key entry point.  Switches to an independent AST element with its
-- own annotation, calculating new offsets, etc
markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a
markAnnotated :: forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated a
a = Entry -> a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
Entry -> a -> EP w m a
enterAnn (a -> Entry
forall a. ExactPrint a => a -> Entry
getAnnotationEntry a
a) a
a

-- | For HsModule, because we do not have a proper SrcSpan, we must
-- indicate to flush trailing comments when done.
data FlushComments = FlushComments
                   | NoFlushComments
                   deriving (FlushComments -> FlushComments -> Bool
(FlushComments -> FlushComments -> Bool)
-> (FlushComments -> FlushComments -> Bool) -> Eq FlushComments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlushComments -> FlushComments -> Bool
== :: FlushComments -> FlushComments -> Bool
$c/= :: FlushComments -> FlushComments -> Bool
/= :: FlushComments -> FlushComments -> Bool
Eq, Int -> FlushComments -> ShowS
[FlushComments] -> ShowS
FlushComments -> String
(Int -> FlushComments -> ShowS)
-> (FlushComments -> String)
-> ([FlushComments] -> ShowS)
-> Show FlushComments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlushComments -> ShowS
showsPrec :: Int -> FlushComments -> ShowS
$cshow :: FlushComments -> String
show :: FlushComments -> String
$cshowList :: [FlushComments] -> ShowS
showList :: [FlushComments] -> ShowS
Show)

-- | For GenLocated SrcSpan, we construct an entry location but cannot update it.
data CanUpdateAnchor = CanUpdateAnchor
                     | CanUpdateAnchorOnly
                     | NoCanUpdateAnchor
                   deriving (CanUpdateAnchor -> CanUpdateAnchor -> Bool
(CanUpdateAnchor -> CanUpdateAnchor -> Bool)
-> (CanUpdateAnchor -> CanUpdateAnchor -> Bool)
-> Eq CanUpdateAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CanUpdateAnchor -> CanUpdateAnchor -> Bool
== :: CanUpdateAnchor -> CanUpdateAnchor -> Bool
$c/= :: CanUpdateAnchor -> CanUpdateAnchor -> Bool
/= :: CanUpdateAnchor -> CanUpdateAnchor -> Bool
Eq, Int -> CanUpdateAnchor -> ShowS
[CanUpdateAnchor] -> ShowS
CanUpdateAnchor -> String
(Int -> CanUpdateAnchor -> ShowS)
-> (CanUpdateAnchor -> String)
-> ([CanUpdateAnchor] -> ShowS)
-> Show CanUpdateAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CanUpdateAnchor -> ShowS
showsPrec :: Int -> CanUpdateAnchor -> ShowS
$cshow :: CanUpdateAnchor -> String
show :: CanUpdateAnchor -> String
$cshowList :: [CanUpdateAnchor] -> ShowS
showList :: [CanUpdateAnchor] -> ShowS
Show, Typeable CanUpdateAnchor
Typeable CanUpdateAnchor =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CanUpdateAnchor -> c CanUpdateAnchor)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CanUpdateAnchor)
-> (CanUpdateAnchor -> Constr)
-> (CanUpdateAnchor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CanUpdateAnchor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CanUpdateAnchor))
-> ((forall b. Data b => b -> b)
    -> CanUpdateAnchor -> CanUpdateAnchor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CanUpdateAnchor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CanUpdateAnchor -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CanUpdateAnchor -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CanUpdateAnchor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CanUpdateAnchor -> m CanUpdateAnchor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CanUpdateAnchor -> m CanUpdateAnchor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CanUpdateAnchor -> m CanUpdateAnchor)
-> Data CanUpdateAnchor
CanUpdateAnchor -> Constr
CanUpdateAnchor -> DataType
(forall b. Data b => b -> b) -> CanUpdateAnchor -> CanUpdateAnchor
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CanUpdateAnchor -> u
forall u. (forall d. Data d => d -> u) -> CanUpdateAnchor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CanUpdateAnchor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CanUpdateAnchor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CanUpdateAnchor -> m CanUpdateAnchor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CanUpdateAnchor -> m CanUpdateAnchor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CanUpdateAnchor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CanUpdateAnchor -> c CanUpdateAnchor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CanUpdateAnchor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CanUpdateAnchor)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CanUpdateAnchor -> c CanUpdateAnchor
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CanUpdateAnchor -> c CanUpdateAnchor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CanUpdateAnchor
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CanUpdateAnchor
$ctoConstr :: CanUpdateAnchor -> Constr
toConstr :: CanUpdateAnchor -> Constr
$cdataTypeOf :: CanUpdateAnchor -> DataType
dataTypeOf :: CanUpdateAnchor -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CanUpdateAnchor)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CanUpdateAnchor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CanUpdateAnchor)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CanUpdateAnchor)
$cgmapT :: (forall b. Data b => b -> b) -> CanUpdateAnchor -> CanUpdateAnchor
gmapT :: (forall b. Data b => b -> b) -> CanUpdateAnchor -> CanUpdateAnchor
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CanUpdateAnchor -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CanUpdateAnchor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CanUpdateAnchor -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CanUpdateAnchor -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CanUpdateAnchor -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CanUpdateAnchor -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CanUpdateAnchor -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CanUpdateAnchor -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CanUpdateAnchor -> m CanUpdateAnchor
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CanUpdateAnchor -> m CanUpdateAnchor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CanUpdateAnchor -> m CanUpdateAnchor
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CanUpdateAnchor -> m CanUpdateAnchor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CanUpdateAnchor -> m CanUpdateAnchor
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CanUpdateAnchor -> m CanUpdateAnchor
Data)

data Entry = Entry Anchor [TrailingAnn] EpAnnComments FlushComments CanUpdateAnchor
           | NoEntryVal

-- | For flagging whether to capture comments in an EpaDelta or not
data CaptureComments = CaptureComments
                     | NoCaptureComments

mkEntry :: Anchor -> [TrailingAnn] -> EpAnnComments -> Entry
mkEntry :: Anchor -> [TrailingAnn] -> EpAnnComments -> Entry
mkEntry Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = Anchor
-> [TrailingAnn]
-> EpAnnComments
-> FlushComments
-> CanUpdateAnchor
-> Entry
Entry Anchor
anc [TrailingAnn]
ts EpAnnComments
cs FlushComments
NoFlushComments CanUpdateAnchor
CanUpdateAnchor

instance (HasTrailing a) => HasEntry (EpAnn a) where
  fromAnn :: EpAnn a -> Entry
fromAnn (EpAnn Anchor
anc a
a EpAnnComments
cs) = Anchor -> [TrailingAnn] -> EpAnnComments -> Entry
mkEntry Anchor
anc (a -> [TrailingAnn]
forall a. HasTrailing a => a -> [TrailingAnn]
trailing a
a) EpAnnComments
cs

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

instance HasTrailing NoEpAnns where
  trailing :: NoEpAnns -> [TrailingAnn]
trailing NoEpAnns
_ = []
  setTrailing :: NoEpAnns -> [TrailingAnn] -> NoEpAnns
setTrailing NoEpAnns
a [TrailingAnn]
_ = NoEpAnns
a

instance HasTrailing EpaLocation where
  trailing :: Anchor -> [TrailingAnn]
trailing Anchor
_ = []
  setTrailing :: Anchor -> [TrailingAnn] -> Anchor
setTrailing Anchor
a [TrailingAnn]
_ = Anchor
a

instance HasTrailing AddEpAnn where
  trailing :: AddEpAnn -> [TrailingAnn]
trailing AddEpAnn
_ = []
  setTrailing :: AddEpAnn -> [TrailingAnn] -> AddEpAnn
setTrailing AddEpAnn
a [TrailingAnn]
_ = AddEpAnn
a

instance HasTrailing [AddEpAnn] where
  trailing :: [AddEpAnn] -> [TrailingAnn]
trailing [AddEpAnn]
_ = []
  setTrailing :: [AddEpAnn] -> [TrailingAnn] -> [AddEpAnn]
setTrailing [AddEpAnn]
a [TrailingAnn]
_ = [AddEpAnn]
a

instance HasTrailing (AddEpAnn, AddEpAnn) where
  trailing :: (AddEpAnn, AddEpAnn) -> [TrailingAnn]
trailing (AddEpAnn, AddEpAnn)
_ = []
  setTrailing :: (AddEpAnn, AddEpAnn) -> [TrailingAnn] -> (AddEpAnn, AddEpAnn)
setTrailing (AddEpAnn, AddEpAnn)
a [TrailingAnn]
_ = (AddEpAnn, AddEpAnn)
a

instance HasTrailing EpAnnSumPat where
  trailing :: EpAnnSumPat -> [TrailingAnn]
trailing EpAnnSumPat
_ = []
  setTrailing :: EpAnnSumPat -> [TrailingAnn] -> EpAnnSumPat
setTrailing EpAnnSumPat
a [TrailingAnn]
_ = EpAnnSumPat
a

instance HasTrailing AnnList where
  trailing :: AnnList -> [TrailingAnn]
trailing AnnList
a = AnnList -> [TrailingAnn]
al_trailing AnnList
a
  setTrailing :: AnnList -> [TrailingAnn] -> AnnList
setTrailing AnnList
a [TrailingAnn]
ts = AnnList
a { al_trailing = ts }

instance HasTrailing AnnListItem where
  trailing :: AnnListItem -> [TrailingAnn]
trailing AnnListItem
a = AnnListItem -> [TrailingAnn]
lann_trailing AnnListItem
a
  setTrailing :: AnnListItem -> [TrailingAnn] -> AnnListItem
setTrailing AnnListItem
a [TrailingAnn]
ts = AnnListItem
a { lann_trailing = ts }

instance HasTrailing AnnPragma where
  trailing :: AnnPragma -> [TrailingAnn]
trailing AnnPragma
_ = []
  setTrailing :: AnnPragma -> [TrailingAnn] -> AnnPragma
setTrailing AnnPragma
a [TrailingAnn]
_ = AnnPragma
a

instance HasTrailing AnnContext where
  trailing :: AnnContext -> [TrailingAnn]
trailing (AnnContext Maybe (IsUnicodeSyntax, Anchor)
ma [Anchor]
_opens [Anchor]
_closes)
    = case Maybe (IsUnicodeSyntax, Anchor)
ma of
      Just (IsUnicodeSyntax
UnicodeSyntax, Anchor
r) -> [Anchor -> TrailingAnn
AddDarrowUAnn Anchor
r]
      Just (IsUnicodeSyntax
NormalSyntax,  Anchor
r) -> [Anchor -> TrailingAnn
AddDarrowAnn Anchor
r]
      Maybe (IsUnicodeSyntax, Anchor)
Nothing -> []

  setTrailing :: AnnContext -> [TrailingAnn] -> AnnContext
setTrailing AnnContext
a [AddDarrowUAnn Anchor
r] = AnnContext
a {ac_darrow = Just (UnicodeSyntax, r)}
  setTrailing AnnContext
a [AddDarrowAnn Anchor
r] = AnnContext
a{ac_darrow = Just (NormalSyntax, r)}
  setTrailing AnnContext
a [] = AnnContext
a{ac_darrow = Nothing}
  setTrailing AnnContext
a [TrailingAnn]
ts = String -> AnnContext
forall a. HasCallStack => String -> a
error (String -> AnnContext) -> String -> AnnContext
forall a b. (a -> b) -> a -> b
$ String
"Cannot setTrailing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TrailingAnn] -> String
forall a. Data a => a -> String
showAst [TrailingAnn]
ts String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnnContext -> String
forall a. Data a => a -> String
showAst AnnContext
a


instance HasTrailing AnnParen where
  trailing :: AnnParen -> [TrailingAnn]
trailing AnnParen
_ = []
  setTrailing :: AnnParen -> [TrailingAnn] -> AnnParen
setTrailing AnnParen
a [TrailingAnn]
_ = AnnParen
a

instance HasTrailing AnnsIf where
  trailing :: AnnsIf -> [TrailingAnn]
trailing AnnsIf
_ = []
  setTrailing :: AnnsIf -> [TrailingAnn] -> AnnsIf
setTrailing AnnsIf
a [TrailingAnn]
_ = AnnsIf
a

instance HasTrailing EpAnnHsCase where
  trailing :: EpAnnHsCase -> [TrailingAnn]
trailing EpAnnHsCase
_ = []
  setTrailing :: EpAnnHsCase -> [TrailingAnn] -> EpAnnHsCase
setTrailing EpAnnHsCase
a [TrailingAnn]
_ = EpAnnHsCase
a

instance HasTrailing AnnFieldLabel where
  trailing :: AnnFieldLabel -> [TrailingAnn]
trailing AnnFieldLabel
_ = []
  setTrailing :: AnnFieldLabel -> [TrailingAnn] -> AnnFieldLabel
setTrailing AnnFieldLabel
a [TrailingAnn]
_ = AnnFieldLabel
a

instance HasTrailing AnnProjection where
  trailing :: AnnProjection -> [TrailingAnn]
trailing AnnProjection
_ = []
  setTrailing :: AnnProjection -> [TrailingAnn] -> AnnProjection
setTrailing AnnProjection
a [TrailingAnn]
_ = AnnProjection
a

instance HasTrailing AnnExplicitSum where
  trailing :: AnnExplicitSum -> [TrailingAnn]
trailing AnnExplicitSum
_ = []
  setTrailing :: AnnExplicitSum -> [TrailingAnn] -> AnnExplicitSum
setTrailing AnnExplicitSum
a [TrailingAnn]
_ = AnnExplicitSum
a

instance HasTrailing (Maybe EpAnnUnboundVar) where
  trailing :: Maybe EpAnnUnboundVar -> [TrailingAnn]
trailing Maybe EpAnnUnboundVar
_ = []
  setTrailing :: Maybe EpAnnUnboundVar -> [TrailingAnn] -> Maybe EpAnnUnboundVar
setTrailing Maybe EpAnnUnboundVar
a [TrailingAnn]
_ = Maybe EpAnnUnboundVar
a

instance HasTrailing GrhsAnn where
  trailing :: GrhsAnn -> [TrailingAnn]
trailing GrhsAnn
_ = []
  setTrailing :: GrhsAnn -> [TrailingAnn] -> GrhsAnn
setTrailing GrhsAnn
a [TrailingAnn]
_ = GrhsAnn
a

instance HasTrailing AnnSig where
  trailing :: AnnSig -> [TrailingAnn]
trailing AnnSig
_ = []
  setTrailing :: AnnSig -> [TrailingAnn] -> AnnSig
setTrailing AnnSig
a [TrailingAnn]
_ = AnnSig
a

instance HasTrailing HsRuleAnn where
  trailing :: HsRuleAnn -> [TrailingAnn]
trailing HsRuleAnn
_ = []
  setTrailing :: HsRuleAnn -> [TrailingAnn] -> HsRuleAnn
setTrailing HsRuleAnn
a [TrailingAnn]
_ = HsRuleAnn
a

instance HasTrailing EpAnnImportDecl where
  trailing :: EpAnnImportDecl -> [TrailingAnn]
trailing EpAnnImportDecl
_ = []
  setTrailing :: EpAnnImportDecl -> [TrailingAnn] -> EpAnnImportDecl
setTrailing EpAnnImportDecl
a [TrailingAnn]
_ = EpAnnImportDecl
a

instance HasTrailing AnnsModule where
  -- Report none, as all are used internally
  trailing :: AnnsModule -> [TrailingAnn]
trailing AnnsModule
_ = []
  setTrailing :: AnnsModule -> [TrailingAnn] -> AnnsModule
setTrailing AnnsModule
a [TrailingAnn]
_ = AnnsModule
a

instance HasTrailing NameAnn where
  trailing :: NameAnn -> [TrailingAnn]
trailing NameAnn
a = NameAnn -> [TrailingAnn]
nann_trailing NameAnn
a
  setTrailing :: NameAnn -> [TrailingAnn] -> NameAnn
setTrailing NameAnn
a [TrailingAnn]
ts = NameAnn
a { nann_trailing = ts }

instance HasTrailing Bool where
  trailing :: Bool -> [TrailingAnn]
trailing Bool
_ = []
  setTrailing :: Bool -> [TrailingAnn] -> Bool
setTrailing Bool
a [TrailingAnn]
_ = Bool
a

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

fromAnn' :: (HasEntry a) => a -> Entry
fromAnn' :: forall a. HasEntry a => a -> Entry
fromAnn' a
an = case a -> Entry
forall a. HasEntry a => a -> Entry
fromAnn a
an of
  Entry
NoEntryVal -> Entry
NoEntryVal
  Entry Anchor
a [TrailingAnn]
ts EpAnnComments
c FlushComments
_ CanUpdateAnchor
u -> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> FlushComments
-> CanUpdateAnchor
-> Entry
Entry Anchor
a [TrailingAnn]
ts EpAnnComments
c FlushComments
FlushComments CanUpdateAnchor
u

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

astId :: (Typeable a) => a -> String
astId :: forall a. Typeable a => a -> String
astId a
a = TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
a)

cua :: (Monad m, Monoid w) => CanUpdateAnchor -> EP w m [a] -> EP w m [a]
cua :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
CanUpdateAnchor -> EP w m [a] -> EP w m [a]
cua CanUpdateAnchor
CanUpdateAnchor EP w m [a]
f = EP w m [a]
f
cua CanUpdateAnchor
CanUpdateAnchorOnly EP w m [a]
_ = [a] -> EP w m [a]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
cua CanUpdateAnchor
NoCanUpdateAnchor EP w m [a]
_ = [a] -> EP w m [a]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | "Enter" an annotation, by using the associated 'anchor' field as
-- the new reference point for calculating all DeltaPos positions.
-- This is the heart of the exact printing process.
--
-- This is combination of the ghc=exactprint Delta.withAST and
-- Print.exactPC functions and effectively does the delta processing
-- immediately followed by the print processing.  JIT ghc-exactprint.
enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a
enterAnn :: forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
Entry -> a -> EP w m a
enterAnn Entry
NoEntryVal a
a = do
  p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a)
  r <- exact a
  debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a)
  return r
enterAnn !(Entry Anchor
anchor' [TrailingAnn]
trailing_anns EpAnnComments
cs FlushComments
flush CanUpdateAnchor
canUpdateAnchor) a
a = do
  acceptSpan <- EP w m Bool
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Bool
getAcceptSpan
  setAcceptSpan False
  case anchor' of
    EpaDelta DeltaPos
_ [LEpaComment]
_ -> Bool -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Bool -> EP w m ()
setAcceptSpan Bool
True
    Anchor
_            -> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  p <- getPosP
  pe0 <- getPriorEndD
  debugM $ "enterAnn:starting:(anchor',p,pe,a) =" ++ show (showAst anchor', p, pe0, astId a)
  prevAnchor <- getAnchorU
  let curAnchor = case Anchor
anchor' of
        EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_) -> RealSrcSpan
r
        Anchor
_ -> RealSrcSpan
prevAnchor
  debugM $ "enterAnn:(curAnchor):=" ++ show (rs2range curAnchor)
  case canUpdateAnchor of
    CanUpdateAnchor
CanUpdateAnchor -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m ()
pushAppliedComments
    CanUpdateAnchor
_ -> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case anchor' of
    EpaDelta DeltaPos
_ [LEpaComment]
dcs -> do
      String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:Delta:Flushing comments"
      [LEpaComment] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
flushComments []
      String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:Delta:Printing prior comments:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [LEpaComment] -> String
forall a. Outputable a => a -> String
showGhc (EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs)
      (Comment -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Comment -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Comment -> EP w m ()
printOneComment ((LEpaComment -> [Comment]) -> [LEpaComment] -> [Comment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LEpaComment -> [Comment]
tokComment ([LEpaComment] -> [Comment]) -> [LEpaComment] -> [Comment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs)
      String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:Delta:Printing EpaDelta comments:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [LEpaComment] -> String
forall a. Outputable a => a -> String
showGhc [LEpaComment]
dcs
      (Comment -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Comment -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Comment -> EP w m ()
printOneComment ((LEpaComment -> [Comment]) -> [LEpaComment] -> [Comment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LEpaComment -> [Comment]
tokComment [LEpaComment]
dcs)
    Anchor
_ -> do
      String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:Adding comments:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [LEpaComment] -> String
forall a. Outputable a => a -> String
showGhc (EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs)
      [LEpaComment] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
addCommentsA (EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs)
  debugM $ "enterAnn:Added comments"
  printCommentsBefore curAnchor
  priorCs <- cua canUpdateAnchor takeAppliedComments -- no pop
  -- -------------------------
  case anchor' of
    EpaDelta DeltaPos
dp [LEpaComment]
_ -> do
      String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn: EpaDelta:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeltaPos -> String
forall a. Show a => a -> String
show DeltaPos
dp
      -- Set the original anchor as prior end, so the rest of this AST
      -- fragment has a reference
      Pos -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndNoLayoutD (RealSrcSpan -> Pos
ss2pos RealSrcSpan
curAnchor)
    Anchor
_ -> do
      if Bool
acceptSpan
        then Pos -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndNoLayoutD (RealSrcSpan -> Pos
ss2pos RealSrcSpan
curAnchor)
        else () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- -------------------------
  if ((fst $ fst $ rs2range curAnchor) >= 0)
    then
      setAnchorU curAnchor
    else
      debugM $ "enterAnn: not calling setAnchorU for : " ++ show (rs2range curAnchor)
  -- -------------------------------------------------------------------
  -- Make sure the running dPriorEndPosition gets updated according to
  -- the change in the current anchor.

  -- Compute the distance from dPriorEndPosition to the start of the new span.

  -- While processing in the context of the prior anchor, we choose to
  -- enter a new Anchor, which has a defined position relative to the
  -- prior anchor, even if we do not actively output anything at that
  -- point.
  -- Is this edp?

  -- -------------------------------------------------------------------
  -- The first part corresponds to the delta phase, so should only use
  -- delta phase variables -----------------------------------
  -- Calculate offset required to get to the start of the SrcSPan
  !off <- getLayoutOffsetD
  let spanStart = RealSrcSpan -> Pos
ss2pos RealSrcSpan
curAnchor
  priorEndAfterComments <- getPriorEndD
  let edp' = LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset
               -- Use the propagated offset if one is set
               -- Note that we need to use the new offset if it has
               -- changed.
               LayoutStartCol
off (Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
priorEndAfterComments RealSrcSpan
curAnchor)
  debugM $ "enterAnn: (edp',off,priorEndAfterComments,curAnchor):" ++ show (edp',off,priorEndAfterComments,rs2range curAnchor)
  let edp'' = case Anchor
anchor' of
        EpaDelta DeltaPos
dp [LEpaComment]
_ -> DeltaPos
dp
        Anchor
_ -> DeltaPos
edp'
  -- ---------------------------------------------
  med <- getExtraDP
  setExtraDP Nothing
  let (edp, medr) = case med of
        Maybe Anchor
Nothing -> (DeltaPos
edp'', Maybe DeltaPos
forall a. Maybe a
Nothing)
        Just (EpaDelta DeltaPos
dp [LEpaComment]
_) -> (DeltaPos
dp, Maybe DeltaPos
forall a. Maybe a
Nothing)
                   -- Replace original with desired one. Allows all
                   -- list entry values to be DP (1,0)
        Just (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_)) -> (DeltaPos
dp, DeltaPos -> Maybe DeltaPos
forall a. a -> Maybe a
Just DeltaPos
dp)
          where
            dp :: DeltaPos
dp = LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset
                   LayoutStartCol
off (Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
priorEndAfterComments RealSrcSpan
r)
        Just (EpaSpan (UnhelpfulSpan UnhelpfulSpanReason
r)) -> String -> (DeltaPos, Maybe DeltaPos)
forall a. HasCallStack => String -> a
panic (String -> (DeltaPos, Maybe DeltaPos))
-> String -> (DeltaPos, Maybe DeltaPos)
forall a b. (a -> b) -> a -> b
$ String
"enterAnn: UnhelpfulSpan:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnhelpfulSpanReason -> String
forall a. Show a => a -> String
show UnhelpfulSpanReason
r
  when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ showAst (med,edp)
  when (isJust medr) $ setExtraDPReturn medr
  -- ---------------------------------------------
  -- Preparation complete, perform the action
  when (priorEndAfterComments < spanStart) (do
    debugM $ "enterAnn.dPriorEndPosition:spanStart=" ++ show spanStart
    modify (\EPState
s -> EPState
s { dPriorEndPosition    = spanStart } ))

  debugM $ "enterAnn: (anchor', curAnchor):" ++ show (anchor', rs2range curAnchor)
  -- debugM $ "enterAnn: (dLHS,spanStart,pec,edp)=" ++ show (off,spanStart,priorEndAfterComments,edp)
  p0 <- getPosP
  d <- getPriorEndD
  debugM $ "enterAnn: (posp, posd)=" ++ show (p0,d)

  -- end of delta phase processing
  -- -------------------------------------------------------------------
  -- start of print phase processing

  advance edp
  debugM $ "enterAnn:exact a starting:" ++ show (showAst anchor')
  a' <- exact a
  debugM $ "enterAnn:exact a done:" ++ show (showAst anchor')

  -- Core recursive exactprint done, start end of Entry processing

  when (flush == FlushComments) $ do
    debugM $ "flushing comments in enterAnn:" ++ showAst (cs, getFollowingComments cs)
    flushComments (getFollowingComments cs)
    debugM $ "flushing comments in enterAnn done"

  !eof <- getEofPos
  case eof of
    Maybe (RealSrcSpan, RealSrcSpan)
Nothing -> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (RealSrcSpan
pos, RealSrcSpan
prior) -> do
       let dp :: DeltaPos
dp = if RealSrcSpan
pos RealSrcSpan -> RealSrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan
prior
             then (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
0)
             else RealSrcSpan -> RealSrcSpan -> DeltaPos
origDelta RealSrcSpan
pos RealSrcSpan
prior
       String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"EOF:(pos,posEnd,prior,dp) =" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos, Pos, DeltaPos) -> String
forall a. Outputable a => a -> String
showGhc (RealSrcSpan -> Pos
ss2pos RealSrcSpan
pos, RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
pos, RealSrcSpan -> Pos
ss2pos RealSrcSpan
prior, DeltaPos
dp)
       DeltaPos
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> String -> EP w m ()
printStringAtLsDelta DeltaPos
dp String
""
       Maybe (RealSrcSpan, RealSrcSpan)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe (RealSrcSpan, RealSrcSpan) -> EP w m ()
setEofPos Maybe (RealSrcSpan, RealSrcSpan)
forall a. Maybe a
Nothing -- Only do this once

  -- Deal with exit from the current anchor
  when (flush == NoFlushComments) $ do
    printCommentsIn curAnchor -- Make sure all comments in the span are printed

  p1 <- getPosP
  pe1 <- getPriorEndD
  debugM $ "enterAnn:done:(anchor,p,pe,a) =" ++ show (showAst anchor', p1, pe1, astId a')

  case anchor' of
    EpaDelta DeltaPos
_ [LEpaComment]
_ -> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    EpaSpan (RealSrcSpan RealSrcSpan
rss Maybe BufSpan
_) -> do
      Bool -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Bool -> EP w m ()
setAcceptSpan Bool
False
      Pos -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndD ((Pos, Pos) -> Pos
forall a b. (a, b) -> b
snd ((Pos, Pos) -> Pos) -> (Pos, Pos) -> Pos
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> (Pos, Pos)
rs2range RealSrcSpan
rss)
    EpaSpan SrcSpan
_ -> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Outside the anchor, mark any trailing
  postCs <- cua canUpdateAnchor takeAppliedCommentsPop
  following <- if (flush == NoFlushComments)
          then do
              let (before, after) = splitAfterTrailingAnns trailing_anns
                                                           (getFollowingComments cs)
              addCommentsA before
              return after
           else return []
  !trailing' <- markTrailing trailing_anns
  -- mapM_ printOneComment (concatMap tokComment $ following)
  addCommentsA following

  -- Update original anchor, comments based on the printing process
  let newAnchor = DeltaPos -> [LEpaComment] -> Anchor
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
edp []
  debugM $ "enterAnn:setAnnotationAnchor:(canUpdateAnchor,newAnchor,priorCs,postCs):" ++ showAst (canUpdateAnchor,newAnchor,priorCs,postCs)
  let r = case CanUpdateAnchor
canUpdateAnchor of
            CanUpdateAnchor
CanUpdateAnchor -> a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a
forall a.
ExactPrint a =>
a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a
setAnnotationAnchor a
a' Anchor
newAnchor [TrailingAnn]
trailing' ([Comment] -> [Comment] -> EpAnnComments
mkEpaComments [Comment]
priorCs [Comment]
postCs)
            CanUpdateAnchor
CanUpdateAnchorOnly -> a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a
forall a.
ExactPrint a =>
a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a
setAnnotationAnchor a
a' Anchor
newAnchor [] EpAnnComments
emptyComments
            CanUpdateAnchor
NoCanUpdateAnchor -> a
a'
  return r

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

-- | Split the span following comments into ones that occur prior to
-- the last trailing ann, and ones after.
splitAfterTrailingAnns :: [TrailingAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
splitAfterTrailingAnns :: [TrailingAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
splitAfterTrailingAnns [] [LEpaComment]
cs = ([], [LEpaComment]
cs)
splitAfterTrailingAnns [TrailingAnn]
tas [LEpaComment]
cs = ([LEpaComment]
before, [LEpaComment]
after)
  where
    trailing_loc :: TrailingAnn -> [RealSrcSpan]
trailing_loc TrailingAnn
ta = case TrailingAnn -> Anchor
ta_location TrailingAnn
ta of
        EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) -> [RealSrcSpan
s]
        Anchor
_ -> []
    ([LEpaComment]
before, [LEpaComment]
after) = case [RealSrcSpan] -> [RealSrcSpan]
forall a. [a] -> [a]
reverse ((TrailingAnn -> [RealSrcSpan]) -> [TrailingAnn] -> [RealSrcSpan]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TrailingAnn -> [RealSrcSpan]
trailing_loc [TrailingAnn]
tas) of
        [] -> ([],[LEpaComment]
cs)
        (RealSrcSpan
s:[RealSrcSpan]
_) -> ([LEpaComment]
b,[LEpaComment]
a)
          where
            s_pos :: Pos
s_pos = RealSrcSpan -> Pos
ss2pos RealSrcSpan
s
            ([LEpaComment]
b,[LEpaComment]
a) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor EpaLocation' NoComments
ll) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
s_pos)
                          [LEpaComment]
cs


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

addCommentsA :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()
addCommentsA :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
addCommentsA [LEpaComment]
csNew = Bool -> [Comment] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> [Comment] -> EP w m ()
addComments Bool
False ((LEpaComment -> [Comment]) -> [LEpaComment] -> [Comment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LEpaComment -> [Comment]
tokComment [LEpaComment]
csNew)

{-
TODO: When we addComments, some may have an anchor that is no longer
valid, as it has been moved and has an anchor_op.

Does an Anchor even make sense for a comment, perhaps it should be an
EpaLocation?

How do we sort them? do we assign a location based on when we add them
to the list, based on the current output pos?  Except the offset is a
delta compared to a reference location.  Need to nail the concept of
the reference location.

By definition it is the current anchor, so work against that. And that
also means that the first entry comment that has moved should not have
a line offset.
-}
addComments :: (Monad m, Monoid w) => Bool -> [Comment] -> EP w m ()
addComments :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> [Comment] -> EP w m ()
addComments Bool
sortNeeded [Comment]
csNew = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"addComments:csNew" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Comment] -> String
forall a. Show a => a -> String
show [Comment]
csNew
  cs <- EP w m [Comment]
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
getUnallocatedComments
  debugM $ "addComments:cs" ++ show cs
  -- We can only sort the comments if we are in the first phase,
  -- were all comments have locations. If any have EpaDelta the
  -- sort will fail, so we do not try.
  if sortNeeded && all noDelta (csNew ++ cs)
    then putUnallocatedComments (sort (cs ++ csNew))
    else putUnallocatedComments (cs ++ csNew)

noDelta :: Comment -> Bool
noDelta :: Comment -> Bool
noDelta Comment
c = case Comment -> EpaLocation' NoComments
commentLoc Comment
c of
    EpaSpan SrcSpan
_ -> Bool
True
    EpaLocation' NoComments
_ -> Bool
False

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

-- | Just before we print out the EOF comments, flush the remaining
-- ones in the state.
flushComments :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()
flushComments :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
flushComments ![LEpaComment]
trailing_anns = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"flushComments entered: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [LEpaComment] -> String
forall a. Data a => a -> String
showAst [LEpaComment]
trailing_anns
  [LEpaComment] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
addCommentsA [LEpaComment]
trailing_anns
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"flushComments after addCommentsA"
  cs <- EP w m [Comment]
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
getUnallocatedComments
  debugM $ "flushComments: got cs"
  debugM $ "flushing comments starting: cs" ++ showAst cs
    -- AZ:TODO: is the sort still needed?
  -- mapM_ printOneComment (sortComments cs)
  mapM_ printOneComment cs
  putUnallocatedComments []
  debugM $ "flushing comments done"

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

-- |In order to interleave annotations into the stream, we turn them into
-- comments. They are removed from the annotation to avoid duplication.
annotationsToComments :: (Monad m, Monoid w)
  => a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a
annotationsToComments :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a
annotationsToComments a
a Lens a [AddEpAnn]
l [AnnKeywordId]
kws = do
  let ([Comment]
newComments, [AddEpAnn]
newAnns) = ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])
go ([],[]) (Getting a [AddEpAnn] -> a -> [AddEpAnn]
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a [AddEpAnn]
Lens a [AddEpAnn]
l a
a)
  Bool -> [Comment] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> [Comment] -> EP w m ()
addComments Bool
True [Comment]
newComments
  a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lens a [AddEpAnn] -> [AddEpAnn] -> a -> a
forall a b. Lens a b -> b -> a -> a
set ([AddEpAnn] -> f [AddEpAnn]) -> a -> f a
Lens a [AddEpAnn]
l ([AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a]
reverse [AddEpAnn]
newAnns) a
a)
  where
    keywords :: Set AnnKeywordId
keywords = [AnnKeywordId] -> Set AnnKeywordId
forall a. Ord a => [a] -> Set a
Set.fromList [AnnKeywordId]
kws

    go :: ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])
    go :: ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])
go ([Comment], [AddEpAnn])
acc [] = ([Comment], [AddEpAnn])
acc
    go ([Comment]
cs',[AddEpAnn]
ans) ((AddEpAnn AnnKeywordId
k Anchor
ss) : [AddEpAnn]
ls)
      | AnnKeywordId -> Set AnnKeywordId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member AnnKeywordId
k Set AnnKeywordId
keywords = ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])
go ((AnnKeywordId -> EpaLocation' NoComments -> Comment
mkKWComment AnnKeywordId
k (Anchor -> EpaLocation' NoComments
epaToNoCommentsLocation Anchor
ss))Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
:[Comment]
cs', [AddEpAnn]
ans) [AddEpAnn]
ls
      | Bool
otherwise             = ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])
go ([Comment]
cs', (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
k Anchor
ss)AddEpAnn -> [AddEpAnn] -> [AddEpAnn]
forall a. a -> [a] -> [a]
:[AddEpAnn]
ans)    [AddEpAnn]
ls

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

-- Temporary function to simply reproduce the "normal" pretty printer output
withPpr :: (Monad m, Monoid w, Outputable a) => a -> EP w m a
withPpr :: forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr a
a = do
  ss <- EP w m RealSrcSpan
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU
  debugM $ "withPpr: ss=" ++ show ss
  printStringAtRs' ss (showPprUnsafe a)
  return a

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

-- | An AST fragment with an annotation must be able to return the
-- requirements for nesting another one, captured in an 'Entry', and
-- to be able to use the rest of the exactprint machinery to print the
-- element.  In the analogy to Outputable, 'exact' plays the role of
-- 'ppr'.
class (Typeable a) => ExactPrint a where
  getAnnotationEntry :: a -> Entry
  setAnnotationAnchor :: a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a
  exact :: (Monad m, Monoid w) => a -> EP w m a

-- ---------------------------------------------------------------------
-- Start of utility functions
-- ---------------------------------------------------------------------

printSourceText :: (Monad m, Monoid w) => SourceText -> String -> EP w m ()
printSourceText :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceText (SourceText
NoSourceText) String
txt   =  String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
txt EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printSourceText (SourceText   FastString
txt) String
_ =  String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (FastString -> String
unpackFS FastString
txt) EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

printSourceTextAA :: (Monad m, Monoid w) => SourceText -> String -> EP w m ()
printSourceTextAA :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceTextAA (SourceText
NoSourceText) String
txt   = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA  String
txt EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printSourceTextAA (SourceText   FastString
txt) String
_ = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA  (FastString -> String
unpackFS FastString
txt) EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

printStringAtRs :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m EpaLocation
printStringAtRs :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> String -> EP w m Anchor
printStringAtRs RealSrcSpan
pa String
str = CaptureComments -> RealSrcSpan -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> RealSrcSpan -> String -> EP w m Anchor
printStringAtRsC CaptureComments
CaptureComments RealSrcSpan
pa String
str

printStringAtRsC :: (Monad m, Monoid w)
  => CaptureComments -> RealSrcSpan -> String -> EP w m EpaLocation
printStringAtRsC :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> RealSrcSpan -> String -> EP w m Anchor
printStringAtRsC CaptureComments
capture RealSrcSpan
pa String
str = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"printStringAtRsC: pa=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ RealSrcSpan -> String
forall a. Data a => a -> String
showAst RealSrcSpan
pa
  RealSrcSpan -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m ()
printCommentsBefore RealSrcSpan
pa
  pe <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD
  debugM $ "printStringAtRsC:pe=" ++ show pe
  let p = Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
pe RealSrcSpan
pa
  p' <- adjustDeltaForOffsetM p
  debugM $ "printStringAtRsC:(p,p')=" ++ show (p,p')
  printStringAtLsDelta p' str
  setPriorEndASTD pa
  cs' <- case capture of
    CaptureComments
CaptureComments -> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
takeAppliedComments
    CaptureComments
NoCaptureComments -> [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  debugM $ "printStringAtRsC:cs'=" ++ show cs'
  debugM $ "printStringAtRsC:p'=" ++ showAst p'
  debugM $ "printStringAtRsC: (EpaDelta p' [])=" ++ showAst (EpaDelta p' NoComments)
  debugM $ "printStringAtRsC: (EpaDelta p' (map comment2LEpaComment cs'))=" ++ showAst (EpaDelta p' (map comment2LEpaComment cs'))
  return (EpaDelta p' (map comment2LEpaComment cs'))

printStringAtRs' :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m ()
printStringAtRs' :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> String -> EP w m ()
printStringAtRs' RealSrcSpan
pa String
str = CaptureComments -> RealSrcSpan -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> RealSrcSpan -> String -> EP w m Anchor
printStringAtRsC CaptureComments
NoCaptureComments RealSrcSpan
pa String
str EP w m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

printStringAtMLoc' :: (Monad m, Monoid w)
  => Maybe EpaLocation -> String -> EP w m (Maybe EpaLocation)
printStringAtMLoc' :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> String -> EP w m (Maybe Anchor)
printStringAtMLoc' (Just Anchor
aa) String
s = Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (Anchor -> Maybe Anchor)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Anchor
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
aa String
s
printStringAtMLoc' Maybe Anchor
Nothing String
s = do
  DeltaPos -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> String -> EP w m ()
printStringAtLsDelta (Int -> DeltaPos
SameLine Int
1) String
s
  Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (DeltaPos -> [LEpaComment] -> Anchor
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
1) []))

printStringAtMLocL :: (Monad m, Monoid w)
  => EpAnn a -> Lens a (Maybe EpaLocation) -> String -> EP w m (EpAnn a)
printStringAtMLocL :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a (Maybe Anchor) -> String -> EP w m (EpAnn a)
printStringAtMLocL (EpAnn Anchor
anc a
an EpAnnComments
cs) Lens a (Maybe Anchor)
l String
s = do
  r <- Maybe Anchor
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> String -> EP w m (Maybe Anchor)
go (Getting a (Maybe Anchor) -> a -> Maybe Anchor
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a (Maybe Anchor)
Lens a (Maybe Anchor)
l a
an) String
s
  return (EpAnn anc (set l r an) cs)
  where
    go :: Maybe Anchor
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
go (Just Anchor
aa) String
str = Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (Anchor -> Maybe Anchor)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Anchor
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
aa String
str
    go Maybe Anchor
Nothing String
str = do
      DeltaPos -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> String -> EP w m ()
printStringAtLsDelta (Int -> DeltaPos
SameLine Int
1) String
str
      Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (DeltaPos -> [LEpaComment] -> Anchor
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
1) []))

printStringAdvanceA :: (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA :: forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA String
str = Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA (DeltaPos -> [LEpaComment] -> Anchor
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) []) String
str EP w m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation
printStringAtAA :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
el String
str = CaptureComments -> Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> Anchor -> String -> EP w m Anchor
printStringAtAAC CaptureComments
CaptureComments Anchor
el String
str

printStringAtNC :: (Monad m, Monoid w) => NoCommentsLocation -> String -> EP w m NoCommentsLocation
printStringAtNC :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation' NoComments
-> String -> EP w m (EpaLocation' NoComments)
printStringAtNC EpaLocation' NoComments
el String
str = do
    el' <- CaptureComments -> Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> Anchor -> String -> EP w m Anchor
printStringAtAAC CaptureComments
NoCaptureComments (EpaLocation' NoComments -> Anchor
noCommentsToEpaLocation EpaLocation' NoComments
el) String
str
    return (epaToNoCommentsLocation el')

printStringAtAAL :: (Monad m, Monoid w)
  => a -> Lens a EpaLocation -> String -> EP w m a
printStringAtAAL :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a Anchor -> String -> EP w m a
printStringAtAAL a
an Lens a Anchor
l String
str = do
  r <- CaptureComments -> Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> Anchor -> String -> EP w m Anchor
printStringAtAAC CaptureComments
CaptureComments (Getting a Anchor -> a -> Anchor
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a Anchor
Lens a Anchor
l a
an) String
str
  return (set l r an)

printStringAtAAC :: (Monad m, Monoid w)
  => CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
printStringAtAAC :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> Anchor -> String -> EP w m Anchor
printStringAtAAC CaptureComments
capture (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_)) String
s = CaptureComments -> RealSrcSpan -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> RealSrcSpan -> String -> EP w m Anchor
printStringAtRsC CaptureComments
capture RealSrcSpan
r String
s
printStringAtAAC CaptureComments
_capture (EpaSpan ss :: SrcSpan
ss@(UnhelpfulSpan UnhelpfulSpanReason
_)) String
_s = String -> EP w m Anchor
forall a. HasCallStack => String -> a
error (String -> EP w m Anchor) -> String -> EP w m Anchor
forall a b. (a -> b) -> a -> b
$ String
"printStringAtAAC:ss=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcSpan -> String
forall a. Show a => a -> String
show SrcSpan
ss
printStringAtAAC CaptureComments
capture (EpaDelta DeltaPos
d [LEpaComment]
cs) String
s = do
  (Comment -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Comment -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Comment -> EP w m ()
printOneComment ([Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ (LEpaComment -> [Comment]) -> [LEpaComment] -> [Comment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LEpaComment -> [Comment]
tokComment [LEpaComment]
cs
  pe1 <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD
  p1 <- getPosP
  printStringAtLsDelta d s
  p2 <- getPosP
  pe2 <- getPriorEndD
  debugM $ "printStringAtAA:(pe1,pe2,p1,p2)=" ++ show (pe1,pe2,p1,p2)
  setPriorEndASTPD (pe1,pe2)
  cs' <- case capture of
    CaptureComments
CaptureComments -> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
takeAppliedComments
    CaptureComments
NoCaptureComments -> [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  debugM $ "printStringAtAA:(pe1,pe2,p1,p2,cs')=" ++ show (pe1,pe2,p1,p2,cs')
  return (EpaDelta d (map comment2LEpaComment cs'))

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

markExternalSourceTextE :: (Monad m, Monoid w) => EpaLocation -> SourceText -> String -> EP w m EpaLocation
markExternalSourceTextE :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> SourceText -> String -> EP w m Anchor
markExternalSourceTextE Anchor
l SourceText
NoSourceText String
txt   = Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
l String
txt
markExternalSourceTextE Anchor
l (SourceText FastString
txt) String
_ = Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
l (FastString -> String
unpackFS FastString
txt)

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

markLensMAA :: (Monad m, Monoid w)
  => EpAnn a -> Lens a (Maybe AddEpAnn) -> EP w m (EpAnn a)
markLensMAA :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a (Maybe AddEpAnn) -> EP w m (EpAnn a)
markLensMAA EpAnn a
epann Lens a (Maybe AddEpAnn)
l = EpAnn a -> Lens (EpAnn a) (Maybe AddEpAnn) -> EP w m (EpAnn a)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a (Maybe AddEpAnn) -> EP w m a
markLensMAA' EpAnn a
epann ((a -> f a) -> EpAnn a -> f (EpAnn a)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> EpAnn a -> f (EpAnn a)
lepa ((a -> f a) -> EpAnn a -> f (EpAnn a))
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn)) -> a -> f a)
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> EpAnn a
-> f (EpAnn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AddEpAnn -> f (Maybe AddEpAnn)) -> a -> f a
Lens a (Maybe AddEpAnn)
l)

markLensMAA' :: (Monad m, Monoid w)
  => a -> Lens a (Maybe AddEpAnn) -> EP w m a
markLensMAA' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a (Maybe AddEpAnn) -> EP w m a
markLensMAA' a
a Lens a (Maybe AddEpAnn)
l =
  case Getting a (Maybe AddEpAnn) -> a -> Maybe AddEpAnn
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a (Maybe AddEpAnn)
Lens a (Maybe AddEpAnn)
l a
a of
    Maybe AddEpAnn
Nothing -> a -> EP w m a
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Just AddEpAnn
aa -> do
      aa' <- AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markAddEpAnn AddEpAnn
aa
      return (set l (Just aa') a)

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

markLensAA :: (Monad m, Monoid w)
  => EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)
markLensAA :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)
markLensAA EpAnn a
epann Lens a AddEpAnn
l = EpAnn a -> Lens (EpAnn a) AddEpAnn -> EP w m (EpAnn a)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> EP w m a
markLensAA' EpAnn a
epann ((a -> f a) -> EpAnn a -> f (EpAnn a)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> EpAnn a -> f (EpAnn a)
lepa ((a -> f a) -> EpAnn a -> f (EpAnn a))
-> ((AddEpAnn -> f AddEpAnn) -> a -> f a)
-> (AddEpAnn -> f AddEpAnn)
-> EpAnn a
-> f (EpAnn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddEpAnn -> f AddEpAnn) -> a -> f a
Lens a AddEpAnn
l)

markLensAA' :: (Monad m, Monoid w)
  => a -> Lens a AddEpAnn -> EP w m a
markLensAA' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> EP w m a
markLensAA' a
a Lens a AddEpAnn
l = do
  a' <- AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markKw (Getting a AddEpAnn -> a -> AddEpAnn
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a AddEpAnn
Lens a AddEpAnn
l a
a)
  return (set l a' a)

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

markEpAnnLMS :: (Monad m, Monoid w)
  => EpAnn a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m (EpAnn a)
markEpAnnLMS :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn a)
markEpAnnLMS EpAnn a
epann Lens a [AddEpAnn]
l AnnKeywordId
kw Maybe String
ms = EpAnn a
-> Lens (EpAnn a) [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn a)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' EpAnn a
epann ((a -> f a) -> EpAnn a -> f (EpAnn a)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> EpAnn a -> f (EpAnn a)
lepa ((a -> f a) -> EpAnn a -> f (EpAnn a))
-> (([AddEpAnn] -> f [AddEpAnn]) -> a -> f a)
-> ([AddEpAnn] -> f [AddEpAnn])
-> EpAnn a
-> f (EpAnn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AddEpAnn] -> f [AddEpAnn]) -> a -> f a
Lens a [AddEpAnn]
l) AnnKeywordId
kw Maybe String
ms

markEpAnnLMS'' :: (Monad m, Monoid w)
  => a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' a
an Lens a [AddEpAnn]
l AnnKeywordId
kw Maybe String
Nothing = a -> Lens a [AddEpAnn] -> AnnKeywordId -> EP w m a
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL a
an ([AddEpAnn] -> f [AddEpAnn]) -> a -> f a
Lens a [AddEpAnn]
l AnnKeywordId
kw
markEpAnnLMS'' a
a Lens a [AddEpAnn]
l AnnKeywordId
kw (Just String
str) = do
  anns <- (AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn)
-> [AddEpAnn]
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
go (Getting a [AddEpAnn] -> a -> [AddEpAnn]
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a [AddEpAnn]
Lens a [AddEpAnn]
l a
a)
  return (set l anns a)
  where
    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn
    go :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
go (AddEpAnn AnnKeywordId
kw' Anchor
r)
      | AnnKeywordId
kw' AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw = do
          r' <- Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
r String
str
          return (AddEpAnn kw' r')
      | Bool
otherwise = AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
kw' Anchor
r)

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

markEpAnnMS' :: (Monad m, Monoid w)
  => [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m [AddEpAnn]
markEpAnnMS' :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m [AddEpAnn]
markEpAnnMS' [AddEpAnn]
anns AnnKeywordId
kw Maybe String
Nothing = [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
anns AnnKeywordId
kw
markEpAnnMS' [AddEpAnn]
anns AnnKeywordId
kw (Just String
str) = do
  (AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn)
-> [AddEpAnn] -> EP w m [AddEpAnn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
go [AddEpAnn]
anns
  where
    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn
    go :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
go (AddEpAnn AnnKeywordId
kw' Anchor
r)
      | AnnKeywordId
kw' AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw = do
          r' <- Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
r String
str
          return (AddEpAnn kw' r')
      | Bool
otherwise = AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
kw' Anchor
r)

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

markEpAnnLMS' :: (Monad m, Monoid w)
  => EpAnn a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m (EpAnn a)
markEpAnnLMS' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn a)
markEpAnnLMS' EpAnn a
an Lens a AddEpAnn
l AnnKeywordId
kw Maybe String
ms = EpAnn a
-> Lens (EpAnn a) AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn a)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS0 EpAnn a
an ((a -> f a) -> EpAnn a -> f (EpAnn a)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> EpAnn a -> f (EpAnn a)
lepa ((a -> f a) -> EpAnn a -> f (EpAnn a))
-> ((AddEpAnn -> f AddEpAnn) -> a -> f a)
-> (AddEpAnn -> f AddEpAnn)
-> EpAnn a
-> f (EpAnn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddEpAnn -> f AddEpAnn) -> a -> f a
Lens a AddEpAnn
l) AnnKeywordId
kw Maybe String
ms

markEpAnnLMS0 :: (Monad m, Monoid w)
  => a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS0 :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS0 a
an Lens a AddEpAnn
l AnnKeywordId
_kw Maybe String
Nothing = a -> Lens a AddEpAnn -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> EP w m a
markLensKwA a
an (AddEpAnn -> f AddEpAnn) -> a -> f a
Lens a AddEpAnn
l
markEpAnnLMS0 a
a Lens a AddEpAnn
l AnnKeywordId
kw (Just String
str) = do
  anns <- AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
go (Getting a AddEpAnn -> a -> AddEpAnn
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a AddEpAnn
Lens a AddEpAnn
l a
a)
  return (set l anns a)
  where
    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn
    go :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
go (AddEpAnn AnnKeywordId
kw' Anchor
r)
      | AnnKeywordId
kw' AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw = do
          r' <- Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
r String
str
          return (AddEpAnn kw' r')
      | Bool
otherwise = AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
kw' Anchor
r)

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

markEpToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
  => EpToken tok -> EP w m (EpToken tok)
markEpToken :: forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken tok
NoEpTok = EpToken tok
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken tok)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpToken tok
forall (tok :: Symbol). EpToken tok
NoEpTok
markEpToken (EpTok Anchor
aa) = do
  aa' <- Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
aa (Proxy tok -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @tok))
  return (EpTok aa')

markEpUniToken :: forall m w tok utok . (Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok)
  => EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken :: forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken EpUniToken tok utok
NoEpUniTok = EpUniToken tok utok
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (EpUniToken tok utok)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpUniToken tok utok
forall (tok :: Symbol) (utok :: Symbol). EpUniToken tok utok
NoEpUniTok
markEpUniToken (EpUniTok Anchor
aa IsUnicodeSyntax
isUnicode)  = do
  aa' <- case IsUnicodeSyntax
isUnicode of
    IsUnicodeSyntax
NormalSyntax  -> Anchor
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
aa (Proxy tok -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @tok))
    IsUnicodeSyntax
UnicodeSyntax -> Anchor
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
aa (Proxy utok -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @utok))
  return (EpUniTok aa' isUnicode)

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

markArrow :: (Monad m, Monoid w) => HsArrow GhcPs -> EP w m (HsArrow GhcPs)
markArrow :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsArrow GhcPs -> EP w m (HsArrow GhcPs)
markArrow (HsUnrestrictedArrow XUnrestrictedArrow GhcPs
arr) = do
  arr' <- EpUniToken "->" "\8594" -> EP w m (EpUniToken "->" "\8594")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken EpUniToken "->" "\8594"
XUnrestrictedArrow GhcPs
arr
  return (HsUnrestrictedArrow arr')
markArrow (HsLinearArrow (EpPct1 EpToken "%1"
pct1 EpUniToken "->" "\8594"
arr)) = do
  pct1' <- EpToken "%1" -> EP w m (EpToken "%1")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "%1"
pct1
  arr' <- markEpUniToken arr
  return (HsLinearArrow (EpPct1 pct1' arr'))
markArrow (HsLinearArrow (EpLolly EpToken "\8888"
arr)) = do
  arr' <- EpToken "\8888" -> EP w m (EpToken "\8888")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "\8888"
arr
  return (HsLinearArrow (EpLolly arr'))
markArrow (HsExplicitMult (EpToken "%"
pct, EpUniToken "->" "\8594"
arr) LHsType GhcPs
t) = do
  pct' <- EpToken "%" -> EP w m (EpToken "%")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "%"
pct
  t' <- markAnnotated t
  arr' <- markEpUniToken arr
  return (HsExplicitMult (pct', arr') t')


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

markAnnCloseP :: (Monad m, Monoid w) => EpAnn AnnPragma -> EP w m (EpAnn AnnPragma)
markAnnCloseP :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> EP w m (EpAnn AnnPragma)
markAnnCloseP EpAnn AnnPragma
an = EpAnn AnnPragma
-> Lens AnnPragma AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn a)
markEpAnnLMS' EpAnn AnnPragma
an (AddEpAnn -> f AddEpAnn) -> AnnPragma -> f AnnPragma
Lens AnnPragma AddEpAnn
lapr_close AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")

markAnnCloseP' :: (Monad m, Monoid w) => AnnPragma -> EP w m AnnPragma
markAnnCloseP' :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnPragma -> EP w m AnnPragma
markAnnCloseP' AnnPragma
an = AnnPragma
-> Lens AnnPragma AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m AnnPragma
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS0 AnnPragma
an (AddEpAnn -> f AddEpAnn) -> AnnPragma -> f AnnPragma
Lens AnnPragma AddEpAnn
lapr_close AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")

markAnnOpenP :: (Monad m, Monoid w) => EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
NoSourceText String
txt   = EpAnn AnnPragma
-> Lens AnnPragma AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn a)
markEpAnnLMS' EpAnn AnnPragma
an (AddEpAnn -> f AddEpAnn) -> AnnPragma -> f AnnPragma
Lens AnnPragma AddEpAnn
lapr_open AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
txt)
markAnnOpenP EpAnn AnnPragma
an (SourceText FastString
txt) String
_ = EpAnn AnnPragma
-> Lens AnnPragma AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn a)
markEpAnnLMS' EpAnn AnnPragma
an (AddEpAnn -> f AddEpAnn) -> AnnPragma -> f AnnPragma
Lens AnnPragma AddEpAnn
lapr_open AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
txt)

markAnnOpenP' :: (Monad m, Monoid w) => AnnPragma -> SourceText -> String -> EP w m AnnPragma
markAnnOpenP' :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnPragma -> SourceText -> String -> EP w m AnnPragma
markAnnOpenP' AnnPragma
an SourceText
NoSourceText String
txt   = AnnPragma
-> Lens AnnPragma AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m AnnPragma
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS0 AnnPragma
an (AddEpAnn -> f AddEpAnn) -> AnnPragma -> f AnnPragma
Lens AnnPragma AddEpAnn
lapr_open AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
txt)
markAnnOpenP' AnnPragma
an (SourceText FastString
txt) String
_ = AnnPragma
-> Lens AnnPragma AddEpAnn
-> AnnKeywordId
-> Maybe String
-> EP w m AnnPragma
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS0 AnnPragma
an (AddEpAnn -> f AddEpAnn) -> AnnPragma -> f AnnPragma
Lens AnnPragma AddEpAnn
lapr_open AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
txt)

markAnnOpen :: (Monad m, Monoid w) => [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen [AddEpAnn]
an SourceText
NoSourceText String
txt   = [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
txt)
markAnnOpen [AddEpAnn]
an (SourceText FastString
txt) String
_ = [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
txt)

markAnnOpen' :: (Monad m, Monoid w)
  => Maybe EpaLocation -> SourceText -> String -> EP w m (Maybe EpaLocation)
markAnnOpen' :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> SourceText -> String -> EP w m (Maybe Anchor)
markAnnOpen' Maybe Anchor
ms SourceText
NoSourceText String
txt   = Maybe Anchor -> String -> EP w m (Maybe Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> String -> EP w m (Maybe Anchor)
printStringAtMLoc' Maybe Anchor
ms String
txt
markAnnOpen' Maybe Anchor
ms (SourceText FastString
txt) String
_ = Maybe Anchor -> String -> EP w m (Maybe Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> String -> EP w m (Maybe Anchor)
printStringAtMLoc' Maybe Anchor
ms (String -> EP w m (Maybe Anchor))
-> String -> EP w m (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
txt

markAnnOpen'' :: (Monad m, Monoid w)
  => EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> SourceText -> String -> EP w m Anchor
markAnnOpen'' Anchor
el SourceText
NoSourceText String
txt   = Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
el String
txt
markAnnOpen'' Anchor
el (SourceText FastString
txt) String
_ = Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
el (String -> EP w m Anchor) -> String -> EP w m Anchor
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
txt

-- ---------------------------------------------------------------------
{-
data AnnParen
  = AnnParen {
      ap_adornment :: ParenType,
      ap_open      :: EpaLocation,
      ap_close     :: EpaLocation
      } deriving (Data)
-}
markOpeningParen, markClosingParen :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen
markOpeningParen :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen AnnParen
an = AnnParen
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> (a, a) -> f (a, a))
-> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> (a, a) -> f (a, a))
-> EP w m AnnParen
markParen AnnParen
an (a -> f a) -> (a, a) -> f (a, a)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
lfst
markClosingParen :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markClosingParen AnnParen
an = AnnParen
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> (a, a) -> f (a, a))
-> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> (a, a) -> f (a, a))
-> EP w m AnnParen
markParen AnnParen
an (a -> f a) -> (a, a) -> f (a, a)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
lsnd

markParen :: (Monad m, Monoid w) => AnnParen -> (forall a. Lens (a,a) a) -> EP w m AnnParen
markParen :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> (a, a) -> f (a, a))
-> EP w m AnnParen
markParen (AnnParen ParenType
pt Anchor
o Anchor
c) forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
l = do
  loc' <- AnnKeywordId -> Anchor -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA (Getting (AnnKeywordId, AnnKeywordId) AnnKeywordId
-> (AnnKeywordId, AnnKeywordId) -> AnnKeywordId
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting (AnnKeywordId, AnnKeywordId) AnnKeywordId
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
l ((AnnKeywordId, AnnKeywordId) -> AnnKeywordId)
-> (AnnKeywordId, AnnKeywordId) -> AnnKeywordId
forall a b. (a -> b) -> a -> b
$ ParenType -> (AnnKeywordId, AnnKeywordId)
kw ParenType
pt) (Getting (Anchor, Anchor) Anchor -> (Anchor, Anchor) -> Anchor
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting (Anchor, Anchor) Anchor
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
l (Anchor
o, Anchor
c))
  let (o',c') = set l loc' (o,c)
  return (AnnParen pt o' c')
  where
    kw :: ParenType -> (AnnKeywordId, AnnKeywordId)
kw ParenType
AnnParens       = (AnnKeywordId
AnnOpenP,  AnnKeywordId
AnnCloseP)
    kw ParenType
AnnParensHash   = (AnnKeywordId
AnnOpenPH, AnnKeywordId
AnnClosePH)
    kw ParenType
AnnParensSquare = (AnnKeywordId
AnnOpenS, AnnKeywordId
AnnCloseS)

-- ---------------------------------------------------------------------
-- Bare bones Optics
-- Base on From https://hackage.haskell.org/package/lens-tutorial-1.0.3/docs/Control-Lens-Tutorial.html

type Lens    a b = forall f . Functor f => (b -> f        b) -> (a -> f        a)
type Getting a b =                         (b -> Const  b b) -> (a -> Const b  a)
type ASetter a b =                         (b -> Identity b) -> (a -> Identity a)

view :: MonadReader s m => Getting s a -> m a
view :: forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting s a
l = (s -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Reader.asks (Const a s -> a
forall {k} a (b :: k). Const a b -> a
getConst (Const a s -> a) -> (s -> Const a s) -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting s a
l a -> Const a a
forall {k} a (b :: k). a -> Const a b
Const)
{-# INLINE view #-}

over :: ASetter a b -> (b -> b) -> (a -> a)
over :: forall a b. ASetter a b -> (b -> b) -> a -> a
over ASetter a b
l b -> b
f = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter a b
l (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (b -> b) -> b -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
f)
{-# INLINE over #-}

set  :: Lens a b -> b -> a -> a
set :: forall a b. Lens a b -> b -> a -> a
set Lens a b
lens b
b = ASetter a b -> (b -> b) -> a -> a
forall a b. ASetter a b -> (b -> b) -> a -> a
over ASetter a b
Lens a b
lens (\b
_ -> b
b)
{-# INLINE set #-}

{-
Question: How do I combine lenses?

Answer: You compose them, using function composition (Yes, really!)

You can think of the function composition operator as having this type:

(.) :: Lens' a b -> Lens' b c -> Lens' a c
-}

-- ---------------------------------------------------------------------
-- Lenses

-- data EpAnn ann
--   = EpAnn { entry   :: !Anchor
--            , anns     :: !ann
--            , comments :: !EpAnnComments
--            }

lepa :: Lens (EpAnn a) a
lepa :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> EpAnn a -> f (EpAnn a)
lepa a -> f a
k EpAnn a
epAnn = (a -> EpAnn a) -> f a -> f (EpAnn a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
newAnns -> EpAnn a
epAnn { anns = newAnns })
                    (a -> f a
k (EpAnn a -> a
forall ann. EpAnn ann -> ann
anns EpAnn a
epAnn))

-- data AnnsModule
--   = AnnsModule {
--     am_main :: [AddEpAnn],
--     am_decls :: AnnList
--     } deriving (Data, Eq)

lam_main :: Lens AnnsModule [AddEpAnn]
lam_main :: Lens AnnsModule [AddEpAnn]
lam_main [AddEpAnn] -> f [AddEpAnn]
k AnnsModule
annsModule = ([AddEpAnn] -> AnnsModule) -> f [AddEpAnn] -> f AnnsModule
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[AddEpAnn]
newAnns -> AnnsModule
annsModule { am_main = newAnns })
                             ([AddEpAnn] -> f [AddEpAnn]
k (AnnsModule -> [AddEpAnn]
am_main AnnsModule
annsModule))

-- lam_decls :: Lens AnnsModule AnnList
-- lam_decls k annsModule = fmap (\newAnns -> annsModule { am_decls = newAnns })
--                               (k (am_decls annsModule))


-- data EpAnnImportDecl = EpAnnImportDecl
--   { importDeclAnnImport    :: EpaLocation
--   , importDeclAnnPragma    :: Maybe (EpaLocation, EpaLocation)
--   , importDeclAnnSafe      :: Maybe EpaLocation
--   , importDeclAnnQualified :: Maybe EpaLocation
--   , importDeclAnnPackage   :: Maybe EpaLocation
--   , importDeclAnnAs        :: Maybe EpaLocation
--   } deriving (Data)

limportDeclAnnImport :: Lens EpAnnImportDecl EpaLocation
limportDeclAnnImport :: Lens EpAnnImportDecl Anchor
limportDeclAnnImport Anchor -> f Anchor
k EpAnnImportDecl
annImp = (Anchor -> EpAnnImportDecl) -> f Anchor -> f EpAnnImportDecl
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> EpAnnImportDecl
annImp { importDeclAnnImport = new })
                                     (Anchor -> f Anchor
k (EpAnnImportDecl -> Anchor
importDeclAnnImport EpAnnImportDecl
annImp))

-- limportDeclAnnPragma :: Lens EpAnnImportDecl (Maybe (EpaLocation, EpaLocation))
-- limportDeclAnnPragma k annImp = fmap (\new -> annImp { importDeclAnnPragma = new })
--                                      (k (importDeclAnnPragma annImp))

limportDeclAnnSafe :: Lens EpAnnImportDecl (Maybe EpaLocation)
limportDeclAnnSafe :: Lens EpAnnImportDecl (Maybe Anchor)
limportDeclAnnSafe Maybe Anchor -> f (Maybe Anchor)
k EpAnnImportDecl
annImp = (Maybe Anchor -> EpAnnImportDecl)
-> f (Maybe Anchor) -> f EpAnnImportDecl
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Anchor
new -> EpAnnImportDecl
annImp { importDeclAnnSafe = new })
                                     (Maybe Anchor -> f (Maybe Anchor)
k (EpAnnImportDecl -> Maybe Anchor
importDeclAnnSafe EpAnnImportDecl
annImp))

limportDeclAnnQualified :: Lens EpAnnImportDecl (Maybe EpaLocation)
limportDeclAnnQualified :: Lens EpAnnImportDecl (Maybe Anchor)
limportDeclAnnQualified Maybe Anchor -> f (Maybe Anchor)
k EpAnnImportDecl
annImp = (Maybe Anchor -> EpAnnImportDecl)
-> f (Maybe Anchor) -> f EpAnnImportDecl
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Anchor
new -> EpAnnImportDecl
annImp { importDeclAnnQualified = new })
                                     (Maybe Anchor -> f (Maybe Anchor)
k (EpAnnImportDecl -> Maybe Anchor
importDeclAnnQualified EpAnnImportDecl
annImp))

limportDeclAnnPackage :: Lens EpAnnImportDecl (Maybe EpaLocation)
limportDeclAnnPackage :: Lens EpAnnImportDecl (Maybe Anchor)
limportDeclAnnPackage Maybe Anchor -> f (Maybe Anchor)
k EpAnnImportDecl
annImp = (Maybe Anchor -> EpAnnImportDecl)
-> f (Maybe Anchor) -> f EpAnnImportDecl
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Anchor
new -> EpAnnImportDecl
annImp { importDeclAnnPackage = new })
                                     (Maybe Anchor -> f (Maybe Anchor)
k (EpAnnImportDecl -> Maybe Anchor
importDeclAnnPackage EpAnnImportDecl
annImp))

-- limportDeclAnnAs :: Lens EpAnnImportDecl (Maybe EpaLocation)
-- limportDeclAnnAs k annImp = fmap (\new -> annImp { importDeclAnnAs = new })
--                                      (k (importDeclAnnAs annImp))

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

-- data AnnList
--   = AnnList {
--       al_anchor    :: Maybe Anchor, -- ^ start point of a list having layout
--       al_open      :: Maybe AddEpAnn,
--       al_close     :: Maybe AddEpAnn,
--       al_rest      :: [AddEpAnn], -- ^ context, such as 'where' keyword
--       al_trailing  :: [TrailingAnn] -- ^ items appearing after the
--                                     -- list, such as '=>' for a
--                                     -- context
--       } deriving (Data,Eq)

lal_open :: Lens AnnList (Maybe AddEpAnn)
lal_open :: Lens AnnList (Maybe AddEpAnn)
lal_open Maybe AddEpAnn -> f (Maybe AddEpAnn)
k AnnList
parent = (Maybe AddEpAnn -> AnnList) -> f (Maybe AddEpAnn) -> f AnnList
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe AddEpAnn
new -> AnnList
parent { al_open = new })
                           (Maybe AddEpAnn -> f (Maybe AddEpAnn)
k (AnnList -> Maybe AddEpAnn
al_open AnnList
parent))

lal_close :: Lens AnnList (Maybe AddEpAnn)
lal_close :: Lens AnnList (Maybe AddEpAnn)
lal_close Maybe AddEpAnn -> f (Maybe AddEpAnn)
k AnnList
parent = (Maybe AddEpAnn -> AnnList) -> f (Maybe AddEpAnn) -> f AnnList
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe AddEpAnn
new -> AnnList
parent { al_close = new })
                           (Maybe AddEpAnn -> f (Maybe AddEpAnn)
k (AnnList -> Maybe AddEpAnn
al_close AnnList
parent))

lal_rest :: Lens AnnList [AddEpAnn]
lal_rest :: Lens AnnList [AddEpAnn]
lal_rest [AddEpAnn] -> f [AddEpAnn]
k AnnList
parent = ([AddEpAnn] -> AnnList) -> f [AddEpAnn] -> f AnnList
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[AddEpAnn]
new -> AnnList
parent { al_rest = new })
                           ([AddEpAnn] -> f [AddEpAnn]
k (AnnList -> [AddEpAnn]
al_rest AnnList
parent))

-- lal_trailing :: Lens AnnList [TrailingAnn]
-- lal_trailing k parent = fmap (\new -> parent { al_trailing = new })
--                            (k (al_trailing parent))

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

lapr_rest :: Lens AnnPragma [AddEpAnn]
lapr_rest :: Lens AnnPragma [AddEpAnn]
lapr_rest [AddEpAnn] -> f [AddEpAnn]
k AnnPragma
parent = ([AddEpAnn] -> AnnPragma) -> f [AddEpAnn] -> f AnnPragma
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[AddEpAnn]
newAnns -> AnnPragma
parent { apr_rest = newAnns })
                          ([AddEpAnn] -> f [AddEpAnn]
k (AnnPragma -> [AddEpAnn]
apr_rest AnnPragma
parent))

lapr_open :: Lens AnnPragma AddEpAnn
lapr_open :: Lens AnnPragma AddEpAnn
lapr_open AddEpAnn -> f AddEpAnn
k AnnPragma
parent = (AddEpAnn -> AnnPragma) -> f AddEpAnn -> f AnnPragma
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AddEpAnn
new -> AnnPragma
parent { apr_open = new })
                          (AddEpAnn -> f AddEpAnn
k (AnnPragma -> AddEpAnn
apr_open AnnPragma
parent))

lapr_close :: Lens AnnPragma AddEpAnn
lapr_close :: Lens AnnPragma AddEpAnn
lapr_close AddEpAnn -> f AddEpAnn
k AnnPragma
parent = (AddEpAnn -> AnnPragma) -> f AddEpAnn -> f AnnPragma
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AddEpAnn
new -> AnnPragma
parent { apr_close = new })
                          (AddEpAnn -> f AddEpAnn
k (AnnPragma -> AddEpAnn
apr_close AnnPragma
parent))

lidl :: Lens [AddEpAnn] [AddEpAnn]
lidl :: Lens [AddEpAnn] [AddEpAnn]
lidl [AddEpAnn] -> f [AddEpAnn]
k [AddEpAnn]
parent = ([AddEpAnn] -> [AddEpAnn]) -> f [AddEpAnn] -> f [AddEpAnn]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[AddEpAnn]
new -> [AddEpAnn]
new)
                     ([AddEpAnn] -> f [AddEpAnn]
k [AddEpAnn]
parent)

lid :: Lens a a
lid :: forall a (f :: * -> *). Functor f => (a -> f a) -> a -> f a
lid a -> f a
k a
parent = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
new -> a
new)
                    (a -> f a
k a
parent)

lfst :: Lens (a,a) a
lfst :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
lfst a -> f a
k (a, a)
parent = (a -> (a, a)) -> f a -> f (a, a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
new -> (a
new, (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
parent))
                     (a -> f a
k ((a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
parent))

lsnd :: Lens (a,a) a
lsnd :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
lsnd a -> f a
k (a, a)
parent = (a -> (a, a)) -> f a -> f (a, a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
new -> ((a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
parent, a
new))
                     (a -> f a
k ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
parent))

-- -------------------------------------
-- data AnnExplicitSum
--   = AnnExplicitSum {
--       aesOpen       :: EpaLocation,
--       aesBarsBefore :: [EpaLocation],
--       aesBarsAfter  :: [EpaLocation],
--       aesClose      :: EpaLocation
--       } deriving Data

laesOpen :: Lens AnnExplicitSum EpaLocation
laesOpen :: Lens AnnExplicitSum Anchor
laesOpen Anchor -> f Anchor
k AnnExplicitSum
parent = (Anchor -> AnnExplicitSum) -> f Anchor -> f AnnExplicitSum
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> AnnExplicitSum
parent { aesOpen = new })
                         (Anchor -> f Anchor
k (AnnExplicitSum -> Anchor
aesOpen AnnExplicitSum
parent))

laesBarsBefore :: Lens AnnExplicitSum [EpaLocation]
laesBarsBefore :: Lens AnnExplicitSum [Anchor]
laesBarsBefore [Anchor] -> f [Anchor]
k AnnExplicitSum
parent = ([Anchor] -> AnnExplicitSum) -> f [Anchor] -> f AnnExplicitSum
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Anchor]
new -> AnnExplicitSum
parent { aesBarsBefore = new })
                               ([Anchor] -> f [Anchor]
k (AnnExplicitSum -> [Anchor]
aesBarsBefore AnnExplicitSum
parent))

laesBarsAfter :: Lens AnnExplicitSum [EpaLocation]
laesBarsAfter :: Lens AnnExplicitSum [Anchor]
laesBarsAfter [Anchor] -> f [Anchor]
k AnnExplicitSum
parent = ([Anchor] -> AnnExplicitSum) -> f [Anchor] -> f AnnExplicitSum
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Anchor]
new -> AnnExplicitSum
parent { aesBarsAfter = new })
                               ([Anchor] -> f [Anchor]
k (AnnExplicitSum -> [Anchor]
aesBarsAfter AnnExplicitSum
parent))

laesClose :: Lens AnnExplicitSum EpaLocation
laesClose :: Lens AnnExplicitSum Anchor
laesClose Anchor -> f Anchor
k AnnExplicitSum
parent = (Anchor -> AnnExplicitSum) -> f Anchor -> f AnnExplicitSum
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> AnnExplicitSum
parent { aesClose = new })
                               (Anchor -> f Anchor
k (AnnExplicitSum -> Anchor
aesClose AnnExplicitSum
parent))

-- -------------------------------------
-- data AnnFieldLabel
--   = AnnFieldLabel {
--       afDot :: Maybe EpaLocation
--       } deriving Data

lafDot :: Lens AnnFieldLabel (Maybe EpaLocation)
lafDot :: Lens AnnFieldLabel (Maybe Anchor)
lafDot Maybe Anchor -> f (Maybe Anchor)
k AnnFieldLabel
parent = (Maybe Anchor -> AnnFieldLabel)
-> f (Maybe Anchor) -> f AnnFieldLabel
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Anchor
new -> AnnFieldLabel
parent { afDot = new })
                         (Maybe Anchor -> f (Maybe Anchor)
k (AnnFieldLabel -> Maybe Anchor
afDot AnnFieldLabel
parent))

-- -------------------------------------
-- data AnnProjection
--   = AnnProjection {
--       apOpen  :: EpaLocation, -- ^ '('
--       apClose :: EpaLocation  -- ^ ')'
--       } deriving Data

lapOpen :: Lens AnnProjection EpaLocation
lapOpen :: Lens AnnProjection Anchor
lapOpen Anchor -> f Anchor
k AnnProjection
parent = (Anchor -> AnnProjection) -> f Anchor -> f AnnProjection
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> AnnProjection
parent { apOpen = new })
                         (Anchor -> f Anchor
k (AnnProjection -> Anchor
apOpen AnnProjection
parent))

lapClose :: Lens AnnProjection EpaLocation
lapClose :: Lens AnnProjection Anchor
lapClose Anchor -> f Anchor
k AnnProjection
parent = (Anchor -> AnnProjection) -> f Anchor -> f AnnProjection
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> AnnProjection
parent { apClose = new })
                         (Anchor -> f Anchor
k (AnnProjection -> Anchor
apClose AnnProjection
parent))

-- -------------------------------------
-- data AnnsIf
--   = AnnsIf {
--       aiIf       :: EpaLocation,
--       aiThen     :: EpaLocation,
--       aiElse     :: EpaLocation,
--       aiThenSemi :: Maybe EpaLocation,
--       aiElseSemi :: Maybe EpaLocation
--       } deriving Data

laiIf :: Lens AnnsIf EpaLocation
laiIf :: Lens AnnsIf Anchor
laiIf Anchor -> f Anchor
k AnnsIf
parent = (Anchor -> AnnsIf) -> f Anchor -> f AnnsIf
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> AnnsIf
parent { aiIf = new })
                      (Anchor -> f Anchor
k (AnnsIf -> Anchor
aiIf AnnsIf
parent))

laiThen :: Lens AnnsIf EpaLocation
laiThen :: Lens AnnsIf Anchor
laiThen Anchor -> f Anchor
k AnnsIf
parent = (Anchor -> AnnsIf) -> f Anchor -> f AnnsIf
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> AnnsIf
parent { aiThen = new })
                        (Anchor -> f Anchor
k (AnnsIf -> Anchor
aiThen AnnsIf
parent))

laiElse :: Lens AnnsIf EpaLocation
laiElse :: Lens AnnsIf Anchor
laiElse Anchor -> f Anchor
k AnnsIf
parent = (Anchor -> AnnsIf) -> f Anchor -> f AnnsIf
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> AnnsIf
parent { aiElse = new })
                        (Anchor -> f Anchor
k (AnnsIf -> Anchor
aiElse AnnsIf
parent))

laiThenSemi :: Lens AnnsIf (Maybe EpaLocation)
laiThenSemi :: Lens AnnsIf (Maybe Anchor)
laiThenSemi Maybe Anchor -> f (Maybe Anchor)
k AnnsIf
parent = (Maybe Anchor -> AnnsIf) -> f (Maybe Anchor) -> f AnnsIf
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Anchor
new -> AnnsIf
parent { aiThenSemi = new })
                            (Maybe Anchor -> f (Maybe Anchor)
k (AnnsIf -> Maybe Anchor
aiThenSemi AnnsIf
parent))

laiElseSemi :: Lens AnnsIf (Maybe EpaLocation)
laiElseSemi :: Lens AnnsIf (Maybe Anchor)
laiElseSemi Maybe Anchor -> f (Maybe Anchor)
k AnnsIf
parent = (Maybe Anchor -> AnnsIf) -> f (Maybe Anchor) -> f AnnsIf
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Anchor
new -> AnnsIf
parent { aiElseSemi = new })
                            (Maybe Anchor -> f (Maybe Anchor)
k (AnnsIf -> Maybe Anchor
aiElseSemi AnnsIf
parent))

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

-- data AnnParen
--   = AnnParen {
--       ap_adornment :: ParenType,
--       ap_open      :: EpaLocation,
--       ap_close     :: EpaLocation
--       } deriving (Data)

-- lap_open :: Lens AnnParen EpaLocation
-- lap_open k parent = fmap (\new -> parent { ap_open = new })
--                          (k (ap_open parent))

-- lap_close :: Lens AnnParen EpaLocation
-- lap_close k parent = fmap (\new -> parent { ap_close = new })
--                           (k (ap_close parent))

-- -------------------------------------
-- data EpAnnHsCase = EpAnnHsCase
--       { hsCaseAnnCase :: EpaLocation
--       , hsCaseAnnOf   :: EpaLocation
--       , hsCaseAnnsRest :: [AddEpAnn]
--       } deriving Data

lhsCaseAnnCase :: Lens EpAnnHsCase EpaLocation
lhsCaseAnnCase :: Lens EpAnnHsCase Anchor
lhsCaseAnnCase Anchor -> f Anchor
k EpAnnHsCase
parent = (Anchor -> EpAnnHsCase) -> f Anchor -> f EpAnnHsCase
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> EpAnnHsCase
parent { hsCaseAnnCase = new })
                               (Anchor -> f Anchor
k (EpAnnHsCase -> Anchor
hsCaseAnnCase EpAnnHsCase
parent))

lhsCaseAnnOf :: Lens EpAnnHsCase EpaLocation
lhsCaseAnnOf :: Lens EpAnnHsCase Anchor
lhsCaseAnnOf Anchor -> f Anchor
k EpAnnHsCase
parent = (Anchor -> EpAnnHsCase) -> f Anchor -> f EpAnnHsCase
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Anchor
new -> EpAnnHsCase
parent { hsCaseAnnOf = new })
                               (Anchor -> f Anchor
k (EpAnnHsCase -> Anchor
hsCaseAnnOf EpAnnHsCase
parent))

lhsCaseAnnsRest :: Lens EpAnnHsCase [AddEpAnn]
lhsCaseAnnsRest :: Lens EpAnnHsCase [AddEpAnn]
lhsCaseAnnsRest [AddEpAnn] -> f [AddEpAnn]
k EpAnnHsCase
parent = ([AddEpAnn] -> EpAnnHsCase) -> f [AddEpAnn] -> f EpAnnHsCase
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[AddEpAnn]
new -> EpAnnHsCase
parent { hsCaseAnnsRest = new })
                                ([AddEpAnn] -> f [AddEpAnn]
k (EpAnnHsCase -> [AddEpAnn]
hsCaseAnnsRest EpAnnHsCase
parent))

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

-- data HsRuleAnn
--   = HsRuleAnn
--        { ra_tyanns :: Maybe (AddEpAnn, AddEpAnn)
--                  -- ^ The locations of 'forall' and '.' for forall'd type vars
--                  -- Using AddEpAnn to capture possible unicode variants
--        , ra_tmanns :: Maybe (AddEpAnn, AddEpAnn)
--                  -- ^ The locations of 'forall' and '.' for forall'd term vars
--                  -- Using AddEpAnn to capture possible unicode variants
--        , ra_rest :: [AddEpAnn]
--        } deriving (Data, Eq)

lra_tyanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))
lra_tyanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))
lra_tyanns Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn))
k HsRuleAnn
parent = (Maybe (AddEpAnn, AddEpAnn) -> HsRuleAnn)
-> f (Maybe (AddEpAnn, AddEpAnn)) -> f HsRuleAnn
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (AddEpAnn, AddEpAnn)
new -> HsRuleAnn
parent { ra_tyanns = new })
                               (Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn))
k (HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
ra_tyanns HsRuleAnn
parent))

ff :: Maybe (a,b) -> (Maybe a,Maybe b)
ff :: forall a b. Maybe (a, b) -> (Maybe a, Maybe b)
ff Maybe (a, b)
Nothing = (Maybe a
forall a. Maybe a
Nothing, Maybe b
forall a. Maybe a
Nothing)
ff (Just (a
a,b
b)) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b -> Maybe b
forall a. a -> Maybe a
Just b
b)


gg :: (Maybe a,Maybe b) -> Maybe (a,b)
gg :: forall a b. (Maybe a, Maybe b) -> Maybe (a, b)
gg (Maybe a
Nothing, Maybe b
Nothing) = Maybe (a, b)
forall a. Maybe a
Nothing
gg (Just a
a, Just b
b) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a,b
b)
gg (Maybe a, Maybe b)
_ = String -> Maybe (a, b)
forall a. HasCallStack => String -> a
error String
"gg:expecting two Nothing or two Just"

lff :: Lens (Maybe (a,b)) (Maybe a,Maybe b)
lff :: forall a b (f :: * -> *).
Functor f =>
((Maybe a, Maybe b) -> f (Maybe a, Maybe b))
-> Maybe (a, b) -> f (Maybe (a, b))
lff (Maybe a, Maybe b) -> f (Maybe a, Maybe b)
k Maybe (a, b)
parent = ((Maybe a, Maybe b) -> Maybe (a, b))
-> f (Maybe a, Maybe b) -> f (Maybe (a, b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe a, Maybe b)
new -> (Maybe a, Maybe b) -> Maybe (a, b)
forall a b. (Maybe a, Maybe b) -> Maybe (a, b)
gg (Maybe a, Maybe b)
new)
                    ((Maybe a, Maybe b) -> f (Maybe a, Maybe b)
k (Maybe (a, b) -> (Maybe a, Maybe b)
forall a b. Maybe (a, b) -> (Maybe a, Maybe b)
ff Maybe (a, b)
parent))

-- (.) :: Lens' a b -> Lens' b c -> Lens' a c
lra_tyanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)
lra_tyanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)
lra_tyanns_fst = (Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> HsRuleAnn -> f HsRuleAnn
Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))
lra_tyanns ((Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
 -> HsRuleAnn -> f HsRuleAnn)
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn))
    -> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> HsRuleAnn
-> f HsRuleAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe AddEpAnn, Maybe AddEpAnn)
 -> f (Maybe AddEpAnn, Maybe AddEpAnn))
-> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn))
forall a b (f :: * -> *).
Functor f =>
((Maybe a, Maybe b) -> f (Maybe a, Maybe b))
-> Maybe (a, b) -> f (Maybe (a, b))
lff (((Maybe AddEpAnn, Maybe AddEpAnn)
  -> f (Maybe AddEpAnn, Maybe AddEpAnn))
 -> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn))
    -> (Maybe AddEpAnn, Maybe AddEpAnn)
    -> f (Maybe AddEpAnn, Maybe AddEpAnn))
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> Maybe (AddEpAnn, AddEpAnn)
-> f (Maybe (AddEpAnn, AddEpAnn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> (Maybe AddEpAnn, Maybe AddEpAnn)
-> f (Maybe AddEpAnn, Maybe AddEpAnn)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
lfst

lra_tyanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)
lra_tyanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)
lra_tyanns_snd = (Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> HsRuleAnn -> f HsRuleAnn
Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))
lra_tyanns ((Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
 -> HsRuleAnn -> f HsRuleAnn)
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn))
    -> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> HsRuleAnn
-> f HsRuleAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe AddEpAnn, Maybe AddEpAnn)
 -> f (Maybe AddEpAnn, Maybe AddEpAnn))
-> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn))
forall a b (f :: * -> *).
Functor f =>
((Maybe a, Maybe b) -> f (Maybe a, Maybe b))
-> Maybe (a, b) -> f (Maybe (a, b))
lff (((Maybe AddEpAnn, Maybe AddEpAnn)
  -> f (Maybe AddEpAnn, Maybe AddEpAnn))
 -> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn))
    -> (Maybe AddEpAnn, Maybe AddEpAnn)
    -> f (Maybe AddEpAnn, Maybe AddEpAnn))
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> Maybe (AddEpAnn, AddEpAnn)
-> f (Maybe (AddEpAnn, AddEpAnn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> (Maybe AddEpAnn, Maybe AddEpAnn)
-> f (Maybe AddEpAnn, Maybe AddEpAnn)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
lsnd

lra_tmanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))
lra_tmanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))
lra_tmanns Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn))
k HsRuleAnn
parent = (Maybe (AddEpAnn, AddEpAnn) -> HsRuleAnn)
-> f (Maybe (AddEpAnn, AddEpAnn)) -> f HsRuleAnn
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (AddEpAnn, AddEpAnn)
new -> HsRuleAnn
parent { ra_tmanns = new })
                               (Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn))
k (HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
ra_tmanns HsRuleAnn
parent))

lra_tmanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)
lra_tmanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)
lra_tmanns_fst = (Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> HsRuleAnn -> f HsRuleAnn
Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))
lra_tmanns ((Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
 -> HsRuleAnn -> f HsRuleAnn)
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn))
    -> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> HsRuleAnn
-> f HsRuleAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe AddEpAnn, Maybe AddEpAnn)
 -> f (Maybe AddEpAnn, Maybe AddEpAnn))
-> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn))
forall a b (f :: * -> *).
Functor f =>
((Maybe a, Maybe b) -> f (Maybe a, Maybe b))
-> Maybe (a, b) -> f (Maybe (a, b))
lff (((Maybe AddEpAnn, Maybe AddEpAnn)
  -> f (Maybe AddEpAnn, Maybe AddEpAnn))
 -> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn))
    -> (Maybe AddEpAnn, Maybe AddEpAnn)
    -> f (Maybe AddEpAnn, Maybe AddEpAnn))
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> Maybe (AddEpAnn, AddEpAnn)
-> f (Maybe (AddEpAnn, AddEpAnn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> (Maybe AddEpAnn, Maybe AddEpAnn)
-> f (Maybe AddEpAnn, Maybe AddEpAnn)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
lfst

lra_tmanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)
lra_tmanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)
lra_tmanns_snd = (Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> HsRuleAnn -> f HsRuleAnn
Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))
lra_tmanns ((Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
 -> HsRuleAnn -> f HsRuleAnn)
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn))
    -> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> HsRuleAnn
-> f HsRuleAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe AddEpAnn, Maybe AddEpAnn)
 -> f (Maybe AddEpAnn, Maybe AddEpAnn))
-> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn))
forall a b (f :: * -> *).
Functor f =>
((Maybe a, Maybe b) -> f (Maybe a, Maybe b))
-> Maybe (a, b) -> f (Maybe (a, b))
lff (((Maybe AddEpAnn, Maybe AddEpAnn)
  -> f (Maybe AddEpAnn, Maybe AddEpAnn))
 -> Maybe (AddEpAnn, AddEpAnn) -> f (Maybe (AddEpAnn, AddEpAnn)))
-> ((Maybe AddEpAnn -> f (Maybe AddEpAnn))
    -> (Maybe AddEpAnn, Maybe AddEpAnn)
    -> f (Maybe AddEpAnn, Maybe AddEpAnn))
-> (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> Maybe (AddEpAnn, AddEpAnn)
-> f (Maybe (AddEpAnn, AddEpAnn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AddEpAnn -> f (Maybe AddEpAnn))
-> (Maybe AddEpAnn, Maybe AddEpAnn)
-> f (Maybe AddEpAnn, Maybe AddEpAnn)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
lsnd

lra_rest :: Lens HsRuleAnn [AddEpAnn]
lra_rest :: Lens HsRuleAnn [AddEpAnn]
lra_rest [AddEpAnn] -> f [AddEpAnn]
k HsRuleAnn
parent = ([AddEpAnn] -> HsRuleAnn) -> f [AddEpAnn] -> f HsRuleAnn
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[AddEpAnn]
new -> HsRuleAnn
parent { ra_rest = new })
                                ([AddEpAnn] -> f [AddEpAnn]
k (HsRuleAnn -> [AddEpAnn]
ra_rest HsRuleAnn
parent))


-- ---------------------------------------------------------------------
-- data GrhsAnn
--   = GrhsAnn {
--       ga_vbar :: Maybe EpaLocation, -- TODO:AZ do we need this?
--       ga_sep  :: AddEpAnn -- ^ Match separator location
--       } deriving (Data)

lga_vbar :: Lens GrhsAnn (Maybe EpaLocation)
lga_vbar :: Lens GrhsAnn (Maybe Anchor)
lga_vbar Maybe Anchor -> f (Maybe Anchor)
k GrhsAnn
parent = (Maybe Anchor -> GrhsAnn) -> f (Maybe Anchor) -> f GrhsAnn
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Anchor
new -> GrhsAnn
parent { ga_vbar = new })
                                (Maybe Anchor -> f (Maybe Anchor)
k (GrhsAnn -> Maybe Anchor
ga_vbar GrhsAnn
parent))

lga_sep :: Lens GrhsAnn AddEpAnn
lga_sep :: Lens GrhsAnn AddEpAnn
lga_sep AddEpAnn -> f AddEpAnn
k GrhsAnn
parent = (AddEpAnn -> GrhsAnn) -> f AddEpAnn -> f GrhsAnn
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AddEpAnn
new -> GrhsAnn
parent { ga_sep = new })
                                (AddEpAnn -> f AddEpAnn
k (GrhsAnn -> AddEpAnn
ga_sep GrhsAnn
parent))

-- ---------------------------------------------------------------------
-- data AnnSig
--   = AnnSig {
--       asDcolon :: AddEpAnn, -- Not an EpaAnchor to capture unicode option
--       asRest   :: [AddEpAnn]
--       } deriving Data

lasDcolon :: Lens AnnSig AddEpAnn
lasDcolon :: Lens AnnSig AddEpAnn
lasDcolon AddEpAnn -> f AddEpAnn
k AnnSig
parent = (AddEpAnn -> AnnSig) -> f AddEpAnn -> f AnnSig
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AddEpAnn
new -> AnnSig
parent { asDcolon = new })
                                (AddEpAnn -> f AddEpAnn
k (AnnSig -> AddEpAnn
asDcolon AnnSig
parent))

lasRest :: Lens AnnSig [AddEpAnn]
lasRest :: Lens AnnSig [AddEpAnn]
lasRest [AddEpAnn] -> f [AddEpAnn]
k AnnSig
parent = ([AddEpAnn] -> AnnSig) -> f [AddEpAnn] -> f AnnSig
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[AddEpAnn]
new -> AnnSig
parent { asRest = new })
                                ([AddEpAnn] -> f [AddEpAnn]
k (AnnSig -> [AddEpAnn]
asRest AnnSig
parent))

-- ---------------------------------------------------------------------
-- data EpAnnSumPat = EpAnnSumPat
--       { sumPatParens      :: [AddEpAnn]
--       , sumPatVbarsBefore :: [EpaLocation]
--       , sumPatVbarsAfter  :: [EpaLocation]
--       } deriving Data

lsumPatParens :: Lens EpAnnSumPat [AddEpAnn]
lsumPatParens :: Lens EpAnnSumPat [AddEpAnn]
lsumPatParens [AddEpAnn] -> f [AddEpAnn]
k EpAnnSumPat
parent = ([AddEpAnn] -> EpAnnSumPat) -> f [AddEpAnn] -> f EpAnnSumPat
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[AddEpAnn]
new -> EpAnnSumPat
parent { sumPatParens = new })
                              ([AddEpAnn] -> f [AddEpAnn]
k (EpAnnSumPat -> [AddEpAnn]
sumPatParens EpAnnSumPat
parent))

lsumPatVbarsBefore :: Lens EpAnnSumPat [EpaLocation]
lsumPatVbarsBefore :: Lens EpAnnSumPat [Anchor]
lsumPatVbarsBefore [Anchor] -> f [Anchor]
k EpAnnSumPat
parent = ([Anchor] -> EpAnnSumPat) -> f [Anchor] -> f EpAnnSumPat
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Anchor]
new -> EpAnnSumPat
parent { sumPatVbarsBefore = new })
                              ([Anchor] -> f [Anchor]
k (EpAnnSumPat -> [Anchor]
sumPatVbarsBefore EpAnnSumPat
parent))

lsumPatVbarsAfter :: Lens EpAnnSumPat [EpaLocation]
lsumPatVbarsAfter :: Lens EpAnnSumPat [Anchor]
lsumPatVbarsAfter [Anchor] -> f [Anchor]
k EpAnnSumPat
parent = ([Anchor] -> EpAnnSumPat) -> f [Anchor] -> f EpAnnSumPat
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Anchor]
new -> EpAnnSumPat
parent { sumPatVbarsAfter = new })
                              ([Anchor] -> f [Anchor]
k (EpAnnSumPat -> [Anchor]
sumPatVbarsAfter EpAnnSumPat
parent))

-- End of lenses
-- ---------------------------------------------------------------------

markLensKwA :: (Monad m, Monoid w)
  => a -> Lens a AddEpAnn -> EP w m a
markLensKwA :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AddEpAnn -> EP w m a
markLensKwA a
a Lens a AddEpAnn
l = do
  loc <- AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markKw (Getting a AddEpAnn -> a -> AddEpAnn
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a AddEpAnn
Lens a AddEpAnn
l a
a)
  return (set l loc a)

markLensKw' :: (Monad m, Monoid w)
  => EpAnn a -> Lens a EpaLocation -> AnnKeywordId -> EP w m (EpAnn a)
markLensKw' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a Anchor -> AnnKeywordId -> EP w m (EpAnn a)
markLensKw' (EpAnn Anchor
anc a
a EpAnnComments
cs) Lens a Anchor
l AnnKeywordId
kw = do
  loc <- AnnKeywordId -> Anchor -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
kw (Getting a Anchor -> a -> Anchor
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a Anchor
Lens a Anchor
l a
a)
  return (EpAnn anc (set l loc a) cs)

markLensKw :: (Monad m, Monoid w)
  => a -> Lens a EpaLocation -> AnnKeywordId -> EP w m a
markLensKw :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a Anchor -> AnnKeywordId -> EP w m a
markLensKw a
a Lens a Anchor
l AnnKeywordId
kw = do
  loc <- AnnKeywordId -> Anchor -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
kw (Getting a Anchor -> a -> Anchor
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a Anchor
Lens a Anchor
l a
a)
  return (set l loc a)

markAnnKwAllL :: (Monad m, Monoid w)
  => a -> Lens a [EpaLocation] -> AnnKeywordId -> EP w m a
markAnnKwAllL :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [Anchor] -> AnnKeywordId -> EP w m a
markAnnKwAllL a
a Lens a [Anchor]
l AnnKeywordId
kw = do
  anns <- (Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor)
-> [Anchor] -> RWST (EPOptions m w) (EPWriter w) EPState m [Anchor]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
kw) (Getting a [Anchor] -> a -> [Anchor]
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a [Anchor]
Lens a [Anchor]
l a
a)
  return (set l anns a)

markLensKwM :: (Monad m, Monoid w)
  => EpAnn a -> Lens a (Maybe EpaLocation) -> AnnKeywordId -> EP w m (EpAnn a)
markLensKwM :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a (Maybe Anchor) -> AnnKeywordId -> EP w m (EpAnn a)
markLensKwM (EpAnn Anchor
anc a
a EpAnnComments
cs) Lens a (Maybe Anchor)
l AnnKeywordId
kw = do
  new <- Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
go (Getting a (Maybe Anchor) -> a -> Maybe Anchor
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a (Maybe Anchor)
Lens a (Maybe Anchor)
l a
a)
  return (EpAnn anc (set l new a) cs)
  where
    go :: Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
go Maybe Anchor
Nothing = Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
    go (Just Anchor
s) = Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (Anchor -> Maybe Anchor)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
kw Anchor
s

markLensKwM' :: (Monad m, Monoid w)
  => a -> Lens a (Maybe EpaLocation) -> AnnKeywordId -> EP w m a
markLensKwM' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a (Maybe Anchor) -> AnnKeywordId -> EP w m a
markLensKwM' a
a Lens a (Maybe Anchor)
l AnnKeywordId
kw = do
  new <- Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
go (Getting a (Maybe Anchor) -> a -> Maybe Anchor
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a (Maybe Anchor)
Lens a (Maybe Anchor)
l a
a)
  return (set l new a)
  where
    go :: Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
go Maybe Anchor
Nothing = Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
    go (Just Anchor
s) = Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (Anchor -> Maybe Anchor)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
kw Anchor
s

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

markEpAnnL' :: (Monad m, Monoid w)
  => EpAnn ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnL' :: forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
EpAnn ann
-> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnL' EpAnn ann
epann Lens ann [AddEpAnn]
l AnnKeywordId
kw = EpAnn ann
-> Lens (EpAnn ann) [AddEpAnn]
-> AnnKeywordId
-> EP w m (EpAnn ann)
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL EpAnn ann
epann ((ann -> f ann) -> EpAnn ann -> f (EpAnn ann)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> EpAnn a -> f (EpAnn a)
lepa ((ann -> f ann) -> EpAnn ann -> f (EpAnn ann))
-> (([AddEpAnn] -> f [AddEpAnn]) -> ann -> f ann)
-> ([AddEpAnn] -> f [AddEpAnn])
-> EpAnn ann
-> f (EpAnn ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AddEpAnn] -> f [AddEpAnn]) -> ann -> f ann
Lens ann [AddEpAnn]
l) AnnKeywordId
kw

markEpAnnL :: (Monad m, Monoid w)
  => ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL :: forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL ann
a Lens ann [AddEpAnn]
l AnnKeywordId
kw = do
  anns <- [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark (Getting ann [AddEpAnn] -> ann -> [AddEpAnn]
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting ann [AddEpAnn]
Lens ann [AddEpAnn]
l ann
a) AnnKeywordId
kw
  return (set l anns a)

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

markEpAnnAllL :: (Monad m, Monoid w)
  => EpAnn ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnAllL :: forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
EpAnn ann
-> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnAllL (EpAnn Anchor
anc ann
a EpAnnComments
cs) Lens ann [AddEpAnn]
l AnnKeywordId
kw = do
  anns <- (AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn)
-> [AddEpAnn]
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
doit (Getting ann [AddEpAnn] -> ann -> [AddEpAnn]
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting ann [AddEpAnn]
Lens ann [AddEpAnn]
l ann
a)
  return (EpAnn anc (set l anns a) cs)
  where
    doit :: AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
doit an :: AddEpAnn
an@(AddEpAnn AnnKeywordId
ka Anchor
_)
      = if AnnKeywordId
ka AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw
          then AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markKw AddEpAnn
an
          else AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return AddEpAnn
an

markEpAnnAllL' :: (Monad m, Monoid w)
  => ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnAllL' :: forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnAllL' ann
a Lens ann [AddEpAnn]
l AnnKeywordId
kw = do
  anns <- (AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn)
-> [AddEpAnn]
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
doit (Getting ann [AddEpAnn] -> ann -> [AddEpAnn]
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting ann [AddEpAnn]
Lens ann [AddEpAnn]
l ann
a)
  return (set l anns a)
  where
    doit :: AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
doit an :: AddEpAnn
an@(AddEpAnn AnnKeywordId
ka Anchor
_)
      = if AnnKeywordId
ka AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw
          then AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markKw AddEpAnn
an
          else AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return AddEpAnn
an

markAddEpAnn :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn
markAddEpAnn :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markAddEpAnn a :: AddEpAnn
a@(AddEpAnn AnnKeywordId
kw Anchor
_) = do
  r <- [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn
a] AnnKeywordId
kw
  case r of
    [AddEpAnn
a'] -> AddEpAnn -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return AddEpAnn
a'
    [AddEpAnn]
_ -> String -> RWST (EPOptions m w) (EPWriter w) EPState m AddEpAnn
forall a. HasCallStack => String -> a
error String
"Should not happen: markAddEpAnn"

mark :: (Monad m, Monoid w) => [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
anns AnnKeywordId
kw = do
  case AnnKeywordId
-> [AddEpAnn] -> ([AddEpAnn], Maybe AddEpAnn, [AddEpAnn])
find' AnnKeywordId
kw [AddEpAnn]
anns of
    ([AddEpAnn]
lead, Just AddEpAnn
aa, [AddEpAnn]
end) -> do
      aa' <- AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markKw AddEpAnn
aa
      return (lead ++ [aa'] ++ end)
    ([AddEpAnn]
_lead, Maybe AddEpAnn
Nothing, [AddEpAnn]
_end) -> case AnnKeywordId
-> [AddEpAnn] -> ([AddEpAnn], Maybe AddEpAnn, [AddEpAnn])
find' (AnnKeywordId -> AnnKeywordId
unicodeAnn AnnKeywordId
kw) [AddEpAnn]
anns of
      ([AddEpAnn]
leadu, Just AddEpAnn
aau, [AddEpAnn]
endu) -> do
        aau' <- AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markKw AddEpAnn
aau
        return (leadu ++ [aau'] ++ endu)
      ([AddEpAnn]
_,Maybe AddEpAnn
Nothing,[AddEpAnn]
_) -> [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
anns

-- | Find for update, returning lead section of the list, item if
-- found, and tail of the list
find' :: AnnKeywordId -> [AddEpAnn] -> ([AddEpAnn], Maybe AddEpAnn, [AddEpAnn])
find' :: AnnKeywordId
-> [AddEpAnn] -> ([AddEpAnn], Maybe AddEpAnn, [AddEpAnn])
find' AnnKeywordId
kw [AddEpAnn]
anns = ([AddEpAnn]
lead, Maybe AddEpAnn
middle, [AddEpAnn]
end)
  where
    ([AddEpAnn]
lead, [AddEpAnn]
rest) = (AddEpAnn -> Bool) -> [AddEpAnn] -> ([AddEpAnn], [AddEpAnn])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(AddEpAnn AnnKeywordId
k Anchor
_) -> AnnKeywordId
k AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw) [AddEpAnn]
anns
    (Maybe AddEpAnn
middle,[AddEpAnn]
end) = case [AddEpAnn]
rest of
      [] -> (Maybe AddEpAnn
forall a. Maybe a
Nothing, [])
      (AddEpAnn
x:[AddEpAnn]
xs) -> (AddEpAnn -> Maybe AddEpAnn
forall a. a -> Maybe a
Just AddEpAnn
x, [AddEpAnn]
xs)

markKw :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn
markKw :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AddEpAnn -> EP w m AddEpAnn
markKw AddEpAnn
an = CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
CaptureComments AddEpAnn
an

markKwC :: (Monad m, Monoid w) => CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
capture (AddEpAnn AnnKeywordId
kw Anchor
ss) = do
  ss' <- CaptureComments -> AnnKeywordId -> Anchor -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AnnKeywordId -> Anchor -> EP w m Anchor
markKwAC CaptureComments
capture AnnKeywordId
kw Anchor
ss
  return (AddEpAnn kw ss')

-- | This should be the main driver of the process, managing printing keywords.
-- It returns the 'EpaDelta' variant of the passed in 'EpaLocation'
markKwA :: (Monad m, Monoid w) => AnnKeywordId -> EpaLocation -> EP w m EpaLocation
markKwA :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
kw Anchor
aa = CaptureComments -> AnnKeywordId -> Anchor -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AnnKeywordId -> Anchor -> EP w m Anchor
markKwAC CaptureComments
CaptureComments AnnKeywordId
kw Anchor
aa

markKwAC :: (Monad m, Monoid w)
  => CaptureComments -> AnnKeywordId -> EpaLocation -> EP w m EpaLocation
markKwAC :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AnnKeywordId -> Anchor -> EP w m Anchor
markKwAC CaptureComments
capture AnnKeywordId
kw Anchor
aa = CaptureComments -> Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> Anchor -> String -> EP w m Anchor
printStringAtAAC CaptureComments
capture Anchor
aa (AnnKeywordId -> String
keywordToString AnnKeywordId
kw)

-- | Print a keyword encoded in a 'TrailingAnn'
markKwT :: (Monad m, Monoid w) => TrailingAnn -> EP w m TrailingAnn
markKwT :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
TrailingAnn -> EP w m TrailingAnn
markKwT (AddSemiAnn Anchor
ss)    = Anchor -> TrailingAnn
AddSemiAnn    (Anchor -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
AnnSemi Anchor
ss
markKwT (AddCommaAnn Anchor
ss)   = Anchor -> TrailingAnn
AddCommaAnn   (Anchor -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
AnnComma Anchor
ss
markKwT (AddVbarAnn Anchor
ss)    = Anchor -> TrailingAnn
AddVbarAnn    (Anchor -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
AnnVbar Anchor
ss
markKwT (AddDarrowAnn Anchor
ss)  = Anchor -> TrailingAnn
AddDarrowAnn  (Anchor -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
AnnDarrow Anchor
ss
markKwT (AddDarrowUAnn Anchor
ss) = Anchor -> TrailingAnn
AddDarrowUAnn (Anchor -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
AnnDarrowU Anchor
ss

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

markAnnList :: (Monad m, Monoid w)
  => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
markAnnList :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
markAnnList EpAnn AnnList
ann EP w m a
action = do
  EpAnn AnnList
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
-> EP w m (EpAnn AnnList, a)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn AnnList
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
-> EP w m (EpAnn AnnList, a)
markAnnListA EpAnn AnnList
ann ((EpAnn AnnList -> EP w m (EpAnn AnnList, a))
 -> EP w m (EpAnn AnnList, a))
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
-> EP w m (EpAnn AnnList, a)
forall a b. (a -> b) -> a -> b
$ \EpAnn AnnList
a -> do
    r <- EP w m a
action
    return (a,r)

markAnnList' :: (Monad m, Monoid w)
  => AnnList -> EP w m a -> EP w m (AnnList, a)
markAnnList' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
AnnList -> EP w m a -> EP w m (AnnList, a)
markAnnList' AnnList
ann EP w m a
action = do
  AnnList -> (AnnList -> EP w m (AnnList, a)) -> EP w m (AnnList, a)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
AnnList -> (AnnList -> EP w m (AnnList, a)) -> EP w m (AnnList, a)
markAnnListA' AnnList
ann ((AnnList -> EP w m (AnnList, a)) -> EP w m (AnnList, a))
-> (AnnList -> EP w m (AnnList, a)) -> EP w m (AnnList, a)
forall a b. (a -> b) -> a -> b
$ \AnnList
a -> do
    r <- EP w m a
action
    return (a,r)

markAnnListA :: (Monad m, Monoid w)
  => EpAnn AnnList
  -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
  -> EP w m (EpAnn AnnList, a)
markAnnListA :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn AnnList
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
-> EP w m (EpAnn AnnList, a)
markAnnListA EpAnn AnnList
an EpAnn AnnList -> EP w m (EpAnn AnnList, a)
action = do
  an0 <- EpAnn AnnList
-> Lens AnnList (Maybe AddEpAnn) -> EP w m (EpAnn AnnList)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a (Maybe AddEpAnn) -> EP w m (EpAnn a)
markLensMAA EpAnn AnnList
an (Maybe AddEpAnn -> f (Maybe AddEpAnn)) -> AnnList -> f AnnList
Lens AnnList (Maybe AddEpAnn)
lal_open
  an1 <- markEpAnnAllL an0 lal_rest AnnSemi
  (an2, r) <- action an1
  an3 <- markLensMAA an2 lal_close
  return (an3, r)

markAnnListA' :: (Monad m, Monoid w)
  => AnnList
  -> (AnnList -> EP w m (AnnList, a))
  -> EP w m (AnnList, a)
markAnnListA' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
AnnList -> (AnnList -> EP w m (AnnList, a)) -> EP w m (AnnList, a)
markAnnListA' AnnList
an AnnList -> EP w m (AnnList, a)
action = do
  an0 <- AnnList -> Lens AnnList (Maybe AddEpAnn) -> EP w m AnnList
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a (Maybe AddEpAnn) -> EP w m a
markLensMAA' AnnList
an (Maybe AddEpAnn -> f (Maybe AddEpAnn)) -> AnnList -> f AnnList
Lens AnnList (Maybe AddEpAnn)
lal_open
  an1 <- markEpAnnAllL' an0 lal_rest AnnSemi
  (an2, r) <- action an1
  an3 <- markLensMAA' an2 lal_close
  return (an3, r)

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

printCommentsBefore :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()
printCommentsBefore :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m ()
printCommentsBefore RealSrcSpan
ss = do
  cs <- RealSrcSpan -> EP w m [Comment]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m [Comment]
commentAllocationBefore RealSrcSpan
ss
  debugM $ "printCommentsBefore: (ss): " ++ showPprUnsafe (rs2range ss)
  -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentLoc cs)
  mapM_ printOneComment cs

printCommentsIn :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()
printCommentsIn :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m ()
printCommentsIn RealSrcSpan
ss = do
  cs <- RealSrcSpan -> EP w m [Comment]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m [Comment]
commentAllocationIn RealSrcSpan
ss
  debugM $ "printCommentsIn: (ss): " ++ showPprUnsafe (rs2range ss)
  -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentLoc cs)
  mapM_ printOneComment cs
  debugM $ "printCommentsIn:done"

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

printOneComment :: (Monad m, Monoid w) => Comment -> EP w m ()
printOneComment :: forall (m :: * -> *) w. (Monad m, Monoid w) => Comment -> EP w m ()
printOneComment c :: Comment
c@(Comment String
_str EpaLocation' NoComments
loc RealSrcSpan
_r Maybe AnnKeywordId
_mo) = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"printOneComment:c=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Comment -> String
forall a. Outputable a => a -> String
showGhc Comment
c
  dp <-case EpaLocation' NoComments
loc of
    EpaDelta DeltaPos
dp NoComments
_ -> DeltaPos -> RWST (EPOptions m w) (EPWriter w) EPState m DeltaPos
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return DeltaPos
dp
    EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_) -> do
        pe <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD
        debugM $ "printOneComment:pe=" ++ showGhc pe
        let dp = Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
pe RealSrcSpan
r
        debugM $ "printOneComment:(dp,pe,loc)=" ++ showGhc (dp,pe,loc)
        adjustDeltaForOffsetM dp
    EpaSpan (UnhelpfulSpan UnhelpfulSpanReason
_) -> DeltaPos -> RWST (EPOptions m w) (EPWriter w) EPState m DeltaPos
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> DeltaPos
SameLine Int
0)
  mep <- getExtraDP
  dp' <- case mep of
    Just (EpaDelta DeltaPos
edp [LEpaComment]
_) -> do
      String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"printOneComment:edp=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeltaPos -> String
forall a. Show a => a -> String
show DeltaPos
edp
      DeltaPos -> RWST (EPOptions m w) (EPWriter w) EPState m DeltaPos
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> EP w m DeltaPos
adjustDeltaForOffsetM DeltaPos
edp
    Maybe Anchor
_ -> DeltaPos -> RWST (EPOptions m w) (EPWriter w) EPState m DeltaPos
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return DeltaPos
dp
  -- Start of debug printing
  LayoutStartCol dOff <- getLayoutOffsetD
  debugM $ "printOneComment:(dp,dp',dOff,loc)=" ++ showGhc (dp,dp',dOff,loc)
  -- End of debug printing
  updateAndApplyComment c dp'
  printQueuedComment c dp'

updateAndApplyComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()
updateAndApplyComment :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Comment -> DeltaPos -> EP w m ()
updateAndApplyComment (Comment String
str EpaLocation' NoComments
anc RealSrcSpan
pp Maybe AnnKeywordId
mo) DeltaPos
dp = do
  Comment -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Comment -> EP w m ()
applyComment (String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe AnnKeywordId
-> Comment
Comment String
str EpaLocation' NoComments
anc' RealSrcSpan
pp Maybe AnnKeywordId
mo)
  where
    (Int
r,Int
c) = RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
pp
    dp'' :: DeltaPos
dp'' = case EpaLocation' NoComments
anc of
      EpaDelta DeltaPos
dp1 NoComments
_ -> DeltaPos
dp1
      EpaSpan (RealSrcSpan RealSrcSpan
la Maybe BufSpan
_) ->
           if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
             then (Pos -> RealSrcSpan -> DeltaPos
ss2delta (Int
r,Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
0) RealSrcSpan
la)
             else (Pos -> RealSrcSpan -> DeltaPos
ss2delta (Int
r,Int
c)   RealSrcSpan
la)
      EpaSpan (UnhelpfulSpan UnhelpfulSpanReason
_) -> Int -> DeltaPos
SameLine Int
0
    dp' :: DeltaPos
dp' = case EpaLocation' NoComments
anc of
      EpaSpan (RealSrcSpan RealSrcSpan
r1 Maybe BufSpan
_) ->
          if RealSrcSpan
pp RealSrcSpan -> RealSrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan
r1
                 then DeltaPos
dp
                 else DeltaPos
dp''
      EpaLocation' NoComments
_ -> DeltaPos
dp''
    op' :: EpaLocation' NoComments
op' = case DeltaPos
dp' of
            SameLine Int
n -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                            then DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp' NoComments
NoComments
                            else DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp NoComments
NoComments
            DeltaPos
_ -> DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp' NoComments
NoComments
    anc' :: EpaLocation' NoComments
anc' = if String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
&& EpaLocation' NoComments
op' EpaLocation' NoComments -> EpaLocation' NoComments -> Bool
forall a. Eq a => a -> a -> Bool
== DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) NoComments
NoComments -- EOF comment
           then DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp NoComments
NoComments
           else DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp NoComments
NoComments

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

commentAllocationBefore :: (Monad m, Monoid w) => RealSrcSpan -> EP w m [Comment]
commentAllocationBefore :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m [Comment]
commentAllocationBefore RealSrcSpan
ss = do
  cs <- EP w m [Comment]
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
getUnallocatedComments
  -- Note: The CPP comment injection may change the file name in the
  -- RealSrcSpan, which affects comparison, as the Ord instance for
  -- RealSrcSpan compares the file first. So we sort via ss2pos
  -- TODO: this is inefficient, use Pos all the way through
  let (earlier,later) = partition (\(Comment String
_str EpaLocation' NoComments
loc RealSrcSpan
_r Maybe AnnKeywordId
_mo) ->
                                     case EpaLocation' NoComments
loc of
                                       EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_) -> (RealSrcSpan -> Pos
ss2pos RealSrcSpan
r) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= (RealSrcSpan -> Pos
ss2pos RealSrcSpan
ss)
                                       EpaLocation' NoComments
_ -> Bool
True -- Choose one
                                  ) cs
  putUnallocatedComments later
  -- debugM $ "commentAllocation:(ss,earlier,later)" ++ show (rs2range ss,earlier,later)
  return earlier

commentAllocationIn :: (Monad m, Monoid w) => RealSrcSpan -> EP w m [Comment]
commentAllocationIn :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m [Comment]
commentAllocationIn RealSrcSpan
ss = do
  cs <- EP w m [Comment]
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
getUnallocatedComments
  -- Note: The CPP comment injection may change the file name in the
  -- RealSrcSpan, which affects comparison, as the Ord instance for
  -- RealSrcSpan compares the file first. So we sort via ss2pos
  -- TODO: this is inefficient, use Pos all the way through
  let (earlier,later) = partition (\(Comment String
_str EpaLocation' NoComments
loc RealSrcSpan
_r Maybe AnnKeywordId
_mo) ->
                                     case EpaLocation' NoComments
loc of
                                       EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_) -> (RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
r) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= (RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
ss)
                                       EpaLocation' NoComments
_ -> Bool
True -- Choose one
                                  ) cs
  putUnallocatedComments later
  -- debugM $ "commentAllocation:(ss,earlier,later)" ++ show (rs2range ss,earlier,later)
  return earlier
-- ---------------------------------------------------------------------

markAnnotatedWithLayout :: (Monad m, Monoid w) => ExactPrint ast => ast -> EP w m ast
markAnnotatedWithLayout :: forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotatedWithLayout ast
a = EP w m ast -> EP w m ast
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EP w m a -> EP w m a
setLayoutBoth (EP w m ast -> EP w m ast) -> EP w m ast -> EP w m ast
forall a b. (a -> b) -> a -> b
$ ast -> EP w m ast
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ast
a

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

markTopLevelList :: (Monad m, Monoid w) => ExactPrint ast => [ast] -> EP w m [ast]
markTopLevelList :: forall (m :: * -> *) w ast.
(Monad m, Monoid w, ExactPrint ast) =>
[ast] -> EP w m [ast]
markTopLevelList [ast]
ls = (ast -> RWST (EPOptions m w) (EPWriter w) EPState m ast)
-> [ast] -> RWST (EPOptions m w) (EPWriter w) EPState m [ast]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ast
a -> RWST (EPOptions m w) (EPWriter w) EPState m ast
-> RWST (EPOptions m w) (EPWriter w) EPState m ast
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EP w m a -> EP w m a
setLayoutTopLevelP (RWST (EPOptions m w) (EPWriter w) EPState m ast
 -> RWST (EPOptions m w) (EPWriter w) EPState m ast)
-> RWST (EPOptions m w) (EPWriter w) EPState m ast
-> RWST (EPOptions m w) (EPWriter w) EPState m ast
forall a b. (a -> b) -> a -> b
$ ast -> RWST (EPOptions m w) (EPWriter w) EPState m ast
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ast
a) [ast]
ls

-- ---------------------------------------------------------------------
-- End of utility functions
-- ---------------------------------------------------------------------
-- Start of ExactPrint instances
-- ---------------------------------------------------------------------

-- | Bare Located elements are simply stripped off without further
-- processing.
instance (ExactPrint a) => ExactPrint (Located a) where
  getAnnotationEntry :: Located a -> Entry
getAnnotationEntry (L SrcSpan
l a
_) = case SrcSpan
l of
    UnhelpfulSpan UnhelpfulSpanReason
_ -> Entry
NoEntryVal
    SrcSpan
_ -> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> FlushComments
-> CanUpdateAnchor
-> Entry
Entry (SrcSpan -> Anchor
forall a. SrcSpan -> EpaLocation' a
EpaSpan SrcSpan
l) [] EpAnnComments
emptyComments FlushComments
NoFlushComments CanUpdateAnchor
CanUpdateAnchorOnly

  setAnnotationAnchor :: Located a -> Anchor -> [TrailingAnn] -> EpAnnComments -> Located a
setAnnotationAnchor (L SrcSpan
l a
a) Anchor
_anc [TrailingAnn]
_ts EpAnnComments
_cs = SrcSpan -> a -> Located a
forall l e. l -> e -> GenLocated l e
L SrcSpan
l a
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Located a -> EP w m (Located a)
exact (L SrcSpan
l a
a) = SrcSpan -> a -> Located a
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (a -> Located a)
-> RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m (Located a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated a
a

instance (ExactPrint a) => ExactPrint (LocatedE a) where
  getAnnotationEntry :: LocatedE a -> Entry
getAnnotationEntry (L Anchor
l a
_) = Anchor
-> [TrailingAnn]
-> EpAnnComments
-> FlushComments
-> CanUpdateAnchor
-> Entry
Entry Anchor
l [] EpAnnComments
emptyComments FlushComments
NoFlushComments CanUpdateAnchor
CanUpdateAnchorOnly
  setAnnotationAnchor :: LocatedE a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedE a
setAnnotationAnchor (L Anchor
_ a
a) Anchor
anc [TrailingAnn]
_ts EpAnnComments
_cs = Anchor -> a -> LocatedE a
forall l e. l -> e -> GenLocated l e
L Anchor
anc a
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedE a -> EP w m (LocatedE a)
exact (L Anchor
la a
a) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedE a:la loc=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Show a => a -> String
show (SrcSpan -> (Pos, Pos)
ss2range (SrcSpan -> (Pos, Pos)) -> SrcSpan -> (Pos, Pos)
forall a b. (a -> b) -> a -> b
$ Anchor -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA Anchor
la)
    a' <- a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated a
a
    return (L la a')

instance (ExactPrint a) => ExactPrint (LocatedA a) where
  getAnnotationEntry :: LocatedA a -> Entry
getAnnotationEntry = LocatedA a -> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: LocatedA a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedA a
setAnnotationAnchor LocatedA a
la Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = LocatedA a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedA a
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn LocatedA a
la Anchor
anc [TrailingAnn]
ts EpAnnComments
cs
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedA a -> EP w m (LocatedA a)
exact (L SrcSpanAnnA
la a
a) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedA a:la loc=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Show a => a -> String
show (SrcSpan -> (Pos, Pos)
ss2range (SrcSpan -> (Pos, Pos)) -> SrcSpan -> (Pos, Pos)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
la)
    a' <- a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated a
a
    return (L la a')

instance (ExactPrint a) => ExactPrint (LocatedAn NoEpAnns a) where
  getAnnotationEntry :: LocatedAn NoEpAnns a -> Entry
getAnnotationEntry = LocatedAn NoEpAnns a -> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: LocatedAn NoEpAnns a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn NoEpAnns a
setAnnotationAnchor LocatedAn NoEpAnns a
la Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = LocatedAn NoEpAnns a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn NoEpAnns a
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn LocatedAn NoEpAnns a
la Anchor
anc [TrailingAnn]
ts EpAnnComments
cs
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedAn NoEpAnns a -> EP w m (LocatedAn NoEpAnns a)
exact (L EpAnn NoEpAnns
la a
a) = do
    a' <- a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated a
a
    return (L la a')

instance (ExactPrint a) => ExactPrint [a] where
  getAnnotationEntry :: [a] -> Entry
getAnnotationEntry = Entry -> [a] -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: [a] -> Anchor -> [TrailingAnn] -> EpAnnComments -> [a]
setAnnotationAnchor [a]
ls Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = [a]
ls
  exact :: forall (m :: * -> *) w. (Monad m, Monoid w) => [a] -> EP w m [a]
exact [a]
ls = (a -> RWST (EPOptions m w) (EPWriter w) EPState m a)
-> [a] -> RWST (EPOptions m w) (EPWriter w) EPState m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [a]
ls

instance (ExactPrint a) => ExactPrint (Maybe a) where
  getAnnotationEntry :: Maybe a -> Entry
getAnnotationEntry = Entry -> Maybe a -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: Maybe a -> Anchor -> [TrailingAnn] -> EpAnnComments -> Maybe a
setAnnotationAnchor Maybe a
ma Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = Maybe a
ma
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe a -> EP w m (Maybe a)
exact Maybe a
ma = (a -> RWST (EPOptions m w) (EPWriter w) EPState m a)
-> Maybe a -> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe a
ma

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

-- | 'Located (HsModule GhcPs)' corresponds to 'ParsedSource'
instance ExactPrint (HsModule GhcPs) where
  getAnnotationEntry :: HsModule GhcPs -> Entry
getAnnotationEntry HsModule GhcPs
hsmod = EpAnn AnnsModule -> Entry
forall a. HasEntry a => a -> Entry
fromAnn' (XModulePs -> EpAnn AnnsModule
hsmodAnn (XModulePs -> EpAnn AnnsModule) -> XModulePs -> EpAnn AnnsModule
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> XCModule GhcPs
forall p. HsModule p -> XCModule p
hsmodExt HsModule GhcPs
hsmod)
  -- A bit pointless actually changing anything here
  setAnnotationAnchor :: HsModule GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsModule GhcPs
setAnnotationAnchor HsModule GhcPs
hsmod Anchor
anc [TrailingAnn]
_ts EpAnnComments
cs = HsModule GhcPs -> Anchor -> EpAnnComments -> HsModule GhcPs
setAnchorHsModule HsModule GhcPs
hsmod Anchor
anc EpAnnComments
cs
                   HsModule GhcPs -> String -> HsModule GhcPs
forall c. c -> String -> c
`debug` (String
"setAnnotationAnchor hsmod called" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Anchor, EpAnnComments) -> String
forall a. Data a => a -> String
showAst (Anchor
anc,EpAnnComments
cs))

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsModule GhcPs -> EP w m (HsModule GhcPs)
exact (HsModule (XModulePs EpAnn AnnsModule
an EpLayout
lo Maybe (LWarningTxt GhcPs)
mdeprec Maybe (LHsDoc GhcPs)
mbDoc) Maybe (XRec GhcPs ModuleName)
mmn Maybe (XRec GhcPs [LIE GhcPs])
mexports [LImportDecl GhcPs]
imports [LHsDecl GhcPs]
decls) = do

    let mbDoc' :: Maybe (LHsDoc GhcPs)
mbDoc' = Maybe (LHsDoc GhcPs)
mbDoc

    (an0, mmn' , mdeprec', mexports') <-
      case Maybe (XRec GhcPs ModuleName)
mmn of
        Maybe (XRec GhcPs ModuleName)
Nothing -> (EpAnn AnnsModule, Maybe (GenLocated SrcSpanAnnA ModuleName),
 Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)),
 Maybe
   (GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpAnn AnnsModule, Maybe (GenLocated SrcSpanAnnA ModuleName),
      Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)),
      Maybe
        (GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn AnnsModule
an, Maybe (XRec GhcPs ModuleName)
Maybe (GenLocated SrcSpanAnnA ModuleName)
mmn, Maybe (LWarningTxt GhcPs)
Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
mdeprec, Maybe (XRec GhcPs [LIE GhcPs])
Maybe
  (GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)])
mexports)
        Just XRec GhcPs ModuleName
m -> do
          an0 <- EpAnn AnnsModule
-> Lens AnnsModule [AddEpAnn]
-> AnnKeywordId
-> EP w m (EpAnn AnnsModule)
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
EpAnn ann
-> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnL' EpAnn AnnsModule
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnsModule -> f AnnsModule
Lens AnnsModule [AddEpAnn]
lam_main AnnKeywordId
AnnModule
          m' <- markAnnotated m

          mdeprec' <- setLayoutTopLevelP $ markAnnotated mdeprec

          mexports' <- setLayoutTopLevelP $ markAnnotated mexports

          an1 <- setLayoutTopLevelP $ markEpAnnL' an0 lam_main AnnWhere

          return (an1, Just m', mdeprec', mexports')

    lo0 <- case lo of
        EpExplicitBraces EpToken "{"
open EpToken "}"
close -> do
          open' <- EpToken "{" -> EP w m (EpToken "{")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "{"
open
          return (EpExplicitBraces open' close)
        EpLayout
_ -> EpLayout -> RWST (EPOptions m w) (EPWriter w) EPState m EpLayout
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpLayout
lo

    am_decls' <- markTrailing (am_decls $ anns an0)

    mid <- markAnnotated (HsModuleImpDecls (am_cs $ anns an0) imports decls)
    let imports' = HsModuleImpDecls -> [LImportDecl GhcPs]
id_imps HsModuleImpDecls
mid
    let decls' = HsModuleImpDecls -> [LHsDecl GhcPs]
id_decls HsModuleImpDecls
mid

    lo1 <- case lo0 of
        EpExplicitBraces EpToken "{"
open EpToken "}"
close -> do
          close' <- EpToken "}" -> EP w m (EpToken "}")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "}"
close
          return (EpExplicitBraces open close')
        EpLayout
_ -> EpLayout -> RWST (EPOptions m w) (EPWriter w) EPState m EpLayout
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpLayout
lo

    -- Print EOF
    case am_eof $ anns an of
      Maybe (RealSrcSpan, RealSrcSpan)
Nothing -> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (RealSrcSpan
pos, RealSrcSpan
prior) -> do
        String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"am_eof:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (RealSrcSpan, RealSrcSpan) -> String
forall a. Outputable a => a -> String
showGhc (RealSrcSpan
pos, RealSrcSpan
prior)
        Maybe (RealSrcSpan, RealSrcSpan)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe (RealSrcSpan, RealSrcSpan) -> EP w m ()
setEofPos ((RealSrcSpan, RealSrcSpan) -> Maybe (RealSrcSpan, RealSrcSpan)
forall a. a -> Maybe a
Just (RealSrcSpan
pos, RealSrcSpan
prior))

    let anf = EpAnn AnnsModule
an0 { anns = (anns an0) { am_decls = am_decls', am_cs = [] }}
    debugM $ "HsModule, anf=" ++ showAst anf

    return (HsModule (XModulePs anf lo1 mdeprec' mbDoc') mmn' mexports' imports' decls')

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

-- | This is used to ensure the comments are updated into the right
-- place for makeDeltaAst.
data HsModuleImpDecls
    = HsModuleImpDecls {
        HsModuleImpDecls -> [LEpaComment]
id_cs     :: [LEpaComment],
        HsModuleImpDecls -> [LImportDecl GhcPs]
id_imps   :: [LImportDecl GhcPs],
        HsModuleImpDecls -> [LHsDecl GhcPs]
id_decls  :: [LHsDecl GhcPs]
    } deriving Typeable HsModuleImpDecls
Typeable HsModuleImpDecls =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> HsModuleImpDecls -> c HsModuleImpDecls)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c HsModuleImpDecls)
-> (HsModuleImpDecls -> Constr)
-> (HsModuleImpDecls -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c HsModuleImpDecls))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c HsModuleImpDecls))
-> ((forall b. Data b => b -> b)
    -> HsModuleImpDecls -> HsModuleImpDecls)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HsModuleImpDecls -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HsModuleImpDecls -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> HsModuleImpDecls -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> HsModuleImpDecls -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> HsModuleImpDecls -> m HsModuleImpDecls)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HsModuleImpDecls -> m HsModuleImpDecls)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HsModuleImpDecls -> m HsModuleImpDecls)
-> Data HsModuleImpDecls
HsModuleImpDecls -> Constr
HsModuleImpDecls -> DataType
(forall b. Data b => b -> b)
-> HsModuleImpDecls -> HsModuleImpDecls
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HsModuleImpDecls -> u
forall u. (forall d. Data d => d -> u) -> HsModuleImpDecls -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsModuleImpDecls -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsModuleImpDecls -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsModuleImpDecls -> m HsModuleImpDecls
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsModuleImpDecls -> m HsModuleImpDecls
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsModuleImpDecls
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsModuleImpDecls -> c HsModuleImpDecls
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsModuleImpDecls)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsModuleImpDecls)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsModuleImpDecls -> c HsModuleImpDecls
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsModuleImpDecls -> c HsModuleImpDecls
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsModuleImpDecls
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsModuleImpDecls
$ctoConstr :: HsModuleImpDecls -> Constr
toConstr :: HsModuleImpDecls -> Constr
$cdataTypeOf :: HsModuleImpDecls -> DataType
dataTypeOf :: HsModuleImpDecls -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsModuleImpDecls)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsModuleImpDecls)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsModuleImpDecls)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsModuleImpDecls)
$cgmapT :: (forall b. Data b => b -> b)
-> HsModuleImpDecls -> HsModuleImpDecls
gmapT :: (forall b. Data b => b -> b)
-> HsModuleImpDecls -> HsModuleImpDecls
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsModuleImpDecls -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsModuleImpDecls -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsModuleImpDecls -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsModuleImpDecls -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsModuleImpDecls -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsModuleImpDecls -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HsModuleImpDecls -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HsModuleImpDecls -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsModuleImpDecls -> m HsModuleImpDecls
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsModuleImpDecls -> m HsModuleImpDecls
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsModuleImpDecls -> m HsModuleImpDecls
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsModuleImpDecls -> m HsModuleImpDecls
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsModuleImpDecls -> m HsModuleImpDecls
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsModuleImpDecls -> m HsModuleImpDecls
Data

instance ExactPrint HsModuleImpDecls where
  -- Use an UnHelpfulSpan for the anchor, we are only interested in the comments
  getAnnotationEntry :: HsModuleImpDecls -> Entry
getAnnotationEntry HsModuleImpDecls
mid = Anchor -> [TrailingAnn] -> EpAnnComments -> Entry
mkEntry (SrcSpan -> Anchor
forall a. SrcSpan -> EpaLocation' a
EpaSpan (UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
UnhelpfulNoLocationInfo)) [] ([LEpaComment] -> EpAnnComments
EpaComments (HsModuleImpDecls -> [LEpaComment]
id_cs HsModuleImpDecls
mid))
  setAnnotationAnchor :: HsModuleImpDecls
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsModuleImpDecls
setAnnotationAnchor HsModuleImpDecls
mid Anchor
_anc [TrailingAnn]
_ EpAnnComments
cs = HsModuleImpDecls
mid { id_cs = priorComments cs ++ getFollowingComments cs }
     HsModuleImpDecls -> String -> HsModuleImpDecls
forall c. c -> String -> c
`debug` (String
"HsModuleImpDecls.setAnnotationAnchor:cs=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ EpAnnComments -> String
forall a. Data a => a -> String
showAst EpAnnComments
cs)
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsModuleImpDecls -> EP w m HsModuleImpDecls
exact (HsModuleImpDecls [LEpaComment]
cs [LImportDecl GhcPs]
imports [LHsDecl GhcPs]
decls) = do
    imports' <- [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (m :: * -> *) w ast.
(Monad m, Monoid w, ExactPrint ast) =>
[ast] -> EP w m [ast]
markTopLevelList [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports
    decls' <- markTopLevelList (filter notDocDecl decls)
    return (HsModuleImpDecls cs imports' decls')


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

instance ExactPrint ModuleName where
  getAnnotationEntry :: ModuleName -> Entry
getAnnotationEntry ModuleName
_ = Entry
NoEntryVal
  setAnnotationAnchor :: ModuleName
-> Anchor -> [TrailingAnn] -> EpAnnComments -> ModuleName
setAnnotationAnchor ModuleName
n Anchor
_anc [TrailingAnn]
_ EpAnnComments
cs = ModuleName
n
     ModuleName -> String -> ModuleName
forall c. c -> String -> c
`debug` (String
"ModuleName.setAnnotationAnchor:cs=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ EpAnnComments -> String
forall a. Data a => a -> String
showAst EpAnnComments
cs)
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ModuleName -> EP w m ModuleName
exact ModuleName
n = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"ModuleName: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
forall a. Outputable a => a -> String
showPprUnsafe ModuleName
n
    ModuleName -> EP w m ModuleName
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr ModuleName
n

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

instance ExactPrint (LocatedP (WarningTxt GhcPs)) where
  getAnnotationEntry :: GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs) -> Entry
getAnnotationEntry = GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs) -> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)
setAnnotationAnchor = GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)
-> EP w m (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
exact (L EpAnn AnnPragma
an (WarningTxt Maybe (LocatedE InWarningCategory)
mb_cat SourceText
src [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
ws)) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# WARNING"
    mb_cat' <- markAnnotated mb_cat
    an1 <- markEpAnnL' an0 lapr_rest AnnOpenS
    ws' <- markAnnotated ws
    an2 <- markEpAnnL' an1 lapr_rest AnnCloseS
    an3 <- markAnnCloseP an2
    return (L an3 (WarningTxt mb_cat' src ws'))

  exact (L EpAnn AnnPragma
an (DeprecatedTxt SourceText
src [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
ws)) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# DEPRECATED"
    an1 <- markEpAnnL' an0 lapr_rest AnnOpenS
    ws' <- markAnnotated ws
    an2 <- markEpAnnL' an1 lapr_rest AnnCloseS
    an3 <- markAnnCloseP an2
    return (L an3 (DeprecatedTxt src ws'))

instance ExactPrint InWarningCategory where
  getAnnotationEntry :: InWarningCategory -> Entry
getAnnotationEntry InWarningCategory
_ = Entry
NoEntryVal
  setAnnotationAnchor :: InWarningCategory
-> Anchor -> [TrailingAnn] -> EpAnnComments -> InWarningCategory
setAnnotationAnchor InWarningCategory
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = InWarningCategory
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
InWarningCategory -> EP w m InWarningCategory
exact (InWarningCategory EpToken "in"
tkIn SourceText
source (L Anchor
l WarningCategory
wc)) = do
      tkIn' <- EpToken "in" -> EP w m (EpToken "in")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "in"
tkIn
      L l' (_,wc') <- markAnnotated (L l (source, wc))
      return (InWarningCategory tkIn' source (L l' wc'))

instance ExactPrint (SourceText, WarningCategory) where
  getAnnotationEntry :: (SourceText, WarningCategory) -> Entry
getAnnotationEntry (SourceText, WarningCategory)
_ = Entry
NoEntryVal
  setAnnotationAnchor :: (SourceText, WarningCategory)
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> (SourceText, WarningCategory)
setAnnotationAnchor (SourceText, WarningCategory)
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = (SourceText, WarningCategory)
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
(SourceText, WarningCategory)
-> EP w m (SourceText, WarningCategory)
exact (SourceText
st, WarningCategory FastString
wc) = do
      case SourceText
st of
          SourceText
NoSourceText -> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (FastString -> String
unpackFS FastString
wc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
          SourceText FastString
src -> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ (FastString -> String
unpackFS FastString
src)
      (SourceText, WarningCategory)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (SourceText, WarningCategory)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText
st, FastString -> WarningCategory
WarningCategory FastString
wc)

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

instance ExactPrint (ImportDecl GhcPs) where
  getAnnotationEntry :: ImportDecl GhcPs -> Entry
getAnnotationEntry ImportDecl GhcPs
idecl = EpAnn EpAnnImportDecl -> Entry
forall a. HasEntry a => a -> Entry
fromAnn (XImportDeclPass -> EpAnn EpAnnImportDecl
ideclAnn (XImportDeclPass -> EpAnn EpAnnImportDecl)
-> XImportDeclPass -> EpAnn EpAnnImportDecl
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XCImportDecl GhcPs
forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt ImportDecl GhcPs
idecl)
  setAnnotationAnchor :: ImportDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> ImportDecl GhcPs
setAnnotationAnchor ImportDecl GhcPs
idecl Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = ImportDecl GhcPs
idecl { ideclExt
                    = (ideclExt idecl) { ideclAnn = setAnchorEpa (ideclAnn $ ideclExt idecl) anc ts cs} }

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ImportDecl GhcPs -> EP w m (ImportDecl GhcPs)
exact (ImportDecl (XImportDeclPass EpAnn EpAnnImportDecl
ann SourceText
msrc Bool
impl)
                     XRec GhcPs ModuleName
modname ImportDeclPkgQual GhcPs
mpkg IsBootInterface
src Bool
safeflag ImportDeclQualifiedStyle
qualFlag Maybe (XRec GhcPs ModuleName)
mAs Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
hiding) = do

    ann0 <- EpAnn EpAnnImportDecl
-> Lens EpAnnImportDecl Anchor
-> AnnKeywordId
-> EP w m (EpAnn EpAnnImportDecl)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a Anchor -> AnnKeywordId -> EP w m (EpAnn a)
markLensKw' EpAnn EpAnnImportDecl
ann (Anchor -> f Anchor) -> EpAnnImportDecl -> f EpAnnImportDecl
Lens EpAnnImportDecl Anchor
limportDeclAnnImport AnnKeywordId
AnnImport
    let (EpAnn _anc an _cs) = ann0

    -- "{-# SOURCE" and "#-}"
    importDeclAnnPragma' <-
      case msrc of
        SourceText FastString
_txt -> do
          String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"ImportDecl sourcetext"
          case EpAnnImportDecl -> Maybe (Anchor, Anchor)
importDeclAnnPragma EpAnnImportDecl
an of
            Just (Anchor
mo, Anchor
mc) -> do
              mo' <- Anchor -> SourceText -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> SourceText -> String -> EP w m Anchor
markAnnOpen'' Anchor
mo SourceText
msrc String
"{-# SOURCE"
              mc' <- printStringAtAA mc "#-}"
              return $ Just (mo', mc')
            Maybe (Anchor, Anchor)
Nothing ->  do
              _ <- Maybe Anchor -> SourceText -> String -> EP w m (Maybe Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> SourceText -> String -> EP w m (Maybe Anchor)
markAnnOpen' Maybe Anchor
forall a. Maybe a
Nothing SourceText
msrc String
"{-# SOURCE"
              printStringAtLsDelta (SameLine 1) "#-}"
              return Nothing
        SourceText
NoSourceText -> Maybe (Anchor, Anchor)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (Anchor, Anchor))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnnImportDecl -> Maybe (Anchor, Anchor)
importDeclAnnPragma EpAnnImportDecl
an)
    ann1 <- if safeflag
      then (markLensKwM ann0 limportDeclAnnSafe AnnSafe)
      else return ann0
    ann2 <-
      case qualFlag of
        ImportDeclQualifiedStyle
QualifiedPre  -- 'qualified' appears in prepositive position.
          -> EpAnn EpAnnImportDecl
-> Lens EpAnnImportDecl (Maybe Anchor)
-> String
-> EP w m (EpAnn EpAnnImportDecl)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a (Maybe Anchor) -> String -> EP w m (EpAnn a)
printStringAtMLocL EpAnn EpAnnImportDecl
ann1 (Maybe Anchor -> f (Maybe Anchor))
-> EpAnnImportDecl -> f EpAnnImportDecl
Lens EpAnnImportDecl (Maybe Anchor)
limportDeclAnnQualified String
"qualified"
        ImportDeclQualifiedStyle
_ -> EpAnn EpAnnImportDecl -> EP w m (EpAnn EpAnnImportDecl)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnn EpAnnImportDecl
ann1
    ann3 <-
      case mpkg of
       RawPkgQual (StringLiteral SourceText
src' FastString
v Maybe (EpaLocation' NoComments)
_) ->
         EpAnn EpAnnImportDecl
-> Lens EpAnnImportDecl (Maybe Anchor)
-> String
-> EP w m (EpAnn EpAnnImportDecl)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a (Maybe Anchor) -> String -> EP w m (EpAnn a)
printStringAtMLocL EpAnn EpAnnImportDecl
ann2 (Maybe Anchor -> f (Maybe Anchor))
-> EpAnnImportDecl -> f EpAnnImportDecl
Lens EpAnnImportDecl (Maybe Anchor)
limportDeclAnnPackage (SourceText -> ShowS
sourceTextToString SourceText
src' (FastString -> String
forall a. Show a => a -> String
show FastString
v))
       ImportDeclPkgQual GhcPs
_ -> EpAnn EpAnnImportDecl -> EP w m (EpAnn EpAnnImportDecl)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnn EpAnnImportDecl
ann2
    modname' <- markAnnotated modname

    ann4 <-
      case qualFlag of
        ImportDeclQualifiedStyle
QualifiedPost  -- 'qualified' appears in postpositive position.
          -> EpAnn EpAnnImportDecl
-> Lens EpAnnImportDecl (Maybe Anchor)
-> String
-> EP w m (EpAnn EpAnnImportDecl)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a (Maybe Anchor) -> String -> EP w m (EpAnn a)
printStringAtMLocL EpAnn EpAnnImportDecl
ann3 (Maybe Anchor -> f (Maybe Anchor))
-> EpAnnImportDecl -> f EpAnnImportDecl
Lens EpAnnImportDecl (Maybe Anchor)
limportDeclAnnQualified String
"qualified"
        ImportDeclQualifiedStyle
_ -> EpAnn EpAnnImportDecl -> EP w m (EpAnn EpAnnImportDecl)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnn EpAnnImportDecl
ann3

    (importDeclAnnAs', mAs') <-
      case mAs of
        Maybe (XRec GhcPs ModuleName)
Nothing -> (Maybe Anchor, Maybe (GenLocated SrcSpanAnnA ModuleName))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe Anchor, Maybe (GenLocated SrcSpanAnnA ModuleName))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnnImportDecl -> Maybe Anchor
importDeclAnnAs EpAnnImportDecl
an, Maybe (GenLocated SrcSpanAnnA ModuleName)
forall a. Maybe a
Nothing)
        Just XRec GhcPs ModuleName
m0 -> do
          a <- Maybe Anchor -> String -> EP w m (Maybe Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> String -> EP w m (Maybe Anchor)
printStringAtMLoc' (EpAnnImportDecl -> Maybe Anchor
importDeclAnnAs EpAnnImportDecl
an) String
"as"
          m'' <- markAnnotated m0
          return (a, Just m'')

    hiding' <-
      case hiding of
        Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Nothing -> Maybe
  (ImportListInterpretation,
   GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)])
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe
        (ImportListInterpretation,
         GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe
  (ImportListInterpretation,
   GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)])
hiding
        Just (ImportListInterpretation
isHiding,XRec GhcPs [LIE GhcPs]
lie) -> do
          lie' <- GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> EP
     w
     m
     (GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs [LIE GhcPs]
GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
lie
          return (Just (isHiding, lie'))

    let (EpAnn anc' an' cs') = ann4
    let an2 = EpAnnImportDecl
an' { importDeclAnnAs = importDeclAnnAs'
                  , importDeclAnnPragma = importDeclAnnPragma'
                  }

    return (ImportDecl (XImportDeclPass (EpAnn anc' an2 cs') msrc impl)
                     modname' mpkg src safeflag qualFlag mAs' hiding')


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

instance ExactPrint HsDocString where
  getAnnotationEntry :: HsDocString -> Entry
getAnnotationEntry HsDocString
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsDocString
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsDocString
setAnnotationAnchor HsDocString
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsDocString
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsDocString -> EP w m HsDocString
exact (MultiLineDocString HsDocStringDecorator
decorator (LHsDocStringChunk
x :| [LHsDocStringChunk]
xs)) = do
    String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (String
"-- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsDocStringDecorator -> String
printDecorator HsDocStringDecorator
decorator)
    pe <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD
    debugM $ "MultiLineDocString: (pe,x)=" ++ showAst (pe,x)
    x' <- markAnnotated x
    xs' <- markAnnotated (map dedentDocChunk xs)
    return (MultiLineDocString decorator (x' :| xs'))
  exact HsDocString
x = do
    -- TODO: can this happen?
    String -> EP w m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ String
"Not exact printing:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsDocString -> String
forall a. Data a => a -> String
showAst HsDocString
x
    HsDocString
-> RWST (EPOptions m w) (EPWriter w) EPState m HsDocString
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsDocString
x


instance ExactPrint HsDocStringChunk where
  getAnnotationEntry :: HsDocStringChunk -> Entry
getAnnotationEntry HsDocStringChunk
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsDocStringChunk
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsDocStringChunk
setAnnotationAnchor HsDocStringChunk
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsDocStringChunk
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsDocStringChunk -> EP w m HsDocStringChunk
exact HsDocStringChunk
chunk = do
    String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsDocStringChunk -> String
unpackHDSC HsDocStringChunk
chunk)
    HsDocStringChunk
-> RWST (EPOptions m w) (EPWriter w) EPState m HsDocStringChunk
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsDocStringChunk
chunk


instance ExactPrint a => ExactPrint (WithHsDocIdentifiers a GhcPs) where
  getAnnotationEntry :: WithHsDocIdentifiers a GhcPs -> Entry
getAnnotationEntry WithHsDocIdentifiers a GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: WithHsDocIdentifiers a GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> WithHsDocIdentifiers a GhcPs
setAnnotationAnchor WithHsDocIdentifiers a GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = WithHsDocIdentifiers a GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
WithHsDocIdentifiers a GhcPs
-> EP w m (WithHsDocIdentifiers a GhcPs)
exact (WithHsDocIdentifiers a
ds [Located (IdP GhcPs)]
ids) = do
    ds' <- a -> EP w m a
forall a (m :: * -> *) w.
(ExactPrint a, Monad m, Monoid w) =>
a -> EP w m a
forall (m :: * -> *) w. (Monad m, Monoid w) => a -> EP w m a
exact a
ds
    return (WithHsDocIdentifiers ds' ids)

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

instance ExactPrint (HsDecl GhcPs) where
  getAnnotationEntry :: HsDecl GhcPs -> Entry
getAnnotationEntry (TyClD      XTyClD GhcPs
_ TyClDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (InstD      XInstD GhcPs
_ InstDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (DerivD     XDerivD GhcPs
_ DerivDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (ValD       XValD GhcPs
_ HsBind GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (SigD       XSigD GhcPs
_ Sig GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (KindSigD   XKindSigD GhcPs
_ StandaloneKindSig GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (DefD       XDefD GhcPs
_ DefaultDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (ForD       XForD GhcPs
_ ForeignDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (WarningD   XWarningD GhcPs
_ WarnDecls GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (AnnD       XAnnD GhcPs
_ AnnDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (RuleD      XRuleD GhcPs
_ RuleDecls GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (SpliceD    XSpliceD GhcPs
_ SpliceDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (DocD       XDocD GhcPs
_ DocDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (RoleAnnotD XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
_) = Entry
NoEntryVal

  -- We do not recurse, the generic traversal using this feature
  -- should do that for us.
  setAnnotationAnchor :: HsDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsDecl GhcPs
setAnnotationAnchor HsDecl GhcPs
d Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsDecl GhcPs
d

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsDecl GhcPs -> EP w m (HsDecl GhcPs)
exact (TyClD       XTyClD GhcPs
x TyClDecl GhcPs
d) = XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD       XTyClD GhcPs
x (TyClDecl GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (TyClDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyClDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (TyClDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated TyClDecl GhcPs
d
  exact (InstD       XInstD GhcPs
x InstDecl GhcPs
d) = XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD       XInstD GhcPs
x (InstDecl GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (InstDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InstDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (InstDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated InstDecl GhcPs
d
  exact (DerivD      XDerivD GhcPs
x DerivDecl GhcPs
d) = XDerivD GhcPs -> DerivDecl GhcPs -> HsDecl GhcPs
forall p. XDerivD p -> DerivDecl p -> HsDecl p
DerivD      XDerivD GhcPs
x (DerivDecl GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (DerivDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DerivDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (DerivDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated DerivDecl GhcPs
d
  exact (ValD        XValD GhcPs
x HsBind GhcPs
d) = XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD        XValD GhcPs
x (HsBind GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsBind GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsBind GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsBind GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsBind GhcPs
d
  exact (SigD        XSigD GhcPs
x Sig GhcPs
d) = XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD        XSigD GhcPs
x (Sig GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (Sig GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (Sig GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Sig GhcPs
d
  exact (KindSigD    XKindSigD GhcPs
x StandaloneKindSig GhcPs
d) = XKindSigD GhcPs -> StandaloneKindSig GhcPs -> HsDecl GhcPs
forall p. XKindSigD p -> StandaloneKindSig p -> HsDecl p
KindSigD    XKindSigD GhcPs
x (StandaloneKindSig GhcPs -> HsDecl GhcPs)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (StandaloneKindSig GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StandaloneKindSig GhcPs
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (StandaloneKindSig GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated StandaloneKindSig GhcPs
d
  exact (DefD        XDefD GhcPs
x DefaultDecl GhcPs
d) = XDefD GhcPs -> DefaultDecl GhcPs -> HsDecl GhcPs
forall p. XDefD p -> DefaultDecl p -> HsDecl p
DefD        XDefD GhcPs
x (DefaultDecl GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (DefaultDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (DefaultDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated DefaultDecl GhcPs
d
  exact (ForD        XForD GhcPs
x ForeignDecl GhcPs
d) = XForD GhcPs -> ForeignDecl GhcPs -> HsDecl GhcPs
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD        XForD GhcPs
x (ForeignDecl GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (ForeignDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (ForeignDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ForeignDecl GhcPs
d
  exact (WarningD    XWarningD GhcPs
x WarnDecls GhcPs
d) = XWarningD GhcPs -> WarnDecls GhcPs -> HsDecl GhcPs
forall p. XWarningD p -> WarnDecls p -> HsDecl p
WarningD    XWarningD GhcPs
x (WarnDecls GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (WarnDecls GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WarnDecls GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (WarnDecls GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated WarnDecls GhcPs
d
  exact (AnnD        XAnnD GhcPs
x AnnDecl GhcPs
d) = XAnnD GhcPs -> AnnDecl GhcPs -> HsDecl GhcPs
forall p. XAnnD p -> AnnDecl p -> HsDecl p
AnnD        XAnnD GhcPs
x (AnnDecl GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (AnnDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (AnnDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated AnnDecl GhcPs
d
  exact (RuleD       XRuleD GhcPs
x RuleDecls GhcPs
d) = XRuleD GhcPs -> RuleDecls GhcPs -> HsDecl GhcPs
forall p. XRuleD p -> RuleDecls p -> HsDecl p
RuleD       XRuleD GhcPs
x (RuleDecls GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (RuleDecls GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuleDecls GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (RuleDecls GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated RuleDecls GhcPs
d
  exact (SpliceD     XSpliceD GhcPs
x SpliceDecl GhcPs
d) = XSpliceD GhcPs -> SpliceDecl GhcPs -> HsDecl GhcPs
forall p. XSpliceD p -> SpliceDecl p -> HsDecl p
SpliceD     XSpliceD GhcPs
x (SpliceDecl GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (SpliceDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpliceDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (SpliceDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated SpliceDecl GhcPs
d
  exact (DocD        XDocD GhcPs
x DocDecl GhcPs
d) = XDocD GhcPs -> DocDecl GhcPs -> HsDecl GhcPs
forall p. XDocD p -> DocDecl p -> HsDecl p
DocD        XDocD GhcPs
x (DocDecl GhcPs -> HsDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (DocDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DocDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (DocDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated DocDecl GhcPs
d
  exact (RoleAnnotD  XRoleAnnotD GhcPs
x RoleAnnotDecl GhcPs
d) = XRoleAnnotD GhcPs -> RoleAnnotDecl GhcPs -> HsDecl GhcPs
forall p. XRoleAnnotD p -> RoleAnnotDecl p -> HsDecl p
RoleAnnotD  XRoleAnnotD GhcPs
x (RoleAnnotDecl GhcPs -> HsDecl GhcPs)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (RoleAnnotDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoleAnnotDecl GhcPs
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (RoleAnnotDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated RoleAnnotDecl GhcPs
d

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

instance ExactPrint (InstDecl GhcPs) where
  getAnnotationEntry :: InstDecl GhcPs -> Entry
getAnnotationEntry (ClsInstD     XClsInstD GhcPs
_ ClsInstDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (DataFamInstD XDataFamInstD GhcPs
_ DataFamInstDecl GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (TyFamInstD   XTyFamInstD GhcPs
_ TyFamInstDecl GhcPs
_) = Entry
NoEntryVal

  setAnnotationAnchor :: InstDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> InstDecl GhcPs
setAnnotationAnchor InstDecl GhcPs
d Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = InstDecl GhcPs
d


  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
InstDecl GhcPs -> EP w m (InstDecl GhcPs)
exact (ClsInstD     XClsInstD GhcPs
a  ClsInstDecl GhcPs
cid) = do
    cid' <- ClsInstDecl GhcPs -> EP w m (ClsInstDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ClsInstDecl GhcPs
cid
    return (ClsInstD     a  cid')
  exact (DataFamInstD XDataFamInstD GhcPs
a DataFamInstDecl GhcPs
decl) = do
    d' <- DataFamInstDeclWithContext -> EP w m DataFamInstDeclWithContext
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ([AddEpAnn]
-> TopLevelFlag
-> DataFamInstDecl GhcPs
-> DataFamInstDeclWithContext
DataFamInstDeclWithContext [AddEpAnn]
forall a. NoAnn a => a
noAnn TopLevelFlag
TopLevel DataFamInstDecl GhcPs
decl)
    return (DataFamInstD a (dc_d d'))
  exact (TyFamInstD XTyFamInstD GhcPs
a TyFamInstDecl GhcPs
eqn) = do
    eqn' <- TyFamInstDecl GhcPs -> EP w m (TyFamInstDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated TyFamInstDecl GhcPs
eqn
    return (TyFamInstD a eqn')

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

data DataFamInstDeclWithContext
  = DataFamInstDeclWithContext
    { DataFamInstDeclWithContext -> [AddEpAnn]
_dc_a :: [AddEpAnn]
    , DataFamInstDeclWithContext -> TopLevelFlag
_dc_f :: TopLevelFlag
    , DataFamInstDeclWithContext -> DataFamInstDecl GhcPs
dc_d :: DataFamInstDecl GhcPs
    }

instance ExactPrint DataFamInstDeclWithContext where
  getAnnotationEntry :: DataFamInstDeclWithContext -> Entry
getAnnotationEntry DataFamInstDeclWithContext
_ = Entry
NoEntryVal
  setAnnotationAnchor :: DataFamInstDeclWithContext
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> DataFamInstDeclWithContext
setAnnotationAnchor DataFamInstDeclWithContext
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = DataFamInstDeclWithContext
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DataFamInstDeclWithContext -> EP w m DataFamInstDeclWithContext
exact (DataFamInstDeclWithContext [AddEpAnn]
an TopLevelFlag
c DataFamInstDecl GhcPs
d) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"starting DataFamInstDeclWithContext:an=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [AddEpAnn] -> String
forall a. Data a => a -> String
showAst [AddEpAnn]
an
    (an', d') <- [AddEpAnn]
-> TopLevelFlag
-> DataFamInstDecl GhcPs
-> EP w m ([AddEpAnn], DataFamInstDecl GhcPs)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> TopLevelFlag
-> DataFamInstDecl GhcPs
-> EP w m ([AddEpAnn], DataFamInstDecl GhcPs)
exactDataFamInstDecl [AddEpAnn]
an TopLevelFlag
c DataFamInstDecl GhcPs
d
    return (DataFamInstDeclWithContext an' c d')

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

exactDataFamInstDecl :: (Monad m, Monoid w)
                     => [AddEpAnn] -> TopLevelFlag -> DataFamInstDecl GhcPs
                     -> EP w m ([AddEpAnn], DataFamInstDecl GhcPs)
exactDataFamInstDecl :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> TopLevelFlag
-> DataFamInstDecl GhcPs
-> EP w m ([AddEpAnn], DataFamInstDecl GhcPs)
exactDataFamInstDecl [AddEpAnn]
an TopLevelFlag
top_lvl
  (DataFamInstDecl (FamEqn { feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_ext    = XCFamEqn GhcPs (HsDataDefn GhcPs)
an2
                           , feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon  = LIdP GhcPs
tycon
                           , feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_bndrs  = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
                           , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_pats   = HsFamEqnPats GhcPs
pats
                           , feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_fixity = LexicalFixity
fixity
                           , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs    = HsDataDefn GhcPs
defn })) = do
    (an', an2', tycon', bndrs', pats',  defn') <- [AddEpAnn]
-> (Maybe (LHsContext GhcPs)
    -> EP
         w
         m
         ([AddEpAnn], LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
          [HsArg
             GhcPs
             (GenLocated SrcSpanAnnA (HsType GhcPs))
             (GenLocated SrcSpanAnnA (HsType GhcPs))],
          Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP
     w
     m
     ([AddEpAnn], [AddEpAnn], LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs,
      [HsArg
         GhcPs
         (GenLocated SrcSpanAnnA (HsType GhcPs))
         (GenLocated SrcSpanAnnA (HsType GhcPs))],
      HsDataDefn GhcPs)
forall (m :: * -> *) w a b.
(Monad m, Monoid w) =>
[AddEpAnn]
-> (Maybe (LHsContext GhcPs)
    -> EP
         w m ([AddEpAnn], LocatedN RdrName, a, b, Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP
     w
     m
     ([AddEpAnn], [AddEpAnn], LocatedN RdrName, a, b, HsDataDefn GhcPs)
exactDataDefn [AddEpAnn]
XCFamEqn GhcPs (HsDataDefn GhcPs)
an2 Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
      HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
      [HsArg
         GhcPs
         (GenLocated SrcSpanAnnA (HsType GhcPs))
         (GenLocated SrcSpanAnnA (HsType GhcPs))],
      Maybe (LHsContext GhcPs))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
      HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
pp_hdr HsDataDefn GhcPs
defn
                                          -- See Note [an and an2 in exactDataFamInstDecl]
    return
      (an',
       DataFamInstDecl ( FamEqn { feqn_ext    = an2'
                                , feqn_tycon  = tycon'
                                , feqn_bndrs  = bndrs'
                                , feqn_pats   = pats'
                                , feqn_fixity = fixity
                                , feqn_rhs    = defn' }))
                    `debug` ("exactDataFamInstDecl: defn' derivs:" ++ showAst (dd_derivs defn'))
  where
    pp_hdr :: (Monad m, Monoid w)
           => Maybe (LHsContext GhcPs)
           -> EP w m ( [AddEpAnn]
                     , LocatedN RdrName
                     , HsOuterTyVarBndrs () GhcPs
                     , HsFamEqnPats GhcPs
                     , Maybe (LHsContext GhcPs))
    pp_hdr :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
      HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
pp_hdr Maybe (LHsContext GhcPs)
mctxt = do
      an0 <- case TopLevelFlag
top_lvl of
               TopLevelFlag
TopLevel -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnInstance -- TODO: maybe in toplevel
               TopLevelFlag
NotTopLevel -> [AddEpAnn]
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
an
      exactHsFamInstLHS an0 tycon bndrs pats fixity mctxt

{-
Note [an and an2 in exactDataFamInstDecl]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The exactDataFamInstDecl function is called to render a
DataFamInstDecl within its surrounding context. This context is
rendered via the 'pp_hdr' function, which uses the exact print
annotations from that context, named 'an'.  The EPAs used for
rendering the DataDefn are contained in the FamEqn, and are called
'an2'.

-}

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

instance ExactPrint (DerivDecl GhcPs) where
  getAnnotationEntry :: DerivDecl GhcPs -> Entry
getAnnotationEntry DerivDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: DerivDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> DerivDecl GhcPs
setAnnotationAnchor DerivDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = DerivDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DerivDecl GhcPs -> EP w m (DerivDecl GhcPs)
exact (DerivDecl (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
mw, [AddEpAnn]
an) LHsSigWcType GhcPs
typ Maybe (LDerivStrategy GhcPs)
ms Maybe (XRec GhcPs OverlapMode)
mov) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDeriving
    ms' <- mapM markAnnotated ms
    an1 <- markEpAnnL an0 lidl AnnInstance
    mw' <- mapM markAnnotated mw
    mov' <- mapM markAnnotated mov
    typ' <- markAnnotated typ
    return (DerivDecl (mw', an1) typ' ms' mov')

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

instance ExactPrint (ForeignDecl GhcPs) where
  getAnnotationEntry :: ForeignDecl GhcPs -> Entry
getAnnotationEntry ForeignDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: ForeignDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> ForeignDecl GhcPs
setAnnotationAnchor ForeignDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = ForeignDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ForeignDecl GhcPs -> EP w m (ForeignDecl GhcPs)
exact (ForeignImport XForeignImport GhcPs
an LIdP GhcPs
n LHsSigType GhcPs
ty ForeignImport GhcPs
fimport) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XForeignImport GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnForeign
    an1 <- markEpAnnL an0 lidl AnnImport

    fimport' <- markAnnotated fimport

    n' <- markAnnotated n
    an2 <- markEpAnnL an1 lidl AnnDcolon
    ty' <- markAnnotated ty
    return (ForeignImport an2 n' ty' fimport')

  exact (ForeignExport XForeignExport GhcPs
an LIdP GhcPs
n LHsSigType GhcPs
ty ForeignExport GhcPs
fexport) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XForeignExport GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnForeign
    an1 <- markEpAnnL an0 lidl AnnExport
    fexport' <- markAnnotated fexport
    n' <- markAnnotated n
    an2 <- markEpAnnL an1 lidl AnnDcolon
    ty' <- markAnnotated ty
    return (ForeignExport an2 n' ty' fexport')

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

instance ExactPrint (ForeignImport GhcPs) where
  getAnnotationEntry :: ForeignImport GhcPs -> Entry
getAnnotationEntry = Entry -> ForeignImport GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: ForeignImport GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> ForeignImport GhcPs
setAnnotationAnchor ForeignImport GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = ForeignImport GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ForeignImport GhcPs -> EP w m (ForeignImport GhcPs)
exact (CImport (L Anchor
ls SourceText
src) XRec GhcPs CCallConv
cconv safety :: XRec GhcPs Safety
safety@(L Anchor
l Safety
_) Maybe Header
mh CImportSpec
imp) = do
    cconv' <- GenLocated Anchor CCallConv -> EP w m (GenLocated Anchor CCallConv)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs CCallConv
GenLocated Anchor CCallConv
cconv
    safety' <- if notDodgyE l
        then markAnnotated safety
        else return safety
    ls' <- if notDodgyE ls
        then markExternalSourceTextE ls src ""
        else return ls
    return (CImport (L ls' src) cconv' safety' mh imp)

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

instance ExactPrint (ForeignExport GhcPs) where
  getAnnotationEntry :: ForeignExport GhcPs -> Entry
getAnnotationEntry = Entry -> ForeignExport GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: ForeignExport GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> ForeignExport GhcPs
setAnnotationAnchor ForeignExport GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = ForeignExport GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ForeignExport GhcPs -> EP w m (ForeignExport GhcPs)
exact (CExport (L Anchor
ls SourceText
src) XRec GhcPs CExportSpec
spec) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"CExport starting"
    spec' <- GenLocated Anchor CExportSpec
-> EP w m (GenLocated Anchor CExportSpec)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs CExportSpec
GenLocated Anchor CExportSpec
spec
    ls' <- if notDodgyE ls
        then markExternalSourceTextE ls src ""
        else return ls
    return (CExport (L ls' src) spec')

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

instance ExactPrint CExportSpec where
  getAnnotationEntry :: CExportSpec -> Entry
getAnnotationEntry = Entry -> CExportSpec -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: CExportSpec
-> Anchor -> [TrailingAnn] -> EpAnnComments -> CExportSpec
setAnnotationAnchor CExportSpec
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = CExportSpec
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CExportSpec -> EP w m CExportSpec
exact (CExportStatic SourceText
st FastString
lbl CCallConv
cconv) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"CExportStatic starting"
    cconv' <- CCallConv -> EP w m CCallConv
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated CCallConv
cconv
    return (CExportStatic st lbl cconv')

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

instance ExactPrint Safety where
  getAnnotationEntry :: Safety -> Entry
getAnnotationEntry = Entry -> Safety -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: Safety -> Anchor -> [TrailingAnn] -> EpAnnComments -> Safety
setAnnotationAnchor Safety
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = Safety
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Safety -> EP w m Safety
exact = Safety -> EP w m Safety
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr

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

instance ExactPrint CCallConv where
  getAnnotationEntry :: CCallConv -> Entry
getAnnotationEntry = Entry -> CCallConv -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: CCallConv -> Anchor -> [TrailingAnn] -> EpAnnComments -> CCallConv
setAnnotationAnchor CCallConv
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = CCallConv
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CCallConv -> EP w m CCallConv
exact = CCallConv -> EP w m CCallConv
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr

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

instance ExactPrint (WarnDecls GhcPs) where
  getAnnotationEntry :: WarnDecls GhcPs -> Entry
getAnnotationEntry WarnDecls GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: WarnDecls GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> WarnDecls GhcPs
setAnnotationAnchor WarnDecls GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = WarnDecls GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
WarnDecls GhcPs -> EP w m (WarnDecls GhcPs)
exact (Warnings ([AddEpAnn]
an,SourceText
src) [LWarnDecl GhcPs]
warns) = do
    an0 <- [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen [AddEpAnn]
an SourceText
src String
"{-# WARNING" -- Note: might be {-# DEPRECATED
    warns' <- markAnnotated warns
    an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")
    return (Warnings (an1,src) warns')

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

instance ExactPrint (WarnDecl GhcPs) where
  getAnnotationEntry :: WarnDecl GhcPs -> Entry
getAnnotationEntry WarnDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: WarnDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> WarnDecl GhcPs
setAnnotationAnchor WarnDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = WarnDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
WarnDecl GhcPs -> EP w m (WarnDecl GhcPs)
exact (Warning (NamespaceSpecifier
ns_spec, [AddEpAnn]
an) [LIdP GhcPs]
lns  (WarningTxt Maybe (LocatedE InWarningCategory)
mb_cat SourceText
src [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
ls )) = do
    mb_cat' <- Maybe (LocatedE InWarningCategory)
-> EP w m (Maybe (LocatedE InWarningCategory))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (LocatedE InWarningCategory)
mb_cat
    ns_spec' <- exactNsSpec ns_spec
    lns' <- markAnnotated lns
    an0 <- markEpAnnL an lidl AnnOpenS -- "["
    ls' <- markAnnotated ls
    an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"
    return (Warning (ns_spec', an1) lns'  (WarningTxt mb_cat' src ls'))
    -- return (Warning an1 lns'  (WarningTxt mb_cat' src ls'))

  exact (Warning (NamespaceSpecifier
ns_spec, [AddEpAnn]
an) [LIdP GhcPs]
lns (DeprecatedTxt SourceText
src [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
ls)) = do
    ns_spec' <- NamespaceSpecifier -> EP w m NamespaceSpecifier
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NamespaceSpecifier -> EP w m NamespaceSpecifier
exactNsSpec NamespaceSpecifier
ns_spec
    lns' <- markAnnotated lns
    an0 <- markEpAnnL an lidl AnnOpenS -- "["
    ls' <- markAnnotated ls
    an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"
    return (Warning (ns_spec', an1) lns' (DeprecatedTxt src ls'))
    -- return (Warning an1 lns' (DeprecatedTxt src ls'))

exactNsSpec :: (Monad m, Monoid w) => NamespaceSpecifier -> EP w m NamespaceSpecifier
exactNsSpec :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NamespaceSpecifier -> EP w m NamespaceSpecifier
exactNsSpec NamespaceSpecifier
NoNamespaceSpecifier = NamespaceSpecifier
-> RWST (EPOptions m w) (EPWriter w) EPState m NamespaceSpecifier
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamespaceSpecifier
NoNamespaceSpecifier
exactNsSpec (TypeNamespaceSpecifier EpToken "type"
type_) = do
  type_' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
type_
  pure (TypeNamespaceSpecifier type_')
exactNsSpec (DataNamespaceSpecifier EpToken "data"
data_) = do
  data_' <- EpToken "data" -> EP w m (EpToken "data")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "data"
data_
  pure (DataNamespaceSpecifier data_')

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

instance ExactPrint StringLiteral where
  getAnnotationEntry :: StringLiteral -> Entry
getAnnotationEntry = Entry -> StringLiteral -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: StringLiteral
-> Anchor -> [TrailingAnn] -> EpAnnComments -> StringLiteral
setAnnotationAnchor StringLiteral
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = StringLiteral
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
StringLiteral -> EP w m StringLiteral
exact (StringLiteral SourceText
src FastString
fs Maybe (EpaLocation' NoComments)
mcomma) = do
    SourceText -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceTextAA SourceText
src (ShowS
forall a. Show a => a -> String
show (FastString -> String
unpackFS FastString
fs))
    mcomma' <- (EpaLocation' NoComments
 -> RWST
      (EPOptions m w) (EPWriter w) EPState m (EpaLocation' NoComments))
-> Maybe (EpaLocation' NoComments)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (EpaLocation' NoComments))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (\EpaLocation' NoComments
r -> EpaLocation' NoComments
-> String
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (EpaLocation' NoComments)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation' NoComments
-> String -> EP w m (EpaLocation' NoComments)
printStringAtNC EpaLocation' NoComments
r String
",") Maybe (EpaLocation' NoComments)
mcomma
    return (StringLiteral src fs mcomma')


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

instance ExactPrint FastString where
  getAnnotationEntry :: FastString -> Entry
getAnnotationEntry = Entry -> FastString -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: FastString
-> Anchor -> [TrailingAnn] -> EpAnnComments -> FastString
setAnnotationAnchor FastString
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = FastString
a

  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.
  -- exact fs = printStringAdvance (show (unpackFS fs))
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
FastString -> EP w m FastString
exact FastString
fs = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (FastString -> String
unpackFS FastString
fs) EP w m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m FastString
-> RWST (EPOptions m w) (EPWriter w) EPState m FastString
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FastString
-> RWST (EPOptions m w) (EPWriter w) EPState m FastString
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return FastString
fs

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

instance ExactPrint (RuleDecls GhcPs) where
  getAnnotationEntry :: RuleDecls GhcPs -> Entry
getAnnotationEntry RuleDecls GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: RuleDecls GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> RuleDecls GhcPs
setAnnotationAnchor RuleDecls GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = RuleDecls GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RuleDecls GhcPs -> EP w m (RuleDecls GhcPs)
exact (HsRules ([AddEpAnn]
an, SourceText
src) [LRuleDecl GhcPs]
rules) = do
    an0 <-
      case SourceText
src of
        SourceText
NoSourceText      -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpen  (String -> Maybe String
forall a. a -> Maybe a
Just String
"{-# RULES")
        SourceText FastString
srcTxt -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpen  (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
srcTxt)
    rules' <- markAnnotated rules
    an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")
    return (HsRules (an1,src) rules')

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

instance ExactPrint (RuleDecl GhcPs) where
  getAnnotationEntry :: RuleDecl GhcPs -> Entry
getAnnotationEntry RuleDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: RuleDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> RuleDecl GhcPs
setAnnotationAnchor RuleDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = RuleDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RuleDecl GhcPs -> EP w m (RuleDecl GhcPs)
exact (HsRule (HsRuleAnn
an,SourceText
nsrc) (L EpAnn NoEpAnns
ln FastString
n) Activation
act Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
mtybndrs [LRuleBndr GhcPs]
termbndrs XRec GhcPs (HsExpr GhcPs)
lhs XRec GhcPs (HsExpr GhcPs)
rhs) = do
    (L ln' _) <- GenLocated (EpAnn NoEpAnns) (SourceText, FastString)
-> EP w m (GenLocated (EpAnn NoEpAnns) (SourceText, FastString))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated (EpAnn NoEpAnns
-> (SourceText, FastString)
-> GenLocated (EpAnn NoEpAnns) (SourceText, FastString)
forall l e. l -> e -> GenLocated l e
L EpAnn NoEpAnns
ln (SourceText
nsrc, FastString
n))
    an0 <- markActivation an lra_rest act
    (an1, mtybndrs') <-
      case mtybndrs of
        Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
Nothing -> (HsRuleAnn, Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (HsRuleAnn, Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsRuleAnn
an0, Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall a. Maybe a
Nothing)
        Just [LHsTyVarBndr () (NoGhcTc GhcPs)]
bndrs -> do
          an1 <-  HsRuleAnn -> Lens HsRuleAnn (Maybe AddEpAnn) -> EP w m HsRuleAnn
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a (Maybe AddEpAnn) -> EP w m a
markLensMAA' HsRuleAnn
an0 (Maybe AddEpAnn -> f (Maybe AddEpAnn)) -> HsRuleAnn -> f HsRuleAnn
Lens HsRuleAnn (Maybe AddEpAnn)
lra_tyanns_fst  -- AnnForall
          bndrs' <- mapM markAnnotated bndrs
          an2 <- markLensMAA' an1 lra_tyanns_snd  -- AnnDot
          return (an2, Just bndrs')

    an2 <- markLensMAA' an1 lra_tmanns_fst  -- AnnForall
    termbndrs' <- mapM markAnnotated termbndrs
    an3 <- markLensMAA' an2 lra_tmanns_snd  -- AnnDot

    lhs' <- markAnnotated lhs
    an4 <- markEpAnnL an3 lra_rest AnnEqual
    rhs' <- markAnnotated rhs
    return (HsRule (an4,nsrc) (L ln' n) act mtybndrs' termbndrs' lhs' rhs')

markActivation :: (Monad m, Monoid w)
  => a -> Lens a [AddEpAnn] -> Activation -> EP w m a
markActivation :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> Activation -> EP w m a
markActivation a
an Lens a [AddEpAnn]
l Activation
act = do
  case Activation
act of
    ActiveBefore SourceText
src Int
phase -> do
      an0 <- a -> Lens a [AddEpAnn] -> AnnKeywordId -> EP w m a
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL a
an ([AddEpAnn] -> f [AddEpAnn]) -> a -> f a
Lens a [AddEpAnn]
l AnnKeywordId
AnnOpenS --  '['
      an1 <- markEpAnnL an0 l AnnTilde -- ~
      an2 <- markEpAnnLMS'' an1 l AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))
      an3 <- markEpAnnL an2 l AnnCloseS -- ']'
      return an3
    ActiveAfter SourceText
src Int
phase -> do
      an0 <- a -> Lens a [AddEpAnn] -> AnnKeywordId -> EP w m a
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL a
an ([AddEpAnn] -> f [AddEpAnn]) -> a -> f a
Lens a [AddEpAnn]
l AnnKeywordId
AnnOpenS --  '['
      an1 <- markEpAnnLMS'' an0 l AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))
      an2 <- markEpAnnL an1 l AnnCloseS -- ']'
      return an2
    Activation
NeverActive -> do
      an0 <- a -> Lens a [AddEpAnn] -> AnnKeywordId -> EP w m a
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL a
an ([AddEpAnn] -> f [AddEpAnn]) -> a -> f a
Lens a [AddEpAnn]
l AnnKeywordId
AnnOpenS --  '['
      an1 <- markEpAnnL an0 l AnnTilde -- ~
      an2 <- markEpAnnL an1 l AnnCloseS -- ']'
      return an2
    Activation
_ -> a -> EP w m a
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
an

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

instance ExactPrint (SpliceDecl GhcPs) where
  getAnnotationEntry :: SpliceDecl GhcPs -> Entry
getAnnotationEntry = Entry -> SpliceDecl GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: SpliceDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> SpliceDecl GhcPs
setAnnotationAnchor SpliceDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = SpliceDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SpliceDecl GhcPs -> EP w m (SpliceDecl GhcPs)
exact (SpliceDecl XSpliceDecl GhcPs
x XRec GhcPs (HsUntypedSplice GhcPs)
splice SpliceDecoration
flag) = do
    splice' <- GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsUntypedSplice GhcPs)
GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
splice
    return (SpliceDecl x splice' flag)

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

instance ExactPrint (DocDecl GhcPs) where
  getAnnotationEntry :: DocDecl GhcPs -> Entry
getAnnotationEntry = Entry -> DocDecl GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: DocDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> DocDecl GhcPs
setAnnotationAnchor DocDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = DocDecl GhcPs
a

  -- We print these as plain comments instead, do a NOP here.
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DocDecl GhcPs -> EP w m (DocDecl GhcPs)
exact DocDecl GhcPs
v = DocDecl GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (DocDecl GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return DocDecl GhcPs
v

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

instance ExactPrint (RoleAnnotDecl GhcPs) where
  getAnnotationEntry :: RoleAnnotDecl GhcPs -> Entry
getAnnotationEntry RoleAnnotDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: RoleAnnotDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> RoleAnnotDecl GhcPs
setAnnotationAnchor RoleAnnotDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = RoleAnnotDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RoleAnnotDecl GhcPs -> EP w m (RoleAnnotDecl GhcPs)
exact (RoleAnnotDecl XCRoleAnnotDecl GhcPs
an LIdP GhcPs
ltycon [XRec GhcPs (Maybe Role)]
roles) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XCRoleAnnotDecl GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnType
    an1 <- markEpAnnL an0 lidl AnnRole
    ltycon' <- markAnnotated ltycon
    let markRole (L EpAnn ann
l (Just a
r)) = do
          (L l' r') <- GenLocated (EpAnn ann) a -> EP w m (GenLocated (EpAnn ann) a)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated (EpAnn ann -> a -> GenLocated (EpAnn ann) a
forall l e. l -> e -> GenLocated l e
L EpAnn ann
l a
r)
          return (L l' (Just r'))
        markRole (L EpAnn ann
l Maybe a
Nothing) = do
          e' <- Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA  (EpAnn ann -> Anchor
forall ann. EpAnn ann -> Anchor
entry EpAnn ann
l) String
"_"
          return (L (l { entry = e'}) Nothing)
    roles' <- mapM markRole roles
    return (RoleAnnotDecl an1 ltycon' roles')

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

instance ExactPrint Role where
  getAnnotationEntry :: Role -> Entry
getAnnotationEntry = Entry -> Role -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: Role -> Anchor -> [TrailingAnn] -> EpAnnComments -> Role
setAnnotationAnchor Role
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = Role
a
  exact :: forall (m :: * -> *) w. (Monad m, Monoid w) => Role -> EP w m Role
exact = Role -> EP w m Role
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr

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

instance ExactPrint (RuleBndr GhcPs) where
  getAnnotationEntry :: RuleBndr GhcPs -> Entry
getAnnotationEntry = Entry -> RuleBndr GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: RuleBndr GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> RuleBndr GhcPs
setAnnotationAnchor RuleBndr GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = RuleBndr GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RuleBndr GhcPs -> EP w m (RuleBndr GhcPs)
exact (RuleBndr XCRuleBndr GhcPs
x LIdP GhcPs
ln) = do
    ln' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
ln
    return (RuleBndr x ln')
  exact (RuleBndrSig XRuleBndrSig GhcPs
an LIdP GhcPs
ln (HsPS XHsPS GhcPs
x LHsType GhcPs
ty)) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XRuleBndrSig GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenP -- "("
    ln' <- markAnnotated ln
    an1 <- markEpAnnL an0 lidl AnnDcolon
    ty' <- markAnnotated ty
    an2 <- markEpAnnL an1 lidl AnnCloseP -- ")"
    return (RuleBndrSig an2 ln' (HsPS x ty'))

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

instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where
  getAnnotationEntry :: FamEqn GhcPs body -> Entry
getAnnotationEntry FamEqn GhcPs body
_ = Entry
NoEntryVal
  setAnnotationAnchor :: FamEqn GhcPs body
-> Anchor -> [TrailingAnn] -> EpAnnComments -> FamEqn GhcPs body
setAnnotationAnchor FamEqn GhcPs body
fe Anchor
_ [TrailingAnn]
_ EpAnnComments
_s = FamEqn GhcPs body
fe
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
FamEqn GhcPs body -> EP w m (FamEqn GhcPs body)
exact (FamEqn { feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_ext = XCFamEqn GhcPs body
an
                , feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon  = LIdP GhcPs
tycon
                , feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_bndrs  = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
                , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_pats   = HsFamEqnPats GhcPs
pats
                , feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_fixity = LexicalFixity
fixity
                , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs    = body
rhs }) = do
    (an0, tycon', bndrs', pats', _) <- [AddEpAnn]
-> LocatedN RdrName
-> HsOuterFamEqnTyVarBndrs GhcPs
-> HsFamEqnPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
      HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> LocatedN RdrName
-> HsOuterFamEqnTyVarBndrs GhcPs
-> HsFamEqnPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
      HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
exactHsFamInstLHS [AddEpAnn]
XCFamEqn GhcPs body
an LIdP GhcPs
LocatedN RdrName
tycon HsOuterFamEqnTyVarBndrs GhcPs
bndrs HsFamEqnPats GhcPs
pats LexicalFixity
fixity Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. Maybe a
Nothing
    an1 <- markEpAnnL an0 lidl AnnEqual
    rhs' <- markAnnotated rhs
    return (FamEqn { feqn_ext = an1
                   , feqn_tycon  = tycon'
                   , feqn_bndrs  = bndrs'
                   , feqn_pats   = pats'
                   , feqn_fixity = fixity
                   , feqn_rhs    = rhs' })

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

exactHsFamInstLHS ::
      (Monad m, Monoid w)
   => [AddEpAnn]
   -> LocatedN RdrName
   -> HsOuterTyVarBndrs () GhcPs
   -> HsFamEqnPats GhcPs
   -> LexicalFixity
   -> Maybe (LHsContext GhcPs)
   -> EP w m ( [AddEpAnn]
             , LocatedN RdrName
             , HsOuterTyVarBndrs () GhcPs
             , HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
exactHsFamInstLHS :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> LocatedN RdrName
-> HsOuterFamEqnTyVarBndrs GhcPs
-> HsFamEqnPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, HsOuterFamEqnTyVarBndrs GhcPs,
      HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
exactHsFamInstLHS [AddEpAnn]
an LocatedN RdrName
thing HsOuterFamEqnTyVarBndrs GhcPs
bndrs HsFamEqnPats GhcPs
typats LexicalFixity
fixity Maybe (LHsContext GhcPs)
mb_ctxt = do
  an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnForall
  bndrs' <- markAnnotated bndrs
  an1 <- markEpAnnL an0 lidl AnnDot
  mb_ctxt' <- mapM markAnnotated mb_ctxt
  (an2, thing', typats') <- exact_pats an1 typats
  return (an2, thing', bndrs', typats', mb_ctxt')
  where
    exact_pats :: (Monad m, Monoid w)
      => [AddEpAnn] -> HsFamEqnPats GhcPs -> EP w m ([AddEpAnn], LocatedN RdrName, HsFamEqnPats GhcPs)
    exact_pats :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> HsFamEqnPats GhcPs
-> EP w m ([AddEpAnn], LocatedN RdrName, HsFamEqnPats GhcPs)
exact_pats [AddEpAnn]
an' (LHsTypeArg GhcPs
patl:LHsTypeArg GhcPs
patr:HsFamEqnPats GhcPs
pats)
      | LexicalFixity
Infix <- LexicalFixity
fixity
      = let exact_op_app :: RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([AddEpAnn], LocatedN RdrName,
   [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))])
exact_op_app = do
              an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnAllL' [AddEpAnn]
an' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenP
              patl' <- markAnnotated patl
              thing' <- markAnnotated thing
              patr' <- markAnnotated patr
              an1 <- markEpAnnAllL' an0 lidl AnnCloseP
              return (an1, thing', [patl',patr'])
        in case HsFamEqnPats GhcPs
pats of
             [] -> EP w m ([AddEpAnn], LocatedN RdrName, HsFamEqnPats GhcPs)
RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([AddEpAnn], LocatedN RdrName,
   [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))])
exact_op_app
             HsFamEqnPats GhcPs
_  -> do
               (an0, thing', p) <- RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([AddEpAnn], LocatedN RdrName,
   [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))])
exact_op_app
               pats' <- mapM markAnnotated pats
               return (an0, thing', p++pats')

    exact_pats [AddEpAnn]
an' HsFamEqnPats GhcPs
pats = do
      an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnAllL' [AddEpAnn]
an' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenP
      thing' <- markAnnotated thing
      pats' <- markAnnotated pats
      an1 <- markEpAnnAllL' an0 lidl AnnCloseP
      return (an1, thing', pats')

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

instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)
     =>  ExactPrint (HsArg GhcPs tm ty) where
  getAnnotationEntry :: HsArg GhcPs tm ty -> Entry
getAnnotationEntry = Entry -> HsArg GhcPs tm ty -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsArg GhcPs tm ty
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsArg GhcPs tm ty
setAnnotationAnchor HsArg GhcPs tm ty
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsArg GhcPs tm ty
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsArg GhcPs tm ty -> EP w m (HsArg GhcPs tm ty)
exact (HsValArg XValArg GhcPs
x tm
tm) = do
      tm' <- tm -> EP w m tm
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated tm
tm
      return (HsValArg x tm')
  exact (HsTypeArg XTypeArg GhcPs
at ty
ty) = do
      at' <- EpToken "@" -> EP w m (EpToken "@")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "@"
XTypeArg GhcPs
at
      ty' <- markAnnotated ty
      return (HsTypeArg at' ty')
  exact x :: HsArg GhcPs tm ty
x@(HsArgPar XArgPar GhcPs
_sp)    = HsArg GhcPs tm ty
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsArg GhcPs tm ty)
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr HsArg GhcPs tm ty
x -- Does not appear in original source

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

instance ExactPrint (ClsInstDecl GhcPs) where
  getAnnotationEntry :: ClsInstDecl GhcPs -> Entry
getAnnotationEntry ClsInstDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: ClsInstDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> ClsInstDecl GhcPs
setAnnotationAnchor ClsInstDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = ClsInstDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ClsInstDecl GhcPs -> EP w m (ClsInstDecl GhcPs)
exact (ClsInstDecl { cid_ext :: forall pass. ClsInstDecl pass -> XCClsInstDecl pass
cid_ext = (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
mbWarn, [AddEpAnn]
an, AnnSortKey DeclTag
sortKey)
                     , cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType GhcPs
inst_ty, cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds = LHsBinds GhcPs
binds
                     , cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_sigs = [LSig GhcPs]
sigs, cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts = [LTyFamInstDecl GhcPs]
ats
                     , cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
cid_overlap_mode = Maybe (XRec GhcPs OverlapMode)
mbOverlap
                     , cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl GhcPs]
adts })
      = do
          (mbWarn', an0, mbOverlap', inst_ty') <- RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)),
   [AddEpAnn], Maybe (GenLocated (EpAnn AnnPragma) OverlapMode),
   GenLocated SrcSpanAnnA (HsSigType GhcPs))
top_matter
          an1 <- markEpAnnL an0 lidl AnnOpenC
          an2 <- markEpAnnAllL' an1 lid AnnSemi
          (sortKey', ds) <- withSortKey sortKey
                               [(ClsAtTag, prepareListAnnotationA ats),
                                (ClsAtdTag, prepareListAnnotationF adts),
                                (ClsMethodTag, prepareListAnnotationA (bagToList binds)),
                                (ClsSigTag, prepareListAnnotationA sigs)
                               ]
          an3 <- markEpAnnL an2 lidl AnnCloseC -- '}'
          let
            ats'   = [Dynamic] -> [LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            adts'  = [Dynamic] -> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            binds' = [LocatedAn AnnListItem (HsBind GhcPs)]
-> Bag (LocatedAn AnnListItem (HsBind GhcPs))
forall a. [a] -> Bag a
listToBag ([LocatedAn AnnListItem (HsBind GhcPs)]
 -> Bag (LocatedAn AnnListItem (HsBind GhcPs)))
-> [LocatedAn AnnListItem (HsBind GhcPs)]
-> Bag (LocatedAn AnnListItem (HsBind GhcPs))
forall a b. (a -> b) -> a -> b
$ [Dynamic] -> [LocatedAn AnnListItem (HsBind GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            sigs'  = [Dynamic] -> [LocatedAn AnnListItem (Sig GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
          return (ClsInstDecl { cid_ext = (mbWarn', an3, sortKey')
                              , cid_poly_ty = inst_ty', cid_binds = binds'
                              , cid_sigs = sigs', cid_tyfam_insts = ats'
                              , cid_overlap_mode = mbOverlap'
                              , cid_datafam_insts = adts' })

      where
        top_matter :: RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)),
   [AddEpAnn], Maybe (GenLocated (EpAnn AnnPragma) OverlapMode),
   GenLocated SrcSpanAnnA (HsSigType GhcPs))
top_matter = do
          an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnInstance
          mw <- mapM markAnnotated mbWarn
          mo <- mapM markAnnotated mbOverlap
          it <- markAnnotated inst_ty
          an1 <- markEpAnnL an0 lidl AnnWhere -- Optional
          return (mw, an1, mo,it)

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

instance ExactPrint (TyFamInstDecl GhcPs) where
  getAnnotationEntry :: TyFamInstDecl GhcPs -> Entry
getAnnotationEntry TyFamInstDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: TyFamInstDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> TyFamInstDecl GhcPs
setAnnotationAnchor TyFamInstDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = TyFamInstDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
TyFamInstDecl GhcPs -> EP w m (TyFamInstDecl GhcPs)
exact d :: TyFamInstDecl GhcPs
d@(TyFamInstDecl { tfid_xtn :: forall pass. TyFamInstDecl pass -> XCTyFamInstDecl pass
tfid_xtn = XCTyFamInstDecl GhcPs
an, tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = TyFamInstEqn GhcPs
eqn }) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XCTyFamInstDecl GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnType
    an1 <- markEpAnnL an0 lidl AnnInstance
    eqn' <- markAnnotated eqn
    return (d { tfid_xtn = an1, tfid_eqn = eqn' })

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

instance ExactPrint (LocatedP OverlapMode) where
  getAnnotationEntry :: GenLocated (EpAnn AnnPragma) OverlapMode -> Entry
getAnnotationEntry = GenLocated (EpAnn AnnPragma) OverlapMode -> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: GenLocated (EpAnn AnnPragma) OverlapMode
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated (EpAnn AnnPragma) OverlapMode
setAnnotationAnchor = GenLocated (EpAnn AnnPragma) OverlapMode
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated (EpAnn AnnPragma) OverlapMode
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn

  -- NOTE: NoOverlap is only used in the typechecker
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated (EpAnn AnnPragma) OverlapMode
-> EP w m (GenLocated (EpAnn AnnPragma) OverlapMode)
exact (L EpAnn AnnPragma
an (NoOverlap SourceText
src)) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# NO_OVERLAP"
    an1 <- markAnnCloseP an0
    return (L an1 (NoOverlap src))

  exact (L EpAnn AnnPragma
an (Overlappable SourceText
src)) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# OVERLAPPABLE"
    an1 <- markAnnCloseP an0
    return (L an1 (Overlappable src))

  exact (L EpAnn AnnPragma
an (Overlapping SourceText
src)) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# OVERLAPPING"
    an1 <- markAnnCloseP an0
    return (L an1 (Overlapping src))

  exact (L EpAnn AnnPragma
an (Overlaps SourceText
src)) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# OVERLAPS"
    an1 <- markAnnCloseP an0
    return (L an1 (Overlaps src))

  exact (L EpAnn AnnPragma
an (Incoherent SourceText
src)) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# INCOHERENT"
    an1 <- markAnnCloseP an0
    return (L an1 (Incoherent src))

  exact (L EpAnn AnnPragma
an (NonCanonical SourceText
src)) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# INCOHERENT"
    an1 <- markAnnCloseP an0
    return (L an1 (Incoherent src))

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

instance ExactPrint (HsBind GhcPs) where
  getAnnotationEntry :: HsBind GhcPs -> Entry
getAnnotationEntry HsBind GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsBind GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsBind GhcPs
setAnnotationAnchor HsBind GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsBind GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsBind GhcPs -> EP w m (HsBind GhcPs)
exact (FunBind XFunBind GhcPs GhcPs
x LIdP GhcPs
fid MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
matches) = do
    matches' <- MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> EP
     w m (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
matches
    let
      fun_id' = case GenLocated
  (EpAnn AnnList)
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
matches') of
        [] -> LIdP GhcPs
fid
        (L SrcSpanAnnA
_ Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m:[GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_) -> case Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext (LIdP (NoGhcTc GhcPs))
forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m of
          FunRhs LIdP (NoGhcTc GhcPs)
f LexicalFixity
_ SrcStrictness
_ -> LIdP (NoGhcTc GhcPs)
LIdP GhcPs
f
          HsMatchContext (LIdP (NoGhcTc GhcPs))
_ -> LIdP GhcPs
fid
    return (FunBind x fun_id' matches')

  exact (PatBind XPatBind GhcPs GhcPs
x LPat GhcPs
pat HsMultAnn GhcPs
q GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
grhss) = do
    q' <- HsMultAnn GhcPs -> EP w m (HsMultAnn GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsMultAnn GhcPs
q
    pat' <- markAnnotated pat
    grhss' <- markAnnotated grhss
    return (PatBind x pat' q' grhss')
  exact (PatSynBind XPatSynBind GhcPs GhcPs
x PatSynBind GhcPs GhcPs
bind) = do
    bind' <- PatSynBind GhcPs GhcPs -> EP w m (PatSynBind GhcPs GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated PatSynBind GhcPs GhcPs
bind
    return (PatSynBind x bind')

  exact HsBind GhcPs
x = String
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsBind GhcPs)
forall a. HasCallStack => String -> a
error (String
 -> RWST (EPOptions m w) (EPWriter w) EPState m (HsBind GhcPs))
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsBind GhcPs)
forall a b. (a -> b) -> a -> b
$ String
"HsBind: exact for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsBind GhcPs -> String
forall a. Data a => a -> String
showAst HsBind GhcPs
x

instance ExactPrint (HsMultAnn GhcPs) where
  getAnnotationEntry :: HsMultAnn GhcPs -> Entry
getAnnotationEntry HsMultAnn GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsMultAnn GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsMultAnn GhcPs
setAnnotationAnchor HsMultAnn GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsMultAnn GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsMultAnn GhcPs -> EP w m (HsMultAnn GhcPs)
exact (HsNoMultAnn XNoMultAnn GhcPs
x) = HsMultAnn GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsMultAnn GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XNoMultAnn GhcPs -> HsMultAnn GhcPs
forall pass. XNoMultAnn pass -> HsMultAnn pass
HsNoMultAnn XNoMultAnn GhcPs
x)
  exact (HsPct1Ann XPct1Ann GhcPs
tok) = do
      tok' <- EpToken "%1" -> EP w m (EpToken "%1")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "%1"
XPct1Ann GhcPs
tok
      return (HsPct1Ann tok')
  exact (HsMultAnn XMultAnn GhcPs
tok LHsType (NoGhcTc GhcPs)
ty) = do
      tok' <- EpToken "%" -> EP w m (EpToken "%")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "%"
XMultAnn GhcPs
tok
      ty' <- markAnnotated ty
      return (HsMultAnn tok' ty')

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

instance ExactPrint (PatSynBind GhcPs GhcPs) where
  getAnnotationEntry :: PatSynBind GhcPs GhcPs -> Entry
getAnnotationEntry PatSynBind GhcPs GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: PatSynBind GhcPs GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> PatSynBind GhcPs GhcPs
setAnnotationAnchor PatSynBind GhcPs GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = PatSynBind GhcPs GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
PatSynBind GhcPs GhcPs -> EP w m (PatSynBind GhcPs GhcPs)
exact (PSB{ psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_ext = XPSB GhcPs GhcPs
an
            , psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id = LIdP GhcPs
psyn, psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_args = HsPatSynDetails GhcPs
details
            , psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def = LPat GhcPs
pat
            , psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir = HsPatSynDir GhcPs
dir }) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XPSB GhcPs GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnPattern
    (an1, psyn', details') <-
      case details of
        InfixCon LIdP GhcPs
v1 LIdP GhcPs
v2 -> do
          v1' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
v1
          psyn' <- markAnnotated psyn
          v2' <- markAnnotated v2
          return (an0, psyn',InfixCon v1' v2')
        PrefixCon [Void]
tvs [LIdP GhcPs]
vs -> do
          psyn' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
psyn
          tvs' <- markAnnotated tvs
          vs' <- markAnnotated vs
          return (an0, psyn', PrefixCon tvs' vs')
        RecCon [RecordPatSynField GhcPs]
vs -> do
          psyn' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
psyn
          an1 <- markEpAnnL an0 lidl AnnOpenC  -- '{'
          vs' <- markAnnotated vs
          an2 <- markEpAnnL an1 lidl AnnCloseC -- '}'
          return (an2, psyn', RecCon vs')

    (an2, pat', dir') <-
      case dir of
        HsPatSynDir GhcPs
Unidirectional           -> do
          an2 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an1 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnLarrow
          pat' <- markAnnotated pat
          return (an2, pat', dir)
        HsPatSynDir GhcPs
ImplicitBidirectional    -> do
          an2 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an1 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnEqual
          pat' <- markAnnotated pat
          return (an2, pat', dir)
        ExplicitBidirectional MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg -> do
          an2 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an1 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnLarrow
          pat' <- markAnnotated pat
          an3 <- markEpAnnL an2 lidl  AnnWhere
          mg' <- markAnnotated mg
          return (an3, pat', ExplicitBidirectional mg')

    return (PSB{ psb_ext = an2
               , psb_id = psyn', psb_args = details'
               , psb_def = pat'
               , psb_dir = dir' })


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

instance ExactPrint (RecordPatSynField GhcPs) where
  getAnnotationEntry :: RecordPatSynField GhcPs -> Entry
getAnnotationEntry = Entry -> RecordPatSynField GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: RecordPatSynField GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> RecordPatSynField GhcPs
setAnnotationAnchor RecordPatSynField GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = RecordPatSynField GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RecordPatSynField GhcPs -> EP w m (RecordPatSynField GhcPs)
exact (RecordPatSynField FieldOcc GhcPs
f LIdP GhcPs
v) = do
      f' <- FieldOcc GhcPs -> EP w m (FieldOcc GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated FieldOcc GhcPs
f
      return (RecordPatSynField f' v)

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

instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where
  getAnnotationEntry :: Match GhcPs (LocatedA (HsCmd GhcPs)) -> Entry
getAnnotationEntry Match GhcPs (LocatedA (HsCmd GhcPs))
_ = Entry
NoEntryVal
  setAnnotationAnchor :: Match GhcPs (LocatedA (HsCmd GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> Match GhcPs (LocatedA (HsCmd GhcPs))
setAnnotationAnchor Match GhcPs (LocatedA (HsCmd GhcPs))
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = Match GhcPs (LocatedA (HsCmd GhcPs))
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Match GhcPs (LocatedA (HsCmd GhcPs))
-> EP w m (Match GhcPs (LocatedA (HsCmd GhcPs)))
exact (Match XCMatch GhcPs (LocatedA (HsCmd GhcPs))
an HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats GRHSs GhcPs (LocatedA (HsCmd GhcPs))
grhss) =
    Match GhcPs (LocatedA (HsCmd GhcPs))
-> EP w m (Match GhcPs (LocatedA (HsCmd GhcPs)))
forall (m :: * -> *) w body.
(Monad m, Monoid w, ExactPrint (GRHSs GhcPs body)) =>
Match GhcPs body -> EP w m (Match GhcPs body)
exactMatch (XCMatch GhcPs (LocatedA (HsCmd GhcPs))
-> HsMatchContext (LIdP (NoGhcTc GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA (HsCmd GhcPs))
-> Match GhcPs (LocatedA (HsCmd GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (LIdP (NoGhcTc p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (LocatedA (HsCmd GhcPs))
an HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats GRHSs GhcPs (LocatedA (HsCmd GhcPs))
grhss)

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

instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where
  getAnnotationEntry :: Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Entry
getAnnotationEntry Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ = Entry
NoEntryVal
  setAnnotationAnchor :: Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
setAnnotationAnchor Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> EP w m (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
exact (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss) =
    Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> EP w m (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall (m :: * -> *) w body.
(Monad m, Monoid w, ExactPrint (GRHSs GhcPs body)) =>
Match GhcPs body -> EP w m (Match GhcPs body)
exactMatch (XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext (LIdP (NoGhcTc GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (LIdP (NoGhcTc p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss)

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

exactMatch :: (Monad m, Monoid w, ExactPrint (GRHSs GhcPs body))
           => (Match GhcPs body) -> EP w m (Match GhcPs body)
exactMatch :: forall (m :: * -> *) w body.
(Monad m, Monoid w, ExactPrint (GRHSs GhcPs body)) =>
Match GhcPs body -> EP w m (Match GhcPs body)
exactMatch (Match XCMatch GhcPs body
an HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats GRHSs GhcPs body
grhss) = do

  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"exact Match entered"

  (an0, mctxt', pats') <-
    case HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt of
      FunRhs LIdP (NoGhcTc GhcPs)
fun LexicalFixity
fixity SrcStrictness
strictness -> do
        String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"exact Match FunRhs:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LocatedN RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe LIdP (NoGhcTc GhcPs)
LocatedN RdrName
fun
        an0' <-
          case SrcStrictness
strictness of
            SrcStrictness
SrcStrict -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XCMatch GhcPs body
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnBang
            SrcStrictness
_ -> [AddEpAnn]
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AddEpAnn]
XCMatch GhcPs body
an
        case fixity of
          LexicalFixity
Prefix -> do
            an' <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> [AnnKeywordId]
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a
annotationsToComments [AddEpAnn]
an0' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl [AnnKeywordId
AnnOpenP,AnnKeywordId
AnnCloseP]
            fun' <- markAnnotated fun
            pats' <- markAnnotated pats
            return (an', FunRhs fun' fixity strictness, pats')
          LexicalFixity
Infix ->
            case [LPat GhcPs]
pats of
              (LPat GhcPs
p1:LPat GhcPs
p2:[LPat GhcPs]
rest)
                | [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
rest -> do
                    p1'  <- GenLocated SrcSpanAnnA (Pat GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1
                    fun' <- markAnnotated fun
                    p2'  <- markAnnotated p2
                    return (an0', FunRhs fun' fixity strictness, [p1',p2'])
                | Bool
otherwise -> do
                    an0  <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an0' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenP
                    p1'  <- markAnnotated p1
                    fun' <- markAnnotated fun
                    p2'  <- markAnnotated p2
                    an1  <- markEpAnnL an0 lidl AnnCloseP
                    rest' <- mapM markAnnotated rest
                    return (an1, FunRhs fun' fixity strictness, p1':p2':rest')
              [LPat GhcPs]
_ -> String
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn], HsMatchContext (LocatedN RdrName),
      [GenLocated SrcSpanAnnA (Pat GhcPs)])
forall a. HasCallStack => String -> a
panic String
"FunRhs"

      -- ToDo: why is LamSingle treated differently?
      LamAlt HsLamVariant
LamSingle -> do
        an0' <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> RWST (EPOptions m w) (EPWriter w) EPState m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XCMatch GhcPs body
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnLam
        pats' <- markAnnotated pats
        return (an0', LamAlt LamSingle, pats')
      LamAlt HsLamVariant
v -> do
        pats' <- [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
        return (an, LamAlt v, pats')

      HsMatchContext (LIdP (NoGhcTc GhcPs))
CaseAlt -> do
        pats' <- [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
        return (an, CaseAlt, pats')
      HsMatchContext (LIdP (NoGhcTc GhcPs))
_ -> do
        mctxt' <- HsMatchContext (LocatedN RdrName)
-> EP w m (HsMatchContext (LocatedN RdrName))
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (LocatedN RdrName)
mctxt
        return (an, mctxt', pats)

  grhss' <- markAnnotated grhss

  return (Match an0 mctxt' pats' grhss')

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

instance ExactPrint (GRHSs GhcPs (LocatedA (HsExpr GhcPs))) where
  getAnnotationEntry :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Entry
getAnnotationEntry (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
_ HsLocalBinds GhcPs
_) = Entry
NoEntryVal
  setAnnotationAnchor :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
setAnnotationAnchor GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> EP w m (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
exact (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
cs [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
binds) = do
    [LEpaComment] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
addCommentsA ([LEpaComment] -> EP w m ()) -> [LEpaComment] -> EP w m ()
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
cs
    [LEpaComment] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
addCommentsA ([LEpaComment] -> EP w m ()) -> [LEpaComment] -> EP w m ()
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
cs
    grhss' <- [GenLocated
   (EpAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     [GenLocated
        (EpAnn NoEpAnns)
        (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (EpAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss
    binds' <- markAnnotated binds
    -- The comments will be added back as they are printed
    return (GRHSs emptyComments grhss' binds')


instance ExactPrint (GRHSs GhcPs (LocatedA (HsCmd GhcPs))) where
  getAnnotationEntry :: GRHSs GhcPs (LocatedA (HsCmd GhcPs)) -> Entry
getAnnotationEntry (GRHSs XCGRHSs GhcPs (LocatedA (HsCmd GhcPs))
_ [LGRHS GhcPs (LocatedA (HsCmd GhcPs))]
_ HsLocalBinds GhcPs
_) = Entry
NoEntryVal
  setAnnotationAnchor :: GRHSs GhcPs (LocatedA (HsCmd GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GRHSs GhcPs (LocatedA (HsCmd GhcPs))
setAnnotationAnchor GRHSs GhcPs (LocatedA (HsCmd GhcPs))
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = GRHSs GhcPs (LocatedA (HsCmd GhcPs))
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GRHSs GhcPs (LocatedA (HsCmd GhcPs))
-> EP w m (GRHSs GhcPs (LocatedA (HsCmd GhcPs)))
exact (GRHSs XCGRHSs GhcPs (LocatedA (HsCmd GhcPs))
cs [LGRHS GhcPs (LocatedA (HsCmd GhcPs))]
grhss HsLocalBinds GhcPs
binds) = do
    [LEpaComment] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
addCommentsA ([LEpaComment] -> EP w m ()) -> [LEpaComment] -> EP w m ()
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments XCGRHSs GhcPs (LocatedA (HsCmd GhcPs))
EpAnnComments
cs
    [LEpaComment] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LEpaComment] -> EP w m ()
addCommentsA ([LEpaComment] -> EP w m ()) -> [LEpaComment] -> EP w m ()
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments XCGRHSs GhcPs (LocatedA (HsCmd GhcPs))
EpAnnComments
cs
    grhss' <- [GenLocated (EpAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsCmd GhcPs)))]
-> EP
     w
     m
     [GenLocated (EpAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsCmd GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LGRHS GhcPs (LocatedA (HsCmd GhcPs))]
[GenLocated (EpAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsCmd GhcPs)))]
grhss
    binds' <- markAnnotated binds
    -- The comments will be added back as they are printed
    return (GRHSs emptyComments grhss' binds')

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

instance ExactPrint (HsLocalBinds GhcPs) where
  getAnnotationEntry :: HsLocalBinds GhcPs -> Entry
getAnnotationEntry (HsValBinds XHsValBinds GhcPs GhcPs
an HsValBindsLR GhcPs GhcPs
_) = EpAnn AnnList -> Entry
forall a. HasEntry a => a -> Entry
fromAnn XHsValBinds GhcPs GhcPs
EpAnn AnnList
an
  getAnnotationEntry (HsIPBinds{}) = Entry
NoEntryVal
  getAnnotationEntry (EmptyLocalBinds{}) = Entry
NoEntryVal

  setAnnotationAnchor :: HsLocalBinds GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsLocalBinds GhcPs
setAnnotationAnchor (HsValBinds XHsValBinds GhcPs GhcPs
an HsValBindsLR GhcPs GhcPs
a) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds (EpAnn AnnList
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList
setAnchorEpaL XHsValBinds GhcPs GhcPs
EpAnn AnnList
an Anchor
anc [TrailingAnn]
ts EpAnnComments
cs) HsValBindsLR GhcPs GhcPs
a
  setAnnotationAnchor HsLocalBinds GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsLocalBinds GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsLocalBinds GhcPs -> EP w m (HsLocalBinds GhcPs)
exact (HsValBinds XHsValBinds GhcPs GhcPs
an HsValBindsLR GhcPs GhcPs
valbinds) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"exact HsValBinds: an=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ EpAnn AnnList -> String
forall a. Data a => a -> String
showAst XHsValBinds GhcPs GhcPs
EpAnn AnnList
an
    an0 <- EpAnn AnnList
-> Lens AnnList [AddEpAnn]
-> AnnKeywordId
-> EP w m (EpAnn AnnList)
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
EpAnn ann
-> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnL' XHsValBinds GhcPs GhcPs
EpAnn AnnList
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
AnnWhere

    case al_anchor $ anns an of
      Just Anchor
anc -> do
        Bool
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HsValBindsLR GhcPs GhcPs -> Bool
forall (a :: Pass) (b :: Pass).
HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyValBinds HsValBindsLR GhcPs GhcPs
valbinds) (RWST (EPOptions m w) (EPWriter w) EPState m ()
 -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ Maybe Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> EP w m ()
setExtraDP (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just Anchor
anc)
      Maybe Anchor
_ -> () -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    (an1, valbinds') <- markAnnList an0 $ markAnnotatedWithLayout valbinds
    debugM $ "exact HsValBinds: an1=" ++ showAst an1
    medr <- getExtraDPReturn
    an2 <- case medr of
             Maybe DeltaPos
Nothing -> EpAnn AnnList -> EP w m (EpAnn AnnList)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnn AnnList
an1
             Just DeltaPos
dp -> do
                 Maybe DeltaPos -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe DeltaPos -> EP w m ()
setExtraDPReturn Maybe DeltaPos
forall a. Maybe a
Nothing
                 EpAnn AnnList -> EP w m (EpAnn AnnList)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn AnnList -> EP w m (EpAnn AnnList))
-> EpAnn AnnList -> EP w m (EpAnn AnnList)
forall a b. (a -> b) -> a -> b
$ EpAnn AnnList
an1 { anns = (anns an1) { al_anchor = Just (EpaDelta dp []) }}
    return (HsValBinds an2 valbinds')

  exact (HsIPBinds XHsIPBinds GhcPs GhcPs
an HsIPBinds GhcPs
bs) = do
    (an2,bs') <- EpAnn AnnList
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, HsIPBinds GhcPs))
-> EP w m (EpAnn AnnList, HsIPBinds GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn AnnList
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
-> EP w m (EpAnn AnnList, a)
markAnnListA XHsIPBinds GhcPs GhcPs
EpAnn AnnList
an ((EpAnn AnnList -> EP w m (EpAnn AnnList, HsIPBinds GhcPs))
 -> EP w m (EpAnn AnnList, HsIPBinds GhcPs))
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, HsIPBinds GhcPs))
-> EP w m (EpAnn AnnList, HsIPBinds GhcPs)
forall a b. (a -> b) -> a -> b
$ \EpAnn AnnList
an0 -> do
                           an1 <- EpAnn AnnList
-> Lens AnnList [AddEpAnn]
-> AnnKeywordId
-> EP w m (EpAnn AnnList)
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
EpAnn ann
-> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnL' EpAnn AnnList
an0 ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
AnnWhere
                           bs' <- markAnnotated bs
                           return (an1, bs')
    return (HsIPBinds an2 bs')
  exact b :: HsLocalBinds GhcPs
b@(EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) = HsLocalBinds GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsLocalBinds GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsLocalBinds GhcPs
b


-- ---------------------------------------------------------------------
instance ExactPrint (HsValBindsLR GhcPs GhcPs) where
  getAnnotationEntry :: HsValBindsLR GhcPs GhcPs -> Entry
getAnnotationEntry HsValBindsLR GhcPs GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsValBindsLR GhcPs GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsValBindsLR GhcPs GhcPs
setAnnotationAnchor HsValBindsLR GhcPs GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsValBindsLR GhcPs GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsValBindsLR GhcPs GhcPs -> EP w m (HsValBindsLR GhcPs GhcPs)
exact (ValBinds XValBinds GhcPs GhcPs
sortKey LHsBinds GhcPs
binds [LSig GhcPs]
sigs) = do
    decls <- EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EP w m a -> EP w m a
setLayoutBoth (EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ (LHsDecl GhcPs
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [LHsDecl GhcPs]
-> EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsDecl GhcPs
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (HsDecl GhcPs))
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ([LHsDecl GhcPs] -> EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> [LHsDecl GhcPs]
-> EP w m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ HsValBindsLR GhcPs GhcPs -> [LHsDecl GhcPs]
hsDeclsValBinds (XValBinds GhcPs GhcPs
-> LHsBinds GhcPs -> [LSig GhcPs] -> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
sortKey LHsBinds GhcPs
binds [LSig GhcPs]
sigs)
    let
      binds' = [LocatedAn AnnListItem (HsBind GhcPs)]
-> Bag (LocatedAn AnnListItem (HsBind GhcPs))
forall a. [a] -> Bag a
listToBag ([LocatedAn AnnListItem (HsBind GhcPs)]
 -> Bag (LocatedAn AnnListItem (HsBind GhcPs)))
-> [LocatedAn AnnListItem (HsBind GhcPs)]
-> Bag (LocatedAn AnnListItem (HsBind GhcPs))
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> [LocatedAn AnnListItem (HsBind GhcPs)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [LocatedAn AnnListItem (HsBind GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [LHsBind GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [LocatedAn AnnListItem (HsBind GhcPs)]
decl2Bind [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
      sigs'  =             (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> [LocatedAn AnnListItem (Sig GhcPs)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [LocatedAn AnnListItem (Sig GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [LSig GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [LocatedAn AnnListItem (Sig GhcPs)]
decl2Sig [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
      sortKey' = [LHsDecl GhcPs] -> AnnSortKey BindTag
captureOrderBinds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
    return (ValBinds sortKey' binds' sigs')
  exact (XValBindsLR XXValBindsLR GhcPs GhcPs
_) = String
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (HsValBindsLR GhcPs GhcPs)
forall a. HasCallStack => String -> a
panic String
"XValBindsLR"

undynamic :: Typeable a => [Dynamic] -> [a]
undynamic :: forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds = (Dynamic -> Maybe a) -> [Dynamic] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic [Dynamic]
ds

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

instance ExactPrint (HsIPBinds GhcPs) where
  getAnnotationEntry :: HsIPBinds GhcPs -> Entry
getAnnotationEntry = Entry -> HsIPBinds GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsIPBinds GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsIPBinds GhcPs
setAnnotationAnchor HsIPBinds GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsIPBinds GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsIPBinds GhcPs -> EP w m (HsIPBinds GhcPs)
exact (IPBinds XIPBinds GhcPs
x [LIPBind GhcPs]
binds) = EP w m (HsIPBinds GhcPs) -> EP w m (HsIPBinds GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EP w m a -> EP w m a
setLayoutBoth (EP w m (HsIPBinds GhcPs) -> EP w m (HsIPBinds GhcPs))
-> EP w m (HsIPBinds GhcPs) -> EP w m (HsIPBinds GhcPs)
forall a b. (a -> b) -> a -> b
$ do
      binds' <- [GenLocated SrcSpanAnnA (IPBind GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (IPBind GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LIPBind GhcPs]
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
binds
      return (IPBinds x binds')

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

instance ExactPrint (IPBind GhcPs) where
  getAnnotationEntry :: IPBind GhcPs -> Entry
getAnnotationEntry IPBind GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: IPBind GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> IPBind GhcPs
setAnnotationAnchor IPBind GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = IPBind GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
IPBind GhcPs -> EP w m (IPBind GhcPs)
exact (IPBind XCIPBind GhcPs
an XRec GhcPs HsIPName
lr XRec GhcPs (HsExpr GhcPs)
rhs) = do
    lr' <- GenLocated (EpAnn NoEpAnns) HsIPName
-> EP w m (GenLocated (EpAnn NoEpAnns) HsIPName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs HsIPName
GenLocated (EpAnn NoEpAnns) HsIPName
lr
    an0 <- markEpAnnL an lidl AnnEqual
    rhs' <- markAnnotated rhs
    return (IPBind an0 lr' rhs')


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

instance ExactPrint HsIPName where
  getAnnotationEntry :: HsIPName -> Entry
getAnnotationEntry = Entry -> HsIPName -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsIPName -> Anchor -> [TrailingAnn] -> EpAnnComments -> HsIPName
setAnnotationAnchor HsIPName
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsIPName
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsIPName -> EP w m HsIPName
exact i :: HsIPName
i@(HsIPName FastString
fs) = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA (String
"?" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (FastString -> String
unpackFS FastString
fs)) EP w m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m HsIPName
-> RWST (EPOptions m w) (EPWriter w) EPState m HsIPName
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsIPName -> RWST (EPOptions m w) (EPWriter w) EPState m HsIPName
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsIPName
i

-- ---------------------------------------------------------------------
-- Managing lists which have been separated, e.g. Sigs and Binds

prepareListAnnotationF :: (Monad m, Monoid w) =>
  [LDataFamInstDecl GhcPs] -> [(RealSrcSpan,EP w m Dynamic)]
prepareListAnnotationF :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[LDataFamInstDecl GhcPs] -> [(RealSrcSpan, EP w m Dynamic)]
prepareListAnnotationF [LDataFamInstDecl GhcPs]
ls = (GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
 -> (RealSrcSpan, EP w m Dynamic))
-> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
-> [(RealSrcSpan, EP w m Dynamic)]
forall a b. (a -> b) -> [a] -> [b]
map (\GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
b -> (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
b, GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs) -> EP w m Dynamic
forall {w} {m :: * -> *} {l}.
(Monoid w, Monad m,
 ExactPrint (GenLocated l DataFamInstDeclWithContext),
 Typeable l) =>
GenLocated l (DataFamInstDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m Dynamic
go GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
b)) [LDataFamInstDecl GhcPs]
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
ls
  where
    go :: GenLocated l (DataFamInstDecl GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m Dynamic
go (L l
l DataFamInstDecl GhcPs
a) = do
      (L l' d') <- GenLocated l DataFamInstDeclWithContext
-> EP w m (GenLocated l DataFamInstDeclWithContext)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated (l
-> DataFamInstDeclWithContext
-> GenLocated l DataFamInstDeclWithContext
forall l e. l -> e -> GenLocated l e
L l
l ([AddEpAnn]
-> TopLevelFlag
-> DataFamInstDecl GhcPs
-> DataFamInstDeclWithContext
DataFamInstDeclWithContext [AddEpAnn]
forall a. NoAnn a => a
noAnn TopLevelFlag
NotTopLevel DataFamInstDecl GhcPs
a))
      return (toDyn (L l' (dc_d d')))

prepareListAnnotationA :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
  => [LocatedAn an a] -> [(RealSrcSpan,EP w m Dynamic)]
prepareListAnnotationA :: forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
[LocatedAn an a] -> [(RealSrcSpan, EP w m Dynamic)]
prepareListAnnotationA [LocatedAn an a]
ls = (LocatedAn an a -> (RealSrcSpan, EP w m Dynamic))
-> [LocatedAn an a] -> [(RealSrcSpan, EP w m Dynamic)]
forall a b. (a -> b) -> [a] -> [b]
map (\LocatedAn an a
b -> (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LocatedAn an a -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedAn an a
b,LocatedAn an a -> EP w m Dynamic
forall {w} {m :: * -> *} {a}.
(Monoid w, Monad m, ExactPrint a) =>
a -> RWST (EPOptions m w) (EPWriter w) EPState m Dynamic
go LocatedAn an a
b)) [LocatedAn an a]
ls
  where
    go :: a -> RWST (EPOptions m w) (EPWriter w) EPState m Dynamic
go a
b = do
      b' <- a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated a
b
      return (toDyn b')

withSortKey :: (Monad m, Monoid w)
  => AnnSortKey DeclTag -> [(DeclTag, [(RealSrcSpan, EP w m Dynamic)])]
  -> EP w m (AnnSortKey DeclTag, [Dynamic])
withSortKey :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnSortKey DeclTag
-> [(DeclTag, [(RealSrcSpan, EP w m Dynamic)])]
-> EP w m (AnnSortKey DeclTag, [Dynamic])
withSortKey AnnSortKey DeclTag
annSortKey [(DeclTag, [(RealSrcSpan, EP w m Dynamic)])]
xs = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"withSortKey:annSortKey=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnnSortKey DeclTag -> String
forall a. Data a => a -> String
showAst AnnSortKey DeclTag
annSortKey
  let (AnnSortKey DeclTag
sk, [(RealSrcSpan, EP w m Dynamic)]
ordered) = case AnnSortKey DeclTag
annSortKey of
                  AnnSortKey DeclTag
NoAnnSortKey -> (AnnSortKey DeclTag
annSortKey', ((DeclTag, (RealSrcSpan, EP w m Dynamic))
 -> (RealSrcSpan, EP w m Dynamic))
-> [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
-> [(RealSrcSpan, EP w m Dynamic)]
forall a b. (a -> b) -> [a] -> [b]
map (DeclTag, (RealSrcSpan, EP w m Dynamic))
-> (RealSrcSpan, EP w m Dynamic)
forall a b. (a, b) -> b
snd [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
os)
                    where
                      doOne :: (a, [b]) -> [(a, b)]
doOne (a
tag, [b]
ds) = (b -> (a, b)) -> [b] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\b
d -> (a
tag, b
d)) [b]
ds
                      xsExpanded :: [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
xsExpanded = ((DeclTag, [(RealSrcSpan, EP w m Dynamic)])
 -> [(DeclTag, (RealSrcSpan, EP w m Dynamic))])
-> [(DeclTag, [(RealSrcSpan, EP w m Dynamic)])]
-> [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DeclTag, [(RealSrcSpan, EP w m Dynamic)])
-> [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
forall {a} {b}. (a, [b]) -> [(a, b)]
doOne [(DeclTag, [(RealSrcSpan, EP w m Dynamic)])]
xs
                      os :: [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
os = ((DeclTag, (RealSrcSpan, EP w m Dynamic))
 -> (DeclTag, (RealSrcSpan, EP w m Dynamic)) -> Ordering)
-> [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
-> [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (DeclTag, (RealSrcSpan, EP w m Dynamic))
-> (DeclTag, (RealSrcSpan, EP w m Dynamic)) -> Ordering
forall a t b1 b2. Ord a => (t, (a, b1)) -> (t, (a, b2)) -> Ordering
orderByFst ([(DeclTag, (RealSrcSpan, EP w m Dynamic))]
 -> [(DeclTag, (RealSrcSpan, EP w m Dynamic))])
-> [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
-> [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
forall a b. (a -> b) -> a -> b
$ [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
xsExpanded
                      annSortKey' :: AnnSortKey DeclTag
annSortKey' = [DeclTag] -> AnnSortKey DeclTag
forall tag. [tag] -> AnnSortKey tag
AnnSortKey (((DeclTag, (RealSrcSpan, EP w m Dynamic)) -> DeclTag)
-> [(DeclTag, (RealSrcSpan, EP w m Dynamic))] -> [DeclTag]
forall a b. (a -> b) -> [a] -> [b]
map (DeclTag, (RealSrcSpan, EP w m Dynamic)) -> DeclTag
forall a b. (a, b) -> a
fst [(DeclTag, (RealSrcSpan, EP w m Dynamic))]
os)
                  AnnSortKey [DeclTag]
_keys -> (AnnSortKey DeclTag
annSortKey, AnnSortKey DeclTag
-> DeclsByTag (EP w m Dynamic) -> [(RealSrcSpan, EP w m Dynamic)]
forall a. AnnSortKey DeclTag -> DeclsByTag a -> [(RealSrcSpan, a)]
orderedDecls AnnSortKey DeclTag
annSortKey ([(DeclTag, [(RealSrcSpan, EP w m Dynamic)])]
-> DeclsByTag (EP w m Dynamic)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DeclTag, [(RealSrcSpan, EP w m Dynamic)])]
xs))
  ordered' <- ((RealSrcSpan, EP w m Dynamic) -> EP w m Dynamic)
-> [(RealSrcSpan, EP w m Dynamic)]
-> RWST (EPOptions m w) (EPWriter w) EPState m [Dynamic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (RealSrcSpan, EP w m Dynamic) -> EP w m Dynamic
forall a b. (a, b) -> b
snd [(RealSrcSpan, EP w m Dynamic)]
ordered
  return (sk, ordered')

orderByFst :: Ord a => (t, (a,b1)) -> (t, (a, b2)) -> Ordering
orderByFst :: forall a t b1 b2. Ord a => (t, (a, b1)) -> (t, (a, b2)) -> Ordering
orderByFst (t
_,(a
a,b1
_)) (t
_,(a
b,b2
_)) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b

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

instance ExactPrint (Sig GhcPs) where
  getAnnotationEntry :: Sig GhcPs -> Entry
getAnnotationEntry Sig GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: Sig GhcPs -> Anchor -> [TrailingAnn] -> EpAnnComments -> Sig GhcPs
setAnnotationAnchor Sig GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = Sig GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Sig GhcPs -> EP w m (Sig GhcPs)
exact (TypeSig XTypeSig GhcPs
an [LIdP GhcPs]
vars LHsSigWcType GhcPs
ty)  = do
    (an', vars', ty') <- AnnSig
-> [LocatedN RdrName]
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> EP
     w
     m
     (AnnSig, [LocatedN RdrName],
      HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
AnnSig
-> [LocatedN RdrName]
-> a
-> EP w m (AnnSig, [LocatedN RdrName], a)
exactVarSig XTypeSig GhcPs
AnnSig
an [LIdP GhcPs]
[LocatedN RdrName]
vars LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
ty
    return (TypeSig an' vars' ty')

  exact (PatSynSig XPatSynSig GhcPs
an [LIdP GhcPs]
lns LHsSigType GhcPs
typ) = do
    an0 <- AnnSig -> Lens AnnSig [AddEpAnn] -> AnnKeywordId -> EP w m AnnSig
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL XPatSynSig GhcPs
AnnSig
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnSig -> f AnnSig
Lens AnnSig [AddEpAnn]
lasRest AnnKeywordId
AnnPattern
    lns' <- markAnnotated lns
    an1 <- markLensAA' an0 lasDcolon
    typ' <- markAnnotated typ
    return (PatSynSig an1 lns' typ')

  exact (ClassOpSig XClassOpSig GhcPs
an Bool
is_deflt [LIdP GhcPs]
vars LHsSigType GhcPs
ty)
    | Bool
is_deflt  = do
        an0 <- AnnSig -> Lens AnnSig [AddEpAnn] -> AnnKeywordId -> EP w m AnnSig
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL XClassOpSig GhcPs
AnnSig
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnSig -> f AnnSig
Lens AnnSig [AddEpAnn]
lasRest AnnKeywordId
AnnDefault
        (an1, vars',ty') <- exactVarSig an0 vars ty
        return (ClassOpSig an1 is_deflt vars' ty')
    | Bool
otherwise = do
        (an0, vars',ty') <- AnnSig
-> [LocatedN RdrName]
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> EP
     w
     m
     (AnnSig, [LocatedN RdrName],
      GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
AnnSig
-> [LocatedN RdrName]
-> a
-> EP w m (AnnSig, [LocatedN RdrName], a)
exactVarSig XClassOpSig GhcPs
AnnSig
an [LIdP GhcPs]
[LocatedN RdrName]
vars LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
        return (ClassOpSig an0 is_deflt vars' ty')

  exact (FixSig XFixSig GhcPs
an (FixitySig XFixitySig GhcPs
ns [LIdP GhcPs]
names (Fixity SourceText
src Int
v FixityDirection
fdir))) = do
    let fixstr :: String
fixstr = case FixityDirection
fdir of
         FixityDirection
InfixL -> String
"infixl"
         FixityDirection
InfixR -> String
"infixr"
         FixityDirection
InfixN -> String
"infix"
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
XFixSig GhcPs
an  ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnInfix (String -> Maybe String
forall a. a -> Maybe a
Just String
fixstr)
    an1 <- markEpAnnLMS'' an0 lidl AnnVal (Just (sourceTextToString src (show v)))
    ns' <- markAnnotated ns
    names' <- markAnnotated names
    return (FixSig an1 (FixitySig ns' names' (Fixity src v fdir)))

  exact (InlineSig XInlineSig GhcPs
an LIdP GhcPs
ln InlinePragma
inl) = do
    an0 <- [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen [AddEpAnn]
XInlineSig GhcPs
an (InlinePragma -> SourceText
inl_src InlinePragma
inl) String
"{-# INLINE"
    an1 <- markActivation an0 id (inl_act inl)
    ln' <- markAnnotated ln
    an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "#-}")
    return (InlineSig an2 ln' inl)

  exact (SpecSig XSpecSig GhcPs
an LIdP GhcPs
ln [LHsSigType GhcPs]
typs InlinePragma
inl) = do
    an0 <- [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen [AddEpAnn]
XSpecSig GhcPs
an (InlinePragma -> SourceText
inl_src InlinePragma
inl) String
"{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE
    an1 <- markActivation an0 lidl (inl_act inl)
    ln' <- markAnnotated ln
    an2 <- markEpAnnL an1 lidl AnnDcolon
    typs' <- markAnnotated typs
    an3 <- markEpAnnLMS'' an2 lidl AnnClose (Just "#-}")
    return (SpecSig an3 ln' typs' inl)

  exact (SpecInstSig ([AddEpAnn]
an,SourceText
src) LHsSigType GhcPs
typ) = do
    an0 <- [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen [AddEpAnn]
an SourceText
src String
"{-# SPECIALISE"
    an1 <- markEpAnnL an0 lidl AnnInstance
    typ' <- markAnnotated typ
    an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "#-}")
    return (SpecInstSig (an2,src) typ')

  exact (MinimalSig ([AddEpAnn]
an,SourceText
src) LBooleanFormula (LIdP GhcPs)
formula) = do
    an0 <- [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen [AddEpAnn]
an SourceText
src String
"{-# MINIMAL"
    formula' <- markAnnotated formula
    an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")
    return (MinimalSig (an1,src) formula')

  exact (SCCFunSig ([AddEpAnn]
an,SourceText
src) LIdP GhcPs
ln Maybe (XRec GhcPs StringLiteral)
ml) = do
    an0 <- [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen [AddEpAnn]
an SourceText
src String
"{-# SCC"
    ln' <- markAnnotated ln
    ml' <- markAnnotated ml
    an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")
    return (SCCFunSig (an1,src) ln' ml')

  exact (CompleteMatchSig ([AddEpAnn]
an,SourceText
src) [LIdP GhcPs]
cs Maybe (LIdP GhcPs)
mty) = do
    an0 <- [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
markAnnOpen [AddEpAnn]
an SourceText
src String
"{-# COMPLETE"
    cs' <- mapM markAnnotated cs
    (an1, mty') <-
      case mty of
        Maybe (LIdP GhcPs)
Nothing -> ([AddEpAnn], Maybe (LocatedN RdrName))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn], Maybe (LocatedN RdrName))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AddEpAnn]
an0, Maybe (LIdP GhcPs)
Maybe (LocatedN RdrName)
mty)
        Just LIdP GhcPs
ty -> do
          an1 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an0 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDcolon
          ty' <- markAnnotated ty
          return (an1, Just ty')
    an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "#-}")
    return (CompleteMatchSig (an2,src) cs' mty')

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

instance ExactPrint NamespaceSpecifier where
  getAnnotationEntry :: NamespaceSpecifier -> Entry
getAnnotationEntry NamespaceSpecifier
_ = Entry
NoEntryVal
  setAnnotationAnchor :: NamespaceSpecifier
-> Anchor -> [TrailingAnn] -> EpAnnComments -> NamespaceSpecifier
setAnnotationAnchor NamespaceSpecifier
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = NamespaceSpecifier
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NamespaceSpecifier -> EP w m NamespaceSpecifier
exact NamespaceSpecifier
NoNamespaceSpecifier = NamespaceSpecifier
-> RWST (EPOptions m w) (EPWriter w) EPState m NamespaceSpecifier
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return NamespaceSpecifier
NoNamespaceSpecifier
  exact (TypeNamespaceSpecifier EpToken "type"
typeTok) = do
      typeTok' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
typeTok
      return (TypeNamespaceSpecifier typeTok')
  exact (DataNamespaceSpecifier EpToken "data"
dataTok) = do
      dataTok' <- EpToken "data" -> EP w m (EpToken "data")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "data"
dataTok
      return (DataNamespaceSpecifier dataTok')

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

exactVarSig :: (Monad m, Monoid w, ExactPrint a)
  => AnnSig -> [LocatedN RdrName] -> a -> EP w m (AnnSig, [LocatedN RdrName], a)
exactVarSig :: forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
AnnSig
-> [LocatedN RdrName]
-> a
-> EP w m (AnnSig, [LocatedN RdrName], a)
exactVarSig AnnSig
an [LocatedN RdrName]
vars a
ty = do
  vars' <- (LocatedN RdrName
 -> RWST (EPOptions m w) (EPWriter w) EPState m (LocatedN RdrName))
-> [LocatedN RdrName]
-> RWST (EPOptions m w) (EPWriter w) EPState m [LocatedN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LocatedN RdrName
-> RWST (EPOptions m w) (EPWriter w) EPState m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LocatedN RdrName]
vars
  an0 <- markLensAA' an lasDcolon
  ty' <- markAnnotated ty
  return (an0, vars', ty')

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

instance ExactPrint (StandaloneKindSig GhcPs) where
  getAnnotationEntry :: StandaloneKindSig GhcPs -> Entry
getAnnotationEntry StandaloneKindSig GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: StandaloneKindSig GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> StandaloneKindSig GhcPs
setAnnotationAnchor StandaloneKindSig GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = StandaloneKindSig GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
StandaloneKindSig GhcPs -> EP w m (StandaloneKindSig GhcPs)
exact (StandaloneKindSig XStandaloneKindSig GhcPs
an LIdP GhcPs
vars LHsSigType GhcPs
sig) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XStandaloneKindSig GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnType
    vars' <- markAnnotated vars
    an1 <- markEpAnnL an0 lidl AnnDcolon
    sig' <- markAnnotated sig
    return (StandaloneKindSig an1 vars' sig')

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

instance ExactPrint (DefaultDecl GhcPs) where
  getAnnotationEntry :: DefaultDecl GhcPs -> Entry
getAnnotationEntry DefaultDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: DefaultDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> DefaultDecl GhcPs
setAnnotationAnchor DefaultDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = DefaultDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DefaultDecl GhcPs -> EP w m (DefaultDecl GhcPs)
exact (DefaultDecl XCDefaultDecl GhcPs
an [LHsType GhcPs]
tys) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XCDefaultDecl GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDefault
    an1 <- markEpAnnL an0 lidl AnnOpenP
    tys' <- markAnnotated tys
    an2 <- markEpAnnL an1 lidl AnnCloseP
    return (DefaultDecl an2 tys')

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

instance ExactPrint (AnnDecl GhcPs) where
  getAnnotationEntry :: AnnDecl GhcPs -> Entry
getAnnotationEntry AnnDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: AnnDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> AnnDecl GhcPs
setAnnotationAnchor AnnDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = AnnDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnDecl GhcPs -> EP w m (AnnDecl GhcPs)
exact (HsAnnotation (AnnPragma
an, SourceText
src) AnnProvenance GhcPs
prov XRec GhcPs (HsExpr GhcPs)
e) = do
    an0 <- AnnPragma -> SourceText -> String -> EP w m AnnPragma
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnPragma -> SourceText -> String -> EP w m AnnPragma
markAnnOpenP' AnnPragma
an SourceText
src String
"{-# ANN"
    (an1, prov') <-
      case prov of
        (ValueAnnProvenance LIdP GhcPs
n) -> do
          n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
          return (an0, ValueAnnProvenance n')
        (TypeAnnProvenance LIdP GhcPs
n) -> do
          an1 <- AnnPragma
-> Lens AnnPragma [AddEpAnn] -> AnnKeywordId -> EP w m AnnPragma
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL AnnPragma
an0 ([AddEpAnn] -> f [AddEpAnn]) -> AnnPragma -> f AnnPragma
Lens AnnPragma [AddEpAnn]
lapr_rest AnnKeywordId
AnnType
          n' <- markAnnotated n
          return (an1, TypeAnnProvenance n')
        AnnProvenance GhcPs
ModuleAnnProvenance -> do
          an1 <- AnnPragma
-> Lens AnnPragma [AddEpAnn] -> AnnKeywordId -> EP w m AnnPragma
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL AnnPragma
an0 ([AddEpAnn] -> f [AddEpAnn]) -> AnnPragma -> f AnnPragma
Lens AnnPragma [AddEpAnn]
lapr_rest AnnKeywordId
AnnModule
          return (an1, prov)

    e' <- markAnnotated e
    an2 <- markAnnCloseP' an1
    return (HsAnnotation (an2,src) prov' e')

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

instance ExactPrint (BF.BooleanFormula (LocatedN RdrName)) where
  getAnnotationEntry :: BooleanFormula (LocatedN RdrName) -> Entry
getAnnotationEntry = Entry -> BooleanFormula (LocatedN RdrName) -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: BooleanFormula (LocatedN RdrName)
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> BooleanFormula (LocatedN RdrName)
setAnnotationAnchor BooleanFormula (LocatedN RdrName)
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = BooleanFormula (LocatedN RdrName)
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
BooleanFormula (LocatedN RdrName)
-> EP w m (BooleanFormula (LocatedN RdrName))
exact (BF.Var LocatedN RdrName
x)  = do
    x' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LocatedN RdrName
x
    return (BF.Var x')
  exact (BF.Or [LBooleanFormula (LocatedN RdrName)]
ls)  = do
    ls' <- [LBooleanFormula (LocatedN RdrName)]
-> EP w m [LBooleanFormula (LocatedN RdrName)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LBooleanFormula (LocatedN RdrName)]
ls
    return (BF.Or ls')
  exact (BF.And [LBooleanFormula (LocatedN RdrName)]
ls) = do
    ls' <- [LBooleanFormula (LocatedN RdrName)]
-> EP w m [LBooleanFormula (LocatedN RdrName)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LBooleanFormula (LocatedN RdrName)]
ls
    return (BF.And ls')
  exact (BF.Parens LBooleanFormula (LocatedN RdrName)
x)  = do
    x' <- LBooleanFormula (LocatedN RdrName)
-> EP w m (LBooleanFormula (LocatedN RdrName))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LBooleanFormula (LocatedN RdrName)
x
    return (BF.Parens x')

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

instance (ExactPrint body) => ExactPrint (HsWildCardBndrs GhcPs body) where
  getAnnotationEntry :: HsWildCardBndrs GhcPs body -> Entry
getAnnotationEntry = Entry -> HsWildCardBndrs GhcPs body -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsWildCardBndrs GhcPs body
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsWildCardBndrs GhcPs body
setAnnotationAnchor HsWildCardBndrs GhcPs body
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_= HsWildCardBndrs GhcPs body
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsWildCardBndrs GhcPs body -> EP w m (HsWildCardBndrs GhcPs body)
exact (HsWC XHsWC GhcPs body
x body
ty) = do
    ty' <- body -> EP w m body
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated body
ty
    return (HsWC x ty')

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

instance ExactPrint (GRHS GhcPs (LocatedA (HsExpr GhcPs))) where
  getAnnotationEntry :: GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Entry
getAnnotationEntry (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an [GuardLStmt GhcPs]
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
_) = EpAnn GrhsAnn -> Entry
forall a. HasEntry a => a -> Entry
fromAnn XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an
  setAnnotationAnchor :: GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
setAnnotationAnchor (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an [GuardLStmt GhcPs]
a GenLocated SrcSpanAnnA (HsExpr GhcPs)
b) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GuardLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS (EpAnn GrhsAnn
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn GrhsAnn
forall an.
HasTrailing an =>
EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an Anchor
anc [TrailingAnn]
ts EpAnnComments
cs) [GuardLStmt GhcPs]
a GenLocated SrcSpanAnnA (HsExpr GhcPs)
b

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> EP w m (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
exact (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an [GuardLStmt GhcPs]
guards GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr) = do
    an0 <- if [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
guards
             then EpAnn GrhsAnn
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpAnn GrhsAnn)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an
             else EpAnn GrhsAnn
-> Lens GrhsAnn (Maybe Anchor)
-> AnnKeywordId
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpAnn GrhsAnn)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a (Maybe Anchor) -> AnnKeywordId -> EP w m (EpAnn a)
markLensKwM XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an (Maybe Anchor -> f (Maybe Anchor)) -> GrhsAnn -> f GrhsAnn
Lens GrhsAnn (Maybe Anchor)
lga_vbar AnnKeywordId
AnnVbar
    guards' <- markAnnotated guards
    an1 <- markLensAA an0 lga_sep -- Mark the matchSeparator for these GRHSs
    expr' <- markAnnotated expr
    return (GRHS an1 guards' expr')

instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where
  getAnnotationEntry :: GRHS GhcPs (LocatedA (HsCmd GhcPs)) -> Entry
getAnnotationEntry (GRHS XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
ann [GuardLStmt GhcPs]
_ LocatedA (HsCmd GhcPs)
_) = EpAnn GrhsAnn -> Entry
forall a. HasEntry a => a -> Entry
fromAnn XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
EpAnn GrhsAnn
ann
  setAnnotationAnchor :: GRHS GhcPs (LocatedA (HsCmd GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GRHS GhcPs (LocatedA (HsCmd GhcPs))
setAnnotationAnchor (GRHS XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
an [GuardLStmt GhcPs]
a LocatedA (HsCmd GhcPs)
b) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
-> [GuardLStmt GhcPs]
-> LocatedA (HsCmd GhcPs)
-> GRHS GhcPs (LocatedA (HsCmd GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS (EpAnn GrhsAnn
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn GrhsAnn
forall an.
HasTrailing an =>
EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
EpAnn GrhsAnn
an Anchor
anc [TrailingAnn]
ts EpAnnComments
cs) [GuardLStmt GhcPs]
a LocatedA (HsCmd GhcPs)
b

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GRHS GhcPs (LocatedA (HsCmd GhcPs))
-> EP w m (GRHS GhcPs (LocatedA (HsCmd GhcPs)))
exact (GRHS XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
an [GuardLStmt GhcPs]
guards LocatedA (HsCmd GhcPs)
expr) = do
    an0 <- EpAnn GrhsAnn
-> Lens GrhsAnn (Maybe Anchor)
-> AnnKeywordId
-> EP w m (EpAnn GrhsAnn)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a (Maybe Anchor) -> AnnKeywordId -> EP w m (EpAnn a)
markLensKwM XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
EpAnn GrhsAnn
an (Maybe Anchor -> f (Maybe Anchor)) -> GrhsAnn -> f GrhsAnn
Lens GrhsAnn (Maybe Anchor)
lga_vbar AnnKeywordId
AnnVbar
    guards' <- markAnnotated guards
    an1 <- markLensAA an0 lga_sep -- Mark the matchSeparator for these GRHSs
    expr' <- markAnnotated expr
    return (GRHS an1 guards' expr')

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

instance ExactPrint (HsExpr GhcPs) where
  getAnnotationEntry :: HsExpr GhcPs -> Entry
getAnnotationEntry HsExpr GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsExpr GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsExpr GhcPs
setAnnotationAnchor HsExpr GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_s = HsExpr GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsExpr GhcPs -> EP w m (HsExpr GhcPs)
exact (HsVar XVar GhcPs
x LIdP GhcPs
n) = do
    -- The parser inserts a placeholder value for a record pun rhs. This must be
    -- filtered.
    let pun_RDR :: String
pun_RDR = String
"pun-right-hand-side"
    n' <- if (LocatedN RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe LIdP GhcPs
LocatedN RdrName
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
pun_RDR)
      then LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
      else LocatedN RdrName -> EP w m (LocatedN RdrName)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return LIdP GhcPs
LocatedN RdrName
n
    return (HsVar x n')
  exact (HsUnboundVar XUnboundVar GhcPs
an RdrName
n) = do
    case XUnboundVar GhcPs
an of
      Just (EpAnnUnboundVar (Anchor
ob,Anchor
cb) Anchor
l) -> do
        ob' <-  Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
ob String
"`"
        l' <- printStringAtAA l  "_"
        cb' <- printStringAtAA cb "`"
        return (HsUnboundVar (Just (EpAnnUnboundVar (ob',cb') l')) n)
      XUnboundVar GhcPs
_ -> do
        String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA String
"_" EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        HsExpr GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcPs -> RdrName -> HsExpr GhcPs
forall p. XUnboundVar p -> RdrName -> HsExpr p
HsUnboundVar XUnboundVar GhcPs
an RdrName
n)
  exact x :: HsExpr GhcPs
x@(HsOverLabel XOverLabel GhcPs
_ SourceText
src FastString
l) = do
    String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA String
"#" EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case SourceText
src of
      SourceText
NoSourceText   -> String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA (FastString -> String
unpackFS FastString
l)  EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      SourceText FastString
txt -> String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvanceA (FastString -> String
unpackFS FastString
txt) EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    HsExpr GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcPs
x

  exact x :: HsExpr GhcPs
x@(HsIPVar XIPVar GhcPs
_ (HsIPName FastString
n))
    = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (String
"?" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FastString -> String
unpackFS FastString
n) EP w m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsExpr GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcPs
x

  exact x :: HsExpr GhcPs
x@(HsOverLit XOverLitE GhcPs
_an HsOverLit GhcPs
ol) = do
    let str :: SourceText
str = case HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
ol of
                HsIntegral   (IL SourceText
src Bool
_ Integer
_) -> SourceText
src
                HsFractional (FL { fl_text :: FractionalLit -> SourceText
fl_text = SourceText
src }) -> SourceText
src
                HsIsString SourceText
src FastString
_          -> SourceText
src
    case SourceText
str of
      SourceText FastString
s -> String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (FastString -> String
unpackFS FastString
s) EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      SourceText
NoSourceText -> HsExpr GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr HsExpr GhcPs
x RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
-> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EP w m ()
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    HsExpr GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcPs
x

  exact (HsLit XLitE GhcPs
an HsLit GhcPs
lit) = do
    lit' <- HsLit GhcPs -> EP w m (HsLit GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr HsLit GhcPs
lit
    return (HsLit an lit')

  exact (HsLam XLam GhcPs
an HsLamVariant
lam_variant MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg) = do
    an0 <- [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
XLam GhcPs
an AnnKeywordId
AnnLam
    an1 <- case lam_variant of
             HsLamVariant
LamSingle -> [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
an0
             HsLamVariant
LamCase -> [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
an0 AnnKeywordId
AnnCase
             HsLamVariant
LamCases -> [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
an0 AnnKeywordId
AnnCases
    mg' <- markAnnotated mg
    return (HsLam an1 lam_variant mg')

  exact (HsApp XApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2) = do
    p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    debugM $ "HsApp entered. p=" ++ show p
    e1' <- markAnnotated e1
    e2' <- markAnnotated e2
    return (HsApp an e1' e2')
  exact (HsAppType XAppTypeE GhcPs
at XRec GhcPs (HsExpr GhcPs)
fun LHsWcType (NoGhcTc GhcPs)
arg) = do
    fun' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
fun
    at' <- markEpToken at
    arg' <- markAnnotated arg
    return (HsAppType at' fun' arg')
  exact (OpApp XOpApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 XRec GhcPs (HsExpr GhcPs)
e3) = do
    e1' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
    e2' <- markAnnotated e2
    e3' <- markAnnotated e3
    return (OpApp an e1' e2' e3')

  exact (NegApp XNegApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
e SyntaxExpr GhcPs
s) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XNegApp GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnMinus
    e' <- markAnnotated e
    return (NegApp an0 e' s)

  exact (HsPar (EpToken "("
lpar, EpToken ")"
rpar) XRec GhcPs (HsExpr GhcPs)
e) = do
    lpar' <- EpToken "(" -> EP w m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "("
lpar
    e' <- markAnnotated e
    debugM $ "HsPar closing paren"
    rpar' <- markEpToken rpar
    debugM $ "HsPar done"
    return (HsPar (lpar', rpar') e')

  exact (SectionL XSectionL GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr XRec GhcPs (HsExpr GhcPs)
op) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    op' <- markAnnotated op
    return (SectionL an expr' op')

  exact (SectionR XSectionR GhcPs
an XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
expr) = do
    op' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op
    expr' <- markAnnotated expr
    return (SectionR an op' expr')

  exact (ExplicitTuple XExplicitTuple GhcPs
an [HsTupArg GhcPs]
args Boxity
b) = do
    an0 <- if Boxity
b Boxity -> Boxity -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity
Boxed then [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XExplicitTuple GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenP
                         else [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XExplicitTuple GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenPH

    args' <- mapM markAnnotated args

    an1 <- if b == Boxed then markEpAnnL an0 lidl AnnCloseP
                         else markEpAnnL an0 lidl AnnClosePH
    debugM $ "ExplicitTuple done"
    return (ExplicitTuple an1 args' b)

  exact (ExplicitSum XExplicitSum GhcPs
an Int
alt Int
arity XRec GhcPs (HsExpr GhcPs)
expr) = do
    an0 <- AnnExplicitSum
-> Lens AnnExplicitSum Anchor
-> AnnKeywordId
-> EP w m AnnExplicitSum
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a Anchor -> AnnKeywordId -> EP w m a
markLensKw XExplicitSum GhcPs
AnnExplicitSum
an (Anchor -> f Anchor) -> AnnExplicitSum -> f AnnExplicitSum
Lens AnnExplicitSum Anchor
laesOpen AnnKeywordId
AnnOpenPH
    an1 <- markAnnKwAllL an0 laesBarsBefore AnnVbar
    expr' <- markAnnotated expr
    an2 <- markAnnKwAllL an1 laesBarsAfter AnnVbar
    an3 <- markLensKw an2 laesClose AnnClosePH
    return (ExplicitSum an3 alt arity expr')

  exact (HsCase XCase GhcPs
an XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
alts) = do
    an0 <- EpAnnHsCase
-> Lens EpAnnHsCase Anchor -> AnnKeywordId -> EP w m EpAnnHsCase
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a Anchor -> AnnKeywordId -> EP w m a
markLensKw XCase GhcPs
EpAnnHsCase
an (Anchor -> f Anchor) -> EpAnnHsCase -> f EpAnnHsCase
Lens EpAnnHsCase Anchor
lhsCaseAnnCase AnnKeywordId
AnnCase
    e' <- markAnnotated e
    an1 <- markLensKw an0 lhsCaseAnnOf AnnOf
    an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC
    an3 <- markEpAnnAllL' an2 lhsCaseAnnsRest AnnSemi
    alts' <- setLayoutBoth $ markAnnotated alts
    an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC
    return (HsCase an4 e' alts')

  exact (HsIf XIf GhcPs
an XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 XRec GhcPs (HsExpr GhcPs)
e3) = do
    an0 <- AnnsIf -> Lens AnnsIf Anchor -> AnnKeywordId -> EP w m AnnsIf
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a Anchor -> AnnKeywordId -> EP w m a
markLensKw XIf GhcPs
AnnsIf
an (Anchor -> f Anchor) -> AnnsIf -> f AnnsIf
Lens AnnsIf Anchor
laiIf AnnKeywordId
AnnIf
    e1' <- markAnnotated e1
    an1 <- markLensKwM' an0 laiThenSemi AnnSemi
    an2 <- markLensKw an1 laiThen AnnThen
    e2' <- markAnnotated e2
    an3 <- markLensKwM' an2 laiElseSemi AnnSemi
    an4 <- markLensKw an3 laiElse AnnElse
    e3' <- markAnnotated e3
    return (HsIf an4 e1' e2' e3')

  exact (HsMultiIf XMultiIf GhcPs
an [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
mg) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XMultiIf GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnIf
    an1 <- markEpAnnL an0 lidl AnnOpenC -- optional
    mg' <- markAnnotated mg
    an2 <- markEpAnnL an1 lidl AnnCloseC -- optional
    return (HsMultiIf an2 mg')

  exact (HsLet (EpToken "let"
tkLet, EpToken "in"
tkIn) HsLocalBinds GhcPs
binds XRec GhcPs (HsExpr GhcPs)
e) = do
    RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EP w m a -> EP w m a
setLayoutBoth (RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
 -> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs))
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ do -- Make sure the 'in' gets indented too
      tkLet' <- EpToken "let" -> EP w m (EpToken "let")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "let"
tkLet
      binds' <- setLayoutBoth $ markAnnotated binds
      tkIn' <- markEpToken tkIn
      e' <- markAnnotated e
      return (HsLet (tkLet',tkIn') binds' e')

  exact (HsDo XDo GhcPs
an HsDoFlavour
do_or_list_comp XRec GhcPs [GuardLStmt GhcPs]
stmts) = do
    String -> EP w m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ String
"HsDo"
    (an',stmts') <- AnnList
-> (AnnList
    -> EP
         w
         m
         (AnnList,
          LocatedL
            [GenLocated
               SrcSpanAnnA
               (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]))
-> EP
     w
     m
     (AnnList,
      LocatedL
        [GenLocated
           SrcSpanAnnA
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
AnnList -> (AnnList -> EP w m (AnnList, a)) -> EP w m (AnnList, a)
markAnnListA' XDo GhcPs
AnnList
an ((AnnList
  -> EP
       w
       m
       (AnnList,
        LocatedL
          [GenLocated
             SrcSpanAnnA
             (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]))
 -> EP
      w
      m
      (AnnList,
       LocatedL
         [GenLocated
            SrcSpanAnnA
            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]))
-> (AnnList
    -> EP
         w
         m
         (AnnList,
          LocatedL
            [GenLocated
               SrcSpanAnnA
               (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]))
-> EP
     w
     m
     (AnnList,
      LocatedL
        [GenLocated
           SrcSpanAnnA
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. (a -> b) -> a -> b
$ \AnnList
a -> AnnList
-> HsDoFlavour
-> LocatedL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     (AnnList,
      LocatedL
        [GenLocated
           SrcSpanAnnA
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList
-> HsDoFlavour
-> LocatedAn an a
-> EP w m (AnnList, LocatedAn an a)
exactDo AnnList
a HsDoFlavour
do_or_list_comp XRec GhcPs [GuardLStmt GhcPs]
LocatedL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
    return (HsDo an' do_or_list_comp stmts')

  exact (ExplicitList XExplicitList GhcPs
an [XRec GhcPs (HsExpr GhcPs)]
es) = do
    String -> EP w m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ String
"ExplicitList start"
    an0 <- AnnList -> Lens AnnList (Maybe AddEpAnn) -> EP w m AnnList
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a (Maybe AddEpAnn) -> EP w m a
markLensMAA' XExplicitList GhcPs
AnnList
an (Maybe AddEpAnn -> f (Maybe AddEpAnn)) -> AnnList -> f AnnList
Lens AnnList (Maybe AddEpAnn)
lal_open
    es' <- markAnnotated es
    an1 <- markLensMAA' an0 lal_close
    debugM $ "ExplicitList end"
    return (ExplicitList an1 es')
  exact (RecordCon XRecordCon GhcPs
an XRec GhcPs (ConLikeP GhcPs)
con_id HsRecordBinds GhcPs
binds) = do
    con_id' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con_id
    an0 <- markEpAnnL an lidl AnnOpenC
    binds' <- markAnnotated binds
    an1 <- markEpAnnL an0 lidl AnnCloseC
    return (RecordCon an1 con_id' binds')
  exact (RecordUpd XRecordUpd GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr LHsRecUpdFields GhcPs
fields) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    an0 <- markEpAnnL an lidl AnnOpenC
    fields' <- markAnnotated fields
    an1 <- markEpAnnL an0 lidl AnnCloseC
    return (RecordUpd an1 expr' fields')
  exact (HsGetField XGetField GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr XRec GhcPs (DotFieldOcc GhcPs)
field) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    field' <- markAnnotated field
    return (HsGetField an expr' field')
  exact (HsProjection XProjection GhcPs
an NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
flds) = do
    an0 <- AnnProjection
-> Lens AnnProjection Anchor
-> AnnKeywordId
-> EP w m AnnProjection
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a Anchor -> AnnKeywordId -> EP w m a
markLensKw XProjection GhcPs
AnnProjection
an (Anchor -> f Anchor) -> AnnProjection -> f AnnProjection
Lens AnnProjection Anchor
lapOpen AnnKeywordId
AnnOpenP
    flds' <- mapM markAnnotated flds
    an1 <- markLensKw an0 lapClose AnnCloseP
    return (HsProjection an1 flds')
  exact (ExprWithTySig XExprWithTySig GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr LHsSigWcType (NoGhcTc GhcPs)
sig) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    an0 <- markEpAnnL an lidl AnnDcolon
    sig' <- markAnnotated sig
    return (ExprWithTySig an0 expr' sig')
  exact (ArithSeq XArithSeq GhcPs
an Maybe (SyntaxExpr GhcPs)
s ArithSeqInfo GhcPs
seqInfo) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XArithSeq GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenS -- '['
    (an1, seqInfo') <-
      case seqInfo of
        From XRec GhcPs (HsExpr GhcPs)
e -> do
          e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
          an' <- markEpAnnL an0 lidl AnnDotdot
          return (an', From e')
        FromTo XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 -> do
          e1' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          an' <- markEpAnnL an0 lidl AnnDotdot
          e2' <- markAnnotated e2
          return (an', FromTo e1' e2')
        FromThen XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 -> do
          e1' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          an' <- markEpAnnL an0 lidl AnnComma
          e2' <- markAnnotated e2
          an'' <- markEpAnnL an' lidl AnnDotdot
          return (an'', FromThen e1' e2')
        FromThenTo XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 XRec GhcPs (HsExpr GhcPs)
e3 -> do
          e1' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          an' <- markEpAnnL an0 lidl AnnComma
          e2' <- markAnnotated e2
          an'' <- markEpAnnL an' lidl AnnDotdot
          e3' <- markAnnotated e3
          return (an'', FromThenTo e1' e2' e3')
    an2 <- markEpAnnL an1 lidl AnnCloseS -- ']'
    return (ArithSeq an2 s seqInfo')


  exact (HsTypedBracket XTypedBracket GhcPs
an XRec GhcPs (HsExpr GhcPs)
e) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
XTypedBracket GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
"[||")
    an1 <- markEpAnnLMS'' an0 lidl AnnOpenE (Just "[e||")
    e' <- markAnnotated e
    an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "||]")
    return (HsTypedBracket an2 e')

  exact (HsUntypedBracket XUntypedBracket GhcPs
an (ExpBr XExpBr GhcPs
a XRec GhcPs (HsExpr GhcPs)
e)) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XUntypedBracket GhcPs
an  ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenEQ -- "[|"
    an1 <- markEpAnnL an0 lidl AnnOpenE  -- "[e|" -- optional
    e' <- markAnnotated e
    an2 <- markEpAnnL an1 lidl AnnCloseQ -- "|]"
    return (HsUntypedBracket an2 (ExpBr a e'))

  exact (HsUntypedBracket XUntypedBracket GhcPs
an (PatBr XPatBr GhcPs
a LPat GhcPs
e)) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
XUntypedBracket GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
"[p|")
    e' <- markAnnotated e
    an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"
    return (HsUntypedBracket an1 (PatBr a e'))

  exact (HsUntypedBracket XUntypedBracket GhcPs
an (DecBrL XDecBrL GhcPs
a [LHsDecl GhcPs]
e)) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
XUntypedBracket GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
"[d|")
    an1 <- markEpAnnL an0 lidl AnnOpenC
    e' <- markAnnotated e
    an2 <- markEpAnnL an1 lidl AnnCloseC
    an3 <- markEpAnnL an2 lidl AnnCloseQ -- "|]"
    return (HsUntypedBracket an3 (DecBrL a e'))

  exact (HsUntypedBracket XUntypedBracket GhcPs
an (TypBr XTypBr GhcPs
a LHsType GhcPs
e)) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' [AddEpAnn]
XUntypedBracket GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
"[t|")
    e' <- markAnnotated e
    an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"
    return (HsUntypedBracket an1 (TypBr a e'))

  exact (HsUntypedBracket XUntypedBracket GhcPs
an (VarBr XVarBr GhcPs
a Bool
b LIdP GhcPs
e)) = do
    (an0, e') <- if Bool
b
      then do
        an' <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XUntypedBracket GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnSimpleQuote
        e' <- markAnnotated e
        return (an', e')
      else do
        an' <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XUntypedBracket GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnThTyQuote
        e' <- markAnnotated e
        return (an', e')
    return (HsUntypedBracket an0 (VarBr a b e'))

  exact (HsTypedSplice XTypedSplice GhcPs
an XRec GhcPs (HsExpr GhcPs)
s)   = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XTypedSplice GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDollarDollar
    s' <- markAnnotated s
    return (HsTypedSplice an0 s')

  exact (HsUntypedSplice XUntypedSplice GhcPs
an HsUntypedSplice GhcPs
s) = do
    s' <- HsUntypedSplice GhcPs -> EP w m (HsUntypedSplice GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsUntypedSplice GhcPs
s
    return (HsUntypedSplice an s')

  exact (HsProc XProc GhcPs
an LPat GhcPs
p LHsCmdTop GhcPs
c) = do
    String -> EP w m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ String
"HsProc start"
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XProc GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnProc
    p' <- markAnnotated p
    an1 <- markEpAnnL an0 lidl AnnRarrow
    debugM $ "HsProc after AnnRarrow"
    c' <- markAnnotated c
    return (HsProc an1 p' c')

  exact (HsStatic XStatic GhcPs
an XRec GhcPs (HsExpr GhcPs)
e) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XStatic GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnStatic
    e' <- markAnnotated e
    return (HsStatic an0 e')

  exact (HsPragE XPragE GhcPs
a HsPragE GhcPs
prag XRec GhcPs (HsExpr GhcPs)
e) = do
    prag' <- HsPragE GhcPs -> EP w m (HsPragE GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsPragE GhcPs
prag
    e' <- markAnnotated e
    return (HsPragE a prag' e')

  exact (HsEmbTy XEmbTy GhcPs
toktype LHsWcType (NoGhcTc GhcPs)
t) = do
    toktype' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XEmbTy GhcPs
EpToken "type"
toktype
    t' <- markAnnotated t
    return (HsEmbTy toktype' t')

  exact HsExpr GhcPs
x = String
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall a. HasCallStack => String -> a
error (String
 -> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs))
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ String
"exact HsExpr for:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsExpr GhcPs -> String
forall a. Data a => a -> String
showAst HsExpr GhcPs
x

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

exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
        => AnnList -> HsDoFlavour -> LocatedAn an a
        -> EP w m (AnnList, LocatedAn an a)
exactDo :: forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList
-> HsDoFlavour
-> LocatedAn an a
-> EP w m (AnnList, LocatedAn an a)
exactDo AnnList
an (DoExpr Maybe ModuleName
m)    LocatedAn an a
stmts = AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m AnnList
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m AnnList
exactMdo AnnList
an Maybe ModuleName
m AnnKeywordId
AnnDo           EP w m AnnList
-> (AnnList
    -> RWST
         (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a))
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> (a -> RWST (EPOptions m w) (EPWriter w) EPState m b)
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AnnList
an0 -> AnnList
-> LocatedAn an a
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList -> LocatedAn an a -> EP w m (AnnList, LocatedAn an a)
markMaybeDodgyStmts AnnList
an0 LocatedAn an a
stmts
exactDo AnnList
an HsDoFlavour
GhciStmtCtxt  LocatedAn an a
stmts = AnnList
-> Lens AnnList [AddEpAnn] -> AnnKeywordId -> EP w m AnnList
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL AnnList
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
AnnDo EP w m AnnList
-> (AnnList
    -> RWST
         (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a))
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> (a -> RWST (EPOptions m w) (EPWriter w) EPState m b)
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AnnList
an0 -> AnnList
-> LocatedAn an a
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList -> LocatedAn an a -> EP w m (AnnList, LocatedAn an a)
markMaybeDodgyStmts AnnList
an0 LocatedAn an a
stmts
exactDo AnnList
an (MDoExpr Maybe ModuleName
m)   LocatedAn an a
stmts = AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m AnnList
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m AnnList
exactMdo AnnList
an Maybe ModuleName
m AnnKeywordId
AnnMdo          EP w m AnnList
-> (AnnList
    -> RWST
         (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a))
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> (a -> RWST (EPOptions m w) (EPWriter w) EPState m b)
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AnnList
an0 -> AnnList
-> LocatedAn an a
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList -> LocatedAn an a -> EP w m (AnnList, LocatedAn an a)
markMaybeDodgyStmts AnnList
an0 LocatedAn an a
stmts
exactDo AnnList
an HsDoFlavour
ListComp      LocatedAn an a
stmts = AnnList
-> LocatedAn an a
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList -> LocatedAn an a -> EP w m (AnnList, LocatedAn an a)
markMaybeDodgyStmts AnnList
an LocatedAn an a
stmts
exactDo AnnList
an HsDoFlavour
MonadComp     LocatedAn an a
stmts = AnnList
-> LocatedAn an a
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList -> LocatedAn an a -> EP w m (AnnList, LocatedAn an a)
markMaybeDodgyStmts AnnList
an LocatedAn an a
stmts

exactMdo :: (Monad m, Monoid w)
  => AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m AnnList
exactMdo :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m AnnList
exactMdo AnnList
an Maybe ModuleName
Nothing            AnnKeywordId
kw = AnnList
-> Lens AnnList [AddEpAnn] -> AnnKeywordId -> EP w m AnnList
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL    AnnList
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
kw
exactMdo AnnList
an (Just ModuleName
module_name) AnnKeywordId
kw = AnnList
-> Lens AnnList [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m AnnList
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a
markEpAnnLMS'' AnnList
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
kw (String -> Maybe String
forall a. a -> Maybe a
Just String
n)
    where
      n :: String
n = (ModuleName -> String
moduleNameString ModuleName
module_name) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ (AnnKeywordId -> String
keywordToString AnnKeywordId
kw)

markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
  => AnnList -> LocatedAn an a -> EP w m (AnnList, LocatedAn an a)
markMaybeDodgyStmts :: forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList -> LocatedAn an a -> EP w m (AnnList, LocatedAn an a)
markMaybeDodgyStmts AnnList
an LocatedAn an a
stmts =
  if LocatedAn an a -> Bool
forall ann a. GenLocated (EpAnn ann) a -> Bool
notDodgy LocatedAn an a
stmts
    then do
      r <- LocatedAn an a -> EP w m (LocatedAn an a)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotatedWithLayout LocatedAn an a
stmts
      return (an, r)
    else (AnnList, LocatedAn an a)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AnnList, LocatedAn an a)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnList
an, LocatedAn an a
stmts)

notDodgy :: GenLocated (EpAnn ann) a -> Bool
notDodgy :: forall ann a. GenLocated (EpAnn ann) a -> Bool
notDodgy (L (EpAnn Anchor
anc ann
_ EpAnnComments
_) a
_) = Anchor -> Bool
notDodgyE Anchor
anc

notDodgyE :: EpaLocation -> Bool
notDodgyE :: Anchor -> Bool
notDodgyE Anchor
anc =
  case Anchor
anc of
    EpaSpan SrcSpan
s -> SrcSpan -> Bool
isGoodSrcSpan SrcSpan
s
    EpaDelta{} -> Bool
True

-- ---------------------------------------------------------------------
instance ExactPrint (HsPragE GhcPs) where
  getAnnotationEntry :: HsPragE GhcPs -> Entry
getAnnotationEntry HsPragSCC{}  = Entry
NoEntryVal
  setAnnotationAnchor :: HsPragE GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsPragE GhcPs
setAnnotationAnchor HsPragE GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsPragE GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsPragE GhcPs -> EP w m (HsPragE GhcPs)
exact (HsPragSCC (AnnPragma
an,SourceText
st) StringLiteral
sl) = do
    an0 <- AnnPragma -> SourceText -> String -> EP w m AnnPragma
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnPragma -> SourceText -> String -> EP w m AnnPragma
markAnnOpenP' AnnPragma
an SourceText
st String
"{-# SCC"
    let txt = SourceText -> ShowS
sourceTextToString (StringLiteral -> SourceText
sl_st StringLiteral
sl) (FastString -> String
unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
sl_fs StringLiteral
sl)
    an1 <- markEpAnnLMS'' an0 lapr_rest AnnVal    (Just txt) -- optional
    an2 <- markEpAnnLMS'' an1 lapr_rest AnnValStr (Just txt) -- optional
    an3 <- markAnnCloseP' an2
    return (HsPragSCC (an3,st) sl)


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

instance ExactPrint (HsUntypedSplice GhcPs) where
  getAnnotationEntry :: HsUntypedSplice GhcPs -> Entry
getAnnotationEntry HsUntypedSplice GhcPs
_ = Entry
NoEntryVal

  setAnnotationAnchor :: HsUntypedSplice GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsUntypedSplice GhcPs
setAnnotationAnchor HsUntypedSplice GhcPs
a Anchor
_ [TrailingAnn]
_  EpAnnComments
_= HsUntypedSplice GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsUntypedSplice GhcPs -> EP w m (HsUntypedSplice GhcPs)
exact (HsUntypedSpliceExpr XUntypedSpliceExpr GhcPs
an XRec GhcPs (HsExpr GhcPs)
e) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XUntypedSpliceExpr GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDollar
    e' <- markAnnotated e
    return (HsUntypedSpliceExpr an0 e')

  exact (HsQuasiQuote XQuasiQuote GhcPs
an IdP GhcPs
q (L EpAnn NoEpAnns
l FastString
fs)) = do
    -- The quasiquote string does not honour layout offsets. Store
    -- the colOffset for now.
    -- TODO: use local?
    oldOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
    EPState{pMarkLayout} <- get
    unless pMarkLayout $ setLayoutOffsetP 0
    printStringAdvance
            -- Note: Lexer.x does not provide unicode alternative. 2017-02-26
            ("[" ++ (showPprUnsafe q) ++ "|" ++ (unpackFS fs) ++ "|]")
    unless pMarkLayout $ setLayoutOffsetP oldOffset
    return (HsQuasiQuote an q (L l fs))

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

-- TODO:AZ: combine these instances
instance ExactPrint (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where
  getAnnotationEntry :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Entry
getAnnotationEntry = Entry
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
setAnnotationAnchor MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> EP
     w m (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
exact (MG XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
matches) = do
    -- TODO:AZ use SortKey, in MG ann.
    matches' <- GenLocated
  (EpAnn AnnList)
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     (GenLocated
        (EpAnn AnnList)
        [GenLocated
           SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
GenLocated
  (EpAnn AnnList)
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches
    return (MG x matches')

instance ExactPrint (MatchGroup GhcPs (LocatedA (HsCmd GhcPs))) where
  getAnnotationEntry :: MatchGroup GhcPs (LocatedA (HsCmd GhcPs)) -> Entry
getAnnotationEntry = Entry -> MatchGroup GhcPs (LocatedA (HsCmd GhcPs)) -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
setAnnotationAnchor MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
-> EP w m (MatchGroup GhcPs (LocatedA (HsCmd GhcPs)))
exact (MG XMG GhcPs (LocatedA (HsCmd GhcPs))
x XRec GhcPs [LMatch GhcPs (LocatedA (HsCmd GhcPs))]
matches) = do
    -- TODO:AZ use SortKey, in MG ann.
    matches' <- if GenLocated
  (EpAnn AnnList)
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))]
-> Bool
forall ann a. GenLocated (EpAnn ann) a -> Bool
notDodgy XRec GhcPs [LMatch GhcPs (LocatedA (HsCmd GhcPs))]
GenLocated
  (EpAnn AnnList)
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))]
matches
      then GenLocated
  (EpAnn AnnList)
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))]
-> EP
     w
     m
     (GenLocated
        (EpAnn AnnList)
        [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs [LMatch GhcPs (LocatedA (HsCmd GhcPs))]
GenLocated
  (EpAnn AnnList)
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))]
matches
      else GenLocated
  (EpAnn AnnList)
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))]
-> EP
     w
     m
     (GenLocated
        (EpAnn AnnList)
        [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))])
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return XRec GhcPs [LMatch GhcPs (LocatedA (HsCmd GhcPs))]
GenLocated
  (EpAnn AnnList)
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))]
matches
    return (MG x matches')

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

instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where
  getAnnotationEntry :: HsRecFields GhcPs body -> Entry
getAnnotationEntry = Entry -> HsRecFields GhcPs body -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsRecFields GhcPs body
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsRecFields GhcPs body
setAnnotationAnchor HsRecFields GhcPs body
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsRecFields GhcPs body
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsRecFields GhcPs body -> EP w m (HsRecFields GhcPs body)
exact (HsRecFields [LHsRecField GhcPs body]
fields Maybe (XRec GhcPs RecFieldsDotDot)
mdot) = do
    fields' <- [GenLocated
   SrcSpanAnnA
   (HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body)]
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LHsRecField GhcPs body]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body)]
fields
    mdot' <- case mdot of
      Maybe (XRec GhcPs RecFieldsDotDot)
Nothing -> Maybe (GenLocated Anchor RecFieldsDotDot)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated Anchor RecFieldsDotDot))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenLocated Anchor RecFieldsDotDot)
forall a. Maybe a
Nothing
      Just (L Anchor
ss RecFieldsDotDot
d) -> do
        ss' <- Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA Anchor
ss String
".."
        return $ Just (L ss' d)
      -- Note: mdot contains the SrcSpan where the ".." appears, if present
    return (HsRecFields fields' mdot')

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

instance (ExactPrint body)
    => ExactPrint (HsFieldBind (LocatedA (FieldOcc GhcPs)) body) where
  getAnnotationEntry :: HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body -> Entry
getAnnotationEntry HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body
setAnnotationAnchor HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body
-> EP
     w m (HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) body)
exact (HsFieldBind XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
an GenLocated SrcSpanAnnA (FieldOcc GhcPs)
f body
arg Bool
isPun) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"HsFieldBind"
    f' <- GenLocated SrcSpanAnnA (FieldOcc GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated GenLocated SrcSpanAnnA (FieldOcc GhcPs)
f
    (an0, arg') <- if isPun then return (an, arg)
             else do
               an0 <- markEpAnnL an lidl AnnEqual
               arg' <- markAnnotated arg
               return (an0, arg')
    return (HsFieldBind an0 f' arg' isPun)

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

instance (ExactPrint body)
    => ExactPrint (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body) where
  getAnnotationEntry :: HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body
-> Entry
getAnnotationEntry HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body
setAnnotationAnchor HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body
-> EP
     w
     m
     (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body)
exact (HsFieldBind XHsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs))
an LocatedAn NoEpAnns (FieldLabelStrings GhcPs)
f body
arg Bool
isPun) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"HsFieldBind FieldLabelStrings"
    f' <- LocatedAn NoEpAnns (FieldLabelStrings GhcPs)
-> EP w m (LocatedAn NoEpAnns (FieldLabelStrings GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LocatedAn NoEpAnns (FieldLabelStrings GhcPs)
f
    (an0, arg') <- if isPun then return (an, arg)
             else do
               an0 <- markEpAnnL an lidl AnnEqual
               arg' <- markAnnotated arg
               return (an0, arg')
    return (HsFieldBind an0 f' arg' isPun)

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

instance (ExactPrint (LocatedA body))
    => ExactPrint (HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)) where
  getAnnotationEntry :: HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)
-> Entry
getAnnotationEntry HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)
setAnnotationAnchor HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)
-> EP
     w
     m
     (HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body))
exact (HsFieldBind XHsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs))
an LocatedA (AmbiguousFieldOcc GhcPs)
f LocatedA body
arg Bool
isPun) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"HsRecUpdField"
    f' <- LocatedA (AmbiguousFieldOcc GhcPs)
-> EP w m (LocatedA (AmbiguousFieldOcc GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LocatedA (AmbiguousFieldOcc GhcPs)
f
    an0 <- if isPun then return an
             else markEpAnnL an lidl AnnEqual
    arg' <- if isPun
              then return arg
              else markAnnotated arg
    return (HsFieldBind an0 f' arg' isPun)

-- ---------------------------------------------------------------------
instance ExactPrint (LHsRecUpdFields GhcPs) where
  getAnnotationEntry :: LHsRecUpdFields GhcPs -> Entry
getAnnotationEntry = Entry -> LHsRecUpdFields GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: LHsRecUpdFields GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> LHsRecUpdFields GhcPs
setAnnotationAnchor LHsRecUpdFields GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = LHsRecUpdFields GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LHsRecUpdFields GhcPs -> EP w m (LHsRecUpdFields GhcPs)
exact flds :: LHsRecUpdFields GhcPs
flds@(RegularRecUpdFields    { recUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdField p p]
recUpdFields  = [LHsRecUpdField GhcPs GhcPs]
rbinds }) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"RegularRecUpdFields"
    rbinds' <- [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (LocatedA (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (LocatedA (AmbiguousFieldOcc GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LHsRecUpdField GhcPs GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (LocatedA (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rbinds
    return $ flds { recUpdFields = rbinds' }
  exact flds :: LHsRecUpdFields GhcPs
flds@(OverloadedRecUpdFields { olRecUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdProj p]
olRecUpdFields = [LHsRecUpdProj GhcPs]
pbinds }) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"OverloadedRecUpdFields"
    pbinds' <- [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (LocatedAn NoEpAnns (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (LocatedAn NoEpAnns (FieldLabelStrings GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LHsRecUpdProj GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (LocatedAn NoEpAnns (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
pbinds
    return $ flds { olRecUpdFields = pbinds' }

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

instance ExactPrint (FieldLabelStrings GhcPs) where
  getAnnotationEntry :: FieldLabelStrings GhcPs -> Entry
getAnnotationEntry = Entry -> FieldLabelStrings GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: FieldLabelStrings GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> FieldLabelStrings GhcPs
setAnnotationAnchor FieldLabelStrings GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = FieldLabelStrings GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
FieldLabelStrings GhcPs -> EP w m (FieldLabelStrings GhcPs)
exact (FieldLabelStrings [XRec GhcPs (DotFieldOcc GhcPs)]
fs) = [XRec GhcPs (DotFieldOcc GhcPs)] -> FieldLabelStrings GhcPs
[GenLocated (EpAnn NoEpAnns) (DotFieldOcc GhcPs)]
-> FieldLabelStrings GhcPs
forall p. [XRec p (DotFieldOcc p)] -> FieldLabelStrings p
FieldLabelStrings ([GenLocated (EpAnn NoEpAnns) (DotFieldOcc GhcPs)]
 -> FieldLabelStrings GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     [GenLocated (EpAnn NoEpAnns) (DotFieldOcc GhcPs)]
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (FieldLabelStrings GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated (EpAnn NoEpAnns) (DotFieldOcc GhcPs)]
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     [GenLocated (EpAnn NoEpAnns) (DotFieldOcc GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [XRec GhcPs (DotFieldOcc GhcPs)]
[GenLocated (EpAnn NoEpAnns) (DotFieldOcc GhcPs)]
fs

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

instance ExactPrint (DotFieldOcc GhcPs) where
  getAnnotationEntry :: DotFieldOcc GhcPs -> Entry
getAnnotationEntry DotFieldOcc GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: DotFieldOcc GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> DotFieldOcc GhcPs
setAnnotationAnchor DotFieldOcc GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = DotFieldOcc GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DotFieldOcc GhcPs -> EP w m (DotFieldOcc GhcPs)
exact (DotFieldOcc XCDotFieldOcc GhcPs
an (L SrcSpanAnnN
loc (FieldLabelString FastString
fs))) = do
    an0 <- AnnFieldLabel
-> Lens AnnFieldLabel (Maybe Anchor)
-> AnnKeywordId
-> EP w m AnnFieldLabel
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a (Maybe Anchor) -> AnnKeywordId -> EP w m a
markLensKwM' XCDotFieldOcc GhcPs
AnnFieldLabel
an (Maybe Anchor -> f (Maybe Anchor))
-> AnnFieldLabel -> f AnnFieldLabel
Lens AnnFieldLabel (Maybe Anchor)
lafDot  AnnKeywordId
AnnDot
    -- The field name has a SrcSpanAnnN, print it as a
    -- LocatedN RdrName
    L loc' _ <- markAnnotated (L loc (mkVarUnqual fs))
    return (DotFieldOcc an0 (L loc' (FieldLabelString fs)))

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

instance ExactPrint (HsTupArg GhcPs) where
  getAnnotationEntry :: HsTupArg GhcPs -> Entry
getAnnotationEntry (Present XPresent GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_) = Entry
NoEntryVal
  getAnnotationEntry (Missing (EpAnn Anchor
_ Bool
False EpAnnComments
_)) = Entry
NoEntryVal
  getAnnotationEntry (Missing XMissing GhcPs
an)   = EpAnn Bool -> Entry
forall a. HasEntry a => a -> Entry
fromAnn XMissing GhcPs
EpAnn Bool
an

  setAnnotationAnchor :: HsTupArg GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsTupArg GhcPs
setAnnotationAnchor (Present XPresent GhcPs
a XRec GhcPs (HsExpr GhcPs)
b) Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = XPresent GhcPs -> XRec GhcPs (HsExpr GhcPs) -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
a XRec GhcPs (HsExpr GhcPs)
b
  setAnnotationAnchor (Missing XMissing GhcPs
an)   Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = XMissing GhcPs -> HsTupArg GhcPs
forall id. XMissing id -> HsTupArg id
Missing (EpAnn Bool
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn Bool
forall an.
HasTrailing an =>
EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa XMissing GhcPs
EpAnn Bool
an Anchor
anc [TrailingAnn]
ts EpAnnComments
cs)

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsTupArg GhcPs -> EP w m (HsTupArg GhcPs)
exact (Present XPresent GhcPs
a XRec GhcPs (HsExpr GhcPs)
e) = XPresent GhcPs -> XRec GhcPs (HsExpr GhcPs) -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
a (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsTupArg GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsTupArg GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e

  exact a :: HsTupArg GhcPs
a@(Missing (EpAnn Anchor
_ Bool
False EpAnnComments
_)) = HsTupArg GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsTupArg GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsTupArg GhcPs
a
  exact a :: HsTupArg GhcPs
a@(Missing XMissing GhcPs
_) = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
"," EP w m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsTupArg GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsTupArg GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsTupArg GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsTupArg GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsTupArg GhcPs
a

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

instance ExactPrint (HsCmdTop GhcPs) where
  getAnnotationEntry :: HsCmdTop GhcPs -> Entry
getAnnotationEntry = Entry -> HsCmdTop GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsCmdTop GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsCmdTop GhcPs
setAnnotationAnchor HsCmdTop GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsCmdTop GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsCmdTop GhcPs -> EP w m (HsCmdTop GhcPs)
exact (HsCmdTop XCmdTop GhcPs
a LHsCmd GhcPs
cmd) = XCmdTop GhcPs -> LHsCmd GhcPs -> HsCmdTop GhcPs
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop XCmdTop GhcPs
a (LocatedA (HsCmd GhcPs) -> HsCmdTop GhcPs)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (LocatedA (HsCmd GhcPs))
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsCmdTop GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocatedA (HsCmd GhcPs)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (LocatedA (HsCmd GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
cmd

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

instance ExactPrint (HsCmd GhcPs) where
  getAnnotationEntry :: HsCmd GhcPs -> Entry
getAnnotationEntry HsCmd GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsCmd GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsCmd GhcPs
setAnnotationAnchor HsCmd GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsCmd GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsCmd GhcPs -> EP w m (HsCmd GhcPs)
exact (HsCmdArrApp XCmdArrApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
arr XRec GhcPs (HsExpr GhcPs)
arg HsArrAppType
o Bool
isRightToLeft) = do
    if Bool
isRightToLeft
      then do
        arr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arr
        an0 <- markKw an
        arg' <- markAnnotated arg
        return (HsCmdArrApp an0 arr' arg' o isRightToLeft)
      else do
        arg' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
        an0 <- markKw an
        arr' <- markAnnotated arr
        return (HsCmdArrApp an0 arr' arg' o isRightToLeft)

  exact (HsCmdArrForm XCmdArrForm GhcPs
an XRec GhcPs (HsExpr GhcPs)
e LexicalFixity
fixity Maybe Fixity
mf [LHsCmdTop GhcPs]
cs) = do
    an0 <- AnnList -> Lens AnnList (Maybe AddEpAnn) -> EP w m AnnList
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a (Maybe AddEpAnn) -> EP w m a
markLensMAA' XCmdArrForm GhcPs
AnnList
an (Maybe AddEpAnn -> f (Maybe AddEpAnn)) -> AnnList -> f AnnList
Lens AnnList (Maybe AddEpAnn)
lal_open
    (e',cs') <- case (fixity, cs) of
      (LexicalFixity
Infix, (GenLocated (EpAnn NoEpAnns) (HsCmdTop GhcPs)
arg1:[GenLocated (EpAnn NoEpAnns) (HsCmdTop GhcPs)]
argrest)) -> do
        arg1' <- GenLocated (EpAnn NoEpAnns) (HsCmdTop GhcPs)
-> EP w m (GenLocated (EpAnn NoEpAnns) (HsCmdTop GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated GenLocated (EpAnn NoEpAnns) (HsCmdTop GhcPs)
arg1
        e' <- markAnnotated e
        argrest' <- markAnnotated argrest
        return (e', arg1':argrest')
      (LexicalFixity
Prefix, [GenLocated (EpAnn NoEpAnns) (HsCmdTop GhcPs)]
_) -> do
        e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
        cs' <- markAnnotated cs
        return (e', cs')
      (LexicalFixity
Infix, []) -> String
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (HsExpr GhcPs),
      [GenLocated (EpAnn NoEpAnns) (HsCmdTop GhcPs)])
forall a. HasCallStack => String -> a
error String
"Not possible"
    an1 <- markLensMAA' an0 lal_close
    return (HsCmdArrForm an1 e' fixity mf cs')

  exact (HsCmdApp XCmdApp GhcPs
an LHsCmd GhcPs
e1 XRec GhcPs (HsExpr GhcPs)
e2) = do
    e1' <- LocatedA (HsCmd GhcPs) -> EP w m (LocatedA (HsCmd GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
e1
    e2' <- markAnnotated e2
    return (HsCmdApp an e1' e2')

  exact (HsCmdLam XCmdLamCase GhcPs
an HsLamVariant
lam_variant MatchGroup GhcPs (LHsCmd GhcPs)
matches) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XCmdLamCase GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnLam
    an1 <- case lam_variant of
             HsLamVariant
LamSingle -> [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
an0
             HsLamVariant
LamCase -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an0 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnCase
             HsLamVariant
LamCases -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an0 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnCases
    matches' <- markAnnotated matches
    return (HsCmdLam an1 lam_variant matches')

  exact (HsCmdPar (EpToken "("
lpar, EpToken ")"
rpar) LHsCmd GhcPs
e) = do
    lpar' <- EpToken "(" -> EP w m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "("
lpar
    e' <- markAnnotated e
    rpar' <- markEpToken rpar
    return (HsCmdPar (lpar', rpar') e')

  exact (HsCmdCase XCmdCase GhcPs
an XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
alts) = do
    an0 <- EpAnnHsCase
-> Lens EpAnnHsCase Anchor -> AnnKeywordId -> EP w m EpAnnHsCase
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a Anchor -> AnnKeywordId -> EP w m a
markLensKw XCmdCase GhcPs
EpAnnHsCase
an (Anchor -> f Anchor) -> EpAnnHsCase -> f EpAnnHsCase
Lens EpAnnHsCase Anchor
lhsCaseAnnCase AnnKeywordId
AnnCase
    e' <- markAnnotated e
    an1 <- markLensKw an0 lhsCaseAnnOf AnnOf
    an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC
    an3 <- markEpAnnAllL' an2 lhsCaseAnnsRest AnnSemi
    alts' <- markAnnotated alts
    an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC
    return (HsCmdCase an4 e' alts')

  exact (HsCmdIf XCmdIf GhcPs
an SyntaxExpr GhcPs
a XRec GhcPs (HsExpr GhcPs)
e1 LHsCmd GhcPs
e2 LHsCmd GhcPs
e3) = do
    an0 <- AnnsIf -> Lens AnnsIf Anchor -> AnnKeywordId -> EP w m AnnsIf
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a Anchor -> AnnKeywordId -> EP w m a
markLensKw XCmdIf GhcPs
AnnsIf
an (Anchor -> f Anchor) -> AnnsIf -> f AnnsIf
Lens AnnsIf Anchor
laiIf AnnKeywordId
AnnIf
    e1' <- markAnnotated e1
    an1 <- markLensKwM' an0 laiThenSemi AnnSemi
    an2 <- markLensKw an1 laiThen AnnThen
    e2' <- markAnnotated e2
    an3 <- markLensKwM' an2 laiElseSemi AnnSemi
    an4 <- markLensKw an3 laiElse AnnElse
    e3' <- markAnnotated e3
    return (HsCmdIf an4 a e1' e2' e3')

  exact (HsCmdLet (EpToken "let"
tkLet, EpToken "in"
tkIn) HsLocalBinds GhcPs
binds LHsCmd GhcPs
e) = do
    RWST (EPOptions m w) (EPWriter w) EPState m (HsCmd GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsCmd GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EP w m a -> EP w m a
setLayoutBoth (RWST (EPOptions m w) (EPWriter w) EPState m (HsCmd GhcPs)
 -> RWST (EPOptions m w) (EPWriter w) EPState m (HsCmd GhcPs))
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsCmd GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsCmd GhcPs)
forall a b. (a -> b) -> a -> b
$ do -- Make sure the 'in' gets indented too
      tkLet' <- EpToken "let" -> EP w m (EpToken "let")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "let"
tkLet
      binds' <- setLayoutBoth $ markAnnotated binds
      tkIn' <- markEpToken tkIn
      e' <- markAnnotated e
      return (HsCmdLet (tkLet', tkIn') binds' e')

  exact (HsCmdDo XCmdDo GhcPs
an XRec GhcPs [CmdLStmt GhcPs]
es) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"HsCmdDo"
    an0 <- AnnList
-> Lens AnnList [AddEpAnn] -> AnnKeywordId -> EP w m AnnList
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL XCmdDo GhcPs
AnnList
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
AnnDo
    es' <- markAnnotated es
    return (HsCmdDo an0 es')

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

instance (
  ExactPrint (LocatedA (body GhcPs)),
                 Anno (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ~ SrcSpanAnnA,
           Anno [GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))] ~ SrcSpanAnnL,
           (ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))])))
   => ExactPrint (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) where
  getAnnotationEntry :: StmtLR GhcPs GhcPs (LocatedA (body GhcPs)) -> Entry
getAnnotationEntry StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
_ = Entry
NoEntryVal
  setAnnotationAnchor :: StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
setAnnotationAnchor StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_s = StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
StmtLR GhcPs GhcPs (LocatedA (body GhcPs))
-> EP w m (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
exact (LastStmt XLastStmt GhcPs GhcPs (LocatedA (body GhcPs))
a LocatedA (body GhcPs)
body Maybe Bool
b SyntaxExpr GhcPs
c) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LastStmt"
    body' <- LocatedA (body GhcPs) -> EP w m (LocatedA (body GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LocatedA (body GhcPs)
body
    return (LastStmt a body' b c)

  exact (BindStmt XBindStmt GhcPs GhcPs (LocatedA (body GhcPs))
an LPat GhcPs
pat LocatedA (body GhcPs)
body) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"BindStmt"
    pat' <- GenLocated SrcSpanAnnA (Pat GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
    an0 <- markEpAnnL an lidl AnnLarrow
    body' <- markAnnotated body
    return (BindStmt an0 pat' body')

  exact (ApplicativeStmt XApplicativeStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ [(SyntaxExpr GhcPs, ApplicativeArg GhcPs)]
_body Maybe (SyntaxExpr GhcPs)
_) = do
    String
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
forall a. HasCallStack => String -> a
error (String
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))))
-> String
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))
forall a b. (a -> b) -> a -> b
$ String
"ApplicativeStmt is introduced in the renamer"

  exact (BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (body GhcPs))
a LocatedA (body GhcPs)
body SyntaxExpr GhcPs
b SyntaxExpr GhcPs
c) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"BodyStmt"
    body' <- LocatedA (body GhcPs) -> EP w m (LocatedA (body GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LocatedA (body GhcPs)
body
    return (BodyStmt a body' b c)

  exact (LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
an HsLocalBinds GhcPs
binds) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LetStmt"
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnLet
    binds' <- markAnnotated binds
    return (LetStmt an0 binds')

  exact (ParStmt XParStmt GhcPs GhcPs (LocatedA (body GhcPs))
a [ParStmtBlock GhcPs GhcPs]
pbs HsExpr GhcPs
b SyntaxExpr GhcPs
c) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"ParStmt"
    pbs' <- [ParStmtBlock GhcPs GhcPs] -> EP w m [ParStmtBlock GhcPs GhcPs]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [ParStmtBlock GhcPs GhcPs]
pbs
    return (ParStmt a pbs' b c)

  exact (TransStmt XTransStmt GhcPs GhcPs (LocatedA (body GhcPs))
an TransForm
form [GuardLStmt GhcPs]
stmts [(IdP GhcPs, IdP GhcPs)]
b XRec GhcPs (HsExpr GhcPs)
using Maybe (XRec GhcPs (HsExpr GhcPs))
by SyntaxExpr GhcPs
c SyntaxExpr GhcPs
d HsExpr GhcPs
e) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"TransStmt"
    stmts' <- [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
    (an', by', using') <- exactTransStmt an by using form
    return (TransStmt an' form stmts' b using' by' c d e)

  exact (RecStmt XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
an XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA (body GhcPs))]
stmts [IdP GhcPs]
a [IdP GhcPs]
b SyntaxExpr GhcPs
c SyntaxExpr GhcPs
d SyntaxExpr GhcPs
e) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"RecStmt"
    an0 <- AnnList
-> Lens AnnList [AddEpAnn] -> AnnKeywordId -> EP w m AnnList
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
AnnList
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
AnnRec
    (an1, stmts') <- markAnnList' an0 (markAnnotated stmts)
    return (RecStmt an1 stmts' a b c d e)

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

instance ExactPrint (ParStmtBlock GhcPs GhcPs) where
  getAnnotationEntry :: ParStmtBlock GhcPs GhcPs -> Entry
getAnnotationEntry = Entry -> ParStmtBlock GhcPs GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: ParStmtBlock GhcPs GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> ParStmtBlock GhcPs GhcPs
setAnnotationAnchor ParStmtBlock GhcPs GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = ParStmtBlock GhcPs GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ParStmtBlock GhcPs GhcPs -> EP w m (ParStmtBlock GhcPs GhcPs)
exact (ParStmtBlock XParStmtBlock GhcPs GhcPs
a [GuardLStmt GhcPs]
stmts [IdP GhcPs]
b SyntaxExpr GhcPs
c) = do
    stmts' <- [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
    return (ParStmtBlock a stmts' b c)

exactTransStmt :: (Monad m, Monoid w)
  => [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm
  -> EP w m ([AddEpAnn], Maybe (LHsExpr GhcPs), (LHsExpr GhcPs))
exactTransStmt :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> Maybe (XRec GhcPs (HsExpr GhcPs))
-> XRec GhcPs (HsExpr GhcPs)
-> TransForm
-> EP
     w
     m
     ([AddEpAnn], Maybe (XRec GhcPs (HsExpr GhcPs)),
      XRec GhcPs (HsExpr GhcPs))
exactTransStmt [AddEpAnn]
an Maybe (XRec GhcPs (HsExpr GhcPs))
by XRec GhcPs (HsExpr GhcPs)
using TransForm
ThenForm = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"exactTransStmt:ThenForm"
  an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnThen
  using' <- markAnnotated using
  case by of
    Maybe (XRec GhcPs (HsExpr GhcPs))
Nothing -> ([AddEpAnn], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
 GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
      GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AddEpAnn]
an0, Maybe (XRec GhcPs (HsExpr GhcPs))
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
by, GenLocated SrcSpanAnnA (HsExpr GhcPs)
using')
    Just XRec GhcPs (HsExpr GhcPs)
b -> do
      an1 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an0 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnBy
      b' <- markAnnotated b
      return (an1, Just b', using')
exactTransStmt [AddEpAnn]
an Maybe (XRec GhcPs (HsExpr GhcPs))
by XRec GhcPs (HsExpr GhcPs)
using TransForm
GroupForm = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"exactTransStmt:GroupForm"
  an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnThen
  an1 <- markEpAnnL an0 lidl AnnGroup
  (an2, by') <- case by of
    Maybe (XRec GhcPs (HsExpr GhcPs))
Nothing -> ([AddEpAnn], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AddEpAnn]
an1, Maybe (XRec GhcPs (HsExpr GhcPs))
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
by)
    Just XRec GhcPs (HsExpr GhcPs)
b -> do
      an2 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an1 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnBy
      b' <- markAnnotated b
      return (an2, Just b')
  an3 <- markEpAnnL an2 lidl AnnUsing
  using' <- markAnnotated using
  return (an3, by', using')

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

instance ExactPrint (TyClDecl GhcPs) where
  getAnnotationEntry :: TyClDecl GhcPs -> Entry
getAnnotationEntry TyClDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: TyClDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> TyClDecl GhcPs
setAnnotationAnchor TyClDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_s = TyClDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
TyClDecl GhcPs -> EP w m (TyClDecl GhcPs)
exact (FamDecl XFamDecl GhcPs
a FamilyDecl GhcPs
decl) = do
    decl' <- FamilyDecl GhcPs -> EP w m (FamilyDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated FamilyDecl GhcPs
decl
    return (FamDecl a decl')

  exact (SynDecl { tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
tcdSExt = XSynDecl GhcPs
an
                 , tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcPs
ltycon, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcPs
tyvars, tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity = LexicalFixity
fixity
                 , tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType GhcPs
rhs }) = do
    -- There may be arbitrary parens around parts of the constructor
    -- that are infix.  Turn these into comments so that they feed
    -- into the right place automatically
    -- TODO: no longer sorting on insert. What now?
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> [AnnKeywordId]
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a
annotationsToComments [AddEpAnn]
XSynDecl GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl [AnnKeywordId
AnnOpenP,AnnKeywordId
AnnCloseP]
    an1 <- markEpAnnL an0 lidl AnnType

    (_anx, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing
    an2 <- markEpAnnL an1 lidl AnnEqual
    rhs' <- markAnnotated rhs
    return (SynDecl { tcdSExt = an2
                    , tcdLName = ltycon', tcdTyVars = tyvars', tcdFixity = fixity
                    , tcdRhs = rhs' })

  -- TODO: add a workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/20452
  exact (DataDecl { tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
tcdDExt = XDataDecl GhcPs
an, tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcPs
ltycon, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcPs
tyvars
                  , tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity = LexicalFixity
fixity, tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcPs
defn }) = do
    (_, an', ltycon', tyvars', _, defn') <-
      [AddEpAnn]
-> (Maybe (LHsContext GhcPs)
    -> EP
         w
         m
         ([AddEpAnn], LocatedN RdrName, LHsQTyVars GhcPs, (),
          Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP
     w
     m
     ([AddEpAnn], [AddEpAnn], LocatedN RdrName, LHsQTyVars GhcPs, (),
      HsDataDefn GhcPs)
forall (m :: * -> *) w a b.
(Monad m, Monoid w) =>
[AddEpAnn]
-> (Maybe (LHsContext GhcPs)
    -> EP
         w m ([AddEpAnn], LocatedN RdrName, a, b, Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP
     w
     m
     ([AddEpAnn], [AddEpAnn], LocatedN RdrName, a, b, HsDataDefn GhcPs)
exactDataDefn [AddEpAnn]
XDataDecl GhcPs
an (LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, LHsQTyVars GhcPs, (),
      Maybe (LHsContext GhcPs))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, LHsQTyVars GhcPs, (),
      Maybe (LHsContext GhcPs))
exactVanillaDeclHead LIdP GhcPs
LocatedN RdrName
ltycon LHsQTyVars GhcPs
tyvars LexicalFixity
fixity) HsDataDefn GhcPs
defn
    return (DataDecl { tcdDExt = an', tcdLName = ltycon', tcdTyVars = tyvars'
                     , tcdFixity = fixity, tcdDataDefn = defn' })

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

  exact (ClassDecl {tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCExt = ([AddEpAnn]
an, EpLayout
lo, AnnSortKey DeclTag
sortKey),
                    tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt = Maybe (LHsContext GhcPs)
context, tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcPs
lclas, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcPs
tyvars,
                    tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity = LexicalFixity
fixity,
                    tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs  = [LHsFunDep GhcPs]
fds,
                    tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig GhcPs]
sigs, tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths = LHsBinds GhcPs
methods,
                    tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl GhcPs]
ats, tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs = [LTyFamInstDecl GhcPs]
at_defs,
                    tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl pass]
tcdDocs = [LDocDecl GhcPs]
_docs})
      -- TODO: add a test that demonstrates tcdDocs
      | [LocatedAn AnnListItem (Sig GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSig GhcPs]
[LocatedAn AnnListItem (Sig GhcPs)]
sigs Bool -> Bool -> Bool
&& Bag (LocatedAn AnnListItem (HsBind GhcPs)) -> Bool
forall a. Bag a -> Bool
isEmptyBag LHsBinds GhcPs
Bag (LocatedAn AnnListItem (HsBind GhcPs))
methods Bool -> Bool -> Bool
&& [LocatedAn AnnListItem (FamilyDecl GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LFamilyDecl GhcPs]
[LocatedAn AnnListItem (FamilyDecl GhcPs)]
ats Bool -> Bool -> Bool
&& [LocatedAn AnnListItem (TyFamInstDecl GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LTyFamInstDecl GhcPs]
[LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
at_defs -- No "where" part
      = do
          (an0, fds', lclas', tyvars',context') <- RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([AddEpAnn], [GenLocated SrcSpanAnnA (FunDep GhcPs)],
   LocatedN RdrName, LHsQTyVars GhcPs,
   Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
top_matter
          an1 <- markEpAnnL an0 lidl AnnOpenC
          an2 <- markEpAnnL an1 lidl AnnCloseC
          return (ClassDecl {tcdCExt = (an2, lo, sortKey),
                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',
                             tcdFixity = fixity,
                             tcdFDs  = fds',
                             tcdSigs = sigs, tcdMeths = methods,
                             tcdATs = ats, tcdATDefs = at_defs,
                             tcdDocs = _docs})

      | Bool
otherwise       -- Laid out
      = do
          (an0, fds', lclas', tyvars',context') <- RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([AddEpAnn], [GenLocated SrcSpanAnnA (FunDep GhcPs)],
   LocatedN RdrName, LHsQTyVars GhcPs,
   Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
top_matter
          an1 <- markEpAnnL    an0 lidl AnnOpenC
          an2 <- markEpAnnAllL' an1 lidl AnnSemi
          (sortKey', ds) <- withSortKey sortKey
                               [(ClsSigTag, prepareListAnnotationA sigs),
                                (ClsMethodTag, prepareListAnnotationA (bagToList methods)),
                                (ClsAtTag, prepareListAnnotationA ats),
                                (ClsAtdTag, prepareListAnnotationA at_defs)
                             -- ++ prepareListAnnotation docs
                               ]
          an3 <- markEpAnnL an2 lidl AnnCloseC
          let
            sigs'    = [Dynamic] -> [LocatedAn AnnListItem (Sig GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            methods' = [LocatedAn AnnListItem (HsBind GhcPs)]
-> Bag (LocatedAn AnnListItem (HsBind GhcPs))
forall a. [a] -> Bag a
listToBag ([LocatedAn AnnListItem (HsBind GhcPs)]
 -> Bag (LocatedAn AnnListItem (HsBind GhcPs)))
-> [LocatedAn AnnListItem (HsBind GhcPs)]
-> Bag (LocatedAn AnnListItem (HsBind GhcPs))
forall a b. (a -> b) -> a -> b
$ [Dynamic] -> [LocatedAn AnnListItem (HsBind GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            ats'     = [Dynamic] -> [LocatedAn AnnListItem (FamilyDecl GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            at_defs' = [Dynamic] -> [LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
          return (ClassDecl {tcdCExt = (an3, lo, sortKey'),
                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',
                             tcdFixity = fixity,
                             tcdFDs  = fds',
                             tcdSigs = sigs', tcdMeths = methods',
                             tcdATs = ats', tcdATDefs = at_defs',
                             tcdDocs = _docs})
      where
        top_matter :: RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([AddEpAnn], [GenLocated SrcSpanAnnA (FunDep GhcPs)],
   LocatedN RdrName, LHsQTyVars GhcPs,
   Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
top_matter = do
          an' <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> [AnnKeywordId]
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a
annotationsToComments [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl  [AnnKeywordId
AnnOpenP, AnnKeywordId
AnnCloseP]
          an0 <- markEpAnnL an' lidl AnnClass
          (_, lclas', tyvars',_,context') <-  exactVanillaDeclHead lclas tyvars fixity context
          (an1, fds') <- if (null fds)
            then return (an0, fds)
            else do
              an1 <- markEpAnnL an0 lidl AnnVbar
              fds' <- markAnnotated fds
              return (an1, fds')
          an2 <- markEpAnnL an1 lidl AnnWhere
          return (an2, fds', lclas', tyvars',context')


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

instance ExactPrint (FunDep GhcPs) where
  getAnnotationEntry :: FunDep GhcPs -> Entry
getAnnotationEntry FunDep GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: FunDep GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> FunDep GhcPs
setAnnotationAnchor FunDep GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = FunDep GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
FunDep GhcPs -> EP w m (FunDep GhcPs)
exact (FunDep XCFunDep GhcPs
an [LIdP GhcPs]
ls [LIdP GhcPs]
rs') = do
    ls' <- [LocatedN RdrName] -> EP w m [LocatedN RdrName]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
ls
    an0 <- markEpAnnL an lidl AnnRarrow
    rs'' <- markAnnotated rs'
    return (FunDep an0 ls' rs'')

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

instance ExactPrint (FamilyDecl GhcPs) where
  getAnnotationEntry :: FamilyDecl GhcPs -> Entry
getAnnotationEntry FamilyDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: FamilyDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> FamilyDecl GhcPs
setAnnotationAnchor FamilyDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = FamilyDecl GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
FamilyDecl GhcPs -> EP w m (FamilyDecl GhcPs)
exact (FamilyDecl { fdExt :: forall pass. FamilyDecl pass -> XCFamilyDecl pass
fdExt = XCFamilyDecl GhcPs
an
                    , fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo GhcPs
info
                    , fdTopLevel :: forall pass. FamilyDecl pass -> TopLevelFlag
fdTopLevel = TopLevelFlag
top_level
                    , fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName = LIdP GhcPs
ltycon
                    , fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars = LHsQTyVars GhcPs
tyvars
                    , fdFixity :: forall pass. FamilyDecl pass -> LexicalFixity
fdFixity = LexicalFixity
fixity
                    , fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L EpAnn NoEpAnns
lr FamilyResultSig GhcPs
result
                    , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn GhcPs)
mb_inj }) = do
    an0 <- [AddEpAnn] -> FamilyInfo GhcPs -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> FamilyInfo GhcPs -> EP w m [AddEpAnn]
exactFlavour [AddEpAnn]
XCFamilyDecl GhcPs
an FamilyInfo GhcPs
info
    an1 <- exact_top_level an0
    an2 <- annotationsToComments an1 lidl [AnnOpenP,AnnCloseP]
    (_, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing
    (an3, result') <- exact_kind an2
    (an4, mb_inj') <-
      case mb_inj of
        Maybe (LInjectivityAnn GhcPs)
Nothing -> ([AddEpAnn],
 Maybe (GenLocated (EpAnn NoEpAnns) (InjectivityAnn GhcPs)))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn],
      Maybe (GenLocated (EpAnn NoEpAnns) (InjectivityAnn GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AddEpAnn]
an3, Maybe (LInjectivityAnn GhcPs)
Maybe (GenLocated (EpAnn NoEpAnns) (InjectivityAnn GhcPs))
mb_inj)
        Just LInjectivityAnn GhcPs
inj -> do
          an4 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an3 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnVbar
          inj' <- markAnnotated inj
          return (an4, Just inj')
    (an5, info') <-
             case info of
               ClosedTypeFamily Maybe [LTyFamInstEqn GhcPs]
mb_eqns -> do
                 an5 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an4 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnWhere
                 an6 <- markEpAnnL an5 lidl AnnOpenC
                 (an7, mb_eqns') <-
                   case mb_eqns of
                     Maybe [LTyFamInstEqn GhcPs]
Nothing -> do
                       an7 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an6 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDotdot
                       return (an7, mb_eqns)
                     Just [LTyFamInstEqn GhcPs]
eqns -> do
                       eqns' <- [GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LTyFamInstEqn GhcPs]
[GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
eqns
                       return (an6, Just eqns')
                 an8 <- markEpAnnL an7 lidl AnnCloseC
                 return (an8, ClosedTypeFamily mb_eqns')
               FamilyInfo GhcPs
_ -> ([AddEpAnn], FamilyInfo GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn], FamilyInfo GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AddEpAnn]
an4, FamilyInfo GhcPs
info)
    return (FamilyDecl { fdExt = an5
                       , fdInfo = info'
                       , fdTopLevel = top_level
                       , fdLName = ltycon'
                       , fdTyVars = tyvars'
                       , fdFixity = fixity
                       , fdResultSig = L lr result'
                       , fdInjectivityAnn = mb_inj' })
    where
      exact_top_level :: [AddEpAnn] -> EP w m [AddEpAnn]
exact_top_level [AddEpAnn]
an' =
        case TopLevelFlag
top_level of
          TopLevelFlag
TopLevel    -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnFamily
          TopLevelFlag
NotTopLevel -> do
            -- It seems that in some kind of legacy
            -- mode the 'family' keyword is still
            -- accepted.
            [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnFamily

      exact_kind :: [AddEpAnn]
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn], FamilyResultSig GhcPs)
exact_kind [AddEpAnn]
an' =
        case FamilyResultSig GhcPs
result of
          NoSig    XNoSig GhcPs
_         -> ([AddEpAnn], FamilyResultSig GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn], FamilyResultSig GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AddEpAnn]
an', FamilyResultSig GhcPs
result)
          KindSig  XCKindSig GhcPs
x LHsType GhcPs
kind    -> do
            an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDcolon
            kind' <- markAnnotated kind
            return (an0, KindSig  x kind')
          TyVarSig XTyVarSig GhcPs
x LHsTyVarBndr () GhcPs
tv_bndr -> do
            an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnEqual
            tv_bndr' <- markAnnotated tv_bndr
            return (an0, TyVarSig x tv_bndr')


exactFlavour :: (Monad m, Monoid w) => [AddEpAnn] -> FamilyInfo GhcPs -> EP w m [AddEpAnn]
exactFlavour :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> FamilyInfo GhcPs -> EP w m [AddEpAnn]
exactFlavour [AddEpAnn]
an FamilyInfo GhcPs
DataFamily            = [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnData
exactFlavour [AddEpAnn]
an FamilyInfo GhcPs
OpenTypeFamily        = [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnType
exactFlavour [AddEpAnn]
an (ClosedTypeFamily {}) = [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnType

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

exactDataDefn
  :: (Monad m, Monoid w)
  => [AddEpAnn]
  -> (Maybe (LHsContext GhcPs) -> EP w m ([AddEpAnn]
                                         , LocatedN RdrName
                                         , a
                                         , b
                                         , Maybe (LHsContext GhcPs))) -- Printing the header
  -> HsDataDefn GhcPs
  -> EP w m ( [AddEpAnn] -- ^ from exactHdr
            , [AddEpAnn] -- ^ updated one passed in
            , LocatedN RdrName, a, b, HsDataDefn GhcPs)
exactDataDefn :: forall (m :: * -> *) w a b.
(Monad m, Monoid w) =>
[AddEpAnn]
-> (Maybe (LHsContext GhcPs)
    -> EP
         w m ([AddEpAnn], LocatedN RdrName, a, b, Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP
     w
     m
     ([AddEpAnn], [AddEpAnn], LocatedN RdrName, a, b, HsDataDefn GhcPs)
exactDataDefn [AddEpAnn]
an Maybe (LHsContext GhcPs)
-> EP
     w m ([AddEpAnn], LocatedN RdrName, a, b, Maybe (LHsContext GhcPs))
exactHdr
                 (HsDataDefn { dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn pass
dd_ext = XCHsDataDefn GhcPs
x, dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ctxt = Maybe (LHsContext GhcPs)
context
                             , dd_cType :: forall pass. HsDataDefn pass -> Maybe (XRec pass CType)
dd_cType = Maybe (XRec GhcPs CType)
mb_ct
                             , dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (LHsType GhcPs)
mb_sig
                             , dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons = DataDefnCons (LConDecl GhcPs)
condecls, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs = HsDeriving GhcPs
derivings }) = do

  an' <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn]
-> [AnnKeywordId]
-> EP w m [AddEpAnn]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a
annotationsToComments [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl [AnnKeywordId
AnnOpenP, AnnKeywordId
AnnCloseP]

  an0 <- case condecls of
    DataTypeCons Bool
is_type_data [LConDecl GhcPs]
_ -> do
      an0' <- if Bool
is_type_data
                then [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnType
                else [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
an'
      markEpAnnL an0' lidl AnnData
    NewTypeCon   LConDecl GhcPs
_ -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an' ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnNewtype

  an1 <- markEpAnnL an0 lidl AnnInstance -- optional
  mb_ct' <- mapM markAnnotated mb_ct
  (anx, ln', tvs', b, context') <- exactHdr context
  (an2, mb_sig') <- case mb_sig of
    Maybe (LHsType GhcPs)
Nothing -> ([AddEpAnn], Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     ([AddEpAnn], Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AddEpAnn]
an1, Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. Maybe a
Nothing)
    Just LHsType GhcPs
kind -> do
      an2 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an1 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDcolon
      kind' <- markAnnotated kind
      return (an2, Just kind')
  an3 <- if (needsWhere condecls)
    then markEpAnnL an2 lidl AnnWhere
    else return an2
  an4 <- markEpAnnL an3 lidl AnnOpenC
  (an5, condecls') <- exact_condecls an4 (toList condecls)
  let condecls'' = case DataDefnCons (LConDecl GhcPs)
condecls of
        DataTypeCons Bool
d [LConDecl GhcPs]
_ -> Bool
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. Bool -> [a] -> DataDefnCons a
DataTypeCons Bool
d [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
condecls'
        NewTypeCon LConDecl GhcPs
_     -> case [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
condecls' of
          [GenLocated SrcSpanAnnA (ConDecl GhcPs)
decl] -> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. a -> DataDefnCons a
NewTypeCon GenLocated SrcSpanAnnA (ConDecl GhcPs)
decl
          [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
_ -> String -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. HasCallStack => String -> a
panic String
"exacprint NewTypeCon"
  an6 <- markEpAnnL an5 lidl AnnCloseC
  derivings' <- mapM markAnnotated derivings
  return (anx, an6, ln', tvs', b,
                 (HsDataDefn { dd_ext = x, dd_ctxt = context'
                             , dd_cType = mb_ct'
                             , dd_kindSig = mb_sig'
                             , dd_cons = condecls'', dd_derivs = derivings' }))


exactVanillaDeclHead :: (Monad m, Monoid w)
                     => LocatedN RdrName
                     -> LHsQTyVars GhcPs
                     -> LexicalFixity
                     -> Maybe (LHsContext GhcPs)
                     -> EP w m ( [AddEpAnn]
                               , LocatedN RdrName
                               , LHsQTyVars GhcPs
                               , (), Maybe (LHsContext GhcPs))
exactVanillaDeclHead :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ([AddEpAnn], LocatedN RdrName, LHsQTyVars GhcPs, (),
      Maybe (LHsContext GhcPs))
exactVanillaDeclHead LocatedN RdrName
thing tvs :: LHsQTyVars GhcPs
tvs@(HsQTvs { hsq_explicit :: forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsq_explicit = [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
tyvars }) LexicalFixity
fixity Maybe (LHsContext GhcPs)
context = do
  let
    exact_tyvars :: [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (LocatedN RdrName,
      [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)])
exact_tyvars (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
varl:[GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
varsr)
      | GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
hvarsr : tvarsr :: [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
tvarsr@(GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
_ : [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
_) <- [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
varsr
      , LexicalFixity
fixity LexicalFixity -> LexicalFixity -> Bool
forall a. Eq a => a -> a -> Bool
== LexicalFixity
Infix = do
          varl' <- GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> EP
     w m (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
varl
          thing' <- markAnnotated thing
          hvarsr' <- markAnnotated hvarsr
          tvarsr' <- markAnnotated tvarsr
          return (thing', varl':hvarsr':tvarsr')
      | LexicalFixity
fixity LexicalFixity -> LexicalFixity -> Bool
forall a. Eq a => a -> a -> Bool
== LexicalFixity
Infix = do
          varl' <- GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> EP
     w m (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
varl
          thing' <- markAnnotated thing
          varsr' <- markAnnotated varsr
          return (thing', varl':varsr')
      | Bool
otherwise = do
          thing' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LocatedN RdrName
thing
          vs <- mapM markAnnotated (varl:varsr)
          return (thing', vs)
    exact_tyvars [] = do
      thing' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LocatedN RdrName
thing
      return (thing', [])
  context' <- (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe
        (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
context
  (thing', tyvars') <- exact_tyvars tyvars
  return (noAnn, thing', tvs { hsq_explicit = tyvars' }, (), context')

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

instance ExactPrint (InjectivityAnn GhcPs) where
  getAnnotationEntry :: InjectivityAnn GhcPs -> Entry
getAnnotationEntry InjectivityAnn GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: InjectivityAnn GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> InjectivityAnn GhcPs
setAnnotationAnchor InjectivityAnn GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = InjectivityAnn GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
InjectivityAnn GhcPs -> EP w m (InjectivityAnn GhcPs)
exact (InjectivityAnn XCInjectivityAnn GhcPs
an LIdP GhcPs
lhs [LIdP GhcPs]
rhs) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XCInjectivityAnn GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnVbar
    lhs' <- markAnnotated lhs
    an1 <- markEpAnnL an0 lidl AnnRarrow
    rhs' <- mapM markAnnotated rhs
    return (InjectivityAnn an1 lhs' rhs')

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

class Typeable flag => ExactPrintTVFlag flag where
  exactTVDelimiters :: (Monad m, Monoid w)
    => [AddEpAnn] -> flag
    -> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
    -> EP w m ([AddEpAnn], flag, (HsTyVarBndr flag GhcPs))

instance ExactPrintTVFlag () where
  exactTVDelimiters :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> ()
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr () GhcPs))
-> EP w m ([AddEpAnn], (), HsTyVarBndr () GhcPs)
exactTVDelimiters [AddEpAnn]
an ()
flag [AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr () GhcPs)
thing_inside = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnAllL' [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
forall a (f :: * -> *). Functor f => (a -> f a) -> a -> f a
Lens [AddEpAnn] [AddEpAnn]
lid AnnKeywordId
AnnOpenP
    (an1, r) <- thing_inside an0
    an2 <- markEpAnnAllL' an1 lid AnnCloseP
    return (an2, flag, r)

instance ExactPrintTVFlag Specificity where
  exactTVDelimiters :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> Specificity
-> ([AddEpAnn]
    -> EP w m ([AddEpAnn], HsTyVarBndr Specificity GhcPs))
-> EP w m ([AddEpAnn], Specificity, HsTyVarBndr Specificity GhcPs)
exactTVDelimiters [AddEpAnn]
an Specificity
s [AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr Specificity GhcPs)
thing_inside = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnAllL' [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
forall a (f :: * -> *). Functor f => (a -> f a) -> a -> f a
Lens [AddEpAnn] [AddEpAnn]
lid AnnKeywordId
open
    (an1, r) <- thing_inside an0
    an2 <- markEpAnnAllL' an1 lid close
    return (an2, s, r)
    where
      (AnnKeywordId
open, AnnKeywordId
close) = case Specificity
s of
        Specificity
SpecifiedSpec -> (AnnKeywordId
AnnOpenP, AnnKeywordId
AnnCloseP)
        Specificity
InferredSpec  -> (AnnKeywordId
AnnOpenC, AnnKeywordId
AnnCloseC)

instance ExactPrintTVFlag (HsBndrVis GhcPs) where
  exactTVDelimiters :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> HsBndrVis GhcPs
-> ([AddEpAnn]
    -> EP w m ([AddEpAnn], HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> EP
     w
     m
     ([AddEpAnn], HsBndrVis GhcPs, HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
exactTVDelimiters [AddEpAnn]
an0 HsBndrVis GhcPs
bvis [AddEpAnn]
-> EP w m ([AddEpAnn], HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
thing_inside = do
    bvis' <- case HsBndrVis GhcPs
bvis of
      HsBndrRequired XBndrRequired GhcPs
_ -> HsBndrVis GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsBndrVis GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsBndrVis GhcPs
bvis
      HsBndrInvisible XBndrInvisible GhcPs
at -> EpToken "@" -> HsBndrVis GhcPs
XBndrInvisible GhcPs -> HsBndrVis GhcPs
forall pass. XBndrInvisible pass -> HsBndrVis pass
HsBndrInvisible (EpToken "@" -> HsBndrVis GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "@")
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsBndrVis GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "@"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "@")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "@"
XBndrInvisible GhcPs
at
    an1 <- markEpAnnAllL' an0 lid AnnOpenP
    (an2, r) <- thing_inside an1
    an3 <- markEpAnnAllL' an2 lid AnnCloseP
    return (an3, bvis', r)

instance ExactPrintTVFlag flag => ExactPrint (HsTyVarBndr flag GhcPs) where
  getAnnotationEntry :: HsTyVarBndr flag GhcPs -> Entry
getAnnotationEntry HsTyVarBndr flag GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsTyVarBndr flag GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsTyVarBndr flag GhcPs
setAnnotationAnchor HsTyVarBndr flag GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsTyVarBndr flag GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsTyVarBndr flag GhcPs -> EP w m (HsTyVarBndr flag GhcPs)
exact (UserTyVar XUserTyVar GhcPs
an flag
flag LIdP GhcPs
n) = do
    r <- [AddEpAnn]
-> flag
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
-> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
forall flag (m :: * -> *) w.
(ExactPrintTVFlag flag, Monad m, Monoid w) =>
[AddEpAnn]
-> flag
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
-> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> flag
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
-> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
exactTVDelimiters [AddEpAnn]
XUserTyVar GhcPs
an flag
flag (([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
 -> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs))
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
-> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
forall a b. (a -> b) -> a -> b
$ \[AddEpAnn]
ani -> do
           n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
           return (ani, UserTyVar an flag n')
    case r of
      ([AddEpAnn]
an', flag
flag', UserTyVar XUserTyVar GhcPs
_ flag
_ LIdP GhcPs
n'') -> HsTyVarBndr flag GhcPs
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (HsTyVarBndr flag GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XUserTyVar GhcPs -> flag -> LIdP GhcPs -> HsTyVarBndr flag GhcPs
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar [AddEpAnn]
XUserTyVar GhcPs
an' flag
flag' LIdP GhcPs
n'')
      ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
_ -> String
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (HsTyVarBndr flag GhcPs)
forall a. HasCallStack => String -> a
error String
"KindedTyVar should never happen here"
  exact (KindedTyVar XKindedTyVar GhcPs
an flag
flag LIdP GhcPs
n LHsType GhcPs
k) = do
    r <- [AddEpAnn]
-> flag
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
-> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
forall flag (m :: * -> *) w.
(ExactPrintTVFlag flag, Monad m, Monoid w) =>
[AddEpAnn]
-> flag
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
-> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> flag
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
-> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
exactTVDelimiters [AddEpAnn]
XKindedTyVar GhcPs
an flag
flag (([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
 -> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs))
-> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))
-> EP w m ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
forall a b. (a -> b) -> a -> b
$ \[AddEpAnn]
ani -> do
          n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
          an0 <- markEpAnnL ani lidl AnnDcolon
          k' <- markAnnotated k
          return (an0, KindedTyVar an0 flag n' k')
    case r of
      ([AddEpAnn]
an',flag
flag', KindedTyVar XKindedTyVar GhcPs
_ flag
_ LIdP GhcPs
n'' LHsType GhcPs
k'') -> HsTyVarBndr flag GhcPs
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (HsTyVarBndr flag GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XKindedTyVar GhcPs
-> flag -> LIdP GhcPs -> LHsType GhcPs -> HsTyVarBndr flag GhcPs
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar [AddEpAnn]
XKindedTyVar GhcPs
an' flag
flag' LIdP GhcPs
n'' LHsType GhcPs
k'')
      ([AddEpAnn], flag, HsTyVarBndr flag GhcPs)
_ -> String
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (HsTyVarBndr flag GhcPs)
forall a. HasCallStack => String -> a
error String
"UserTyVar should never happen here"

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

instance ExactPrint (HsType GhcPs) where
  getAnnotationEntry :: HsType GhcPs -> Entry
getAnnotationEntry HsType GhcPs
_         = Entry
NoEntryVal
  setAnnotationAnchor :: HsType GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsType GhcPs
setAnnotationAnchor HsType GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_s = HsType GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsType GhcPs -> EP w m (HsType GhcPs)
exact (HsForAllTy { hst_xforall :: forall pass. HsType pass -> XForAllTy pass
hst_xforall = XForAllTy GhcPs
an
                    , hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope GhcPs
tele, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
ty }) = do
    tele' <- HsForAllTelescope GhcPs -> EP w m (HsForAllTelescope GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsForAllTelescope GhcPs
tele
    ty' <- markAnnotated ty
    return (HsForAllTy { hst_xforall = an
                       , hst_tele = tele', hst_body = ty' })

  exact (HsQualTy XQualTy GhcPs
an LHsContext GhcPs
ctxt LHsType GhcPs
ty) = do
    ctxt' <- GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> EP
     w
     m
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt
    ty' <- markAnnotated ty
    return (HsQualTy an ctxt' ty')
  exact (HsTyVar XTyVar GhcPs
an PromotionFlag
promoted LIdP GhcPs
name) = do
    an0 <- if (PromotionFlag
promoted PromotionFlag -> PromotionFlag -> Bool
forall a. Eq a => a -> a -> Bool
== PromotionFlag
IsPromoted)
             then [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XTyVar GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnSimpleQuote
             else [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
XTyVar GhcPs
an
    name' <- markAnnotated name
    return (HsTyVar an0 promoted name')
  exact (HsAppTy XAppTy GhcPs
an LHsType GhcPs
t1 LHsType GhcPs
t2) = do
    t1' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1
    t2' <- markAnnotated t2
    return (HsAppTy an t1' t2')
  exact (HsAppKindTy XAppKindTy GhcPs
at LHsType GhcPs
ty LHsType GhcPs
ki) = do
    ty' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    at' <- markEpToken at
    ki' <- markAnnotated ki
    return (HsAppKindTy at' ty' ki')
  exact (HsFunTy XFunTy GhcPs
an HsArrow GhcPs
mult LHsType GhcPs
ty1 LHsType GhcPs
ty2) = do
    ty1' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty1
    mult' <- markArrow mult
    ty2' <- markAnnotated ty2
    return (HsFunTy an mult' ty1' ty2')
  exact (HsListTy XListTy GhcPs
an LHsType GhcPs
tys) = do
    an0 <- AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen XListTy GhcPs
AnnParen
an
    tys' <- markAnnotated tys
    an1 <- markClosingParen an0
    return (HsListTy an1 tys')
  exact (HsTupleTy XTupleTy GhcPs
an HsTupleSort
con [LHsType GhcPs]
tys) = do
    an0 <- AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen XTupleTy GhcPs
AnnParen
an
    tys' <- markAnnotated tys
    an1 <- markClosingParen an0
    return (HsTupleTy an1 con tys')
  exact (HsSumTy XSumTy GhcPs
an [LHsType GhcPs]
tys) = do
    an0 <- AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen XSumTy GhcPs
AnnParen
an
    tys' <- markAnnotated tys
    an1 <- markClosingParen an0
    return (HsSumTy an1 tys')
  exact (HsOpTy XOpTy GhcPs
an PromotionFlag
promoted LHsType GhcPs
t1 LIdP GhcPs
lo LHsType GhcPs
t2) = do
    an0 <- if (PromotionFlag -> Bool
isPromoted PromotionFlag
promoted)
        then [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XOpTy GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnSimpleQuote
        else [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
XOpTy GhcPs
an
    t1' <- markAnnotated t1
    lo' <- markAnnotated lo
    t2' <- markAnnotated t2
    return (HsOpTy an0 promoted t1' lo' t2')
  exact (HsParTy XParTy GhcPs
an LHsType GhcPs
ty) = do
    an0 <- AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen XParTy GhcPs
AnnParen
an
    ty' <- markAnnotated ty
    an1 <- markClosingParen an0
    return (HsParTy an1 ty')
  exact (HsIParamTy XIParamTy GhcPs
an XRec GhcPs HsIPName
n LHsType GhcPs
t) = do
    n' <- GenLocated (EpAnn NoEpAnns) HsIPName
-> EP w m (GenLocated (EpAnn NoEpAnns) HsIPName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs HsIPName
GenLocated (EpAnn NoEpAnns) HsIPName
n
    an0 <- markEpAnnL an lidl AnnDcolon
    t' <- markAnnotated t
    return (HsIParamTy an0 n' t')
  exact (HsStarTy XStarTy GhcPs
an Bool
isUnicode) = do
    if Bool
isUnicode
        then String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
"\x2605" -- Unicode star
        else String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
"*"
    HsType GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XStarTy GhcPs -> Bool -> HsType GhcPs
forall pass. XStarTy pass -> Bool -> HsType pass
HsStarTy XStarTy GhcPs
an Bool
isUnicode)
  exact (HsKindSig XKindSig GhcPs
an LHsType GhcPs
ty LHsType GhcPs
k) = do
    ty' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    an0 <- markEpAnnL an lidl AnnDcolon
    k' <- markAnnotated k
    return (HsKindSig an0 ty' k')
  exact (HsSpliceTy XSpliceTy GhcPs
a HsUntypedSplice GhcPs
splice) = do
    splice' <- HsUntypedSplice GhcPs -> EP w m (HsUntypedSplice GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsUntypedSplice GhcPs
splice
    return (HsSpliceTy a splice')
  exact (HsDocTy XDocTy GhcPs
an LHsType GhcPs
ty LHsDoc GhcPs
doc) = do
    ty' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    return (HsDocTy an ty' doc)
  exact (HsBangTy XBangTy GhcPs
an (HsSrcBang SourceText
mt SrcUnpackedness
up SrcStrictness
str) LHsType GhcPs
ty) = do
    an0 <-
      case SourceText
mt of
        SourceText
NoSourceText -> [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
XBangTy GhcPs
an
        SourceText FastString
src -> do
          String -> EP w m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ String
"HsBangTy: src=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FastString -> String
forall a. Data a => a -> String
showAst FastString
src
          an0 <- [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m [AddEpAnn]
markEpAnnMS' [AddEpAnn]
XBangTy GhcPs
an AnnKeywordId
AnnOpen  (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
src)
          an1 <- markEpAnnMS' an0 AnnClose (Just "#-}")
          debugM $ "HsBangTy: done unpackedness"
          return an1
    an1 <-
      case str of
        SrcStrictness
SrcLazy     -> [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
an0 AnnKeywordId
AnnTilde
        SrcStrictness
SrcStrict   -> [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
an0 AnnKeywordId
AnnBang
        SrcStrictness
NoSrcStrict -> [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
an0
    ty' <- markAnnotated ty
    return (HsBangTy an1 (HsSrcBang mt up str) ty')
  exact (HsExplicitListTy XExplicitListTy GhcPs
an PromotionFlag
prom [LHsType GhcPs]
tys) = do
    an0 <- if (PromotionFlag -> Bool
isPromoted PromotionFlag
prom)
             then [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
XExplicitListTy GhcPs
an AnnKeywordId
AnnSimpleQuote
             else [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
XExplicitListTy GhcPs
an
    an1 <- mark an0 AnnOpenS
    tys' <- markAnnotated tys
    an2 <- mark an1 AnnCloseS
    return (HsExplicitListTy an2 prom tys')
  exact (HsExplicitTupleTy XExplicitTupleTy GhcPs
an [LHsType GhcPs]
tys) = do
    an0 <- [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
mark [AddEpAnn]
XExplicitTupleTy GhcPs
an AnnKeywordId
AnnSimpleQuote
    an1 <- mark an0 AnnOpenP
    tys' <- markAnnotated tys
    an2 <- mark an1 AnnCloseP
    return (HsExplicitTupleTy an2 tys')
  exact (HsTyLit XTyLit GhcPs
a HsTyLit GhcPs
lit) = do
    case HsTyLit GhcPs
lit of
      (HsNumTy XNumTy GhcPs
src Integer
v) -> SourceText -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceText XNumTy GhcPs
SourceText
src (Integer -> String
forall a. Show a => a -> String
show Integer
v)
      (HsStrTy XStrTy GhcPs
src FastString
v) -> SourceText -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceText XStrTy GhcPs
SourceText
src (FastString -> String
forall a. Show a => a -> String
show FastString
v)
      (HsCharTy XCharTy GhcPs
src Char
v) -> SourceText -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceText XCharTy GhcPs
SourceText
src (Char -> String
forall a. Show a => a -> String
show Char
v)
    HsType GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTyLit GhcPs -> HsTyLit GhcPs -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit GhcPs
a HsTyLit GhcPs
lit)
  exact t :: HsType GhcPs
t@(HsWildCardTy XWildCardTy GhcPs
_) = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
"_" EP w m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsType GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsType GhcPs
t
  exact HsType GhcPs
x = String
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a. HasCallStack => String -> a
error (String
 -> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs))
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ String
"missing match for HsType:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsType GhcPs -> String
forall a. Data a => a -> String
showAst HsType GhcPs
x

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

instance ExactPrint (HsForAllTelescope GhcPs) where
  getAnnotationEntry :: HsForAllTelescope GhcPs -> Entry
getAnnotationEntry (HsForAllVis XHsForAllVis GhcPs
an [LHsTyVarBndr () GhcPs]
_)   = EpAnnForallTy -> Entry
forall a. HasEntry a => a -> Entry
fromAnn XHsForAllVis GhcPs
EpAnnForallTy
an
  getAnnotationEntry (HsForAllInvis XHsForAllInvis GhcPs
an [LHsTyVarBndr Specificity GhcPs]
_) = EpAnnForallTy -> Entry
forall a. HasEntry a => a -> Entry
fromAnn XHsForAllInvis GhcPs
EpAnnForallTy
an

  setAnnotationAnchor :: HsForAllTelescope GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsForAllTelescope GhcPs
setAnnotationAnchor (HsForAllVis XHsForAllVis GhcPs
an [LHsTyVarBndr () GhcPs]
a) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = XHsForAllVis GhcPs
-> [LHsTyVarBndr () GhcPs] -> HsForAllTelescope GhcPs
forall pass.
XHsForAllVis pass
-> [LHsTyVarBndr () pass] -> HsForAllTelescope pass
HsForAllVis (EpAnnForallTy
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnnForallTy
forall an.
HasTrailing an =>
EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa XHsForAllVis GhcPs
EpAnnForallTy
an Anchor
anc [TrailingAnn]
ts EpAnnComments
cs) [LHsTyVarBndr () GhcPs]
a
  setAnnotationAnchor (HsForAllInvis XHsForAllInvis GhcPs
an [LHsTyVarBndr Specificity GhcPs]
a) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = XHsForAllInvis GhcPs
-> [LHsTyVarBndr Specificity GhcPs] -> HsForAllTelescope GhcPs
forall pass.
XHsForAllInvis pass
-> [LHsTyVarBndr Specificity pass] -> HsForAllTelescope pass
HsForAllInvis (EpAnnForallTy
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnnForallTy
forall an.
HasTrailing an =>
EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa XHsForAllInvis GhcPs
EpAnnForallTy
an Anchor
anc [TrailingAnn]
ts EpAnnComments
cs) [LHsTyVarBndr Specificity GhcPs]
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsForAllTelescope GhcPs -> EP w m (HsForAllTelescope GhcPs)
exact (HsForAllVis XHsForAllVis GhcPs
an [LHsTyVarBndr () GhcPs]
bndrs)   = do
    an0 <- EpAnnForallTy
-> Lens (AddEpAnn, AddEpAnn) AddEpAnn -> EP w m EpAnnForallTy
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)
markLensAA XHsForAllVis GhcPs
EpAnnForallTy
an (AddEpAnn -> f AddEpAnn)
-> (AddEpAnn, AddEpAnn) -> f (AddEpAnn, AddEpAnn)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
Lens (AddEpAnn, AddEpAnn) AddEpAnn
lfst -- AnnForall
    bndrs' <- markAnnotated bndrs
    an1 <- markLensAA an0 lsnd -- AnnRarrow
    return (HsForAllVis an1 bndrs')

  exact (HsForAllInvis XHsForAllInvis GhcPs
an [LHsTyVarBndr Specificity GhcPs]
bndrs) = do
    an0 <- EpAnnForallTy
-> Lens (AddEpAnn, AddEpAnn) AddEpAnn -> EP w m EpAnnForallTy
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)
markLensAA XHsForAllInvis GhcPs
EpAnnForallTy
an (AddEpAnn -> f AddEpAnn)
-> (AddEpAnn, AddEpAnn) -> f (AddEpAnn, AddEpAnn)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
Lens (AddEpAnn, AddEpAnn) AddEpAnn
lfst -- AnnForall
    bndrs' <- markAnnotated bndrs
    an1 <- markLensAA an0 lsnd -- AnnDot
    return (HsForAllInvis an1 bndrs')

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

instance ExactPrint (HsDerivingClause GhcPs) where
  getAnnotationEntry :: HsDerivingClause GhcPs -> Entry
getAnnotationEntry HsDerivingClause GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsDerivingClause GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsDerivingClause GhcPs
setAnnotationAnchor HsDerivingClause GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsDerivingClause GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsDerivingClause GhcPs -> EP w m (HsDerivingClause GhcPs)
exact (HsDerivingClause { deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_ext      = XCHsDerivingClause GhcPs
an
                          , deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy = Maybe (LDerivStrategy GhcPs)
dcs
                          , deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_tys      = LDerivClauseTys GhcPs
dct }) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XCHsDerivingClause GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnDeriving
    dcs0 <- case dcs of
            Just (L EpAnn NoEpAnns
_ ViaStrategy{}) -> Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LDerivStrategy GhcPs)
Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
dcs
            Maybe (LDerivStrategy GhcPs)
_ -> (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
-> Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (LDerivStrategy GhcPs)
Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
dcs
    dct' <- markAnnotated dct
    dcs1 <- case dcs0 of
            Just (L EpAnn NoEpAnns
_ ViaStrategy{}) -> (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
-> Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
dcs0
            Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
_ -> Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
dcs0
    return (HsDerivingClause { deriv_clause_ext      = an0
                             , deriv_clause_strategy = dcs1
                             , deriv_clause_tys      = dct' })

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

instance ExactPrint (DerivStrategy GhcPs) where
  getAnnotationEntry :: DerivStrategy GhcPs -> Entry
getAnnotationEntry DerivStrategy GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: DerivStrategy GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> DerivStrategy GhcPs
setAnnotationAnchor DerivStrategy GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = DerivStrategy GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DerivStrategy GhcPs -> EP w m (DerivStrategy GhcPs)
exact (StockStrategy XStockStrategy GhcPs
an)    = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XStockStrategy GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
forall a (f :: * -> *). Functor f => (a -> f a) -> a -> f a
Lens [AddEpAnn] [AddEpAnn]
lid AnnKeywordId
AnnStock
    return (StockStrategy an0)
  exact (AnyclassStrategy XAnyClassStrategy GhcPs
an) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XAnyClassStrategy GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
forall a (f :: * -> *). Functor f => (a -> f a) -> a -> f a
Lens [AddEpAnn] [AddEpAnn]
lid AnnKeywordId
AnnAnyclass
    return (AnyclassStrategy an0)
  exact (NewtypeStrategy XNewtypeStrategy GhcPs
an)  = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XNewtypeStrategy GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
forall a (f :: * -> *). Functor f => (a -> f a) -> a -> f a
Lens [AddEpAnn] [AddEpAnn]
lid AnnKeywordId
AnnNewtype
    return (NewtypeStrategy an0)
  exact (ViaStrategy (XViaStrategyPs [AddEpAnn]
an LHsSigType GhcPs
ty)) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
forall a (f :: * -> *). Functor f => (a -> f a) -> a -> f a
Lens [AddEpAnn] [AddEpAnn]
lid AnnKeywordId
AnnVia
    ty' <- markAnnotated ty
    return (ViaStrategy (XViaStrategyPs an0 ty'))

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

instance (ExactPrint a) => ExactPrint (LocatedC a) where
  getAnnotationEntry :: LocatedC a -> Entry
getAnnotationEntry (L SrcSpanAnnC
sann a
_) = SrcSpanAnnC -> Entry
forall a. HasEntry a => a -> Entry
fromAnn SrcSpanAnnC
sann
  setAnnotationAnchor :: LocatedC a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedC a
setAnnotationAnchor = LocatedC a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedC a
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedC a -> EP w m (LocatedC a)
exact (L (EpAnn Anchor
anc (AnnContext Maybe (IsUnicodeSyntax, Anchor)
ma [Anchor]
opens [Anchor]
closes) EpAnnComments
cs) a
a) = do
    opens' <- (Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor)
-> [Anchor] -> RWST (EPOptions m w) (EPWriter w) EPState m [Anchor]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (AnnKeywordId
-> Anchor -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnKeywordId -> Anchor -> EP w m Anchor
markKwA AnnKeywordId
AnnOpenP) [Anchor]
opens
    a' <- markAnnotated a
    closes' <- mapM (markKwA AnnCloseP) closes
    return (L (EpAnn anc (AnnContext ma opens' closes') cs) a')

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

instance ExactPrint (DerivClauseTys GhcPs) where
  getAnnotationEntry :: DerivClauseTys GhcPs -> Entry
getAnnotationEntry = Entry -> DerivClauseTys GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: DerivClauseTys GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> DerivClauseTys GhcPs
setAnnotationAnchor DerivClauseTys GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = DerivClauseTys GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DerivClauseTys GhcPs -> EP w m (DerivClauseTys GhcPs)
exact (DctSingle XDctSingle GhcPs
x LHsSigType GhcPs
ty) = do
    ty' <- GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
    return (DctSingle x ty')
  exact (DctMulti XDctMulti GhcPs
x [LHsSigType GhcPs]
tys) = do
    tys' <- [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LHsSigType GhcPs]
[GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys
    return (DctMulti x tys')

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

instance ExactPrint (HsSigType GhcPs) where
  getAnnotationEntry :: HsSigType GhcPs -> Entry
getAnnotationEntry = Entry -> HsSigType GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsSigType GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsSigType GhcPs
setAnnotationAnchor HsSigType GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsSigType GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsSigType GhcPs -> EP w m (HsSigType GhcPs)
exact (HsSig XHsSig GhcPs
a HsOuterSigTyVarBndrs GhcPs
bndrs LHsType GhcPs
ty) = do
    bndrs' <- HsOuterSigTyVarBndrs GhcPs -> EP w m (HsOuterSigTyVarBndrs GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsOuterSigTyVarBndrs GhcPs
bndrs
    ty' <- markAnnotated ty
    return (HsSig a bndrs' ty')

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

instance ExactPrint (LocatedN RdrName) where
  getAnnotationEntry :: LocatedN RdrName -> Entry
getAnnotationEntry (L SrcSpanAnnN
sann RdrName
_) = SrcSpanAnnN -> Entry
forall a. HasEntry a => a -> Entry
fromAnn SrcSpanAnnN
sann
  setAnnotationAnchor :: LocatedN RdrName
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedN RdrName
setAnnotationAnchor = LocatedN RdrName
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedN RdrName
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedN RdrName -> EP w m (LocatedN RdrName)
exact (L (EpAnn Anchor
anc NameAnn
ann EpAnnComments
cs) RdrName
n) = do
    ann' <-
      case NameAnn
ann of
        NameAnn NameAdornment
a Anchor
o Anchor
l Anchor
c [TrailingAnn]
t -> do
          mn <- NameAdornment
-> Anchor
-> Maybe (Anchor, RdrName)
-> Anchor
-> EP w m (Anchor, Maybe (Anchor, RdrName), Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment
-> Anchor
-> Maybe (Anchor, RdrName)
-> Anchor
-> EP w m (Anchor, Maybe (Anchor, RdrName), Anchor)
markName NameAdornment
a Anchor
o ((Anchor, RdrName) -> Maybe (Anchor, RdrName)
forall a. a -> Maybe a
Just (Anchor
l,RdrName
n)) Anchor
c
          case mn of
            (Anchor
o', (Just (Anchor
l',RdrName
_n)), Anchor
c') -> do
              NameAnn -> RWST (EPOptions m w) (EPWriter w) EPState m NameAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameAdornment
-> Anchor -> Anchor -> Anchor -> [TrailingAnn] -> NameAnn
NameAnn NameAdornment
a Anchor
o' Anchor
l' Anchor
c' [TrailingAnn]
t)
            (Anchor, Maybe (Anchor, RdrName), Anchor)
_ -> String -> RWST (EPOptions m w) (EPWriter w) EPState m NameAnn
forall a. HasCallStack => String -> a
error String
"ExactPrint (LocatedN RdrName)"
        NameAnnCommas NameAdornment
a Anchor
o [Anchor]
commas Anchor
c [TrailingAnn]
t -> do
          let (AnnKeywordId
kwo,AnnKeywordId
kwc) = NameAdornment -> (AnnKeywordId, AnnKeywordId)
adornments NameAdornment
a
          (AddEpAnn _ o') <- CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
NoCaptureComments (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
kwo Anchor
o)
          commas' <- forM commas (\Anchor
loc -> AddEpAnn -> Anchor
locFromAdd (AddEpAnn -> Anchor)
-> EP w m AddEpAnn
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
NoCaptureComments (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
AnnComma Anchor
loc))
          (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)
          return (NameAnnCommas a o' commas' c' t)
        NameAnnBars NameAdornment
a Anchor
o [Anchor]
bars Anchor
c [TrailingAnn]
t -> do
          let (AnnKeywordId
kwo,AnnKeywordId
kwc) = NameAdornment -> (AnnKeywordId, AnnKeywordId)
adornments NameAdornment
a
          (AddEpAnn _ o') <- CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
NoCaptureComments (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
kwo Anchor
o)
          bars' <- forM bars (\Anchor
loc -> AddEpAnn -> Anchor
locFromAdd (AddEpAnn -> Anchor)
-> EP w m AddEpAnn
-> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
NoCaptureComments (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
AnnVbar Anchor
loc))
          (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)
          return (NameAnnBars a o' bars' c' t)
        NameAnnOnly NameAdornment
a Anchor
o Anchor
c [TrailingAnn]
t -> do
          (o',_,c') <- NameAdornment
-> Anchor
-> Maybe (Anchor, RdrName)
-> Anchor
-> EP w m (Anchor, Maybe (Anchor, RdrName), Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment
-> Anchor
-> Maybe (Anchor, RdrName)
-> Anchor
-> EP w m (Anchor, Maybe (Anchor, RdrName), Anchor)
markName NameAdornment
a Anchor
o Maybe (Anchor, RdrName)
forall a. Maybe a
Nothing Anchor
c
          return (NameAnnOnly a o' c' t)
        NameAnnRArrow Bool
unicode Maybe Anchor
o Anchor
nl Maybe Anchor
c [TrailingAnn]
t -> do
          o' <- case Maybe Anchor
o of
            Just Anchor
o0 -> do
              (AddEpAnn _ o') <- CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
NoCaptureComments (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenP Anchor
o0)
              return (Just o')
            Maybe Anchor
Nothing -> Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          (AddEpAnn _ nl') <-
            if unicode
              then markKwC NoCaptureComments (AddEpAnn AnnRarrowU nl)
              else markKwC NoCaptureComments (AddEpAnn AnnRarrow nl)
          c' <- case c of
            Just Anchor
c0 -> do
              (AddEpAnn _ c') <- CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
NoCaptureComments (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseP Anchor
c0)
              return (Just c')
            Maybe Anchor
Nothing -> Maybe Anchor
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          return (NameAnnRArrow unicode o' nl' c' t)
        NameAnnQuote Anchor
q SrcSpanAnnN
name [TrailingAnn]
t -> do
          String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"NameAnnQuote"
          (AddEpAnn _ q') <- CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
NoCaptureComments (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
AnnSimpleQuote Anchor
q)
          (L name' _) <- markAnnotated (L name n)
          return (NameAnnQuote q' name' t)
        NameAnnTrailing [TrailingAnn]
t -> do
          _anc' <- Anchor
-> RdrName -> RWST (EPOptions m w) (EPWriter w) EPState m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> RdrName -> EP w m Anchor
printUnicode Anchor
anc RdrName
n
          return (NameAnnTrailing t)
    return (L (EpAnn anc ann' cs) n)

locFromAdd :: AddEpAnn -> EpaLocation
locFromAdd :: AddEpAnn -> Anchor
locFromAdd (AddEpAnn AnnKeywordId
_ Anchor
loc) = Anchor
loc

printUnicode :: (Monad m, Monoid w) => Anchor -> RdrName -> EP w m Anchor
printUnicode :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> RdrName -> EP w m Anchor
printUnicode Anchor
anc RdrName
n = do
  let str :: String
str = case (RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe RdrName
n) of
            -- TODO: unicode support?
              String
"forall" -> if RealSrcSpan -> Int
spanLength (Anchor -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor Anchor
anc) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"∀" else String
"forall"
              String
s -> String
s
  loc <- CaptureComments -> Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> Anchor -> String -> EP w m Anchor
printStringAtAAC CaptureComments
NoCaptureComments (DeltaPos -> [LEpaComment] -> Anchor
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) []) String
str
  case loc of
    EpaSpan SrcSpan
_ -> Anchor -> EP w m Anchor
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Anchor
anc
    EpaDelta DeltaPos
dp [] -> Anchor -> EP w m Anchor
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Anchor -> EP w m Anchor) -> Anchor -> EP w m Anchor
forall a b. (a -> b) -> a -> b
$ DeltaPos -> [LEpaComment] -> Anchor
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp []
    EpaDelta DeltaPos
_ [LEpaComment]
_cs -> String -> EP w m Anchor
forall a. HasCallStack => String -> a
error String
"printUnicode should not capture comments"


markName :: (Monad m, Monoid w)
  => NameAdornment -> EpaLocation -> Maybe (EpaLocation,RdrName) -> EpaLocation
  -> EP w m (EpaLocation, Maybe (EpaLocation,RdrName), EpaLocation)
markName :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment
-> Anchor
-> Maybe (Anchor, RdrName)
-> Anchor
-> EP w m (Anchor, Maybe (Anchor, RdrName), Anchor)
markName NameAdornment
adorn Anchor
open Maybe (Anchor, RdrName)
mname Anchor
close = do
  let (AnnKeywordId
kwo,AnnKeywordId
kwc) = NameAdornment -> (AnnKeywordId, AnnKeywordId)
adornments NameAdornment
adorn
  (AddEpAnn _ open') <- CaptureComments -> AddEpAnn -> EP w m AddEpAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> AddEpAnn -> EP w m AddEpAnn
markKwC CaptureComments
CaptureComments (AnnKeywordId -> Anchor -> AddEpAnn
AddEpAnn AnnKeywordId
kwo Anchor
open)
  mname' <-
    case mname of
      Maybe (Anchor, RdrName)
Nothing -> Maybe (Anchor, RdrName)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (Anchor, RdrName))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor, RdrName)
forall a. Maybe a
Nothing
      Just (Anchor
name, RdrName
a) -> do
        name' <- CaptureComments -> Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> Anchor -> String -> EP w m Anchor
printStringAtAAC CaptureComments
CaptureComments Anchor
name (RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe RdrName
a)
        return (Just (name',a))
  (AddEpAnn _ close') <- markKwC CaptureComments (AddEpAnn kwc close)
  return (open', mname', close')

adornments :: NameAdornment -> (AnnKeywordId, AnnKeywordId)
adornments :: NameAdornment -> (AnnKeywordId, AnnKeywordId)
adornments NameAdornment
NameParens     = (AnnKeywordId
AnnOpenP, AnnKeywordId
AnnCloseP)
adornments NameAdornment
NameParensHash = (AnnKeywordId
AnnOpenPH, AnnKeywordId
AnnClosePH)
adornments NameAdornment
NameBackquotes = (AnnKeywordId
AnnBackquote, AnnKeywordId
AnnBackquote)
adornments NameAdornment
NameSquare     = (AnnKeywordId
AnnOpenS, AnnKeywordId
AnnCloseS)

markTrailing :: (Monad m, Monoid w) => [TrailingAnn] -> EP w m [TrailingAnn]
markTrailing :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[TrailingAnn] -> EP w m [TrailingAnn]
markTrailing [TrailingAnn]
ts = do
  p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  debugM $ "markTrailing:" ++ showPprUnsafe (p,ts)
  mapM markKwT ts

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

-- based on pp_condecls in Decls.hs
exact_condecls :: (Monad m, Monoid w)
  => [AddEpAnn] -> [LConDecl GhcPs] -> EP w m ([AddEpAnn],[LConDecl GhcPs])
exact_condecls :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[AddEpAnn]
-> [LConDecl GhcPs] -> EP w m ([AddEpAnn], [LConDecl GhcPs])
exact_condecls [AddEpAnn]
an [LConDecl GhcPs]
cs
  | Bool
gadt_syntax                  -- In GADT syntax
  = do
      cs' <- (GenLocated SrcSpanAnnA (ConDecl GhcPs)
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
cs
      return (an, cs')
  | Bool
otherwise                    -- In H98 syntax
  = do
      an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnEqual
      cs' <- mapM markAnnotated cs
      return (an0, cs')
  where
    gadt_syntax :: Bool
gadt_syntax = case [LConDecl GhcPs]
cs of
      []                      -> Bool
False
      (L SrcSpanAnnA
_ ConDeclH98{}  : [LConDecl GhcPs]
_) -> Bool
False
      (L SrcSpanAnnA
_ ConDeclGADT{} : [LConDecl GhcPs]
_) -> Bool
True

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

instance ExactPrint (ConDecl GhcPs) where
  getAnnotationEntry :: ConDecl GhcPs -> Entry
getAnnotationEntry ConDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: ConDecl GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> ConDecl GhcPs
setAnnotationAnchor ConDecl GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = ConDecl GhcPs
a

-- based on pprConDecl
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ConDecl GhcPs -> EP w m (ConDecl GhcPs)
exact (ConDeclH98 { con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_ext = XConDeclH98 GhcPs
an
                    , con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = LIdP GhcPs
con
                    , con_forall :: forall pass. ConDecl pass -> Bool
con_forall = Bool
has_forall
                    , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity GhcPs]
ex_tvs
                    , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcPs)
mcxt
                    , con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details GhcPs
args
                    , con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_doc = Maybe (LHsDoc GhcPs)
doc }) = do
    an0 <- if Bool
has_forall
      then [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XConDeclH98 GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnForall
      else [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
XConDeclH98 GhcPs
an
    ex_tvs' <- mapM markAnnotated ex_tvs
    an1 <- if has_forall
      then markEpAnnL an0 lidl AnnDot
      else return an0
    mcxt' <- mapM markAnnotated mcxt
    an2 <- if (isJust mcxt)
      then markEpAnnL an1 lidl AnnDarrow
      else return an1

    (con', args') <- exact_details args
    return (ConDeclH98 { con_ext = an2
                       , con_name = con'
                       , con_forall = has_forall
                       , con_ex_tvs = ex_tvs'
                       , con_mb_cxt = mcxt'
                       , con_args = args'
                       , con_doc = doc })

    where
    -- In ppr_details: let's not print the multiplicities (they are always 1, by
    -- definition) as they do not appear in an actual declaration.
      exact_details :: HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (LocatedN RdrName,
      HsConDetails
        Void
        (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
        (GenLocated
           (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]))
exact_details (InfixCon HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t1 HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t2) = do
        t1' <- HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> EP w m (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t1
        con' <- markAnnotated con
        t2' <- markAnnotated t2
        return (con', InfixCon t1' t2')
      exact_details (PrefixCon [Void]
tyargs [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
tys) = do
        con' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
con
        tyargs' <- markAnnotated tyargs
        tys' <- markAnnotated tys
        return (con', PrefixCon tyargs' tys')
      exact_details (RecCon GenLocated
  (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields) = do
        con' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
con
        fields' <- markAnnotated fields
        return (con', RecCon fields')

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

  exact (ConDeclGADT { con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_g_ext = (EpUniToken "::" "\8759"
dcol, [AddEpAnn]
an)
                     , con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names = NonEmpty (LIdP GhcPs)
cons
                     , con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_bndrs = XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
bndrs
                     , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcPs)
mcxt, con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails GhcPs
args
                     , con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty = LHsType GhcPs
res_ty, con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_doc = Maybe (LHsDoc GhcPs)
doc }) = do
    cons' <- (LocatedN RdrName -> EP w m (LocatedN RdrName))
-> NonEmpty (LocatedN RdrName)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (NonEmpty (LocatedN RdrName))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated NonEmpty (LIdP GhcPs)
NonEmpty (LocatedN RdrName)
cons
    dcol' <- markEpUniToken dcol
    an1 <- annotationsToComments an lidl  [AnnOpenP, AnnCloseP]

    -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558
    bndrs' <- case bndrs of
      L SrcSpanAnnA
_ (HsOuterImplicit XHsOuterImplicit GhcPs
_) -> GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
bndrs
      XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
_ -> GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
bndrs

    mcxt' <- mapM markAnnotated mcxt
    an2 <- if (isJust mcxt)
      then markEpAnnL an1 lidl AnnDarrow
      else return an1
    args' <-
      case args of
          (PrefixConGADT XPrefixConGADT GhcPs
x [HsScaled GhcPs (LHsType GhcPs)]
args0) -> do
            args0' <- (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> EP w m (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> EP w m [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> EP w m (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [HsScaled GhcPs (LHsType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
args0
            return (PrefixConGADT x args0')
          (RecConGADT XRecConGADT GhcPs
rarr XRec GhcPs [LConDeclField GhcPs]
fields) -> do
            fields' <- GenLocated
  (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> EP
     w
     m
     (GenLocated
        (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs [LConDeclField GhcPs]
GenLocated
  (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields
            rarr' <- markEpUniToken rarr
            return (RecConGADT rarr' fields')
    res_ty' <- markAnnotated res_ty
    return (ConDeclGADT { con_g_ext = (dcol', an2)
                        , con_names = cons'
                        , con_bndrs = bndrs'
                        , con_mb_cxt = mcxt', con_g_args = args'
                        , con_res_ty = res_ty', con_doc = doc })

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

instance ExactPrint Void where
  getAnnotationEntry :: Void -> Entry
getAnnotationEntry = Entry -> Void -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: Void -> Anchor -> [TrailingAnn] -> EpAnnComments -> Void
setAnnotationAnchor Void
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = Void
a
  exact :: forall (m :: * -> *) w. (Monad m, Monoid w) => Void -> EP w m Void
exact Void
x = Void -> RWST (EPOptions m w) (EPWriter w) EPState m Void
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Void
x

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

instance ExactPrintTVFlag flag => ExactPrint (HsOuterTyVarBndrs flag GhcPs) where
  getAnnotationEntry :: HsOuterTyVarBndrs flag GhcPs -> Entry
getAnnotationEntry (HsOuterImplicit XHsOuterImplicit GhcPs
_) = Entry
NoEntryVal
  getAnnotationEntry (HsOuterExplicit XHsOuterExplicit GhcPs flag
an [LHsTyVarBndr flag (NoGhcTc GhcPs)]
_) = EpAnnForallTy -> Entry
forall a. HasEntry a => a -> Entry
fromAnn XHsOuterExplicit GhcPs flag
EpAnnForallTy
an

  setAnnotationAnchor :: HsOuterTyVarBndrs flag GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> HsOuterTyVarBndrs flag GhcPs
setAnnotationAnchor (HsOuterImplicit XHsOuterImplicit GhcPs
a) Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = XHsOuterImplicit GhcPs -> HsOuterTyVarBndrs flag GhcPs
forall flag pass.
XHsOuterImplicit pass -> HsOuterTyVarBndrs flag pass
HsOuterImplicit XHsOuterImplicit GhcPs
a
  setAnnotationAnchor (HsOuterExplicit XHsOuterExplicit GhcPs flag
an [LHsTyVarBndr flag (NoGhcTc GhcPs)]
a) Anchor
anc [TrailingAnn]
ts EpAnnComments
cs = XHsOuterExplicit GhcPs flag
-> [LHsTyVarBndr flag (NoGhcTc GhcPs)]
-> HsOuterTyVarBndrs flag GhcPs
forall flag pass.
XHsOuterExplicit pass flag
-> [LHsTyVarBndr flag (NoGhcTc pass)]
-> HsOuterTyVarBndrs flag pass
HsOuterExplicit (EpAnnForallTy
-> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnnForallTy
forall an.
HasTrailing an =>
EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa XHsOuterExplicit GhcPs flag
EpAnnForallTy
an Anchor
anc [TrailingAnn]
ts EpAnnComments
cs) [LHsTyVarBndr flag (NoGhcTc GhcPs)]
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsOuterTyVarBndrs flag GhcPs
-> EP w m (HsOuterTyVarBndrs flag GhcPs)
exact b :: HsOuterTyVarBndrs flag GhcPs
b@(HsOuterImplicit XHsOuterImplicit GhcPs
_) = HsOuterTyVarBndrs flag GhcPs
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (HsOuterTyVarBndrs flag GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsOuterTyVarBndrs flag GhcPs
b
  exact (HsOuterExplicit XHsOuterExplicit GhcPs flag
an [LHsTyVarBndr flag (NoGhcTc GhcPs)]
bndrs) = do
    an0 <- EpAnnForallTy
-> Lens (AddEpAnn, AddEpAnn) AddEpAnn -> EP w m EpAnnForallTy
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)
markLensAA XHsOuterExplicit GhcPs flag
EpAnnForallTy
an (AddEpAnn -> f AddEpAnn)
-> (AddEpAnn, AddEpAnn) -> f (AddEpAnn, AddEpAnn)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> (a, a) -> f (a, a)
Lens (AddEpAnn, AddEpAnn) AddEpAnn
lfst -- "forall"
    bndrs' <- markAnnotated bndrs
    an1 <- markLensAA an0 lsnd -- "."
    return (HsOuterExplicit an1 bndrs')

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

instance ExactPrint (ConDeclField GhcPs) where
  getAnnotationEntry :: ConDeclField GhcPs -> Entry
getAnnotationEntry ConDeclField GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: ConDeclField GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> ConDeclField GhcPs
setAnnotationAnchor ConDeclField GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = ConDeclField GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ConDeclField GhcPs -> EP w m (ConDeclField GhcPs)
exact (ConDeclField XConDeclField GhcPs
an [LFieldOcc GhcPs]
names LHsType GhcPs
ftype Maybe (LHsDoc GhcPs)
mdoc) = do
    names' <- [GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LFieldOcc GhcPs]
[GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
names
    an0 <- markEpAnnL an lidl AnnDcolon
    ftype' <- markAnnotated ftype
    return (ConDeclField an0 names' ftype' mdoc)

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

instance ExactPrint (FieldOcc GhcPs) where
  getAnnotationEntry :: FieldOcc GhcPs -> Entry
getAnnotationEntry = Entry -> FieldOcc GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: FieldOcc GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> FieldOcc GhcPs
setAnnotationAnchor FieldOcc GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = FieldOcc GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
FieldOcc GhcPs -> EP w m (FieldOcc GhcPs)
exact (FieldOcc XCFieldOcc GhcPs
x XRec GhcPs RdrName
n) = do
      n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs RdrName
LocatedN RdrName
n
      return (FieldOcc x n')

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

instance ExactPrint (AmbiguousFieldOcc GhcPs) where
  getAnnotationEntry :: AmbiguousFieldOcc GhcPs -> Entry
getAnnotationEntry = Entry -> AmbiguousFieldOcc GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: AmbiguousFieldOcc GhcPs
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> AmbiguousFieldOcc GhcPs
setAnnotationAnchor AmbiguousFieldOcc GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = AmbiguousFieldOcc GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AmbiguousFieldOcc GhcPs -> EP w m (AmbiguousFieldOcc GhcPs)
exact f :: AmbiguousFieldOcc GhcPs
f@(Unambiguous XUnambiguous GhcPs
_ XRec GhcPs RdrName
n) = LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs RdrName
LocatedN RdrName
n EP w m (LocatedN RdrName)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AmbiguousFieldOcc GhcPs)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AmbiguousFieldOcc GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AmbiguousFieldOcc GhcPs
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AmbiguousFieldOcc GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return AmbiguousFieldOcc GhcPs
f
  exact f :: AmbiguousFieldOcc GhcPs
f@(Ambiguous   XAmbiguous GhcPs
_ XRec GhcPs RdrName
n) = LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs RdrName
LocatedN RdrName
n EP w m (LocatedN RdrName)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AmbiguousFieldOcc GhcPs)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AmbiguousFieldOcc GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AmbiguousFieldOcc GhcPs
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (AmbiguousFieldOcc GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return AmbiguousFieldOcc GhcPs
f

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

instance (ExactPrint a) => ExactPrint (HsScaled GhcPs a) where
  getAnnotationEntry :: HsScaled GhcPs a -> Entry
getAnnotationEntry = Entry -> HsScaled GhcPs a -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsScaled GhcPs a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsScaled GhcPs a
setAnnotationAnchor HsScaled GhcPs a
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsScaled GhcPs a
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsScaled GhcPs a -> EP w m (HsScaled GhcPs a)
exact (HsScaled HsArrow GhcPs
arr a
t) = do
    t' <- a -> EP w m a
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated a
t
    arr' <- markArrow arr
    return (HsScaled arr' t')

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

instance ExactPrint (LocatedP CType) where
  getAnnotationEntry :: GenLocated (EpAnn AnnPragma) CType -> Entry
getAnnotationEntry = GenLocated (EpAnn AnnPragma) CType -> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: GenLocated (EpAnn AnnPragma) CType
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated (EpAnn AnnPragma) CType
setAnnotationAnchor = GenLocated (EpAnn AnnPragma) CType
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated (EpAnn AnnPragma) CType
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated (EpAnn AnnPragma) CType
-> EP w m (GenLocated (EpAnn AnnPragma) CType)
exact (L EpAnn AnnPragma
an (CType SourceText
stp Maybe Header
mh (SourceText
stct,FastString
ct))) = do
    an0 <- EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)
markAnnOpenP EpAnn AnnPragma
an SourceText
stp String
"{-# CTYPE"
    an1 <- case mh of
             Maybe Header
Nothing -> EpAnn AnnPragma -> EP w m (EpAnn AnnPragma)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnn AnnPragma
an0
             Just (Header SourceText
srcH FastString
_h) ->
               EpAnn AnnPragma
-> Lens AnnPragma [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn AnnPragma)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a
-> Lens a [AddEpAnn]
-> AnnKeywordId
-> Maybe String
-> EP w m (EpAnn a)
markEpAnnLMS EpAnn AnnPragma
an0 ([AddEpAnn] -> f [AddEpAnn]) -> AnnPragma -> f AnnPragma
Lens AnnPragma [AddEpAnn]
lapr_rest AnnKeywordId
AnnHeader (String -> Maybe String
forall a. a -> Maybe a
Just (SourceText -> String -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
srcH String
"" String
""))
    an2 <- markEpAnnLMS an1 lapr_rest AnnVal (Just (toSourceTextWithSuffix stct (unpackFS ct) ""))
    an3 <- markAnnCloseP an2
    return (L an3 (CType stp mh (stct,ct)))

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

instance ExactPrint (SourceText, RuleName) where
  -- We end up at the right place from the Located wrapper
  getAnnotationEntry :: (SourceText, FastString) -> Entry
getAnnotationEntry = Entry -> (SourceText, FastString) -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: (SourceText, FastString)
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> (SourceText, FastString)
setAnnotationAnchor (SourceText, FastString)
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = (SourceText, FastString)
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
(SourceText, FastString) -> EP w m (SourceText, FastString)
exact (SourceText
st, FastString
rn)
    = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (SourceText -> String -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
st (FastString -> String
unpackFS FastString
rn) String
"")
      EP w m ()
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (SourceText, FastString)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (SourceText, FastString)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SourceText, FastString)
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (SourceText, FastString)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText
st, FastString
rn)


-- =====================================================================
-- LocatedL instances start --
--
-- Each is dealt with specifically, as they have
-- different wrapping annotations in the al_rest zone.
--
-- In future, the annotation could perhaps be improved, with an
-- 'al_pre' and 'al_post' set of annotations to be simply sorted and
-- applied.
-- ---------------------------------------------------------------------

instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where
  getAnnotationEntry :: GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Entry
getAnnotationEntry = GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
setAnnotationAnchor = GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> EP
     w
     m
     (GenLocated (EpAnn AnnList) [GenLocated SrcSpanAnnA (IE GhcPs)])
exact (L EpAnn AnnList
an [GenLocated SrcSpanAnnA (IE GhcPs)]
ies) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LIE"
    an0 <- EpAnn AnnList
-> Lens AnnList [AddEpAnn]
-> AnnKeywordId
-> EP w m (EpAnn AnnList)
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
EpAnn ann
-> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnL' EpAnn AnnList
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
AnnHiding
    p <- getPosP
    debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p
    (an1, ies') <- markAnnList an0 (markAnnotated (filter notIEDoc ies))
    return (L an1 ies')

instance (ExactPrint (Match GhcPs (LocatedA body)))
   => ExactPrint (LocatedL [LocatedA (Match GhcPs (LocatedA body))]) where
  getAnnotationEntry :: LocatedL [LocatedA (Match GhcPs (LocatedA body))] -> Entry
getAnnotationEntry = LocatedL [LocatedA (Match GhcPs (LocatedA body))] -> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: LocatedL [LocatedA (Match GhcPs (LocatedA body))]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> LocatedL [LocatedA (Match GhcPs (LocatedA body))]
setAnnotationAnchor = LocatedL [LocatedA (Match GhcPs (LocatedA body))]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> LocatedL [LocatedA (Match GhcPs (LocatedA body))]
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedL [LocatedA (Match GhcPs (LocatedA body))]
-> EP w m (LocatedL [LocatedA (Match GhcPs (LocatedA body))])
exact (L EpAnn AnnList
an [LocatedA (Match GhcPs (LocatedA body))]
a) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LMatch"
    -- TODO: markAnnList?
    an0 <- EpAnn AnnList
-> Lens AnnList [AddEpAnn]
-> AnnKeywordId
-> EP w m (EpAnn AnnList)
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
EpAnn ann
-> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)
markEpAnnAllL EpAnn AnnList
an ([AddEpAnn] -> f [AddEpAnn]) -> AnnList -> f AnnList
Lens AnnList [AddEpAnn]
lal_rest AnnKeywordId
AnnWhere
    an1 <- markLensMAA an0 lal_open
    an2 <- markEpAnnAllL an1 lal_rest AnnSemi
    a' <- markAnnotated a
    an3 <- markLensMAA an2 lal_close
    return (L an3 a')

instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]) where
  getAnnotationEntry :: LocatedL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Entry
getAnnotationEntry = LocatedL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: LocatedL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> LocatedL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
setAnnotationAnchor = LocatedL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> LocatedL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     (LocatedL
        [GenLocated
           SrcSpanAnnA
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
exact (L EpAnn AnnList
an [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [ExprLStmt"
    (an'', stmts') <- EpAnn AnnList
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     (EpAnn AnnList,
      [GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
markAnnList EpAnn AnnList
an (EP
   w
   m
   [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> EP
      w
      m
      (EpAnn AnnList,
       [GenLocated
          SrcSpanAnnA
          (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]))
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     (EpAnn AnnList,
      [GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a b. (a -> b) -> a -> b
$ do
      case [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Maybe
     ([GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
      GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. [a] -> Maybe ([a], a)
snocView [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts of
        Just ([GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
initStmts, ls :: GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ls@(L SrcSpanAnnA
_ (LastStmt XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
_body Maybe Bool
_ SyntaxExpr GhcPs
_))) -> do
          String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [ExprLStmt: snocView"
          ls' <- GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> EP
     w
     m
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ls
          initStmts' <- markAnnotated initStmts
          return (initStmts' ++ [ls'])
        Maybe
  ([GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
   GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
_ -> do
          [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
    return (L an'' stmts')

instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]) where
  getAnnotationEntry :: GenLocated
  (EpAnn AnnList)
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Entry
getAnnotationEntry = GenLocated
  (EpAnn AnnList)
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: GenLocated
  (EpAnn AnnList)
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated
     (EpAnn AnnList)
     [GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
setAnnotationAnchor = GenLocated
  (EpAnn AnnList)
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated
     (EpAnn AnnList)
     [GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated
  (EpAnn AnnList)
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> EP
     w
     m
     (GenLocated
        (EpAnn AnnList)
        [GenLocated
           SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))])
exact (L EpAnn AnnList
ann [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
es) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [CmdLStmt"
    an0 <- EpAnn AnnList
-> Lens AnnList (Maybe AddEpAnn) -> EP w m (EpAnn AnnList)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a (Maybe AddEpAnn) -> EP w m (EpAnn a)
markLensMAA EpAnn AnnList
ann (Maybe AddEpAnn -> f (Maybe AddEpAnn)) -> AnnList -> f AnnList
Lens AnnList (Maybe AddEpAnn)
lal_open
    es' <- mapM markAnnotated es
    an1 <- markLensMAA an0 lal_close
    return (L an1 es')

instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where
  getAnnotationEntry :: GenLocated
  (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Entry
getAnnotationEntry = GenLocated
  (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: GenLocated
  (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated
     (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
setAnnotationAnchor = GenLocated
  (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> GenLocated
     (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated
  (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> EP
     w
     m
     (GenLocated
        (EpAnn AnnList) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
exact (L EpAnn AnnList
an [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fs) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LConDeclField"
    (an', fs') <- EpAnn AnnList
-> EP w m [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> EP
     w m (EpAnn AnnList, [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
markAnnList EpAnn AnnList
an ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fs)
    return (L an' fs')

instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
  getAnnotationEntry :: LBooleanFormula (LocatedN RdrName) -> Entry
getAnnotationEntry = LBooleanFormula (LocatedN RdrName) -> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: LBooleanFormula (LocatedN RdrName)
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> LBooleanFormula (LocatedN RdrName)
setAnnotationAnchor = LBooleanFormula (LocatedN RdrName)
-> Anchor
-> [TrailingAnn]
-> EpAnnComments
-> LBooleanFormula (LocatedN RdrName)
forall an a.
HasTrailing an =>
LocatedAn an a
-> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LBooleanFormula (LocatedN RdrName)
-> EP w m (LBooleanFormula (LocatedN RdrName))
exact (L EpAnn AnnList
an BooleanFormula (LocatedN RdrName)
bf) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LBooleanFormula"
    (an', bf') <- EpAnn AnnList
-> EP w m (BooleanFormula (LocatedN RdrName))
-> EP w m (EpAnn AnnList, BooleanFormula (LocatedN RdrName))
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
markAnnList EpAnn AnnList
an (BooleanFormula (LocatedN RdrName)
-> EP w m (BooleanFormula (LocatedN RdrName))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated BooleanFormula (LocatedN RdrName)
bf)
    return (L an' bf')

-- ---------------------------------------------------------------------
-- LocatedL instances end --
-- =====================================================================

instance ExactPrint (IE GhcPs) where
  getAnnotationEntry :: IE GhcPs -> Entry
getAnnotationEntry IE GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: IE GhcPs -> Anchor -> [TrailingAnn] -> EpAnnComments -> IE GhcPs
setAnnotationAnchor IE GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = IE GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
IE GhcPs -> EP w m (IE GhcPs)
exact (IEVar XIEVar GhcPs
depr LIEWrappedName GhcPs
ln Maybe (LHsDoc GhcPs)
doc) = do
    depr' <- Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
XIEVar GhcPs
depr
    ln' <- markAnnotated ln
    doc' <- markAnnotated doc
    return (IEVar depr' ln' doc')
  exact (IEThingAbs (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
depr, [AddEpAnn]
an) LIEWrappedName GhcPs
thing Maybe (LHsDoc GhcPs)
doc) = do
    depr' <- Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
depr
    thing' <- markAnnotated thing
    doc' <- markAnnotated doc
    return (IEThingAbs (depr', an) thing' doc')
  exact (IEThingAll (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
depr, [AddEpAnn]
an) LIEWrappedName GhcPs
thing Maybe (LHsDoc GhcPs)
doc) = do
    depr' <- Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
depr
    thing' <- markAnnotated thing
    an0 <- markEpAnnL an  lidl AnnOpenP
    an1 <- markEpAnnL an0 lidl AnnDotdot
    an2 <- markEpAnnL an1 lidl AnnCloseP
    doc' <- markAnnotated doc
    return (IEThingAll (depr', an2) thing' doc')

  exact (IEThingWith (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
depr, [AddEpAnn]
an) LIEWrappedName GhcPs
thing IEWildcard
wc [LIEWrappedName GhcPs]
withs Maybe (LHsDoc GhcPs)
doc) = do
    depr' <- Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
depr
    thing' <- markAnnotated thing
    an0 <- markEpAnnL an lidl AnnOpenP
    (an1, wc', withs') <-
      case wc of
        IEWildcard
NoIEWildcard -> do
          withs'' <- [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
withs
          return (an0, wc, withs'')
        IEWildcard Int
pos -> do
          let ([GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
bs, [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
as) = Int
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> ([GenLocated SrcSpanAnnA (IEWrappedName GhcPs)],
    [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
withs
          bs' <- [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
bs
          an1 <- markEpAnnL an0 lidl AnnDotdot
          an2 <- markEpAnnL an1 lidl AnnComma
          as' <- markAnnotated as
          return (an2, wc, bs'++as')
    an2 <- markEpAnnL an1 lidl AnnCloseP
    doc' <- markAnnotated doc
    return (IEThingWith (depr', an2) thing' wc' withs' doc')

  exact (IEModuleContents (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
depr, [AddEpAnn]
an) XRec GhcPs ModuleName
m) = do
    depr' <- Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated (EpAnn AnnPragma) (WarningTxt GhcPs))
depr
    an0 <- markEpAnnL an lidl AnnModule
    m' <- markAnnotated m
    return (IEModuleContents (depr', an0) m')

  -- These three exist to not error out, but are no-ops The contents
  -- appear as "normal" comments too, which we process instead.
  exact (IEGroup XIEGroup GhcPs
x Int
lev LHsDoc GhcPs
doc) = do
    IE GhcPs -> RWST (EPOptions m w) (EPWriter w) EPState m (IE GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XIEGroup GhcPs -> Int -> LHsDoc GhcPs -> IE GhcPs
forall pass. XIEGroup pass -> Int -> ExportDoc pass -> IE pass
IEGroup XIEGroup GhcPs
x Int
lev LHsDoc GhcPs
doc)
  exact (IEDoc XIEDoc GhcPs
x LHsDoc GhcPs
doc) = do
    IE GhcPs -> RWST (EPOptions m w) (EPWriter w) EPState m (IE GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XIEDoc GhcPs -> LHsDoc GhcPs -> IE GhcPs
forall pass. XIEDoc pass -> ExportDoc pass -> IE pass
IEDoc XIEDoc GhcPs
x LHsDoc GhcPs
doc)
  exact (IEDocNamed XIEDocNamed GhcPs
x String
str) = do
    IE GhcPs -> RWST (EPOptions m w) (EPWriter w) EPState m (IE GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XIEDocNamed GhcPs -> String -> IE GhcPs
forall pass. XIEDocNamed pass -> String -> IE pass
IEDocNamed XIEDocNamed GhcPs
x String
str)

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

instance ExactPrint (IEWrappedName GhcPs) where
  getAnnotationEntry :: IEWrappedName GhcPs -> Entry
getAnnotationEntry = Entry -> IEWrappedName GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: IEWrappedName GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> IEWrappedName GhcPs
setAnnotationAnchor IEWrappedName GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = IEWrappedName GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
IEWrappedName GhcPs -> EP w m (IEWrappedName GhcPs)
exact (IEName XIEName GhcPs
x LIdP GhcPs
n) = do
    n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    return (IEName x n')
  exact (IEPattern XIEPattern GhcPs
r LIdP GhcPs
n) = do
    r' <- Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA XIEPattern GhcPs
Anchor
r String
"pattern"
    n' <- markAnnotated n
    return (IEPattern r' n')
  exact (IEType XIEType GhcPs
r LIdP GhcPs
n) = do
    r' <- Anchor -> String -> EP w m Anchor
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Anchor -> String -> EP w m Anchor
printStringAtAA XIEType GhcPs
Anchor
r String
"type"
    n' <- markAnnotated n
    return (IEType r' n')

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

instance ExactPrint (Pat GhcPs) where
  getAnnotationEntry :: Pat GhcPs -> Entry
getAnnotationEntry Pat GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: Pat GhcPs -> Anchor -> [TrailingAnn] -> EpAnnComments -> Pat GhcPs
setAnnotationAnchor Pat GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = Pat GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Pat GhcPs -> EP w m (Pat GhcPs)
exact (WildPat XWildPat GhcPs
w) = do
    anchor' <- EP w m RealSrcSpan
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU
    debugM $ "WildPat:anchor'=" ++ show anchor'
    _ <- printStringAtRs anchor' "_"
    return (WildPat w)
  exact (VarPat XVarPat GhcPs
x LIdP GhcPs
n) = do
    -- The parser inserts a placeholder value for a record pun rhs. This must be
    -- filtered.
    let pun_RDR :: String
pun_RDR = String
"pun-right-hand-side"
    n' <- if (LocatedN RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe LIdP GhcPs
LocatedN RdrName
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
pun_RDR)
      then LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
      else LocatedN RdrName -> EP w m (LocatedN RdrName)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return LIdP GhcPs
LocatedN RdrName
n
    return (VarPat x n')
  exact (LazyPat XLazyPat GhcPs
an LPat GhcPs
pat) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XLazyPat GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnTilde
    pat' <- markAnnotated pat
    return (LazyPat an0 pat')
  exact (AsPat XAsPat GhcPs
at LIdP GhcPs
n LPat GhcPs
pat) = do
    n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    at' <- markEpToken at
    pat' <- markAnnotated pat
    return (AsPat at' n' pat')
  exact (ParPat (EpToken "("
lpar, EpToken ")"
rpar) LPat GhcPs
pat) = do
    lpar' <- EpToken "(" -> EP w m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "("
lpar
    pat' <- markAnnotated pat
    rpar' <- markEpToken rpar
    return (ParPat (lpar', rpar') pat')

  exact (BangPat XBangPat GhcPs
an LPat GhcPs
pat) = do
    an0 <- [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XBangPat GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnBang
    pat' <- markAnnotated pat
    return (BangPat an0 pat')

  exact (ListPat XListPat GhcPs
an [LPat GhcPs]
pats) = do
    (an', pats') <- AnnList
-> EP w m [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> EP w m (AnnList, [GenLocated SrcSpanAnnA (Pat GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
AnnList -> EP w m a -> EP w m (AnnList, a)
markAnnList' XListPat GhcPs
AnnList
an ([GenLocated SrcSpanAnnA (Pat GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats)
    return (ListPat an' pats')

  exact (TuplePat XTuplePat GhcPs
an [LPat GhcPs]
pats Boxity
boxity) = do
    an0 <- case Boxity
boxity of
             Boxity
Boxed   -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XTuplePat GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenP
             Boxity
Unboxed -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XTuplePat GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnOpenPH
    pats' <- markAnnotated pats
    an1 <- case boxity of
             Boxity
Boxed   -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an0 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnCloseP
             Boxity
Unboxed -> [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
an0 ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnClosePH
    return (TuplePat an1 pats' boxity)

  exact (SumPat XSumPat GhcPs
an LPat GhcPs
pat Int
alt Int
arity) = do
    an0 <- EpAnnSumPat
-> Lens EpAnnSumPat [AddEpAnn]
-> AnnKeywordId
-> EP w m EpAnnSumPat
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL XSumPat GhcPs
EpAnnSumPat
an ([AddEpAnn] -> f [AddEpAnn]) -> EpAnnSumPat -> f EpAnnSumPat
Lens EpAnnSumPat [AddEpAnn]
lsumPatParens AnnKeywordId
AnnOpenPH
    an1 <- markAnnKwAllL an0 lsumPatVbarsBefore AnnVbar
    pat' <- markAnnotated pat
    an2 <- markAnnKwAllL an1 lsumPatVbarsAfter AnnVbar
    an3 <- markEpAnnL an2 lsumPatParens AnnClosePH
    return (SumPat an3 pat' alt arity)

  exact (ConPat XConPat GhcPs
an XRec GhcPs (ConLikeP GhcPs)
con HsConPatDetails GhcPs
details) = do
    (an', con', details') <- [AddEpAnn]
-> LocatedN RdrName
-> HsConPatDetails GhcPs
-> EP w m ([AddEpAnn], LocatedN RdrName, HsConPatDetails GhcPs)
forall (m :: * -> *) w con.
(Monad m, Monoid w, ExactPrint con) =>
[AddEpAnn]
-> con
-> HsConPatDetails GhcPs
-> EP w m ([AddEpAnn], con, HsConPatDetails GhcPs)
exactUserCon [AddEpAnn]
XConPat GhcPs
an XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con HsConPatDetails GhcPs
details
    return (ConPat an' con' details')
  exact (ViewPat XViewPat GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr LPat GhcPs
pat) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    an0 <- markEpAnnL an lidl AnnRarrow
    pat' <- markAnnotated pat
    return (ViewPat an0 expr' pat')
  exact (SplicePat XSplicePat GhcPs
x HsUntypedSplice GhcPs
splice) = do
    splice' <- HsUntypedSplice GhcPs -> EP w m (HsUntypedSplice GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsUntypedSplice GhcPs
splice
    return (SplicePat x splice')
  exact p :: Pat GhcPs
p@(LitPat XLitPat GhcPs
_ HsLit GhcPs
lit) = String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (HsLit GhcPs -> String
hsLit2String HsLit GhcPs
lit) RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m (Pat GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (Pat GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pat GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (Pat GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pat GhcPs
p
  exact (NPat XNPat GhcPs
an XRec GhcPs (HsOverLit GhcPs)
ol Maybe (SyntaxExpr GhcPs)
mn SyntaxExpr GhcPs
z) = do
    an0 <- if (Maybe NoExtField -> Bool
forall a. Maybe a -> Bool
isJust Maybe NoExtField
Maybe (SyntaxExpr GhcPs)
mn)
      then [AddEpAnn]
-> Lens [AddEpAnn] [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]
forall (m :: * -> *) w ann.
(Monad m, Monoid w) =>
ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann
markEpAnnL [AddEpAnn]
XNPat GhcPs
an ([AddEpAnn] -> f [AddEpAnn]) -> [AddEpAnn] -> f [AddEpAnn]
Lens [AddEpAnn] [AddEpAnn]
lidl AnnKeywordId
AnnMinus
      else [AddEpAnn] -> EP w m [AddEpAnn]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [AddEpAnn]
XNPat GhcPs
an
    ol' <- markAnnotated ol
    return (NPat an0 ol' mn z)

  exact (NPlusKPat XNPlusKPat GhcPs
an LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
k HsOverLit GhcPs
lit2 SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b) = do
    n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    an' <- printStringAtAAL an lid "+"
    k' <- markAnnotated k
    return (NPlusKPat an' n' k' lit2 a b)

  exact (SigPat XSigPat GhcPs
an LPat GhcPs
pat HsPatSigType (NoGhcTc GhcPs)
sig) = do
    pat' <- GenLocated SrcSpanAnnA (Pat GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
    an0 <- markEpAnnL an lidl AnnDcolon
    sig' <- markAnnotated sig
    return (SigPat an0 pat' sig')

  exact (EmbTyPat XEmbTyPat GhcPs
toktype HsTyPat (NoGhcTc GhcPs)
tp) = do
    toktype' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XEmbTyPat GhcPs
EpToken "type"
toktype
    tp' <- markAnnotated tp
    return (EmbTyPat toktype' tp')

  exact (InvisPat XInvisPat GhcPs
tokat HsTyPat (NoGhcTc GhcPs)
tp) = do
    tokat' <- EpToken "@" -> EP w m (EpToken "@")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XInvisPat GhcPs
EpToken "@"
tokat
    tp' <- markAnnotated tp
    pure (InvisPat tokat' tp')

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

-- Note: Keep this section, for backport to GHC 9.10

-- instance ExactPrint (ArgPat GhcPs) where
--   getAnnotationEntry (VisPat _ pat) = getAnnotationEntry pat
--   getAnnotationEntry InvisPat{}     = NoEntryVal

--   setAnnotationAnchor (VisPat x pat) anc ts cs = VisPat x (setAnnotationAnchor pat anc ts cs)
--   setAnnotationAnchor a@(InvisPat _ _) _ _ _   = a

--   exact (VisPat x pat) = do
--     pat' <- markAnnotated pat
--     pure (VisPat x pat')

--   exact (InvisPat tokat tp) = do
--     tokat' <- markEpToken tokat
--     tp' <- markAnnotated tp
--     pure (InvisPat tokat' tp')

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

instance ExactPrint (HsPatSigType GhcPs) where
  getAnnotationEntry :: HsPatSigType GhcPs -> Entry
getAnnotationEntry = Entry -> HsPatSigType GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsPatSigType GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsPatSigType GhcPs
setAnnotationAnchor HsPatSigType GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsPatSigType GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsPatSigType GhcPs -> EP w m (HsPatSigType GhcPs)
exact (HsPS XHsPS GhcPs
an LHsType GhcPs
ty) = do
    ty' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    return (HsPS an ty')

instance ExactPrint (HsTyPat GhcPs) where
  getAnnotationEntry :: HsTyPat GhcPs -> Entry
getAnnotationEntry = Entry -> HsTyPat GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsTyPat GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsTyPat GhcPs
setAnnotationAnchor HsTyPat GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsTyPat GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsTyPat GhcPs -> EP w m (HsTyPat GhcPs)
exact (HsTP XHsTP GhcPs
an LHsType GhcPs
ty) = do
    ty' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    return (HsTP an ty')

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

instance ExactPrint (HsOverLit GhcPs) where
  getAnnotationEntry :: HsOverLit GhcPs -> Entry
getAnnotationEntry = Entry -> HsOverLit GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  setAnnotationAnchor :: HsOverLit GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsOverLit GhcPs
setAnnotationAnchor HsOverLit GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsOverLit GhcPs
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsOverLit GhcPs -> EP w m (HsOverLit GhcPs)
exact HsOverLit GhcPs
ol =
    let str :: SourceText
str = case HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
ol of
                HsIntegral   (IL SourceText
src Bool
_ Integer
_) -> SourceText
src
                HsFractional (FL{ fl_text :: FractionalLit -> SourceText
fl_text = SourceText
src }) -> SourceText
src
                HsIsString SourceText
src FastString
_ -> SourceText
src
    in
      case SourceText
str of
        SourceText FastString
s -> String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (FastString -> String
unpackFS FastString
s) EP w m () -> EP w m (HsOverLit GhcPs) -> EP w m (HsOverLit GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsOverLit GhcPs -> EP w m (HsOverLit GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsOverLit GhcPs
ol
        SourceText
NoSourceText -> HsOverLit GhcPs -> EP w m (HsOverLit GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsOverLit GhcPs
ol

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

hsLit2String :: HsLit GhcPs -> String
hsLit2String :: HsLit GhcPs -> String
hsLit2String HsLit GhcPs
lit =
  case HsLit GhcPs
lit of
    HsChar       XHsChar GhcPs
src Char
v   -> SourceText -> Char -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsChar GhcPs
SourceText
src Char
v String
""
    HsCharPrim   XHsCharPrim GhcPs
src Char
p   -> SourceText -> Char -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsCharPrim GhcPs
SourceText
src Char
p String
""
    HsString     XHsString GhcPs
src FastString
v   -> SourceText -> FastString -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsString GhcPs
SourceText
src FastString
v String
""
    HsStringPrim XHsStringPrim GhcPs
src ByteString
v   -> SourceText -> ByteString -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsStringPrim GhcPs
SourceText
src ByteString
v String
""
    HsInt        XHsInt GhcPs
_ (IL SourceText
src Bool
_ Integer
v)   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
src Integer
v String
""
    HsIntPrim    XHsIntPrim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsIntPrim GhcPs
SourceText
src Integer
v String
""
    HsWordPrim   XHsWordPrim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsWordPrim GhcPs
SourceText
src Integer
v String
""
    HsInt8Prim   XHsInt8Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsInt8Prim GhcPs
SourceText
src Integer
v String
""
    HsInt16Prim  XHsInt16Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsInt16Prim GhcPs
SourceText
src Integer
v String
""
    HsInt32Prim  XHsInt32Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsInt32Prim GhcPs
SourceText
src Integer
v String
""
    HsInt64Prim  XHsInt64Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsInt64Prim GhcPs
SourceText
src Integer
v String
""
    HsWord8Prim  XHsWord8Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsWord8Prim GhcPs
SourceText
src Integer
v String
""
    HsWord16Prim XHsWord16Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsWord16Prim GhcPs
SourceText
src Integer
v String
""
    HsWord32Prim XHsWord32Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsWord32Prim GhcPs
SourceText
src Integer
v String
""
    HsWord64Prim XHsWord64Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsWord64Prim GhcPs
SourceText
src Integer
v String
""
    HsInteger    XHsInteger GhcPs
src Integer
v Type
_ -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsInteger GhcPs
SourceText
src Integer
v String
""
    HsRat        XHsRat GhcPs
_ fl :: FractionalLit
fl@(FL{fl_text :: FractionalLit -> SourceText
fl_text = SourceText
src }) Type
_ -> SourceText -> FractionalLit -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
src FractionalLit
fl String
""
    HsFloatPrim  XHsFloatPrim GhcPs
_ fl :: FractionalLit
fl@(FL{fl_text :: FractionalLit -> SourceText
fl_text = SourceText
src })   -> SourceText -> FractionalLit -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
src FractionalLit
fl String
"#"
    HsDoublePrim XHsDoublePrim GhcPs
_ fl :: FractionalLit
fl@(FL{fl_text :: FractionalLit -> SourceText
fl_text = SourceText
src })   -> SourceText -> FractionalLit -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
src FractionalLit
fl String
"##"

toSourceTextWithSuffix :: (Show a) => SourceText -> a -> String -> String
toSourceTextWithSuffix :: forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix (SourceText
NoSourceText)    a
alt String
suffix = a -> String
forall a. Show a => a -> String
show a
alt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix
toSourceTextWithSuffix (SourceText FastString
txt) a
_alt String
suffix = FastString -> String
unpackFS FastString
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix

sourceTextToString :: SourceText -> String -> String
sourceTextToString :: SourceText -> ShowS
sourceTextToString SourceText
NoSourceText String
alt   = String
alt
sourceTextToString (SourceText FastString
txt) String
_ = FastString -> String
unpackFS FastString
txt

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

exactUserCon :: (Monad m, Monoid w, ExactPrint con)
  => [AddEpAnn] -> con -> HsConPatDetails GhcPs
  -> EP w m ([AddEpAnn], con, HsConPatDetails GhcPs)
exactUserCon :: forall (m :: * -> *) w con.
(Monad m, Monoid w, ExactPrint con) =>
[AddEpAnn]
-> con
-> HsConPatDetails GhcPs
-> EP w m ([AddEpAnn], con, HsConPatDetails GhcPs)
exactUserCon [AddEpAnn]
an con
c (InfixCon LPat GhcPs
p1 LPat GhcPs
p2) = do
  p1' <- GenLocated SrcSpanAnnA (Pat GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1
  c' <- markAnnotated c
  p2' <- markAnnotated p2
  return (an, c', InfixCon p1' p2')
exactUserCon [AddEpAnn]
an con
c HsConPatDetails GhcPs
details = do
  c' <- con -> EP w m con
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated con
c
  an0 <- markEpAnnL an lidl AnnOpenC
  details' <- exactConArgs details
  an1 <- markEpAnnL an0 lidl AnnCloseC
  return (an1, c', details')

instance ExactPrint (HsConPatTyArg GhcPs) where
  getAnnotationEntry :: HsConPatTyArg GhcPs -> Entry
getAnnotationEntry HsConPatTyArg GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: HsConPatTyArg GhcPs
-> Anchor -> [TrailingAnn] -> EpAnnComments -> HsConPatTyArg GhcPs
setAnnotationAnchor HsConPatTyArg GhcPs
a Anchor
_ [TrailingAnn]
_ EpAnnComments
_ = HsConPatTyArg GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsConPatTyArg GhcPs -> EP w m (HsConPatTyArg GhcPs)
exact (HsConPatTyArg XConPatTyArg GhcPs
at HsTyPat GhcPs
tyarg) = do
    at' <- EpToken "@" -> EP w m (EpToken "@")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "@"
XConPatTyArg GhcPs
at
    tyarg' <- markAnnotated tyarg
    return (HsConPatTyArg at' tyarg')

exactConArgs :: (Monad m, Monoid w)
  => HsConPatDetails GhcPs -> EP w m (HsConPatDetails GhcPs)
exactConArgs :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsConPatDetails GhcPs -> EP w m (HsConPatDetails GhcPs)
exactConArgs (PrefixCon [HsConPatTyArg (NoGhcTc GhcPs)]
tyargs [LPat GhcPs]
pats) = do
  tyargs' <- [HsConPatTyArg GhcPs] -> EP w m [HsConPatTyArg GhcPs]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [HsConPatTyArg (NoGhcTc GhcPs)]
[HsConPatTyArg GhcPs]
tyargs
  pats' <- markAnnotated pats
  return (PrefixCon tyargs' pats')
exactConArgs (InfixCon LPat GhcPs
p1 LPat GhcPs
p2) = do
  p1' <- GenLocated SrcSpanAnnA (Pat GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1
  p2' <- markAnnotated p2
  return (InfixCon p1' p2')
exactConArgs (RecCon HsRecFields GhcPs (LPat GhcPs)
rpats) = do
  rpats' <- HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
-> EP w m (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsRecFields GhcPs (LPat GhcPs)
HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
rpats
  return (RecCon rpats')

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

entryFromLocatedA :: (HasTrailing ann) => LocatedAn ann a -> Entry
entryFromLocatedA :: forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA (L EpAnn ann
la a
_) = EpAnn ann -> Entry
forall a. HasEntry a => a -> Entry
fromAnn EpAnn ann
la

-- =====================================================================
-- Utility stuff
-- ---------------------------------------------------------------------

-- |This should be the final point where things are mode concrete,
-- before output.
-- NOTE: despite the name, this is the ghc-exactprint final output for
-- the PRINT phase.
printStringAtLsDelta :: (Monad m, Monoid w) => DeltaPos -> String -> EP w m ()
printStringAtLsDelta :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> String -> EP w m ()
printStringAtLsDelta DeltaPos
cl String
s = do
  p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  colOffset <- getLayoutOffsetP
  if isGoodDeltaWithOffset cl colOffset
    then do
      printStringAt (undelta p cl colOffset) s
      p' <- getPosP
      d <- getPriorEndD
      debugM $ "printStringAtLsDelta:(pos,p,p',d,s):" ++ show (undelta p cl colOffset,p,p',d,s)
    else return () `debug` ("printStringAtLsDelta:bad delta for (mc,s):" ++ show (cl,s))

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

isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool
isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool
isGoodDeltaWithOffset DeltaPos
dp LayoutStartCol
colOffset = DeltaPos -> Bool
isGoodDelta (Int -> Int -> DeltaPos
deltaPos Int
l Int
c)
  where (Int
l,Int
c) = Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta (Int
0,Int
0) DeltaPos
dp LayoutStartCol
colOffset

-- | Print a comment, using the current layout offset to convert the
-- @DeltaPos@ to an absolute position.
printQueuedComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()
printQueuedComment :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Comment -> DeltaPos -> EP w m ()
printQueuedComment Comment{String
commentContents :: String
commentContents :: Comment -> String
commentContents} DeltaPos
dp = do
  p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  d <- getPriorEndD
  colOffset <- getLayoutOffsetP
  let (dr,dc) = undelta (0,0) dp colOffset
  -- do not lose comments against the left margin
  when (isGoodDelta (deltaPos dr (max 0 dc))) $ do
    printCommentAt (undelta p dp colOffset) commentContents
  p' <- getPosP
  d' <- getPriorEndD
  debugM $ "printQueuedComment: (p,p',d,d')=" ++ show (p,p',d,d')
  debugM $ "printQueuedComment: (p,p',dp,colOffset,undelta)=" ++ show (p,p',dp,colOffset,undelta p dp colOffset)

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

setLayoutBoth :: (Monad m, Monoid w) => EP w m a -> EP w m a
setLayoutBoth :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EP w m a -> EP w m a
setLayoutBoth EP w m a
k = do
  oldLHS <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetD
  oldAnchorOffset <- getLayoutOffsetP
  debugM $ "setLayoutBoth: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)
  modify (\EPState
a -> EPState
a { dMarkLayout = True
                  , pMarkLayout = True } )
  let reset = do
        String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setLayoutBoth:reset: (oldLHS,oldAnchorOffset)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (LayoutStartCol, LayoutStartCol) -> String
forall a. Show a => a -> String
show (LayoutStartCol
oldLHS,LayoutStartCol
oldAnchorOffset)
        (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
a -> EPState
a { dMarkLayout = False
                        , dLHS = oldLHS
                        , pMarkLayout = False
                        , pLHS = oldAnchorOffset} )
  k <* reset

-- Use 'local', designed for this
setLayoutTopLevelP :: (Monad m, Monoid w) => EP w m a -> EP w m a
setLayoutTopLevelP :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EP w m a -> EP w m a
setLayoutTopLevelP EP w m a
k = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setLayoutTopLevelP entered"
  oldAnchorOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
  modify (\EPState
a -> EPState
a { pMarkLayout = False
                  , pLHS = 0} )
  r <- k
  debugM $ "setLayoutTopLevelP:resetting"
  setLayoutOffsetP oldAnchorOffset
  return r

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

getPosP :: (Monad m, Monoid w) => EP w m Pos
getPosP :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP = (EPState -> Pos) -> RWST (EPOptions m w) (EPWriter w) EPState m Pos
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> Pos
epPos

setPosP :: (Monad m, Monoid w) => Pos -> EP w m ()
setPosP :: forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPosP Pos
l = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setPosP:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
l
  (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s {epPos = l})

getExtraDP :: (Monad m, Monoid w) => EP w m (Maybe Anchor)
getExtraDP :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m (Maybe Anchor)
getExtraDP = (EPState -> Maybe Anchor)
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe Anchor)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> Maybe Anchor
uExtraDP

setExtraDP :: (Monad m, Monoid w) => Maybe Anchor -> EP w m ()
setExtraDP :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> EP w m ()
setExtraDP Maybe Anchor
md = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setExtraDP:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Anchor -> String
forall a. Show a => a -> String
show Maybe Anchor
md
  (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s {uExtraDP = md})

getExtraDPReturn :: (Monad m, Monoid w) => EP w m (Maybe DeltaPos)
getExtraDPReturn :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m (Maybe DeltaPos)
getExtraDPReturn = (EPState -> Maybe DeltaPos)
-> RWST (EPOptions m w) (EPWriter w) EPState m (Maybe DeltaPos)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> Maybe DeltaPos
uExtraDPReturn

setExtraDPReturn :: (Monad m, Monoid w) => Maybe DeltaPos -> EP w m ()
setExtraDPReturn :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe DeltaPos -> EP w m ()
setExtraDPReturn Maybe DeltaPos
md = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setExtraDPReturn:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe DeltaPos -> String
forall a. Show a => a -> String
show Maybe DeltaPos
md
  (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s {uExtraDPReturn = md})

getPriorEndD :: (Monad m, Monoid w) => EP w m Pos
getPriorEndD :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD = (EPState -> Pos) -> RWST (EPOptions m w) (EPWriter w) EPState m Pos
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> Pos
dPriorEndPosition

getAnchorU :: (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU = (EPState -> RealSrcSpan)
-> RWST (EPOptions m w) (EPWriter w) EPState m RealSrcSpan
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> RealSrcSpan
uAnchorSpan

getAcceptSpan ::(Monad m, Monoid w) => EP w m Bool
getAcceptSpan :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Bool
getAcceptSpan = (EPState -> Bool)
-> RWST (EPOptions m w) (EPWriter w) EPState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> Bool
pAcceptSpan

setAcceptSpan ::(Monad m, Monoid w) => Bool -> EP w m ()
setAcceptSpan :: forall (m :: * -> *) w. (Monad m, Monoid w) => Bool -> EP w m ()
setAcceptSpan Bool
f =
  (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { pAcceptSpan = f })

setPriorEndD :: (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndD :: forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndD Pos
pe = do
  Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndNoLayoutD Pos
pe

setPriorEndNoLayoutD :: (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndNoLayoutD :: forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndNoLayoutD Pos
pe = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setPriorEndNoLayoutD:pe=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
pe
  (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { dPriorEndPosition = pe })

setPriorEndASTD :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()
setPriorEndASTD :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m ()
setPriorEndASTD RealSrcSpan
pe = (Pos, Pos) -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
(Pos, Pos) -> EP w m ()
setPriorEndASTPD (RealSrcSpan -> (Pos, Pos)
rs2range RealSrcSpan
pe)

setPriorEndASTPD :: (Monad m, Monoid w) => (Pos,Pos) -> EP w m ()
setPriorEndASTPD :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
(Pos, Pos) -> EP w m ()
setPriorEndASTPD pe :: (Pos, Pos)
pe@(Pos
fm,Pos
to) = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setPriorEndASTD:pe=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Show a => a -> String
show (Pos, Pos)
pe
  Int -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Int -> EP w m ()
setLayoutStartD (Pos -> Int
forall a b. (a, b) -> b
snd Pos
fm)
  (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { dPriorEndPosition = to } )

setLayoutStartD :: (Monad m, Monoid w) => Int -> EP w m ()
setLayoutStartD :: forall (m :: * -> *) w. (Monad m, Monoid w) => Int -> EP w m ()
setLayoutStartD Int
p = do
  EPState{dMarkLayout} <- RWST (EPOptions m w) (EPWriter w) EPState m EPState
forall s (m :: * -> *). MonadState s m => m s
get
  when dMarkLayout $ do
    debugM $ "setLayoutStartD: setting dLHS=" ++ show p
    modify (\EPState
s -> EPState
s { dMarkLayout = False
                    , dLHS = LayoutStartCol p})

getLayoutOffsetD :: (Monad m, Monoid w) => EP w m LayoutStartCol
getLayoutOffsetD :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetD = (EPState -> LayoutStartCol)
-> RWST (EPOptions m w) (EPWriter w) EPState m LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> LayoutStartCol
dLHS

setAnchorU :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()
setAnchorU :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m ()
setAnchorU RealSrcSpan
rss = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setAnchorU:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Show a => a -> String
show (RealSrcSpan -> (Pos, Pos)
rs2range RealSrcSpan
rss)
  (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { uAnchorSpan = rss })

getEofPos :: (Monad m, Monoid w) => EP w m (Maybe (RealSrcSpan, RealSrcSpan))
getEofPos :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m (Maybe (RealSrcSpan, RealSrcSpan))
getEofPos = (EPState -> Maybe (RealSrcSpan, RealSrcSpan))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (RealSrcSpan, RealSrcSpan))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> Maybe (RealSrcSpan, RealSrcSpan)
epEof

setEofPos :: (Monad m, Monoid w) => Maybe (RealSrcSpan, RealSrcSpan) -> EP w m ()
setEofPos :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe (RealSrcSpan, RealSrcSpan) -> EP w m ()
setEofPos Maybe (RealSrcSpan, RealSrcSpan)
l = (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s {epEof = l})

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

getUnallocatedComments :: (Monad m, Monoid w) => EP w m [Comment]
getUnallocatedComments :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
getUnallocatedComments = (EPState -> [Comment])
-> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> [Comment]
epComments

putUnallocatedComments :: (Monad m, Monoid w) => [Comment] -> EP w m ()
putUnallocatedComments :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[Comment] -> EP w m ()
putUnallocatedComments ![Comment]
cs = (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epComments = cs } )

-- | Push a fresh stack frame for the applied comments gatherer
pushAppliedComments  :: (Monad m, Monoid w) => EP w m ()
pushAppliedComments :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m ()
pushAppliedComments = (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epCommentsApplied = []:(epCommentsApplied s) })

-- | Return the comments applied since the last call
-- takeAppliedComments, and clear them, not popping the stack
takeAppliedComments :: (Monad m, Monoid w) => EP w m [Comment]
takeAppliedComments :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
takeAppliedComments = do
  !ccs <- (EPState -> [[Comment]])
-> RWST (EPOptions m w) (EPWriter w) EPState m [[Comment]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> [[Comment]]
epCommentsApplied
  case ccs of
    [] -> do
      (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epCommentsApplied = [] })
      [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [Comment]
h:[[Comment]]
t -> do
      (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epCommentsApplied = []:t })
      [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Comment] -> [Comment]
forall a. [a] -> [a]
reverse [Comment]
h)

-- | Return the comments applied since the last call
-- takeAppliedComments, and clear them, popping the stack
takeAppliedCommentsPop :: (Monad m, Monoid w) => EP w m [Comment]
takeAppliedCommentsPop :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
takeAppliedCommentsPop = do
  !ccs <- (EPState -> [[Comment]])
-> RWST (EPOptions m w) (EPWriter w) EPState m [[Comment]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> [[Comment]]
epCommentsApplied
  case ccs of
    [] -> do
      (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epCommentsApplied = [] })
      [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [Comment]
h:[[Comment]]
t -> do
      (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epCommentsApplied = t })
      [Comment] -> RWST (EPOptions m w) (EPWriter w) EPState m [Comment]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Comment] -> [Comment]
forall a. [a] -> [a]
reverse [Comment]
h)

-- | Mark a comment as being applied.  This is used to update comments
-- when doing delta processing
applyComment :: (Monad m, Monoid w) => Comment -> EP w m ()
applyComment :: forall (m :: * -> *) w. (Monad m, Monoid w) => Comment -> EP w m ()
applyComment Comment
c = do
  !ccs <- (EPState -> [[Comment]])
-> RWST (EPOptions m w) (EPWriter w) EPState m [[Comment]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> [[Comment]]
epCommentsApplied
  case ccs of
    []    -> (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epCommentsApplied = [[c]] } )
    ([Comment]
h:[[Comment]]
t) -> (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epCommentsApplied = (c:h):t } )

getLayoutOffsetP :: (Monad m, Monoid w) => EP w m LayoutStartCol
getLayoutOffsetP :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP = (EPState -> LayoutStartCol)
-> RWST (EPOptions m w) (EPWriter w) EPState m LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> LayoutStartCol
pLHS

setLayoutOffsetP :: (Monad m, Monoid w) => LayoutStartCol -> EP w m ()
setLayoutOffsetP :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LayoutStartCol -> EP w m ()
setLayoutOffsetP LayoutStartCol
c = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"setLayoutOffsetP:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LayoutStartCol -> String
forall a. Show a => a -> String
show LayoutStartCol
c
  (EPState -> EPState)
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { pLHS = c })


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

advance :: (Monad m, Monoid w) => DeltaPos -> EP w m ()
advance :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> EP w m ()
advance DeltaPos
dp = do
  p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  colOffset <- getLayoutOffsetP
  debugM $ "advance:(p,dp,colOffset,ws)=" ++ show (p,dp,colOffset,undelta p dp colOffset)
  if isGoodDelta dp
    then do
      printWhitespace (undelta p dp colOffset)
      -- Sync point. We only call advance as we start the sub-span
      -- processing, so force the dPriorEndPosition to ???
      p0 <- getPosP
      d <- getPriorEndD
      r <- getAnchorU
      setPriorEndD (fst $ rs2range r)
      debugM $ "advance:after: (posp, posd, posd')=" ++ show (p0,d,fst $ rs2range r)
    else
      return ()

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

adjustDeltaForOffsetM :: (Monad m, Monoid w) => DeltaPos -> EP w m DeltaPos
adjustDeltaForOffsetM :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> EP w m DeltaPos
adjustDeltaForOffsetM DeltaPos
dp = do
  colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetD
  return (adjustDeltaForOffset colOffset dp)

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

printString :: (Monad m, Monoid w) => Bool -> String -> EP w m ()
printString :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
layout String
str = do
  EPState{epPos = (_,c), pMarkLayout} <- RWST (EPOptions m w) (EPWriter w) EPState m EPState
forall s (m :: * -> *). MonadState s m => m s
get
  EPOptions{epTokenPrint, epWhitespacePrint} <- ask
  when (pMarkLayout && layout) $ do
    debugM $ "printString: setting pLHS to " ++ show c
    modify (\EPState
s -> EPState
s { pLHS = LayoutStartCol c, pMarkLayout = False } )

  -- Advance position, taking care of any newlines in the string
  let strDP = String -> DeltaPos
dpFromString String
str
      cr = DeltaPos -> Int
getDeltaLine DeltaPos
strDP
  p <- getPosP
  d <- getPriorEndD
  colOffsetP <- getLayoutOffsetP
  colOffsetD <- getLayoutOffsetD
  -- debugM $ "printString:(p,colOffset,strDP,cr)="  ++ show (p,colOffset,strDP,cr)
  if cr == 0
    then do
      setPosP      (undelta p strDP colOffsetP)
      setPriorEndD (undelta d strDP colOffsetD)
    else do
      setPosP      (undelta p strDP 1)
      setPriorEndD (undelta d strDP 1)

  -- Debug stuff
  -- pp <- getPosP
  -- debugM $ "printString: (p,pp,str)" ++ show (p,pp,str)
  -- Debug end

  --
  if not layout && c == 0
    then lift (epWhitespacePrint str) >>= \w
s -> EPWriter w -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell EPWriter { output :: w
output = w
s}
    else lift (epTokenPrint      str) >>= \w
s -> EPWriter w -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell EPWriter { output :: w
output = w
s}

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

printStringAdvance :: (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance :: forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
str = do
  ss <- EP w m RealSrcSpan
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU
  _ <- printStringAtRs ss str
  return ()

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

newLine :: (Monad m, Monoid w) => EP w m ()
newLine :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m ()
newLine = do
    (l,_) <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    (ld,_) <- getPriorEndD
    printString False "\n"
    setPosP (l+1,1)
    setPriorEndNoLayoutD (ld+1,1)

padUntil :: (Monad m, Monoid w) => Pos -> EP w m ()
padUntil :: forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
padUntil (Int
l,Int
c) = do
    (l1,c1) <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    if | l1 == l && c1 <= c -> printString False $ replicate (c - c1) ' '
       | l1 < l             -> newLine >> padUntil (l,c)
       | otherwise          -> return ()

printWhitespace :: (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace :: forall (m :: * -> *) w. (Monad m, Monoid w) => 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 :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Pos -> String -> EP w m ()
printCommentAt Pos
p String
str = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"printCommentAt: (pos,str)" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, String) -> String
forall a. Show a => a -> String
show (Pos
p,String
str)
  Pos -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace Pos
p RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> String -> RWST (EPOptions m w) (EPWriter w) EPState 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 :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
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 a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
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