{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf           #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns         #-}
{-# LANGUAGE UndecidableInstances  #-} -- For the (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ExactPrint instance

module Language.Haskell.GHC.ExactPrint.ExactPrint
  (
    ExactPrint(..)
  , exactPrint
  -- , exactPrintWithOptions
  ) where

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

import Control.Monad.Identity
import Control.Monad.RWS
import Data.Data ( Data )
import Data.Foldable
import qualified Data.Set.Ordered as OSet
import Data.Typeable
import Data.List ( partition, sort, sortBy)
import Data.Maybe ( isJust )

import Data.Void

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

-- import Debug.Trace

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

exactPrint :: ExactPrint ast => Located ast -> String
exactPrint :: forall ast. ExactPrint ast => Located ast -> String
exactPrint Located ast
ast = Identity String -> String
forall a. Identity a -> a
runIdentity (PrintOptions Identity String -> Annotated () -> Identity String
runEP PrintOptions Identity String
stringOptions (Located ast -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located ast
ast))

type EP w m a = RWST (PrintOptions m w) (EPWriter w) EPState m a
type EPP a = EP String Identity a

runEP :: PrintOptions Identity String
      -> Annotated () -> Identity String
runEP :: PrintOptions Identity String -> Annotated () -> Identity String
runEP PrintOptions Identity String
epReader Annotated ()
action =
  ((EPState, EPWriter String) -> String)
-> Identity (EPState, EPWriter String) -> Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EPWriter String -> String
forall a. EPWriter a -> a
output (EPWriter String -> String)
-> ((EPState, EPWriter String) -> EPWriter String)
-> (EPState, EPWriter String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EPState, EPWriter String) -> EPWriter String
forall a b. (a, b) -> b
snd) (Identity (EPState, EPWriter String) -> Identity String)
-> (Annotated () -> Identity (EPState, EPWriter String))
-> Annotated ()
-> Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (\Annotated ()
next -> Annotated ()
-> PrintOptions Identity String
-> EPState
-> Identity (EPState, EPWriter String)
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> r -> s -> m (s, w)
execRWST Annotated ()
next PrintOptions Identity String
epReader EPState
defaultEPState)
    (Annotated () -> Identity (EPState, EPWriter String))
-> (Annotated () -> Annotated ())
-> Annotated ()
-> Identity (EPState, EPWriter String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated () -> Annotated ()
xx (Annotated () -> Identity String)
-> Annotated () -> Identity String
forall a b. (a -> b) -> a -> b
$ Annotated ()
action

xx :: Annotated () -> EP String Identity ()
-- xx :: Annotated() -> RWST (PrintOptions m w) (EPWriter w) EPState m ()
xx :: Annotated () -> Annotated ()
xx = Annotated () -> Annotated ()
forall a. a -> a
id

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

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
             , epComments :: [Comment]
epComments = []
             }


-- ---------------------------------------------------------------------
-- 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 PrintOptions m a = PrintOptions
            {
              forall (m :: * -> *) a.
PrintOptions 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. PrintOptions m a -> String -> m a
epTokenPrint :: String -> m a
            , forall (m :: * -> *) a. PrintOptions m a -> String -> m a
epWhitespacePrint :: String -> m a
            , forall (m :: * -> *) a. PrintOptions m a -> Rigidity
epRigidity :: Rigidity
            }

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

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

data EPWriter a = EPWriter
              { 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

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

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

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

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

-- type Annotated = FreeT AnnotationF Identity
type Annotated a = EP String Identity a

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

-- | Key entry point.  Switches to an independent AST element with its
-- own annotation, calculating new offsets, etc
markAnnotated :: ExactPrint a => a -> Annotated ()
markAnnotated :: forall a. ExactPrint a => a -> Annotated ()
markAnnotated a
a = Entry -> a -> Annotated ()
forall a. ExactPrint a => Entry -> a -> Annotated ()
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
/= :: FlushComments -> FlushComments -> Bool
$c/= :: FlushComments -> FlushComments -> Bool
== :: FlushComments -> FlushComments -> Bool
$c== :: 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
showList :: [FlushComments] -> ShowS
$cshowList :: [FlushComments] -> ShowS
show :: FlushComments -> String
$cshow :: FlushComments -> String
showsPrec :: Int -> FlushComments -> ShowS
$cshowsPrec :: Int -> FlushComments -> ShowS
Show)

data Entry = Entry Anchor EpAnnComments FlushComments
           | NoEntryVal

instance HasEntry (SrcSpanAnn' (EpAnn an)) where
  fromAnn :: SrcSpanAnn' (EpAnn an) -> Entry
fromAnn (SrcSpanAnn EpAnn an
EpAnnNotUsed SrcSpan
ss) = Anchor -> EpAnnComments -> FlushComments -> Entry
Entry (SrcSpan -> Anchor
spanAsAnchor SrcSpan
ss) EpAnnComments
emptyComments FlushComments
NoFlushComments
  fromAnn (SrcSpanAnn EpAnn an
an SrcSpan
_) = EpAnn an -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn EpAnn an
an

instance HasEntry (EpAnn a) where
  fromAnn :: EpAnn a -> Entry
fromAnn (EpAnn Anchor
anchor a
_ EpAnnComments
cs) = Anchor -> EpAnnComments -> FlushComments -> Entry
Entry Anchor
anchor EpAnnComments
cs FlushComments
NoFlushComments
  fromAnn EpAnn a
EpAnnNotUsed = Entry
NoEntryVal

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

fromAnn' :: (HasEntry a) => a -> Entry
fromAnn' :: forall ast. HasEntry ast => ast -> Entry
fromAnn' a
an = case a -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn a
an of
  Entry
NoEntryVal -> Entry
NoEntryVal
  Entry Anchor
a EpAnnComments
c FlushComments
_ -> Anchor -> EpAnnComments -> FlushComments -> Entry
Entry Anchor
a EpAnnComments
c FlushComments
FlushComments

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

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)

-- | "Enter" an annotation, by using the associated 'anchor' field as
-- the new reference point for calculating all DeltaPos positions.
--
-- 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 :: (ExactPrint a) => Entry -> a -> Annotated ()
enterAnn :: forall a. ExactPrint a => Entry -> a -> Annotated ()
enterAnn Entry
NoEntryVal a
a = do
  Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:NO ANN:(p,a) =" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, String) -> String
forall a. Show a => a -> String
show (Pos
p, a -> String
forall a. Typeable a => a -> String
astId a
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" starting"
  a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
exact a
a
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:NO ANN:p =" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, String) -> String
forall a. Show a => a -> String
show (Pos
p, a -> String
forall a. Typeable a => a -> String
astId a
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" done"
enterAnn (Entry Anchor
anchor' EpAnnComments
cs FlushComments
flush) a
a = do
  Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:(p,a) =" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, String) -> String
forall a. Show a => a -> String
show (Pos
p, a -> String
forall a. Typeable a => a -> String
astId a
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" starting"
  -- debugM $ "enterAnn:(cs) =" ++ showGhc (cs)
  let curAnchor :: RealSrcSpan
curAnchor = Anchor -> RealSrcSpan
anchor Anchor
anchor' -- As a base for the current AST element
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:(curAnchor):=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Show a => a -> String
show (RealSrcSpan -> (Pos, Pos)
rs2range RealSrcSpan
curAnchor)
  [LEpaComment] -> Annotated ()
addCommentsA (EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs)
  RealSrcSpan -> Annotated ()
printComments RealSrcSpan
curAnchor
  -- -------------------------
  case Anchor -> AnchorOperation
anchor_op Anchor
anchor' of
    MovedAnchor DeltaPos
dp -> do
      String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn: MovedAnchor:" 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
      -- BUT: this means the entry DP can be calculated incorrectly too,
      -- for immediately nested items.
      Pos -> Annotated ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndNoLayoutD (RealSrcSpan -> Pos
ss2pos RealSrcSpan
curAnchor)
    AnchorOperation
_ -> do
      () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- -------------------------
  RealSrcSpan -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> EP w m ()
setAnchorU RealSrcSpan
curAnchor
  -- -------------------------------------------------------------------
  -- 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
  LayoutStartCol
off <- (EPState -> LayoutStartCol)
-> RWST
     (PrintOptions Identity String)
     (EPWriter String)
     EPState
     Identity
     LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> LayoutStartCol
dLHS
  let spanStart :: Pos
spanStart = RealSrcSpan -> Pos
ss2pos RealSrcSpan
curAnchor
  Pos
priorEndAfterComments <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD
  let edp' :: DeltaPos
edp' = Int -> LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset Int
0
               -- 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)
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn: (edp',off,priorEndAfterComments,curAnchor):" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (DeltaPos, LayoutStartCol, Pos, (Pos, Pos)) -> String
forall a. Show a => a -> String
show (DeltaPos
edp',LayoutStartCol
off,Pos
priorEndAfterComments,RealSrcSpan -> (Pos, Pos)
rs2range RealSrcSpan
curAnchor)
  let edp'' :: DeltaPos
edp'' = case Anchor -> AnchorOperation
anchor_op Anchor
anchor' of
        MovedAnchor DeltaPos
dp -> DeltaPos
dp
        AnchorOperation
_ -> DeltaPos
edp'
  -- ---------------------------------------------
  -- let edp = edp''
  Maybe Anchor
med <- EP String Identity (Maybe Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m (Maybe Anchor)
getExtraDP
  Maybe Anchor -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe Anchor -> EP w m ()
setExtraDP Maybe Anchor
forall a. Maybe a
Nothing
  let edp :: DeltaPos
edp = case Maybe Anchor
med of
        Maybe Anchor
Nothing -> DeltaPos
edp''
        Just (Anchor RealSrcSpan
_ (MovedAnchor DeltaPos
dp)) -> DeltaPos
dp
                   -- Replace original with desired one. Allows all
                   -- list entry values to be DP (1,0)
        Just (Anchor RealSrcSpan
r AnchorOperation
_) -> DeltaPos
dp
          where
            dp :: DeltaPos
dp = Int -> LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset Int
0
                   LayoutStartCol
off (Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
priorEndAfterComments RealSrcSpan
r)
  Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Anchor -> Bool
forall a. Maybe a -> Bool
isJust Maybe Anchor
med) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn:(med,edp)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Maybe Anchor, DeltaPos) -> String
forall a. Show a => a -> String
show (Maybe Anchor
med,DeltaPos
edp)
  -- ---------------------------------------------
  -- Preparation complete, perform the action
  Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Pos
priorEndAfterComments Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
spanStart) (do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn.dPriorEndPosition:spanStart=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
spanStart
    (EPState -> EPState) -> Annotated ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { dPriorEndPosition :: Pos
dPriorEndPosition    = Pos
spanStart } ))

  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn: (anchor_op, curAnchor):" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (AnchorOperation, (Pos, Pos)) -> String
forall a. Show a => a -> String
show (Anchor -> AnchorOperation
anchor_op Anchor
anchor', RealSrcSpan -> (Pos, Pos)
rs2range RealSrcSpan
curAnchor)
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"enterAnn: (dLHS,spanStart,pec,edp)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (LayoutStartCol, Pos, Pos, DeltaPos) -> String
forall a. Show a => a -> String
show (LayoutStartCol
off,Pos
spanStart,Pos
priorEndAfterComments,DeltaPos
edp)

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

  let mflush :: Annotated ()
mflush = Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FlushComments
flush FlushComments -> FlushComments -> Bool
forall a. Eq a => a -> a -> Bool
== FlushComments
FlushComments) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
        String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"flushing comments in enterAnn"
        [LEpaComment] -> Annotated ()
flushComments (EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs)
        -- flushComments []

  -- let
  --   st = annNone
  -- withOffset st (advance edp >> exact a >> mflush)
  (DeltaPos -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> EP w m ()
advance DeltaPos
edp Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
exact a
a Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Annotated ()
mflush)

  Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FlushComments
flush FlushComments -> FlushComments -> Bool
forall a. Eq a => a -> a -> Bool
== FlushComments
NoFlushComments) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs) [LEpaComment] -> [LEpaComment] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"starting trailing comments:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [LEpaComment] -> String
forall a. Data a => a -> String
showAst (EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs)
      (Comment -> Annotated ()) -> [Comment] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Comment -> Annotated ()
printOneComment ((LEpaComment -> Comment) -> [LEpaComment] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map LEpaComment -> Comment
tokComment ([LEpaComment] -> [Comment]) -> [LEpaComment] -> [Comment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs)
      String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"ending trailing comments"

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

addCommentsA :: [LEpaComment] -> EPP ()
addCommentsA :: [LEpaComment] -> Annotated ()
addCommentsA [LEpaComment]
csNew = [Comment] -> Annotated ()
addComments ((LEpaComment -> Comment) -> [LEpaComment] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map LEpaComment -> Comment
tokComment [LEpaComment]
csNew)

addComments :: [Comment] -> EPP ()
addComments :: [Comment] -> Annotated ()
addComments [Comment]
csNew = do
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"addComments:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Comment] -> String
forall a. Show a => a -> String
show [Comment]
csNew
  [Comment]
cs <- EP String Identity [Comment]
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
getUnallocatedComments
  -- Make sure we merge duplicates while sorting, needed until
  -- https://gitlab.haskell.org/ghc/ghc/-/issues/20239 is resolved
  let ocs :: OSet Comment
ocs = [Comment] -> OSet Comment
forall a. Ord a => [a] -> OSet a
OSet.fromList [Comment]
cs
  let ncs :: OSet Comment
ncs = [Comment] -> OSet Comment
forall a. Ord a => [a] -> OSet a
OSet.fromList [Comment]
csNew
  [Comment] -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[Comment] -> EP w m ()
putUnallocatedComments (OSet Comment -> [Comment]
forall a. OSet a -> [a]
OSet.toAscList (OSet Comment
ocs OSet Comment -> OSet Comment -> OSet Comment
forall a. Ord a => OSet a -> OSet a -> OSet a
OSet.<>| OSet Comment
ncs))


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

-- | Just before we print out the EOF comments, flush the remaining
-- ones in the state.
flushComments :: [LEpaComment] -> EPP ()
flushComments :: [LEpaComment] -> Annotated ()
flushComments [LEpaComment]
trailing = do
  [LEpaComment] -> Annotated ()
addCommentsA [LEpaComment]
trailing
  [Comment]
cs <- EP String Identity [Comment]
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m [Comment]
getUnallocatedComments
  -- Must compare without span filenames, for CPP injected comments with fake filename
  let cmp :: Comment -> Comment -> Ordering
cmp (Comment String
_ Anchor
l1 Maybe AnnKeywordId
_) (Comment String
_ Anchor
l2 Maybe AnnKeywordId
_) = Pos -> Pos -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
l1) (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
l2)
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"flushing comments starting"
  (Comment -> Annotated ()) -> [Comment] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Comment -> Annotated ()
printOneComment ((Comment -> Comment -> Ordering) -> [Comment] -> [Comment]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Comment -> Comment -> Ordering
cmp [Comment]
cs)
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"flushing comments done"

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

-- |In order to interleave annotations into the stream, we turn them into
-- comments.
annotationsToComments :: [AddEpAnn] -> [AnnKeywordId] -> EPP ()
annotationsToComments :: [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToComments [AddEpAnn]
ans [AnnKeywordId]
kws = do
  let
    getSpans :: AnnKeywordId -> [AddEpAnn] -> [EpaLocation]
getSpans AnnKeywordId
_ [] = []
    getSpans AnnKeywordId
k1 (AddEpAnn AnnKeywordId
k2 EpaLocation
ss:[AddEpAnn]
as)
      | AnnKeywordId
k1 AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
k2 = EpaLocation
ss EpaLocation -> [EpaLocation] -> [EpaLocation]
forall a. a -> [a] -> [a]
: AnnKeywordId -> [AddEpAnn] -> [EpaLocation]
getSpans AnnKeywordId
k1 [AddEpAnn]
as
      | Bool
otherwise = AnnKeywordId -> [AddEpAnn] -> [EpaLocation]
getSpans AnnKeywordId
k1 [AddEpAnn]
as
    doOne :: AnnKeywordId -> EPP [Comment]
    doOne :: AnnKeywordId -> EP String Identity [Comment]
doOne AnnKeywordId
kw = do
      let sps :: [EpaLocation]
sps =AnnKeywordId -> [AddEpAnn] -> [EpaLocation]
getSpans AnnKeywordId
kw [AddEpAnn]
ans
      [Comment] -> EP String Identity [Comment]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Comment] -> EP String Identity [Comment])
-> [Comment] -> EP String Identity [Comment]
forall a b. (a -> b) -> a -> b
$ (EpaLocation -> Comment) -> [EpaLocation] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map (AnnKeywordId -> EpaLocation -> Comment
mkKWComment AnnKeywordId
kw ) [EpaLocation]
sps
    -- TODO:AZ make sure these are sorted/merged properly when the invariant for
    -- allocateComments is re-established.
  [[Comment]]
newComments <- (AnnKeywordId -> EP String Identity [Comment])
-> [AnnKeywordId]
-> RWST
     (PrintOptions Identity String)
     (EPWriter String)
     EPState
     Identity
     [[Comment]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnnKeywordId -> EP String Identity [Comment]
doOne [AnnKeywordId]
kws
  [Comment] -> Annotated ()
addComments ([[Comment]] -> [Comment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Comment]]
newComments)

annotationsToCommentsA :: EpAnn [AddEpAnn] -> [AnnKeywordId] -> EPP ()
annotationsToCommentsA :: EpAnn [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToCommentsA EpAnn [AddEpAnn]
EpAnnNotUsed [AnnKeywordId]
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
annotationsToCommentsA EpAnn [AddEpAnn]
an [AnnKeywordId]
kws = [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToComments (EpAnn [AddEpAnn] -> [AddEpAnn]
forall ann. EpAnn ann -> ann
anns EpAnn [AddEpAnn]
an) [AnnKeywordId]
kws

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

-- Temporary function to simply reproduce the "normal" pretty printer output
withPpr :: (Outputable a) => a -> Annotated ()
withPpr :: forall a. Outputable a => a -> Annotated ()
withPpr a
a = do
  RealSrcSpan
ss <- EP String Identity RealSrcSpan
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"withPpr: ss=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ RealSrcSpan -> String
forall a. Show a => a -> String
show RealSrcSpan
ss
  RealSrcSpan -> String -> Annotated ()
printStringAtKw' RealSrcSpan
ss (a -> String
forall a. Outputable a => a -> String
showPprUnsafe a
a)

-- ---------------------------------------------------------------------
-- Modeled on Outputable

-- | 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
  exact :: a -> Annotated ()

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

-- | 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
_) = Anchor -> EpAnnComments -> FlushComments -> Entry
Entry (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) EpAnnComments
emptyComments FlushComments
NoFlushComments
  exact :: Located a -> Annotated ()
exact (L SrcSpan
_ a
a) = a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated a
a

instance (ExactPrint a) => ExactPrint (LocatedA a) where
  getAnnotationEntry :: LocatedA a -> Entry
getAnnotationEntry = LocatedA a -> Entry
forall ann a. LocatedAn ann a -> Entry
entryFromLocatedA
  exact :: LocatedA a -> Annotated ()
exact (L SrcSpanAnnA
la a
a) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
la)
    a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated a
a
    EpAnn AnnListItem -> Annotated ()
markALocatedA (SrcSpanAnnA -> EpAnn AnnListItem
forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnA
la)

instance (ExactPrint a) => ExactPrint [a] where
  getAnnotationEntry :: [a] -> Entry
getAnnotationEntry = Entry -> [a] -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: [a] -> Annotated ()
exact [a]
ls = (a -> Annotated ()) -> [a] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
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
  exact :: Maybe a -> Annotated ()
exact Maybe a
Nothing = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  exact (Just a
a) = a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated a
a

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

-- | 'Located (HsModule GhcPs)' corresponds to 'ParsedSource'
instance ExactPrint HsModule where
  getAnnotationEntry :: HsModule -> Entry
getAnnotationEntry HsModule
hsmod = EpAnn AnnsModule -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn' (HsModule -> EpAnn AnnsModule
hsmodAnn HsModule
hsmod)

  exact :: HsModule -> Annotated ()
exact hsmod :: HsModule
hsmod@(HsModule EpAnn AnnsModule
EpAnnNotUsed LayoutInfo
_ Maybe (GenLocated SrcSpan ModuleName)
_ Maybe (LocatedL [LIE GhcPs])
_ [LImportDecl GhcPs]
_ [LHsDecl GhcPs]
_ Maybe (LocatedP WarningTxt)
_ Maybe LHsDocString
_) = HsModule -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr HsModule
hsmod
  exact (HsModule EpAnn AnnsModule
an LayoutInfo
_lo Maybe (GenLocated SrcSpan ModuleName)
mmn Maybe (LocatedL [LIE GhcPs])
mexports [LImportDecl GhcPs]
imports [LHsDecl GhcPs]
decls Maybe (LocatedP WarningTxt)
mdeprec Maybe LHsDocString
mbDoc) = do

    Maybe LHsDocString -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe LHsDocString
mbDoc

    case Maybe (GenLocated SrcSpan ModuleName)
mmn of
      Maybe (GenLocated SrcSpan ModuleName)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (L SrcSpan
ln ModuleName
mn) -> do
        EpAnn AnnsModule
-> (AnnsModule -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn AnnsModule
an AnnsModule -> [AddEpAnn]
am_main AnnKeywordId
AnnModule
        GenLocated SrcSpan ModuleName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated (SrcSpan -> ModuleName -> GenLocated SrcSpan ModuleName
forall l e. l -> e -> GenLocated l e
L SrcSpan
ln ModuleName
mn)

        -- forM_ mdeprec markLocated
        Annotated () -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutTopLevelP (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Maybe (LocatedP WarningTxt) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LocatedP WarningTxt)
mdeprec

        Annotated () -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutTopLevelP (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Maybe (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LocatedL [LIE GhcPs])
Maybe (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
mexports

        String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsModule.AnnWhere coming"
        Annotated () -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutTopLevelP (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn AnnsModule
-> (AnnsModule -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn AnnsModule
an AnnsModule -> [AddEpAnn]
am_main AnnKeywordId
AnnWhere

    Bool -> AnnList -> Annotated () -> Annotated ()
markAnnList' Bool
False (AnnsModule -> AnnList
am_decls (AnnsModule -> AnnList) -> AnnsModule -> AnnList
forall a b. (a -> b) -> a -> b
$ EpAnn AnnsModule -> AnnsModule
forall ann. EpAnn ann -> ann
anns EpAnn AnnsModule
an) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> Annotated ()
forall a. ExactPrint a => [a] -> Annotated ()
markTopLevelList [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports
      [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> Annotated ()
forall a. ExactPrint a => [a] -> Annotated ()
markTopLevelList [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls

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

-- TODO:AZ: do we *need* the following, or can we capture it in the AST?
-- | We can have a list with its own entry point defined. Create a
-- data structure to capture this, for defining an ExactPrint instance
data AnnotatedList a = AnnotatedList (Maybe Anchor) a
                     deriving (AnnotatedList a -> AnnotatedList a -> Bool
(AnnotatedList a -> AnnotatedList a -> Bool)
-> (AnnotatedList a -> AnnotatedList a -> Bool)
-> Eq (AnnotatedList a)
forall a. Eq a => AnnotatedList a -> AnnotatedList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotatedList a -> AnnotatedList a -> Bool
$c/= :: forall a. Eq a => AnnotatedList a -> AnnotatedList a -> Bool
== :: AnnotatedList a -> AnnotatedList a -> Bool
$c== :: forall a. Eq a => AnnotatedList a -> AnnotatedList a -> Bool
Eq,Int -> AnnotatedList a -> ShowS
[AnnotatedList a] -> ShowS
AnnotatedList a -> String
(Int -> AnnotatedList a -> ShowS)
-> (AnnotatedList a -> String)
-> ([AnnotatedList a] -> ShowS)
-> Show (AnnotatedList a)
forall a. Show a => Int -> AnnotatedList a -> ShowS
forall a. Show a => [AnnotatedList a] -> ShowS
forall a. Show a => AnnotatedList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnotatedList a] -> ShowS
$cshowList :: forall a. Show a => [AnnotatedList a] -> ShowS
show :: AnnotatedList a -> String
$cshow :: forall a. Show a => AnnotatedList a -> String
showsPrec :: Int -> AnnotatedList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AnnotatedList a -> ShowS
Show)

instance (ExactPrint a) => ExactPrint (AnnotatedList a) where
  getAnnotationEntry :: AnnotatedList a -> Entry
getAnnotationEntry (AnnotatedList (Just Anchor
anc) a
_) = Anchor -> EpAnnComments -> FlushComments -> Entry
Entry Anchor
anc ([LEpaComment] -> EpAnnComments
EpaComments []) FlushComments
NoFlushComments
  getAnnotationEntry (AnnotatedList Maybe Anchor
Nothing    a
_) = Entry
NoEntryVal

  exact :: AnnotatedList a -> Annotated ()
exact (AnnotatedList Maybe Anchor
an a
ls) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"AnnotatedList:an=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Anchor -> String
forall a. Show a => a -> String
show Maybe Anchor
an
    a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotatedWithLayout a
ls


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

printSourceText :: SourceText -> String -> EPP ()
printSourceText :: SourceText -> String -> Annotated ()
printSourceText SourceText
NoSourceText String
txt   =  String -> Annotated ()
printStringAdvance String
txt
printSourceText (SourceText String
txt) String
_ =  String -> Annotated ()
printStringAdvance String
txt

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

printStringAtRs :: RealSrcSpan -> String -> EPP ()
printStringAtRs :: RealSrcSpan -> String -> Annotated ()
printStringAtRs RealSrcSpan
ss String
str = RealSrcSpan -> String -> Annotated ()
printStringAtKw' RealSrcSpan
ss String
str

printStringAtSs :: SrcSpan -> String -> EPP ()
printStringAtSs :: SrcSpan -> String -> Annotated ()
printStringAtSs SrcSpan
ss String
str = RealSrcSpan -> String -> Annotated ()
printStringAtKw' (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
ss) String
str

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

-- AZ:TODO get rid of this
printStringAtMkw :: Maybe EpaLocation -> String -> EPP ()
printStringAtMkw :: Maybe EpaLocation -> String -> Annotated ()
printStringAtMkw (Just EpaLocation
aa) String
s = EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
aa String
s
printStringAtMkw Maybe EpaLocation
Nothing String
s = DeltaPos -> String -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> String -> EP w m ()
printStringAtLsDelta (Int -> DeltaPos
SameLine Int
1) String
s


printStringAtAA :: EpaLocation -> String -> EPP ()
printStringAtAA :: EpaLocation -> String -> Annotated ()
printStringAtAA (EpaSpan RealSrcSpan
r) String
s = RealSrcSpan -> String -> Annotated ()
printStringAtKw' RealSrcSpan
r String
s
printStringAtAA (EpaDelta DeltaPos
d) String
s = do
  Pos
pe <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD
  Pos
p1 <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  DeltaPos -> String -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> String -> EP w m ()
printStringAtLsDelta DeltaPos
d String
s
  Pos
p2 <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"printStringAtAA:(pe,p1,p2)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos, Pos) -> String
forall a. Show a => a -> String
show (Pos
pe,Pos
p1,Pos
p2)
  Bool -> (Pos, Pos) -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> (Pos, Pos) -> EP w m ()
setPriorEndASTPD Bool
True (Pos
p1,Pos
p2)

-- Based on Delta.addAnnotationWorker
printStringAtKw' :: RealSrcSpan -> String -> EPP ()
printStringAtKw' :: RealSrcSpan -> String -> Annotated ()
printStringAtKw' RealSrcSpan
pa String
str = do
  RealSrcSpan -> Annotated ()
printComments RealSrcSpan
pa
  Pos
pe <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"printStringAtKw':pe=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
pe
  let p :: DeltaPos
p = Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
pe RealSrcSpan
pa
  DeltaPos
p' <- DeltaPos -> EPP DeltaPos
adjustDeltaForOffsetM DeltaPos
p
  DeltaPos -> String -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DeltaPos -> String -> EP w m ()
printStringAtLsDelta DeltaPos
p' String
str
  Bool -> RealSrcSpan -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> RealSrcSpan -> EP w m ()
setPriorEndASTD Bool
True RealSrcSpan
pa

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

markExternalSourceText :: SrcSpan -> SourceText -> String -> EPP ()
markExternalSourceText :: SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
NoSourceText String
txt   = RealSrcSpan -> String -> Annotated ()
printStringAtKw' (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) String
txt
markExternalSourceText SrcSpan
l (SourceText String
txt) String
_ = RealSrcSpan -> String -> Annotated ()
printStringAtKw' (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) String
txt

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

markAddEpAnn :: AddEpAnn -> EPP ()
markAddEpAnn :: AddEpAnn -> Annotated ()
markAddEpAnn a :: AddEpAnn
a@(AddEpAnn AnnKeywordId
kw EpaLocation
_) = [AddEpAnn] -> AnnKeywordId -> Annotated ()
mark [AddEpAnn
a] AnnKeywordId
kw

markLocatedMAA :: EpAnn a -> (a -> Maybe AddEpAnn) -> EPP ()
markLocatedMAA :: forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA EpAnn a
EpAnnNotUsed  a -> Maybe AddEpAnn
_  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markLocatedMAA (EpAnn Anchor
_ a
a EpAnnComments
_) a -> Maybe AddEpAnn
f =
  case a -> Maybe AddEpAnn
f a
a of
    Maybe AddEpAnn
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just AddEpAnn
aa -> AddEpAnn -> Annotated ()
markAddEpAnn AddEpAnn
aa

markLocatedAA :: EpAnn a -> (a -> AddEpAnn) -> EPP ()
markLocatedAA :: forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA EpAnn a
EpAnnNotUsed  a -> AddEpAnn
_  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markLocatedAA (EpAnn Anchor
_ a
a EpAnnComments
_) a -> AddEpAnn
f = AddEpAnn -> Annotated ()
markKw (a -> AddEpAnn
f a
a)

markLocatedAAL :: EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> EPP ()
markLocatedAAL :: forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn a
EpAnnNotUsed  a -> [AddEpAnn]
_ AnnKeywordId
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markLocatedAAL (EpAnn Anchor
_ a
a EpAnnComments
_) a -> [AddEpAnn]
f AnnKeywordId
kw = [AddEpAnn] -> Annotated ()
go (a -> [AddEpAnn]
f a
a)
  where
    go :: [AddEpAnn] -> Annotated ()
go [] = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (aa :: AddEpAnn
aa@(AddEpAnn AnnKeywordId
kw' EpaLocation
_):[AddEpAnn]
as)
      | AnnKeywordId
kw' AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw = [AddEpAnn] -> AnnKeywordId -> Annotated ()
mark [AddEpAnn
aa] AnnKeywordId
kw
      | Bool
otherwise = [AddEpAnn] -> Annotated ()
go [AddEpAnn]
as

markLocatedAALS :: EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Maybe String -> EPP ()
markLocatedAALS :: forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn a
an a -> [AddEpAnn]
f AnnKeywordId
kw Maybe String
Nothing = EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn a
an a -> [AddEpAnn]
f AnnKeywordId
kw
markLocatedAALS EpAnn a
EpAnnNotUsed  a -> [AddEpAnn]
_ AnnKeywordId
_ Maybe String
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markLocatedAALS (EpAnn Anchor
_ a
a EpAnnComments
_) a -> [AddEpAnn]
f AnnKeywordId
kw (Just String
str) = [AddEpAnn] -> Annotated ()
go (a -> [AddEpAnn]
f a
a)
  where
    go :: [AddEpAnn] -> Annotated ()
go [] = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (AddEpAnn AnnKeywordId
kw' EpaLocation
r:[AddEpAnn]
as)
      | AnnKeywordId
kw' AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw = EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
r String
str
      | Bool
otherwise = [AddEpAnn] -> Annotated ()
go [AddEpAnn]
as

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

markArrow :: EpAnn TrailingAnn -> HsArrow GhcPs -> EPP ()
markArrow :: EpAnn TrailingAnn -> HsArrow GhcPs -> Annotated ()
markArrow EpAnn TrailingAnn
an HsArrow GhcPs
arr = do
  case HsArrow GhcPs
arr of
    HsUnrestrictedArrow IsUnicodeSyntax
_u ->
      () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    HsLinearArrow IsUnicodeSyntax
_u Maybe AddEpAnn
ma -> do
      (AddEpAnn -> Annotated ()) -> Maybe AddEpAnn -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AddEpAnn -> Annotated ()
markAddEpAnn Maybe AddEpAnn
ma
    HsExplicitMult IsUnicodeSyntax
_u Maybe AddEpAnn
ma LHsType GhcPs
t  -> do
      (AddEpAnn -> Annotated ()) -> Maybe AddEpAnn -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AddEpAnn -> Annotated ()
markAddEpAnn Maybe AddEpAnn
ma
      GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t

  case EpAnn TrailingAnn
an of
    EpAnn TrailingAnn
EpAnnNotUsed -> () -> Annotated ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    EpAnn TrailingAnn
_ -> TrailingAnn -> Annotated ()
markKwT (EpAnn TrailingAnn -> TrailingAnn
forall ann. EpAnn ann -> ann
anns EpAnn TrailingAnn
an)

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

markAnnCloseP :: EpAnn AnnPragma -> EPP ()
markAnnCloseP :: EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an = EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn AnnPragma
an (AddEpAnn -> [AddEpAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddEpAnn -> [AddEpAnn])
-> (AnnPragma -> AddEpAnn) -> AnnPragma -> [AddEpAnn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnPragma -> AddEpAnn
apr_close) AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")

markAnnOpenP :: EpAnn AnnPragma -> SourceText -> String -> EPP ()
markAnnOpenP :: EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
NoSourceText String
txt   = EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn AnnPragma
an (AddEpAnn -> [AddEpAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddEpAnn -> [AddEpAnn])
-> (AnnPragma -> AddEpAnn) -> AnnPragma -> [AddEpAnn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnPragma -> AddEpAnn
apr_open) AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
txt)
markAnnOpenP EpAnn AnnPragma
an (SourceText String
txt) String
_ = EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn AnnPragma
an (AddEpAnn -> [AddEpAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddEpAnn -> [AddEpAnn])
-> (AnnPragma -> AddEpAnn) -> AnnPragma -> [AddEpAnn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnPragma -> AddEpAnn
apr_open) AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
txt)

markAnnOpen :: EpAnn [AddEpAnn] -> SourceText -> String -> EPP ()
markAnnOpen :: EpAnn [AddEpAnn] -> SourceText -> String -> Annotated ()
markAnnOpen EpAnn [AddEpAnn]
an SourceText
NoSourceText String
txt   = EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
txt)
markAnnOpen EpAnn [AddEpAnn]
an (SourceText String
txt) String
_ = EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
txt)

markAnnOpen' :: Maybe EpaLocation -> SourceText -> String -> EPP ()
markAnnOpen' :: Maybe EpaLocation -> SourceText -> String -> Annotated ()
markAnnOpen' Maybe EpaLocation
ms SourceText
NoSourceText String
txt   = Maybe EpaLocation -> String -> Annotated ()
printStringAtMkw Maybe EpaLocation
ms String
txt
markAnnOpen' Maybe EpaLocation
ms (SourceText String
txt) String
_ = Maybe EpaLocation -> String -> Annotated ()
printStringAtMkw Maybe EpaLocation
ms String
txt

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

markOpeningParen, markClosingParen :: EpAnn AnnParen -> EPP ()
markOpeningParen :: EpAnn AnnParen -> Annotated ()
markOpeningParen EpAnn AnnParen
an = EpAnn AnnParen -> (forall a. (a, a) -> a) -> Annotated ()
markParen EpAnn AnnParen
an forall a. (a, a) -> a
forall a b. (a, b) -> a
fst
markClosingParen :: EpAnn AnnParen -> Annotated ()
markClosingParen EpAnn AnnParen
an = EpAnn AnnParen -> (forall a. (a, a) -> a) -> Annotated ()
markParen EpAnn AnnParen
an forall a. (a, a) -> a
forall a b. (a, b) -> b
snd

markParen :: EpAnn AnnParen -> (forall a. (a,a) -> a) -> EPP ()
markParen :: EpAnn AnnParen -> (forall a. (a, a) -> a) -> Annotated ()
markParen EpAnn AnnParen
EpAnnNotUsed forall a. (a, a) -> a
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markParen (EpAnn Anchor
_ (AnnParen ParenType
pt EpaLocation
o EpaLocation
c) EpAnnComments
_) forall a. (a, a) -> a
f = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA ((AnnKeywordId, AnnKeywordId) -> AnnKeywordId
forall a. (a, a) -> a
f ((AnnKeywordId, AnnKeywordId) -> AnnKeywordId)
-> (AnnKeywordId, AnnKeywordId) -> AnnKeywordId
forall a b. (a -> b) -> a -> b
$ ParenType -> (AnnKeywordId, AnnKeywordId)
kw ParenType
pt) ((EpaLocation, EpaLocation) -> EpaLocation
forall a. (a, a) -> a
f (EpaLocation
o, EpaLocation
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)


markAnnKw :: EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> EPP ()
markAnnKw :: forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw EpAnn a
EpAnnNotUsed  a -> EpaLocation
_ AnnKeywordId
_  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markAnnKw (EpAnn Anchor
_ a
a EpAnnComments
_) a -> EpaLocation
f AnnKeywordId
kw = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
kw (a -> EpaLocation
f a
a)

markAnnKwAll :: EpAnn a -> (a -> [EpaLocation]) -> AnnKeywordId -> EPP ()
markAnnKwAll :: forall a.
EpAnn a -> (a -> [EpaLocation]) -> AnnKeywordId -> Annotated ()
markAnnKwAll EpAnn a
EpAnnNotUsed  a -> [EpaLocation]
_ AnnKeywordId
_  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markAnnKwAll (EpAnn Anchor
_ a
a EpAnnComments
_) a -> [EpaLocation]
f AnnKeywordId
kw = (EpaLocation -> Annotated ()) -> [EpaLocation] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
kw) ([EpaLocation] -> [EpaLocation]
forall a. Ord a => [a] -> [a]
sort (a -> [EpaLocation]
f a
a))

markAnnKwM :: EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> EPP ()
markAnnKwM :: forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM EpAnn a
EpAnnNotUsed  a -> Maybe EpaLocation
_ AnnKeywordId
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markAnnKwM (EpAnn Anchor
_ a
a EpAnnComments
_) a -> Maybe EpaLocation
f AnnKeywordId
kw = Maybe EpaLocation -> Annotated ()
go (a -> Maybe EpaLocation
f a
a)
  where
    go :: Maybe EpaLocation -> Annotated ()
go Maybe EpaLocation
Nothing = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (Just EpaLocation
s) = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
kw EpaLocation
s

markALocatedA :: EpAnn AnnListItem -> EPP ()
markALocatedA :: EpAnn AnnListItem -> Annotated ()
markALocatedA EpAnn AnnListItem
EpAnnNotUsed  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markALocatedA (EpAnn Anchor
_ AnnListItem
a EpAnnComments
_) = [TrailingAnn] -> Annotated ()
markTrailing (AnnListItem -> [TrailingAnn]
lann_trailing AnnListItem
a)

markEpAnn :: EpAnn [AddEpAnn] -> AnnKeywordId -> EPP ()
markEpAnn :: EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
EpAnnNotUsed AnnKeywordId
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markEpAnn (EpAnn Anchor
_ [AddEpAnn]
a EpAnnComments
_) AnnKeywordId
kw = [AddEpAnn] -> AnnKeywordId -> Annotated ()
mark [AddEpAnn]
a AnnKeywordId
kw

markEpAnn' :: EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EPP ()
markEpAnn' :: forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn ann
EpAnnNotUsed ann -> [AddEpAnn]
_ AnnKeywordId
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markEpAnn' (EpAnn Anchor
_ ann
a EpAnnComments
_) ann -> [AddEpAnn]
f AnnKeywordId
kw = [AddEpAnn] -> AnnKeywordId -> Annotated ()
mark (ann -> [AddEpAnn]
f ann
a) AnnKeywordId
kw

markEpAnnAll :: EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EPP ()
markEpAnnAll :: forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll EpAnn ann
EpAnnNotUsed ann -> [AddEpAnn]
_ AnnKeywordId
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markEpAnnAll (EpAnn Anchor
_ ann
a EpAnnComments
_) ann -> [AddEpAnn]
f AnnKeywordId
kw = (AddEpAnn -> Annotated ()) -> [AddEpAnn] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AddEpAnn -> Annotated ()
markKw ([AddEpAnn] -> [AddEpAnn]
forall a. Ord a => [a] -> [a]
sort [AddEpAnn]
anns)
  where
    anns :: [AddEpAnn]
anns = (AddEpAnn -> Bool) -> [AddEpAnn] -> [AddEpAnn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(AddEpAnn AnnKeywordId
ka EpaLocation
_) -> AnnKeywordId
ka AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw) (ann -> [AddEpAnn]
f ann
a)

markAnnAll :: [AddEpAnn] -> AnnKeywordId -> EPP ()
markAnnAll :: [AddEpAnn] -> AnnKeywordId -> Annotated ()
markAnnAll [AddEpAnn]
a AnnKeywordId
kw = (AddEpAnn -> Annotated ()) -> [AddEpAnn] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AddEpAnn -> Annotated ()
markKw ([AddEpAnn] -> [AddEpAnn]
forall a. Ord a => [a] -> [a]
sort [AddEpAnn]
anns)
  where
    anns :: [AddEpAnn]
anns = (AddEpAnn -> Bool) -> [AddEpAnn] -> [AddEpAnn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(AddEpAnn AnnKeywordId
ka EpaLocation
_) -> AnnKeywordId
ka AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw) [AddEpAnn]
a

mark :: [AddEpAnn] -> AnnKeywordId -> EPP ()
mark :: [AddEpAnn] -> AnnKeywordId -> Annotated ()
mark [AddEpAnn]
anns AnnKeywordId
kw = do
  case (AddEpAnn -> Bool) -> [AddEpAnn] -> Maybe AddEpAnn
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AddEpAnn AnnKeywordId
k EpaLocation
_) -> AnnKeywordId
k AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw) [AddEpAnn]
anns of
    Just AddEpAnn
aa -> AddEpAnn -> Annotated ()
markKw AddEpAnn
aa
    Maybe AddEpAnn
Nothing -> case (AddEpAnn -> Bool) -> [AddEpAnn] -> Maybe AddEpAnn
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AddEpAnn AnnKeywordId
k EpaLocation
_) -> AnnKeywordId
k AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== (AnnKeywordId -> AnnKeywordId
unicodeAnn AnnKeywordId
kw)) [AddEpAnn]
anns of
      Just AddEpAnn
aau -> AddEpAnn -> Annotated ()
markKw AddEpAnn
aau
      Maybe AddEpAnn
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

markKwT :: TrailingAnn -> EPP ()
markKwT :: TrailingAnn -> Annotated ()
markKwT (AddSemiAnn EpaLocation
ss)    = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnSemi EpaLocation
ss
markKwT (AddCommaAnn EpaLocation
ss)   = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnComma EpaLocation
ss
markKwT (AddVbarAnn EpaLocation
ss)    = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnVbar EpaLocation
ss
markKwT (AddRarrowAnn EpaLocation
ss)  = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnRarrow EpaLocation
ss
markKwT (AddRarrowAnnU EpaLocation
ss) = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnRarrowU EpaLocation
ss
markKwT (AddLollyAnnU EpaLocation
ss)  = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnLollyU EpaLocation
ss

markKw :: AddEpAnn -> EPP ()
markKw :: AddEpAnn -> Annotated ()
markKw (AddEpAnn AnnKeywordId
kw EpaLocation
ss) = AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
kw EpaLocation
ss

-- | This should be the main driver of the process, managing comments
markKwA :: AnnKeywordId -> EpaLocation -> EPP ()
markKwA :: AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
kw EpaLocation
aa = EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
aa (KeywordId -> String
keywordToString (AnnKeywordId -> KeywordId
G AnnKeywordId
kw))

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

markAnnList :: Bool -> EpAnn AnnList -> EPP () -> EPP ()
markAnnList :: Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
_ EpAnn AnnList
EpAnnNotUsed Annotated ()
action = Annotated ()
action
markAnnList Bool
reallyTrail (EpAnn Anchor
_ AnnList
ann EpAnnComments
_) Annotated ()
action = Bool -> AnnList -> Annotated () -> Annotated ()
markAnnList' Bool
reallyTrail AnnList
ann Annotated ()
action

markAnnList' :: Bool -> AnnList -> EPP () -> EPP ()
markAnnList' :: Bool -> AnnList -> Annotated () -> Annotated ()
markAnnList' Bool
reallyTrail AnnList
ann Annotated ()
action = do
  Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"markAnnList : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, AnnList) -> String
forall a. Outputable a => a -> String
showPprUnsafe (Pos
p, AnnList
ann)
  (AddEpAnn -> Annotated ()) -> Maybe AddEpAnn -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AddEpAnn -> Annotated ()
markAddEpAnn (AnnList -> Maybe AddEpAnn
al_open AnnList
ann)
  Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
reallyTrail (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [TrailingAnn] -> Annotated ()
markTrailing (AnnList -> [TrailingAnn]
al_trailing AnnList
ann) -- Only makes sense for HsModule.
  [AddEpAnn] -> AnnKeywordId -> Annotated ()
markAnnAll ([AddEpAnn] -> [AddEpAnn]
forall a. Ord a => [a] -> [a]
sort ([AddEpAnn] -> [AddEpAnn]) -> [AddEpAnn] -> [AddEpAnn]
forall a b. (a -> b) -> a -> b
$ AnnList -> [AddEpAnn]
al_rest AnnList
ann) AnnKeywordId
AnnSemi
  Annotated ()
action
  (AddEpAnn -> Annotated ()) -> Maybe AddEpAnn -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AddEpAnn -> Annotated ()
markAddEpAnn (AnnList -> Maybe AddEpAnn
al_close AnnList
ann)
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"markAnnList: calling markTrailing with:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TrailingAnn] -> String
forall a. Outputable a => a -> String
showPprUnsafe (AnnList -> [TrailingAnn]
al_trailing AnnList
ann)
  Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
reallyTrail (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [TrailingAnn] -> Annotated ()
markTrailing (AnnList -> [TrailingAnn]
al_trailing AnnList
ann) -- normal case

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

printComments :: RealSrcSpan -> EPP ()
printComments :: RealSrcSpan -> Annotated ()
printComments RealSrcSpan
ss = do
  [Comment]
cs <- RealSrcSpan -> EP String Identity [Comment]
commentAllocation RealSrcSpan
ss
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"printComments: (ss): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Outputable a => a -> String
showPprUnsafe (RealSrcSpan -> (Pos, Pos)
rs2range RealSrcSpan
ss)
  -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentAnchor cs)
  (Comment -> Annotated ()) -> [Comment] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Comment -> Annotated ()
printOneComment [Comment]
cs

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

printOneComment :: Comment -> EPP ()
printOneComment :: Comment -> Annotated ()
printOneComment c :: Comment
c@(Comment String
_str Anchor
loc Maybe AnnKeywordId
_mo) = do
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
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
  DeltaPos
dp <-case Anchor -> AnchorOperation
anchor_op Anchor
loc of
    MovedAnchor DeltaPos
dp -> DeltaPos -> EPP DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return DeltaPos
dp
    AnchorOperation
_ -> do
        Pos
pe <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPriorEndD
        let dp :: DeltaPos
dp = Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
pe (Anchor -> RealSrcSpan
anchor Anchor
loc)
        String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"printOneComment:(dp,pe,anchor loc)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (DeltaPos, Pos, Pos) -> String
forall a. Outputable a => a -> String
showGhc (DeltaPos
dp,Pos
pe,RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
loc)
        DeltaPos -> EPP DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return DeltaPos
dp
  DeltaPos
dp'' <- DeltaPos -> EPP DeltaPos
adjustDeltaForOffsetM DeltaPos
dp
  Maybe Anchor
mep <- EP String Identity (Maybe Anchor)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m (Maybe Anchor)
getExtraDP
  DeltaPos
dp' <- case Maybe Anchor
mep of
    Just (Anchor RealSrcSpan
_ (MovedAnchor DeltaPos
edp)) -> do
      String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
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 -> EPP DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return DeltaPos
edp
    Maybe Anchor
_ -> DeltaPos -> EPP DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return DeltaPos
dp''
  LayoutStartCol Int
dOff <- (EPState -> LayoutStartCol)
-> RWST
     (PrintOptions Identity String)
     (EPWriter String)
     EPState
     Identity
     LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> LayoutStartCol
dLHS
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"printOneComment:(dp,dp',dp'',dOff)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (DeltaPos, DeltaPos, DeltaPos, Int) -> String
forall a. Outputable a => a -> String
showGhc (DeltaPos
dp,DeltaPos
dp',DeltaPos
dp'',Int
dOff)
  Pos -> Annotated ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPriorEndD (RealSrcSpan -> Pos
ss2posEnd (Anchor -> RealSrcSpan
anchor Anchor
loc))
  RealSrcSpan -> Comment -> DeltaPos -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> Comment -> DeltaPos -> EP w m ()
printQueuedComment (Anchor -> RealSrcSpan
anchor Anchor
loc) Comment
c DeltaPos
dp'

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

commentAllocation :: RealSrcSpan -> EPP [Comment]
commentAllocation :: RealSrcSpan -> EP String Identity [Comment]
commentAllocation RealSrcSpan
ss = do
  [Comment]
cs <- EP String Identity [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 ([Comment]
earlier,[Comment]
later) = (Comment -> Bool) -> [Comment] -> ([Comment], [Comment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Comment String
_str Anchor
loc Maybe AnnKeywordId
_mo) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
loc) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= (RealSrcSpan -> Pos
ss2pos RealSrcSpan
ss)) [Comment]
cs
  [Comment] -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[Comment] -> EP w m ()
putUnallocatedComments [Comment]
later
  -- debugM $ "commentAllocation:(ss,earlier,later)" ++ show (rs2range ss,earlier,later)
  [Comment] -> EP String Identity [Comment]
forall (m :: * -> *) a. Monad m => a -> m a
return [Comment]
earlier

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


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

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

markTopLevelList :: ExactPrint ast => [ast] -> EPP ()
markTopLevelList :: forall a. ExactPrint a => [a] -> Annotated ()
markTopLevelList [ast]
ls = (ast -> Annotated ()) -> [ast] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ast
a -> Annotated () -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutTopLevelP (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ ast -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ast
a) [ast]
ls

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

instance ExactPrint ModuleName where
  getAnnotationEntry :: ModuleName -> Entry
getAnnotationEntry ModuleName
_ = Entry
NoEntryVal
  exact :: ModuleName -> Annotated ()
exact ModuleName
n = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
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 -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr ModuleName
n

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

instance ExactPrint (LocatedP WarningTxt) where
  getAnnotationEntry :: LocatedP WarningTxt -> Entry
getAnnotationEntry = LocatedP WarningTxt -> Entry
forall ann a. LocatedAn ann a -> Entry
entryFromLocatedA
  exact :: LocatedP WarningTxt -> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnPragma
an SrcSpan
_) (WarningTxt (L SrcSpan
_ SourceText
src) [Located StringLiteral]
ws)) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# WARNING"
    EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnOpenS
    [Located StringLiteral] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [Located StringLiteral]
ws
    EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnCloseS
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an

  exact (L (SrcSpanAnn EpAnn AnnPragma
an SrcSpan
_) (DeprecatedTxt (L SrcSpan
_ SourceText
src) [Located StringLiteral]
ws)) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# DEPRECATED"
    EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnOpenS
    [Located StringLiteral] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [Located StringLiteral]
ws
    EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnCloseS
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an

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

instance ExactPrint (ImportDecl GhcPs) where
  getAnnotationEntry :: ImportDecl GhcPs -> Entry
getAnnotationEntry ImportDecl GhcPs
idecl = EpAnn EpAnnImportDecl -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (ImportDecl GhcPs -> XCImportDecl GhcPs
forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt ImportDecl GhcPs
idecl)
  exact :: ImportDecl GhcPs -> Annotated ()
exact x :: ImportDecl GhcPs
x@(ImportDecl XCImportDecl GhcPs
EpAnn EpAnnImportDecl
EpAnnNotUsed SourceText
_ XRec GhcPs ModuleName
_ Maybe StringLiteral
_ IsBootInterface
_ Bool
_ ImportDeclQualifiedStyle
_ Bool
_ Maybe (XRec GhcPs ModuleName)
_ Maybe (Bool, XRec GhcPs [LIE GhcPs])
_) = ImportDecl GhcPs -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr ImportDecl GhcPs
x
  exact (ImportDecl ann :: XCImportDecl GhcPs
ann@(EpAnn Anchor
_ EpAnnImportDecl
an EpAnnComments
_) SourceText
msrc (L SrcSpan
lm ModuleName
modname) Maybe StringLiteral
mpkg IsBootInterface
_src Bool
safeflag ImportDeclQualifiedStyle
qualFlag Bool
_impl Maybe (XRec GhcPs ModuleName)
mAs Maybe (Bool, XRec GhcPs [LIE GhcPs])
hiding) = do

    EpAnn EpAnnImportDecl
-> (EpAnnImportDecl -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCImportDecl GhcPs
EpAnn EpAnnImportDecl
ann EpAnnImportDecl -> EpaLocation
importDeclAnnImport AnnKeywordId
AnnImport

    -- "{-# SOURCE" and "#-}"
    case SourceText
msrc of
      SourceText String
_txt -> do
        String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"ImportDecl sourcetext"
        let mo :: Maybe EpaLocation
mo = ((EpaLocation, EpaLocation) -> EpaLocation)
-> Maybe (EpaLocation, EpaLocation) -> Maybe EpaLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EpaLocation, EpaLocation) -> EpaLocation
forall a b. (a, b) -> a
fst (Maybe (EpaLocation, EpaLocation) -> Maybe EpaLocation)
-> Maybe (EpaLocation, EpaLocation) -> Maybe EpaLocation
forall a b. (a -> b) -> a -> b
$ EpAnnImportDecl -> Maybe (EpaLocation, EpaLocation)
importDeclAnnPragma EpAnnImportDecl
an
        let mc :: Maybe EpaLocation
mc = ((EpaLocation, EpaLocation) -> EpaLocation)
-> Maybe (EpaLocation, EpaLocation) -> Maybe EpaLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EpaLocation, EpaLocation) -> EpaLocation
forall a b. (a, b) -> b
snd (Maybe (EpaLocation, EpaLocation) -> Maybe EpaLocation)
-> Maybe (EpaLocation, EpaLocation) -> Maybe EpaLocation
forall a b. (a -> b) -> a -> b
$ EpAnnImportDecl -> Maybe (EpaLocation, EpaLocation)
importDeclAnnPragma EpAnnImportDecl
an
        Maybe EpaLocation -> SourceText -> String -> Annotated ()
markAnnOpen' Maybe EpaLocation
mo SourceText
msrc String
"{-# SOURCE"
        Maybe EpaLocation -> String -> Annotated ()
printStringAtMkw Maybe EpaLocation
mc String
"#-}"
      SourceText
NoSourceText -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
safeflag (EpAnn EpAnnImportDecl
-> (EpAnnImportDecl -> Maybe EpaLocation)
-> AnnKeywordId
-> Annotated ()
forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM XCImportDecl GhcPs
EpAnn EpAnnImportDecl
ann EpAnnImportDecl -> Maybe EpaLocation
importDeclAnnSafe AnnKeywordId
AnnSafe)
    case ImportDeclQualifiedStyle
qualFlag of
      ImportDeclQualifiedStyle
QualifiedPre  -- 'qualified' appears in prepositive position.
        -> Maybe EpaLocation -> String -> Annotated ()
printStringAtMkw (EpAnnImportDecl -> Maybe EpaLocation
importDeclAnnQualified EpAnnImportDecl
an) String
"qualified"
      ImportDeclQualifiedStyle
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case Maybe StringLiteral
mpkg of
     Just (StringLiteral SourceText
src FastString
v Maybe RealSrcSpan
_) ->
       Maybe EpaLocation -> String -> Annotated ()
printStringAtMkw (EpAnnImportDecl -> Maybe EpaLocation
importDeclAnnPackage EpAnnImportDecl
an) (SourceText -> ShowS
sourceTextToString SourceText
src (FastString -> String
forall a. Show a => a -> String
show FastString
v))
     Maybe StringLiteral
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    RealSrcSpan -> String -> Annotated ()
printStringAtKw' (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
lm) (ModuleName -> String
moduleNameString ModuleName
modname)

    case ImportDeclQualifiedStyle
qualFlag of
      ImportDeclQualifiedStyle
QualifiedPost  -- 'qualified' appears in postpositive position.
        -> Maybe EpaLocation -> String -> Annotated ()
printStringAtMkw (EpAnnImportDecl -> Maybe EpaLocation
importDeclAnnQualified EpAnnImportDecl
an) String
"qualified"
      ImportDeclQualifiedStyle
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    case Maybe (XRec GhcPs ModuleName)
mAs of
      Maybe (XRec GhcPs ModuleName)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (L SrcSpan
l ModuleName
mn) -> do
        Maybe EpaLocation -> String -> Annotated ()
printStringAtMkw (EpAnnImportDecl -> Maybe EpaLocation
importDeclAnnAs EpAnnImportDecl
an) String
"as"
        RealSrcSpan -> String -> Annotated ()
printStringAtKw' (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (ModuleName -> String
moduleNameString ModuleName
mn)

    case Maybe (Bool, XRec GhcPs [LIE GhcPs])
hiding of
      Maybe (Bool, XRec GhcPs [LIE GhcPs])
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (Bool
_isHiding,XRec GhcPs [LIE GhcPs]
lie) -> LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs [LIE GhcPs]
LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)]
lie
 --   markTrailingSemi


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

instance ExactPrint HsDocString where
  getAnnotationEntry :: HsDocString -> Entry
getAnnotationEntry HsDocString
_ = Entry
NoEntryVal
  exact :: HsDocString -> Annotated ()
exact = HsDocString -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr -- TODO:AZ use annotations

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

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
_) = Entry
NoEntryVal
  getAnnotationEntry (RoleAnnotD XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
_) = Entry
NoEntryVal

  exact :: HsDecl GhcPs -> Annotated ()
exact (TyClD       XTyClD GhcPs
_ TyClDecl GhcPs
d) = TyClDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated TyClDecl GhcPs
d
  exact (InstD       XInstD GhcPs
_ InstDecl GhcPs
d) = InstDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated InstDecl GhcPs
d
  exact (DerivD      XDerivD GhcPs
_ DerivDecl GhcPs
d) = DerivDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated DerivDecl GhcPs
d
  exact (ValD        XValD GhcPs
_ HsBind GhcPs
d) = HsBind GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsBind GhcPs
d
  exact (SigD        XSigD GhcPs
_ Sig GhcPs
d) = Sig GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Sig GhcPs
d
  exact (KindSigD    XKindSigD GhcPs
_ StandaloneKindSig GhcPs
d) = StandaloneKindSig GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated StandaloneKindSig GhcPs
d
  exact (DefD        XDefD GhcPs
_ DefaultDecl GhcPs
d) = DefaultDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated DefaultDecl GhcPs
d
  exact (ForD        XForD GhcPs
_ ForeignDecl GhcPs
d) = ForeignDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ForeignDecl GhcPs
d
  exact (WarningD    XWarningD GhcPs
_ WarnDecls GhcPs
d) = WarnDecls GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated WarnDecls GhcPs
d
  exact (AnnD        XAnnD GhcPs
_ AnnDecl GhcPs
d) = AnnDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated AnnDecl GhcPs
d
  exact (RuleD       XRuleD GhcPs
_ RuleDecls GhcPs
d) = RuleDecls GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated RuleDecls GhcPs
d
  exact (SpliceD     XSpliceD GhcPs
_ SpliceDecl GhcPs
d) = SpliceDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated SpliceDecl GhcPs
d
  exact (DocD        XDocD GhcPs
_ DocDecl
d) = DocDecl -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated DocDecl
d
  exact (RoleAnnotD  XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
d) = RoleAnnotDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
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
an DataFamInstDecl GhcPs
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XDataFamInstD GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (TyFamInstD   XTyFamInstD GhcPs
_  TyFamInstDecl GhcPs
_) = Entry
NoEntryVal


  exact :: InstDecl GhcPs -> Annotated ()
exact (ClsInstD     XClsInstD GhcPs
_  ClsInstDecl GhcPs
cid) = ClsInstDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ClsInstDecl GhcPs
cid
  exact (DataFamInstD XDataFamInstD GhcPs
an DataFamInstDecl GhcPs
decl) = do
    EpAnn [AddEpAnn]
-> TopLevelFlag -> DataFamInstDecl GhcPs -> Annotated ()
exactDataFamInstDecl XDataFamInstD GhcPs
EpAnn [AddEpAnn]
an TopLevelFlag
TopLevel DataFamInstDecl GhcPs
decl
  exact (TyFamInstD XTyFamInstD GhcPs
_ TyFamInstDecl GhcPs
eqn) = do
    TyFamInstDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated TyFamInstDecl GhcPs
eqn

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

exactDataFamInstDecl :: EpAnn [AddEpAnn] -> TopLevelFlag -> (DataFamInstDecl GhcPs) -> EPP ()
exactDataFamInstDecl :: EpAnn [AddEpAnn]
-> TopLevelFlag -> DataFamInstDecl GhcPs -> Annotated ()
exactDataFamInstDecl EpAnn [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  = HsOuterTyVarBndrs () GhcPs
bndrs
                            , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats   = HsTyPats 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 }))
  = DataDefnWithContext -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated (EpAnn [AddEpAnn]
-> (Maybe (LHsContext GhcPs) -> Annotated ())
-> HsDataDefn GhcPs
-> DataDefnWithContext
DataDefnWithContext XCFamEqn GhcPs (HsDataDefn GhcPs)
EpAnn [AddEpAnn]
an2 Maybe (LHsContext GhcPs) -> Annotated ()
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Annotated ()
pp_hdr HsDataDefn GhcPs
defn) -- See Note [an and an2 in exactDataFamInstDecl]
  where
    pp_hdr :: Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Annotated ()
pp_hdr Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mctxt = do
      case TopLevelFlag
top_lvl of
        TopLevelFlag
TopLevel -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnInstance -- TODO: maybe in toplevel
        TopLevelFlag
NotTopLevel -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      EpAnn [AddEpAnn]
-> LocatedN RdrName
-> HsOuterTyVarBndrs () GhcPs
-> HsTyPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> Annotated ()
exactHsFamInstLHS EpAnn [AddEpAnn]
an LIdP GhcPs
LocatedN RdrName
tycon HsOuterTyVarBndrs () GhcPs
bndrs HsTyPats GhcPs
pats LexicalFixity
fixity Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
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 {deriv_ext :: forall pass. DerivDecl pass -> XCDerivDecl pass
deriv_ext = XCDerivDecl GhcPs
an} ) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCDerivDecl GhcPs
EpAnn [AddEpAnn]
an
  exact :: DerivDecl GhcPs -> Annotated ()
exact (DerivDecl XCDerivDecl GhcPs
an LHsSigWcType GhcPs
typ Maybe (LDerivStrategy GhcPs)
ms Maybe (XRec GhcPs OverlapMode)
mov) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCDerivDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDeriving
    (GenLocated SrcSpan (DerivStrategy GhcPs) -> Annotated ())
-> Maybe (GenLocated SrcSpan (DerivStrategy GhcPs)) -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpan (DerivStrategy GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LDerivStrategy GhcPs)
Maybe (GenLocated SrcSpan (DerivStrategy GhcPs))
ms
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCDerivDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnInstance
    (GenLocated SrcSpanAnnP OverlapMode -> Annotated ())
-> Maybe (GenLocated SrcSpanAnnP OverlapMode) -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnP OverlapMode -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (XRec GhcPs OverlapMode)
Maybe (GenLocated SrcSpanAnnP OverlapMode)
mov
    HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
typ

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

instance ExactPrint (ForeignDecl GhcPs) where
  getAnnotationEntry :: ForeignDecl GhcPs -> Entry
getAnnotationEntry (ForeignImport XForeignImport GhcPs
an LIdP GhcPs
_ LHsSigType GhcPs
_  ForeignImport
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XForeignImport GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ForeignExport XForeignExport GhcPs
an LIdP GhcPs
_ LHsSigType GhcPs
_  ForeignExport
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XForeignExport GhcPs
EpAnn [AddEpAnn]
an

  exact :: ForeignDecl GhcPs -> Annotated ()
exact (ForeignImport XForeignImport GhcPs
an LIdP GhcPs
n LHsSigType GhcPs
ty ForeignImport
fimport) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XForeignImport GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnForeign
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XForeignImport GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnImport

    ForeignImport -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ForeignImport
fimport

    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XForeignImport GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty

  exact (ForeignExport XForeignExport GhcPs
an LIdP GhcPs
n LHsSigType GhcPs
ty ForeignExport
fexport) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XForeignExport GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnForeign
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XForeignExport GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnExport
    ForeignExport -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ForeignExport
fexport
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XForeignExport GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty

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

instance ExactPrint ForeignImport where
  getAnnotationEntry :: ForeignImport -> Entry
getAnnotationEntry = Entry -> ForeignImport -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: ForeignImport -> Annotated ()
exact (CImport Located CCallConv
cconv safety :: Located Safety
safety@(L SrcSpan
ll Safety
_) Maybe Header
_mh CImportSpec
_imp (L SrcSpan
ls SourceText
src)) = do
    Located CCallConv -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located CCallConv
cconv
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SrcSpan
ll SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
noSrcSpan) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located Safety -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located Safety
safety
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SrcSpan
ls SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
noSrcSpan) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
ls SourceText
src String
""

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

instance ExactPrint ForeignExport where
  getAnnotationEntry :: ForeignExport -> Entry
getAnnotationEntry = Entry -> ForeignExport -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: ForeignExport -> Annotated ()
exact (CExport Located CExportSpec
spec (L SrcSpan
ls SourceText
src)) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"CExport starting"
    Located CExportSpec -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located CExportSpec
spec
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SrcSpan
ls SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
noSrcSpan) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
ls SourceText
src String
""

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

instance ExactPrint CExportSpec where
  getAnnotationEntry :: CExportSpec -> Entry
getAnnotationEntry = Entry -> CExportSpec -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: CExportSpec -> Annotated ()
exact (CExportStatic SourceText
_st FastString
_lbl CCallConv
cconv) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"CExportStatic starting"
    CCallConv -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated CCallConv
cconv

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

instance ExactPrint Safety where
  getAnnotationEntry :: Safety -> Entry
getAnnotationEntry = Entry -> Safety -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: Safety -> Annotated ()
exact = Safety -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr

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

instance ExactPrint CCallConv where
  getAnnotationEntry :: CCallConv -> Entry
getAnnotationEntry = Entry -> CCallConv -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: CCallConv -> Annotated ()
exact = CCallConv -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr

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

instance ExactPrint (WarnDecls GhcPs) where
  getAnnotationEntry :: WarnDecls GhcPs -> Entry
getAnnotationEntry (Warnings XWarnings GhcPs
an SourceText
_ [LWarnDecl GhcPs]
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XWarnings GhcPs
EpAnn [AddEpAnn]
an
  exact :: WarnDecls GhcPs -> Annotated ()
exact (Warnings XWarnings GhcPs
an SourceText
src [LWarnDecl GhcPs]
warns) = do
    EpAnn [AddEpAnn] -> SourceText -> String -> Annotated ()
markAnnOpen XWarnings GhcPs
EpAnn [AddEpAnn]
an SourceText
src String
"{-# WARNING" -- Note: might be {-# DEPRECATED
    [GenLocated SrcSpanAnnA (WarnDecl GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LWarnDecl GhcPs]
[GenLocated SrcSpanAnnA (WarnDecl GhcPs)]
warns
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XWarnings GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")

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

instance ExactPrint (WarnDecl GhcPs) where
  getAnnotationEntry :: WarnDecl GhcPs -> Entry
getAnnotationEntry (Warning XWarning GhcPs
an [LIdP GhcPs]
_ WarningTxt
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XWarning GhcPs
EpAnn [AddEpAnn]
an

  exact :: WarnDecl GhcPs -> Annotated ()
exact (Warning XWarning GhcPs
an [LIdP GhcPs]
lns WarningTxt
txt) = do
    [LocatedN RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
lns
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XWarning GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenS -- "["
    case WarningTxt
txt of
      WarningTxt    GenLocated SrcSpan SourceText
_src [Located StringLiteral]
ls -> [Located StringLiteral] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [Located StringLiteral]
ls
      DeprecatedTxt GenLocated SrcSpan SourceText
_src [Located StringLiteral]
ls -> [Located StringLiteral] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [Located StringLiteral]
ls
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XWarning GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseS -- "]"

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

instance ExactPrint StringLiteral where
  getAnnotationEntry :: StringLiteral -> Entry
getAnnotationEntry = Entry -> StringLiteral -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: StringLiteral -> Annotated ()
exact (StringLiteral SourceText
src FastString
fs Maybe RealSrcSpan
mcomma) = do
    SourceText -> String -> Annotated ()
printSourceText SourceText
src (ShowS
forall a. Show a => a -> String
show (FastString -> String
unpackFS FastString
fs))
    (RealSrcSpan -> Annotated ()) -> Maybe RealSrcSpan -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\RealSrcSpan
r -> RealSrcSpan -> String -> Annotated ()
printStringAtKw' RealSrcSpan
r String
",") Maybe RealSrcSpan
mcomma

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

instance ExactPrint FastString where
  getAnnotationEntry :: FastString -> Entry
getAnnotationEntry = Entry -> FastString -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.
  -- exact fs = printStringAdvance (show (unpackFS fs))
  exact :: FastString -> Annotated ()
exact FastString
fs = String -> Annotated ()
printStringAdvance (FastString -> String
unpackFS FastString
fs)


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

instance ExactPrint (RuleDecls GhcPs) where
  getAnnotationEntry :: RuleDecls GhcPs -> Entry
getAnnotationEntry (HsRules XCRuleDecls GhcPs
an SourceText
_ [LRuleDecl GhcPs]
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCRuleDecls GhcPs
EpAnn [AddEpAnn]
an
  exact :: RuleDecls GhcPs -> Annotated ()
exact (HsRules XCRuleDecls GhcPs
an SourceText
src [LRuleDecl GhcPs]
rules) = do
    case SourceText
src of
      SourceText
NoSourceText      -> EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XCRuleDecls GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen  (String -> Maybe String
forall a. a -> Maybe a
Just String
"{-# RULES")
      SourceText String
srcTxt -> EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XCRuleDecls GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen  (String -> Maybe String
forall a. a -> Maybe a
Just String
srcTxt)
    [GenLocated SrcSpanAnnA (RuleDecl GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LRuleDecl GhcPs]
[GenLocated SrcSpanAnnA (RuleDecl GhcPs)]
rules
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XCRuleDecls GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")
    -- markTrailingSemi

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

instance ExactPrint (RuleDecl GhcPs) where
  getAnnotationEntry :: RuleDecl GhcPs -> Entry
getAnnotationEntry (HsRule {rd_ext :: forall pass. RuleDecl pass -> XHsRule pass
rd_ext = XHsRule GhcPs
an}) = EpAnn HsRuleAnn -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XHsRule GhcPs
EpAnn HsRuleAnn
an
  exact :: RuleDecl GhcPs -> Annotated ()
exact (HsRule XHsRule GhcPs
an XRec GhcPs (SourceText, FastString)
ln Activation
act Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
mtybndrs [LRuleBndr GhcPs]
termbndrs XRec GhcPs (HsExpr GhcPs)
lhs XRec GhcPs (HsExpr GhcPs)
rhs) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM String
"HsRule entered"
    GenLocated SrcSpan (SourceText, FastString) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (SourceText, FastString)
GenLocated SrcSpan (SourceText, FastString)
ln
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM String
"HsRule after ln"
    EpAnn HsRuleAnn
-> (HsRuleAnn -> [AddEpAnn]) -> Activation -> Annotated ()
forall a.
EpAnn a -> (a -> [AddEpAnn]) -> Activation -> Annotated ()
markActivation XHsRule GhcPs
EpAnn HsRuleAnn
an HsRuleAnn -> [AddEpAnn]
ra_rest Activation
act
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM String
"HsRule after act"
    case Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
mtybndrs of
      Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just [LHsTyVarBndr () (NoGhcTc GhcPs)]
bndrs -> do
        EpAnn HsRuleAnn -> (HsRuleAnn -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA XHsRule GhcPs
EpAnn HsRuleAnn
an (\HsRuleAnn
a -> ((AddEpAnn, AddEpAnn) -> AddEpAnn)
-> Maybe (AddEpAnn, AddEpAnn) -> Maybe AddEpAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> a
fst (HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
ra_tyanns HsRuleAnn
a))  -- AnnForall
        (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Annotated ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsTyVarBndr () (NoGhcTc GhcPs)]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
bndrs
        EpAnn HsRuleAnn -> (HsRuleAnn -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA XHsRule GhcPs
EpAnn HsRuleAnn
an (\HsRuleAnn
a -> ((AddEpAnn, AddEpAnn) -> AddEpAnn)
-> Maybe (AddEpAnn, AddEpAnn) -> Maybe AddEpAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> b
snd (HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
ra_tyanns HsRuleAnn
a))  -- AnnDot

    EpAnn HsRuleAnn -> (HsRuleAnn -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA XHsRule GhcPs
EpAnn HsRuleAnn
an (\HsRuleAnn
a -> ((AddEpAnn, AddEpAnn) -> AddEpAnn)
-> Maybe (AddEpAnn, AddEpAnn) -> Maybe AddEpAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> a
fst (HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
ra_tmanns HsRuleAnn
a))  -- AnnForall
    (GenLocated SrcSpan (RuleBndr GhcPs) -> Annotated ())
-> [GenLocated SrcSpan (RuleBndr GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpan (RuleBndr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LRuleBndr GhcPs]
[GenLocated SrcSpan (RuleBndr GhcPs)]
termbndrs
    EpAnn HsRuleAnn -> (HsRuleAnn -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA XHsRule GhcPs
EpAnn HsRuleAnn
an (\HsRuleAnn
a -> ((AddEpAnn, AddEpAnn) -> AddEpAnn)
-> Maybe (AddEpAnn, AddEpAnn) -> Maybe AddEpAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> b
snd (HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
ra_tmanns HsRuleAnn
a))  -- AnnDot

    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs
    EpAnn HsRuleAnn
-> (HsRuleAnn -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' XHsRule GhcPs
EpAnn HsRuleAnn
an HsRuleAnn -> [AddEpAnn]
ra_rest AnnKeywordId
AnnEqual
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs

markActivation :: EpAnn a -> (a -> [AddEpAnn]) -> Activation -> Annotated ()
markActivation :: forall a.
EpAnn a -> (a -> [AddEpAnn]) -> Activation -> Annotated ()
markActivation EpAnn a
an a -> [AddEpAnn]
fn Activation
act = do
  case Activation
act of
    ActiveBefore SourceText
src Int
phase -> do
      EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnOpenS --  '['
      EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnTilde -- ~
      EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnVal (String -> Maybe String
forall a. a -> Maybe a
Just (SourceText -> String -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
src (Int -> String
forall a. Show a => a -> String
show Int
phase) String
""))
      EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnCloseS -- ']'
    ActiveAfter SourceText
src Int
phase -> do
      EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnOpenS --  '['
      EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnVal (String -> Maybe String
forall a. a -> Maybe a
Just (SourceText -> String -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
src (Int -> String
forall a. Show a => a -> String
show Int
phase) String
""))
      EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnCloseS -- ']'
    Activation
NeverActive -> do
      EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnOpenS --  '['
      EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnTilde -- ~
      EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' EpAnn a
an a -> [AddEpAnn]
fn AnnKeywordId
AnnCloseS -- ']'
    Activation
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance ExactPrint (SpliceDecl GhcPs) where
  getAnnotationEntry :: SpliceDecl GhcPs -> Entry
getAnnotationEntry = Entry -> SpliceDecl GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: SpliceDecl GhcPs -> Annotated ()
exact (SpliceDecl XSpliceDecl GhcPs
_ XRec GhcPs (HsSplice GhcPs)
splice SpliceExplicitFlag
_flag) = do
    GenLocated SrcSpanAnnA (HsSplice GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsSplice GhcPs)
GenLocated SrcSpanAnnA (HsSplice GhcPs)
splice

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

instance ExactPrint DocDecl where
  getAnnotationEntry :: DocDecl -> Entry
getAnnotationEntry = Entry -> DocDecl -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: DocDecl -> Annotated ()
exact DocDecl
v =
    let str :: String
str =
          case DocDecl
v of
            (DocCommentNext HsDocString
ds)     -> HsDocString -> String
unpackHDS HsDocString
ds
            (DocCommentPrev HsDocString
ds)     -> HsDocString -> String
unpackHDS HsDocString
ds
            (DocCommentNamed String
_s HsDocString
ds) -> HsDocString -> String
unpackHDS HsDocString
ds
            (DocGroup Int
_i HsDocString
ds)        -> HsDocString -> String
unpackHDS HsDocString
ds
    in
      String -> Annotated ()
printStringAdvance String
str

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

instance ExactPrint (RoleAnnotDecl GhcPs) where
  getAnnotationEntry :: RoleAnnotDecl GhcPs -> Entry
getAnnotationEntry (RoleAnnotDecl XCRoleAnnotDecl GhcPs
an LIdP GhcPs
_ [XRec GhcPs (Maybe Role)]
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCRoleAnnotDecl GhcPs
EpAnn [AddEpAnn]
an
  exact :: RoleAnnotDecl GhcPs -> Annotated ()
exact (RoleAnnotDecl XCRoleAnnotDecl GhcPs
an LIdP GhcPs
ltycon [XRec GhcPs (Maybe Role)]
roles) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCRoleAnnotDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnType
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCRoleAnnotDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnRole
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
ltycon
    let markRole :: GenLocated SrcSpan (Maybe e) -> Annotated ()
markRole (L SrcSpan
l (Just e
r)) = GenLocated SrcSpan e -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated (SrcSpan -> e -> GenLocated SrcSpan e
forall l e. l -> e -> GenLocated l e
L SrcSpan
l e
r)
        markRole (L SrcSpan
l Maybe e
Nothing) = SrcSpan -> String -> Annotated ()
printStringAtSs SrcSpan
l String
"_"
    (GenLocated SrcSpan (Maybe Role) -> Annotated ())
-> [GenLocated SrcSpan (Maybe Role)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpan (Maybe Role) -> Annotated ()
forall {e}.
ExactPrint e =>
GenLocated SrcSpan (Maybe e) -> Annotated ()
markRole [XRec GhcPs (Maybe Role)]
[GenLocated SrcSpan (Maybe Role)]
roles

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

instance ExactPrint Role where
  getAnnotationEntry :: Role -> Entry
getAnnotationEntry = Entry -> Role -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: Role -> Annotated ()
exact = Role -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr

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

instance ExactPrint (RuleBndr GhcPs) where
  getAnnotationEntry :: RuleBndr GhcPs -> Entry
getAnnotationEntry = Entry -> RuleBndr GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: RuleBndr GhcPs -> Annotated ()
exact (RuleBndr XCRuleBndr GhcPs
_ LIdP GhcPs
ln) = LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
ln
  exact (RuleBndrSig XRuleBndrSig GhcPs
an LIdP GhcPs
ln (HsPS XHsPS GhcPs
_ LHsType GhcPs
ty)) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XRuleBndrSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenP -- "("
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
ln
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XRuleBndrSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XRuleBndrSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseP -- ")"

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

instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where
  getAnnotationEntry :: FamEqn GhcPs body -> Entry
getAnnotationEntry (FamEqn { feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_ext = XCFamEqn GhcPs body
an}) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCFamEqn GhcPs body
EpAnn [AddEpAnn]
an
  exact :: FamEqn GhcPs body -> Annotated ()
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  = HsOuterTyVarBndrs () GhcPs
bndrs
                , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats   = HsTyPats 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
    EpAnn [AddEpAnn]
-> LocatedN RdrName
-> HsOuterTyVarBndrs () GhcPs
-> HsTyPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> Annotated ()
exactHsFamInstLHS XCFamEqn GhcPs body
EpAnn [AddEpAnn]
an LIdP GhcPs
LocatedN RdrName
tycon HsOuterTyVarBndrs () GhcPs
bndrs HsTyPats GhcPs
pats LexicalFixity
fixity Maybe (LHsContext GhcPs)
forall a. Maybe a
Nothing
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamEqn GhcPs body
EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual
    body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated body
rhs

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

exactHsFamInstLHS ::
      EpAnn [AddEpAnn]
   -> LocatedN RdrName
   -> HsOuterTyVarBndrs () GhcPs
   -> HsTyPats GhcPs
   -> LexicalFixity
   -> Maybe (LHsContext GhcPs)
   -> EPP ()
exactHsFamInstLHS :: EpAnn [AddEpAnn]
-> LocatedN RdrName
-> HsOuterTyVarBndrs () GhcPs
-> HsTyPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> Annotated ()
exactHsFamInstLHS EpAnn [AddEpAnn]
an LocatedN RdrName
thing HsOuterTyVarBndrs () GhcPs
bndrs HsTyPats GhcPs
typats LexicalFixity
fixity Maybe (LHsContext GhcPs)
mb_ctxt = do
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnForall
  HsOuterTyVarBndrs () GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsOuterTyVarBndrs () GhcPs
bndrs
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnDot
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> Annotated ())
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mb_ctxt
  HsTyPats GhcPs -> Annotated ()
exact_pats HsTyPats GhcPs
typats
  where
    exact_pats :: HsTyPats GhcPs -> EPP ()
    exact_pats :: HsTyPats GhcPs -> Annotated ()
exact_pats (LHsTypeArg GhcPs
patl:LHsTypeArg GhcPs
patr:HsTyPats GhcPs
pats)
      | LexicalFixity
Infix <- LexicalFixity
fixity
      = let exact_op_app :: Annotated ()
exact_op_app = do
              [AddEpAnn] -> AnnKeywordId -> Annotated ()
markAnnAll (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
an) AnnKeywordId
AnnOpenP
              HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsTypeArg GhcPs
HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
patl
              LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
thing
              HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsTypeArg GhcPs
HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
patr
              [AddEpAnn] -> AnnKeywordId -> Annotated ()
markAnnAll (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
an) AnnKeywordId
AnnCloseP
        in case HsTyPats GhcPs
pats of
             [] -> Annotated ()
exact_op_app
             HsTyPats GhcPs
_  -> do
               -- markEpAnn an AnnOpenP
               Annotated ()
exact_op_app
               -- markEpAnn an AnnCloseP
               (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Annotated ())
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HsArg
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsTyPats GhcPs
[HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
pats

    exact_pats HsTyPats GhcPs
pats = do
      [AddEpAnn] -> AnnKeywordId -> Annotated ()
markAnnAll (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
an) AnnKeywordId
AnnOpenP
      LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
thing
      [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsTyPats GhcPs
[HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
pats
      [AddEpAnn] -> AnnKeywordId -> Annotated ()
markAnnAll (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
an) AnnKeywordId
AnnCloseP

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

-- instance ExactPrint (LHsTypeArg GhcPs) where
instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)
     =>  ExactPrint (HsArg tm ty) where
  getAnnotationEntry :: HsArg tm ty -> Entry
getAnnotationEntry = Entry -> HsArg tm ty -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: HsArg tm ty -> Annotated ()
exact (HsValArg tm
tm)    = tm -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated tm
tm
  exact (HsTypeArg SrcSpan
ss ty
ty) = SrcSpan -> String -> Annotated ()
printStringAtSs SrcSpan
ss String
"@" Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ty -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ty
ty
  exact x :: HsArg tm ty
x@(HsArgPar SrcSpan
_sp)   = HsArg tm ty -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr HsArg tm ty
x -- Does not appear in original source

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

instance ExactPrint (ClsInstDecl GhcPs) where
  getAnnotationEntry :: ClsInstDecl GhcPs -> Entry
getAnnotationEntry ClsInstDecl GhcPs
cid = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn ((EpAnn [AddEpAnn], AnnSortKey) -> EpAnn [AddEpAnn]
forall a b. (a, b) -> a
fst ((EpAnn [AddEpAnn], AnnSortKey) -> EpAnn [AddEpAnn])
-> (EpAnn [AddEpAnn], AnnSortKey) -> EpAnn [AddEpAnn]
forall a b. (a -> b) -> a -> b
$ ClsInstDecl GhcPs -> XCClsInstDecl GhcPs
forall pass. ClsInstDecl pass -> XCClsInstDecl pass
cid_ext ClsInstDecl GhcPs
cid)

  exact :: ClsInstDecl GhcPs -> Annotated ()
exact (ClsInstDecl { cid_ext :: forall pass. ClsInstDecl pass -> XCClsInstDecl pass
cid_ext = (EpAnn [AddEpAnn]
an, AnnSortKey
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
          Annotated ()
top_matter
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnWhere
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC
          EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnSemi
          AnnSortKey -> [(RealSrcSpan, Annotated ())] -> Annotated ()
withSortKey AnnSortKey
sortKey
                               ([LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA [LTyFamInstDecl GhcPs]
[LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
ats
                             [(RealSrcSpan, Annotated ())]
-> [(RealSrcSpan, Annotated ())] -> [(RealSrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ (DataFamInstDecl GhcPs -> Annotated ())
-> [LocatedAn AnnListItem (DataFamInstDecl GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall a an.
(a -> Annotated ())
-> [LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationF (EpAnn [AddEpAnn]
-> TopLevelFlag -> DataFamInstDecl GhcPs -> Annotated ()
exactDataFamInstDecl EpAnn [AddEpAnn]
an TopLevelFlag
NotTopLevel ) [LDataFamInstDecl GhcPs]
[LocatedAn AnnListItem (DataFamInstDecl GhcPs)]
adts
                             [(RealSrcSpan, Annotated ())]
-> [(RealSrcSpan, Annotated ())] -> [(RealSrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LocatedAn AnnListItem (HsBind GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA (Bag (LocatedAn AnnListItem (HsBind GhcPs))
-> [LocatedAn AnnListItem (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
Bag (LocatedAn AnnListItem (HsBind GhcPs))
binds)
                             [(RealSrcSpan, Annotated ())]
-> [(RealSrcSpan, Annotated ())] -> [(RealSrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LocatedAn AnnListItem (Sig GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA [LSig GhcPs]
[LocatedAn AnnListItem (Sig GhcPs)]
sigs
                               )
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC -- '}'

      where
        top_matter :: Annotated ()
top_matter = do
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnInstance
          (GenLocated SrcSpanAnnP OverlapMode -> Annotated ())
-> Maybe (GenLocated SrcSpanAnnP OverlapMode) -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnP OverlapMode -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (XRec GhcPs OverlapMode)
Maybe (GenLocated SrcSpanAnnP OverlapMode)
mbOverlap
          GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
inst_ty
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnWhere -- Optional

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

instance ExactPrint (TyFamInstDecl GhcPs) where
  getAnnotationEntry :: TyFamInstDecl GhcPs -> Entry
getAnnotationEntry (TyFamInstDecl XCTyFamInstDecl GhcPs
an TyFamInstEqn GhcPs
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCTyFamInstDecl GhcPs
EpAnn [AddEpAnn]
an

  exact :: TyFamInstDecl GhcPs -> Annotated ()
exact (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
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCTyFamInstDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnType
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCTyFamInstDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnInstance
    FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated TyFamInstEqn GhcPs
FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
eqn

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

instance ExactPrint (LocatedP OverlapMode) where
  getAnnotationEntry :: GenLocated SrcSpanAnnP OverlapMode -> Entry
getAnnotationEntry = GenLocated SrcSpanAnnP OverlapMode -> Entry
forall ann a. LocatedAn ann a -> Entry
entryFromLocatedA

  -- NOTE: NoOverlap is only used in the typechecker
  exact :: GenLocated SrcSpanAnnP OverlapMode -> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnPragma
an SrcSpan
_) (NoOverlap SourceText
src)) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# NO_OVERLAP"
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an

  exact (L (SrcSpanAnn EpAnn AnnPragma
an SrcSpan
_) (Overlappable SourceText
src)) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# OVERLAPPABLE"
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an

  exact (L (SrcSpanAnn EpAnn AnnPragma
an SrcSpan
_) (Overlapping SourceText
src)) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# OVERLAPPING"
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an

  exact (L (SrcSpanAnn EpAnn AnnPragma
an SrcSpan
_) (Overlaps SourceText
src)) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# OVERLAPS"
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an

  exact (L (SrcSpanAnn EpAnn AnnPragma
an SrcSpan
_) (Incoherent SourceText
src)) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
src String
"{-# INCOHERENT"
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an

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

instance ExactPrint (HsBind GhcPs) where
  getAnnotationEntry :: HsBind GhcPs -> Entry
getAnnotationEntry FunBind{} = Entry
NoEntryVal
  getAnnotationEntry PatBind{pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_ext=XPatBind GhcPs GhcPs
an} = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XPatBind GhcPs GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry VarBind{} = Entry
NoEntryVal
  getAnnotationEntry AbsBinds{} = Entry
NoEntryVal
  getAnnotationEntry PatSynBind{} = Entry
NoEntryVal

  exact :: HsBind GhcPs -> Annotated ()
exact (FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
matches [CoreTickish]
_) = do
    MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
matches
  exact (PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
pat GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
grhss ([CoreTickish], [[CoreTickish]])
_) = do
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
    GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss
  exact (PatSynBind XPatSynBind GhcPs GhcPs
_ PatSynBind GhcPs GhcPs
bind) = PatSynBind GhcPs GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated PatSynBind GhcPs GhcPs
bind

  exact HsBind GhcPs
x = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
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 (PatSynBind GhcPs GhcPs) where
  getAnnotationEntry :: PatSynBind GhcPs GhcPs -> Entry
getAnnotationEntry (PSB { psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_ext = XPSB GhcPs GhcPs
an}) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
an

  exact :: PatSynBind GhcPs GhcPs -> Annotated ()
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
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnPattern
    case HsPatSynDetails GhcPs
details of
      InfixCon LIdP GhcPs
v1 LIdP GhcPs
v2 -> do
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
v1
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
psyn
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
v2
      PrefixCon [Void]
tvs [LIdP GhcPs]
vs -> do
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
psyn
        [Void] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [Void]
tvs
        [LocatedN RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
vs
      RecCon [RecordPatSynField GhcPs]
vs -> do
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
psyn
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC  -- '{'
        [RecordPatSynField GhcPs] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [RecordPatSynField GhcPs]
vs
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC -- '}'

    case HsPatSynDir GhcPs
dir of
      HsPatSynDir GhcPs
Unidirectional           -> do
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnLarrow
        GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
      HsPatSynDir GhcPs
ImplicitBidirectional    -> do
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual
        GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
      ExplicitBidirectional MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg -> do
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnLarrow
        GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnWhere
        MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg


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

instance ExactPrint (RecordPatSynField GhcPs) where
  getAnnotationEntry :: RecordPatSynField GhcPs -> Entry
getAnnotationEntry = Entry -> RecordPatSynField GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: RecordPatSynField GhcPs -> Annotated ()
exact (RecordPatSynField { recordPatSynField :: forall pass. RecordPatSynField pass -> FieldOcc pass
recordPatSynField = FieldOcc GhcPs
v }) = FieldOcc GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated FieldOcc GhcPs
v

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

instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where
  getAnnotationEntry :: Match GhcPs (LocatedA (HsCmd GhcPs)) -> Entry
getAnnotationEntry (Match XCMatch GhcPs (LocatedA (HsCmd GhcPs))
ann HsMatchContext (NoGhcTc GhcPs)
_ [LPat GhcPs]
_ GRHSs GhcPs (LocatedA (HsCmd GhcPs))
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCMatch GhcPs (LocatedA (HsCmd GhcPs))
EpAnn [AddEpAnn]
ann

  exact :: Match GhcPs (LocatedA (HsCmd GhcPs)) -> Annotated ()
exact (Match XCMatch GhcPs (LocatedA (HsCmd GhcPs))
an HsMatchContext (NoGhcTc GhcPs)
mctxt [LPat GhcPs]
pats GRHSs GhcPs (LocatedA (HsCmd GhcPs))
grhss) = do
    Match GhcPs (LocatedA (HsCmd GhcPs)) -> Annotated ()
forall body.
ExactPrint (GRHSs GhcPs body) =>
Match GhcPs body -> Annotated ()
exactMatch (XCMatch GhcPs (LocatedA (HsCmd GhcPs))
-> HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA (HsCmd GhcPs))
-> Match GhcPs (LocatedA (HsCmd GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (LocatedA (HsCmd GhcPs))
an HsMatchContext (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 XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ann HsMatchContext (NoGhcTc GhcPs)
_ [LPat GhcPs]
_ GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
ann

  exact :: Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Annotated ()
exact (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an HsMatchContext (NoGhcTc GhcPs)
mctxt [LPat GhcPs]
pats GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss) = do
    Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Annotated ()
forall body.
ExactPrint (GRHSs GhcPs body) =>
Match GhcPs body -> Annotated ()
exactMatch (XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an HsMatchContext (NoGhcTc GhcPs)
mctxt [LPat GhcPs]
pats GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss)

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

exactMatch :: (ExactPrint (GRHSs GhcPs body)) => (Match GhcPs body) -> Annotated ()
exactMatch :: forall body.
ExactPrint (GRHSs GhcPs body) =>
Match GhcPs body -> Annotated ()
exactMatch (Match XCMatch GhcPs body
an HsMatchContext (NoGhcTc GhcPs)
mctxt [LPat GhcPs]
pats GRHSs GhcPs body
grhss) = do
-- Based on Expr.pprMatch

  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"exact Match entered"

  -- herald
  case HsMatchContext (NoGhcTc GhcPs)
mctxt of
    FunRhs LIdP (NoGhcTc GhcPs)
fun LexicalFixity
fixity SrcStrictness
strictness -> do
      String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
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
      case SrcStrictness
strictness of
        SrcStrictness
SrcStrict -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCMatch GhcPs body
EpAnn [AddEpAnn]
an AnnKeywordId
AnnBang
        SrcStrictness
_ -> () -> Annotated ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      case LexicalFixity
fixity of
        LexicalFixity
Prefix -> do
          EpAnn [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToCommentsA XCMatch GhcPs body
EpAnn [AddEpAnn]
an [AnnKeywordId
AnnOpenP,AnnKeywordId
AnnCloseP]
          LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP (NoGhcTc GhcPs)
LocatedN RdrName
fun
          [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
        LexicalFixity
Infix ->
          case [LPat GhcPs]
pats of
            (LPat GhcPs
p1:LPat GhcPs
p2:[LPat GhcPs]
rest)
              | [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
rest -> do
                  GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1
                  LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP (NoGhcTc GhcPs)
LocatedN RdrName
fun
                  GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p2
              | Bool
otherwise -> do
                  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCMatch GhcPs body
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenP
                  GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1
                  LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP (NoGhcTc GhcPs)
LocatedN RdrName
fun
                  GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p2
                  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCMatch GhcPs body
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseP
                  (GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
rest
            [LPat GhcPs]
_ -> String -> Annotated ()
forall a. String -> a
panic String
"FunRhs"
    HsMatchContext (NoGhcTc GhcPs)
LambdaExpr -> do
      EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCMatch GhcPs body
EpAnn [AddEpAnn]
an AnnKeywordId
AnnLam
      [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
    HsMatchContext (NoGhcTc GhcPs)
GHC.CaseAlt -> do
      [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
    HsMatchContext (NoGhcTc GhcPs)
_ -> HsMatchContext GhcPs -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr HsMatchContext GhcPs
HsMatchContext (NoGhcTc GhcPs)
mctxt

  GRHSs GhcPs body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated GRHSs GhcPs body
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

  exact :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Annotated ()
exact (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
binds) = do
    [GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss
    HsLocalBinds GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsLocalBinds GhcPs
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

  exact :: GRHSs GhcPs (LocatedA (HsCmd GhcPs)) -> Annotated ()
exact (GRHSs XCGRHSs GhcPs (LocatedA (HsCmd GhcPs))
_an [LGRHS GhcPs (LocatedA (HsCmd GhcPs))]
grhss HsLocalBinds GhcPs
binds) = do
    [GenLocated SrcSpan (GRHS GhcPs (LocatedA (HsCmd GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LGRHS GhcPs (LocatedA (HsCmd GhcPs))]
[GenLocated SrcSpan (GRHS GhcPs (LocatedA (HsCmd GhcPs)))]
grhss
    HsLocalBinds GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsLocalBinds GhcPs
binds

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

-- Temporary until https://gitlab.haskell.org/ghc/ghc/-/issues/20247
-- is fixed
fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn EpAnn AnnList
EpAnnNotUsed = EpAnn AnnList
forall ann. EpAnn ann
EpAnnNotUsed
fixValbindsAnn (EpAnn Anchor
anchor (AnnList Maybe Anchor
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
  = (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (Anchor -> [AddEpAnn] -> Anchor
widenAnchor Anchor
anchor ((TrailingAnn -> AddEpAnn) -> [TrailingAnn] -> [AddEpAnn]
forall a b. (a -> b) -> [a] -> [b]
map TrailingAnn -> AddEpAnn
toEpaAnn [TrailingAnn]
t)) (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
  where
    toEpaAnn :: TrailingAnn -> AddEpAnn
toEpaAnn (AddSemiAnn EpaLocation
ss)    = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnSemi EpaLocation
ss
    toEpaAnn (AddCommaAnn EpaLocation
ss)   = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnComma EpaLocation
ss
    toEpaAnn (AddVbarAnn EpaLocation
ss)    = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnVbar EpaLocation
ss
    toEpaAnn (AddRarrowAnn EpaLocation
ss)  = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnRarrow EpaLocation
ss
    toEpaAnn (AddRarrowAnnU EpaLocation
ss) = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnRarrowU EpaLocation
ss
    toEpaAnn (AddLollyAnnU EpaLocation
ss)  = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnLollyU EpaLocation
ss

-- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256
fixAnnListAnn :: EpAnn AnnList -> EpAnn AnnList
fixAnnListAnn :: EpAnn AnnList -> EpAnn AnnList
fixAnnListAnn EpAnn AnnList
EpAnnNotUsed = EpAnn AnnList
forall ann. EpAnn ann
EpAnnNotUsed
fixAnnListAnn (EpAnn Anchor
anchor (AnnList Maybe Anchor
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)
  = (Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (Anchor -> [AddEpAnn] -> Anchor
widenAnchor Anchor
anchor [AddEpAnn]
r) (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
ma Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
r [TrailingAnn]
t) EpAnnComments
cs)

-- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256
fixSrcAnnL :: SrcSpanAnnL -> SrcSpanAnnL
fixSrcAnnL :: SrcSpanAnnL -> SrcSpanAnnL
fixSrcAnnL (SrcSpanAnn EpAnn AnnList
an SrcSpan
l) = EpAnn AnnList -> SrcSpan -> SrcSpanAnnL
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (EpAnn AnnList -> EpAnn AnnList
fixAnnListAnn EpAnn AnnList
an) SrcSpan
l

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

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

  exact :: HsLocalBinds GhcPs -> Annotated ()
exact (HsValBinds XHsValBinds GhcPs GhcPs
an' HsValBindsLR GhcPs GhcPs
valbinds) = do
    let an :: EpAnn AnnList
an = EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn XHsValBinds GhcPs GhcPs
EpAnn AnnList
an'
    EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn AnnList
an AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnWhere
    let manc :: Maybe Anchor
manc = case EpAnn AnnList
an of
                 EpAnn AnnList
EpAnnNotUsed -> Maybe Anchor
forall a. Maybe a
Nothing
                 EpAnn AnnList
_ -> AnnList -> Maybe Anchor
al_anchor (AnnList -> Maybe Anchor) -> AnnList -> Maybe Anchor
forall a b. (a -> b) -> a -> b
$ EpAnn AnnList -> AnnList
forall ann. EpAnn ann -> ann
anns EpAnn AnnList
an

    case Maybe Anchor
manc of
      Just Anchor
anc -> do
        Bool -> Annotated () -> Annotated ()
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) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Maybe Anchor -> Annotated ()
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
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
False EpAnn AnnList
an (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ HsValBindsLR GhcPs GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotatedWithLayout HsValBindsLR GhcPs GhcPs
valbinds

  exact (HsIPBinds XHsIPBinds GhcPs GhcPs
an HsIPBinds GhcPs
bs)
    = Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
True XHsIPBinds GhcPs GhcPs
EpAnn AnnList
an (EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL XHsIPBinds GhcPs GhcPs
EpAnn AnnList
an AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnWhere Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsIPBinds GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsIPBinds GhcPs
bs)
  exact (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

  exact :: HsValBindsLR GhcPs GhcPs -> Annotated ()
exact (ValBinds XValBinds GhcPs GhcPs
sortKey LHsBinds GhcPs
binds [LSig GhcPs]
sigs) = do
    Annotated () -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutBoth (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnSortKey -> [(RealSrcSpan, Annotated ())] -> Annotated ()
withSortKey XValBinds GhcPs GhcPs
AnnSortKey
sortKey
       ([LocatedAn AnnListItem (HsBind GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA (Bag (LocatedAn AnnListItem (HsBind GhcPs))
-> [LocatedAn AnnListItem (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
Bag (LocatedAn AnnListItem (HsBind GhcPs))
binds)
     [(RealSrcSpan, Annotated ())]
-> [(RealSrcSpan, Annotated ())] -> [(RealSrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LocatedAn AnnListItem (Sig GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA [LSig GhcPs]
[LocatedAn AnnListItem (Sig GhcPs)]
sigs
       )
  exact (XValBindsLR XXValBindsLR GhcPs GhcPs
_) = String -> Annotated ()
forall a. String -> a
panic String
"XValBindsLR"

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

instance ExactPrint (HsIPBinds GhcPs) where
  getAnnotationEntry :: HsIPBinds GhcPs -> Entry
getAnnotationEntry = Entry -> HsIPBinds GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

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

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

instance ExactPrint (IPBind GhcPs) where
  getAnnotationEntry :: IPBind GhcPs -> Entry
getAnnotationEntry (IPBind XCIPBind GhcPs
an Either (XRec GhcPs HsIPName) (IdP GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCIPBind GhcPs
EpAnn [AddEpAnn]
an

  exact :: IPBind GhcPs -> Annotated ()
exact (IPBind XCIPBind GhcPs
an (Left XRec GhcPs HsIPName
lr) XRec GhcPs (HsExpr GhcPs)
rhs) = do
    GenLocated SrcSpan HsIPName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs HsIPName
GenLocated SrcSpan HsIPName
lr
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCIPBind GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs

  exact (IPBind XCIPBind GhcPs
_ (Right IdP GhcPs
_) XRec GhcPs (HsExpr GhcPs)
_) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"ExactPrint IPBind: Right only after typechecker"

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

instance ExactPrint HsIPName where
  getAnnotationEntry :: HsIPName -> Entry
getAnnotationEntry = Entry -> HsIPName -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: HsIPName -> Annotated ()
exact (HsIPName FastString
fs) = String -> Annotated ()
printStringAdvance (String
"?" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (FastString -> String
unpackFS FastString
fs))

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

prepareListAnnotationF :: (a -> EPP ()) -> [LocatedAn an a] -> [(RealSrcSpan,EPP ())]
prepareListAnnotationF :: forall a an.
(a -> Annotated ())
-> [LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationF a -> Annotated ()
f [LocatedAn an a]
ls
  = (LocatedAn an a -> (RealSrcSpan, Annotated ()))
-> [LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn an a
b, a -> Annotated ()
f (LocatedAn an a -> a
forall l e. GenLocated l e -> e
unLoc LocatedAn an a
b))) [LocatedAn an a]
ls

prepareListAnnotationA :: ExactPrint (LocatedAn an a)
  => [LocatedAn an a] -> [(RealSrcSpan,EPP ())]
prepareListAnnotationA :: forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA [LocatedAn an a]
ls = (LocatedAn an a -> (RealSrcSpan, Annotated ()))
-> [LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn an a
b,LocatedAn an a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedAn an a
b)) [LocatedAn an a]
ls

withSortKey :: AnnSortKey -> [(RealSrcSpan, EPP ())] -> EPP ()
withSortKey :: AnnSortKey -> [(RealSrcSpan, Annotated ())] -> Annotated ()
withSortKey AnnSortKey
annSortKey [(RealSrcSpan, Annotated ())]
xs = do
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"withSortKey:annSortKey=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnnSortKey -> String
forall a. Data a => a -> String
showAst AnnSortKey
annSortKey
  let ordered :: [(RealSrcSpan, Annotated ())]
ordered = case AnnSortKey
annSortKey of
                  AnnSortKey
NoAnnSortKey -> ((RealSrcSpan, Annotated ())
 -> (RealSrcSpan, Annotated ()) -> Ordering)
-> [(RealSrcSpan, Annotated ())] -> [(RealSrcSpan, Annotated ())]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan, Annotated ())
-> (RealSrcSpan, Annotated ()) -> Ordering
forall a b1 b2. Ord a => (a, b1) -> (a, b2) -> Ordering
orderByFst [(RealSrcSpan, Annotated ())]
xs
                  -- Just keys -> error $ "withSortKey: keys" ++ show keys
                  AnnSortKey [RealSrcSpan]
keys -> [(RealSrcSpan, Annotated ())]
-> [RealSrcSpan] -> [(RealSrcSpan, Annotated ())]
forall a. [(RealSrcSpan, a)] -> [RealSrcSpan] -> [(RealSrcSpan, a)]
orderByKey [(RealSrcSpan, Annotated ())]
xs [RealSrcSpan]
keys
                                -- `debug` ("withSortKey:" ++
                                --          showPprUnsafe (map fst (sortBy (comparing (flip elemIndex keys . fst)) xs),
                                --                  map fst xs,
                                --                  keys)
                                --          )
  ((RealSrcSpan, Annotated ()) -> Annotated ())
-> [(RealSrcSpan, Annotated ())] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RealSrcSpan, Annotated ()) -> Annotated ()
forall a b. (a, b) -> b
snd [(RealSrcSpan, Annotated ())]
ordered

orderByFst :: Ord a => (a, b1) -> (a, b2) -> Ordering
orderByFst :: forall a b1 b2. Ord a => (a, b1) -> (a, b2) -> Ordering
orderByFst (a
a,b1
_) (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 (TypeSig XTypeSig GhcPs
a [LIdP GhcPs]
_ LHsSigWcType GhcPs
_)  = EpAnn AnnSig -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XTypeSig GhcPs
EpAnn AnnSig
a
  getAnnotationEntry (PatSynSig XPatSynSig GhcPs
a [LIdP GhcPs]
_ LHsSigType GhcPs
_) = EpAnn AnnSig -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XPatSynSig GhcPs
EpAnn AnnSig
a
  getAnnotationEntry (ClassOpSig XClassOpSig GhcPs
a Bool
_ [LIdP GhcPs]
_ LHsSigType GhcPs
_) = EpAnn AnnSig -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XClassOpSig GhcPs
EpAnn AnnSig
a
  getAnnotationEntry (IdSig {}) = Entry
NoEntryVal
  getAnnotationEntry (FixSig XFixSig GhcPs
a FixitySig GhcPs
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XFixSig GhcPs
EpAnn [AddEpAnn]
a
  getAnnotationEntry (InlineSig XInlineSig GhcPs
a LIdP GhcPs
_ InlinePragma
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XInlineSig GhcPs
EpAnn [AddEpAnn]
a
  getAnnotationEntry (SpecSig XSpecSig GhcPs
a LIdP GhcPs
_ [LHsSigType GhcPs]
_ InlinePragma
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSpecSig GhcPs
EpAnn [AddEpAnn]
a
  getAnnotationEntry (SpecInstSig XSpecInstSig GhcPs
a SourceText
_ LHsSigType GhcPs
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSpecInstSig GhcPs
EpAnn [AddEpAnn]
a
  getAnnotationEntry (MinimalSig XMinimalSig GhcPs
a SourceText
_ LBooleanFormula (LIdP GhcPs)
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XMinimalSig GhcPs
EpAnn [AddEpAnn]
a
  getAnnotationEntry (SCCFunSig XSCCFunSig GhcPs
a SourceText
_ LIdP GhcPs
_ Maybe (XRec GhcPs StringLiteral)
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSCCFunSig GhcPs
EpAnn [AddEpAnn]
a
  getAnnotationEntry (CompleteMatchSig XCompleteMatchSig GhcPs
a SourceText
_ XRec GhcPs [LIdP GhcPs]
_ Maybe (LIdP GhcPs)
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCompleteMatchSig GhcPs
EpAnn [AddEpAnn]
a

  exact :: Sig GhcPs -> Annotated ()
exact (TypeSig XTypeSig GhcPs
an [LIdP GhcPs]
vars LHsSigWcType GhcPs
ty)  = EpAnn AnnSig
-> [LocatedN RdrName]
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> Annotated ()
forall a.
ExactPrint a =>
EpAnn AnnSig -> [LocatedN RdrName] -> a -> Annotated ()
exactVarSig XTypeSig GhcPs
EpAnn AnnSig
an [LIdP GhcPs]
[LocatedN RdrName]
vars LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
ty

  exact (PatSynSig XPatSynSig GhcPs
an [LIdP GhcPs]
lns LHsSigType GhcPs
typ) = do
    EpAnn AnnSig
-> (AnnSig -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL XPatSynSig GhcPs
EpAnn AnnSig
an AnnSig -> [AddEpAnn]
asRest AnnKeywordId
AnnPattern
    [LocatedN RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
lns
    EpAnn AnnSig -> (AnnSig -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XPatSynSig GhcPs
EpAnn AnnSig
an AnnSig -> AddEpAnn
asDcolon
    GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
typ

  exact (ClassOpSig XClassOpSig GhcPs
an Bool
is_deflt [LIdP GhcPs]
vars LHsSigType GhcPs
ty)
    | Bool
is_deflt  = EpAnn AnnSig
-> (AnnSig -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL XClassOpSig GhcPs
EpAnn AnnSig
an AnnSig -> [AddEpAnn]
asRest AnnKeywordId
AnnDefault Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EpAnn AnnSig
-> [LocatedN RdrName]
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> Annotated ()
forall a.
ExactPrint a =>
EpAnn AnnSig -> [LocatedN RdrName] -> a -> Annotated ()
exactVarSig XClassOpSig GhcPs
EpAnn AnnSig
an [LIdP GhcPs]
[LocatedN RdrName]
vars LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
    | Bool
otherwise = EpAnn AnnSig
-> [LocatedN RdrName]
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> Annotated ()
forall a.
ExactPrint a =>
EpAnn AnnSig -> [LocatedN RdrName] -> a -> Annotated ()
exactVarSig XClassOpSig GhcPs
EpAnn AnnSig
an [LIdP GhcPs]
[LocatedN RdrName]
vars LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty

  exact (FixSig XFixSig GhcPs
an (FixitySig XFixitySig GhcPs
_ [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"
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XFixSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnInfix (String -> Maybe String
forall a. a -> Maybe a
Just String
fixstr)
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XFixSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnVal (String -> Maybe String
forall a. a -> Maybe a
Just (SourceText -> ShowS
sourceTextToString SourceText
src (Int -> String
forall a. Show a => a -> String
show Int
v)))
    [LocatedN RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
names


  exact (InlineSig XInlineSig GhcPs
an LIdP GhcPs
ln InlinePragma
inl) = do
    EpAnn [AddEpAnn] -> SourceText -> String -> Annotated ()
markAnnOpen XInlineSig GhcPs
EpAnn [AddEpAnn]
an (InlinePragma -> SourceText
inl_src InlinePragma
inl) String
"{-# INLINE"
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn]) -> Activation -> Annotated ()
forall a.
EpAnn a -> (a -> [AddEpAnn]) -> Activation -> Annotated ()
markActivation XInlineSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id (InlinePragma -> Activation
inl_act InlinePragma
inl)
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
ln
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"InlineSig:an=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ EpAnn [AddEpAnn] -> String
forall a. Data a => a -> String
showAst XInlineSig GhcPs
EpAnn [AddEpAnn]
an
    Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"InlineSig: p=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
p
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XInlineSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"InlineSig:done"

  exact (SpecSig XSpecSig GhcPs
an LIdP GhcPs
ln [LHsSigType GhcPs]
typs InlinePragma
inl) = do
    EpAnn [AddEpAnn] -> SourceText -> String -> Annotated ()
markAnnOpen XSpecSig GhcPs
EpAnn [AddEpAnn]
an (InlinePragma -> SourceText
inl_src InlinePragma
inl) String
"{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn]) -> Activation -> Annotated ()
forall a.
EpAnn a -> (a -> [AddEpAnn]) -> Activation -> Annotated ()
markActivation XSpecSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id (InlinePragma -> Activation
inl_act InlinePragma
inl)
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
ln
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XSpecSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsSigType GhcPs]
[GenLocated SrcSpanAnnA (HsSigType GhcPs)]
typs
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XSpecSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")

  exact (SpecInstSig XSpecInstSig GhcPs
an SourceText
src LHsSigType GhcPs
typ) = do
    EpAnn [AddEpAnn] -> SourceText -> String -> Annotated ()
markAnnOpen XSpecInstSig GhcPs
EpAnn [AddEpAnn]
an SourceText
src String
"{-# SPECIALISE"
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XSpecInstSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnInstance
    GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
typ
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XSpecInstSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")


  exact (MinimalSig XMinimalSig GhcPs
an SourceText
src LBooleanFormula (LIdP GhcPs)
formula) = do
    EpAnn [AddEpAnn] -> SourceText -> String -> Annotated ()
markAnnOpen XMinimalSig GhcPs
EpAnn [AddEpAnn]
an SourceText
src String
"{-# MINIMAL"
    LBooleanFormula (LocatedN RdrName) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LBooleanFormula (LIdP GhcPs)
LBooleanFormula (LocatedN RdrName)
formula
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XMinimalSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")

  exact (SCCFunSig XSCCFunSig GhcPs
an SourceText
src LIdP GhcPs
ln Maybe (XRec GhcPs StringLiteral)
ml) = do
    EpAnn [AddEpAnn] -> SourceText -> String -> Annotated ()
markAnnOpen XSCCFunSig GhcPs
EpAnn [AddEpAnn]
an SourceText
src String
"{-# SCC"
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
ln
    Maybe (Located StringLiteral) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (XRec GhcPs StringLiteral)
Maybe (Located StringLiteral)
ml
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XSCCFunSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")

  exact (CompleteMatchSig XCompleteMatchSig GhcPs
an SourceText
src XRec GhcPs [LIdP GhcPs]
cs Maybe (LIdP GhcPs)
mty) = do
    EpAnn [AddEpAnn] -> SourceText -> String -> Annotated ()
markAnnOpen XCompleteMatchSig GhcPs
EpAnn [AddEpAnn]
an SourceText
src String
"{-# COMPLETE"
    GenLocated SrcSpan [LocatedN RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs [LIdP GhcPs]
GenLocated SrcSpan [LocatedN RdrName]
cs
    case Maybe (LIdP GhcPs)
mty of
      Maybe (LIdP GhcPs)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just LIdP GhcPs
ty -> do
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCompleteMatchSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
ty
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XCompleteMatchSig GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")

  exact Sig GhcPs
x = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"exact Sig for:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Sig GhcPs -> String
forall a. Data a => a -> String
showAst Sig GhcPs
x

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

exactVarSig :: (ExactPrint a) => EpAnn AnnSig -> [LocatedN RdrName] -> a -> EPP ()
exactVarSig :: forall a.
ExactPrint a =>
EpAnn AnnSig -> [LocatedN RdrName] -> a -> Annotated ()
exactVarSig EpAnn AnnSig
an [LocatedN RdrName]
vars a
ty = do
  (LocatedN RdrName -> Annotated ())
-> [LocatedN RdrName] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LocatedN RdrName]
vars
  EpAnn AnnSig -> (AnnSig -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA EpAnn AnnSig
an AnnSig -> AddEpAnn
asDcolon
  a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated a
ty

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

instance ExactPrint (StandaloneKindSig GhcPs) where
  getAnnotationEntry :: StandaloneKindSig GhcPs -> Entry
getAnnotationEntry (StandaloneKindSig XStandaloneKindSig GhcPs
an LIdP GhcPs
_ LHsSigType GhcPs
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XStandaloneKindSig GhcPs
EpAnn [AddEpAnn]
an

  exact :: StandaloneKindSig GhcPs -> Annotated ()
exact (StandaloneKindSig XStandaloneKindSig GhcPs
an LIdP GhcPs
vars LHsSigType GhcPs
sig) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XStandaloneKindSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnType
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
vars
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XStandaloneKindSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
sig

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

instance ExactPrint (DefaultDecl GhcPs) where
  getAnnotationEntry :: DefaultDecl GhcPs -> Entry
getAnnotationEntry (DefaultDecl XCDefaultDecl GhcPs
an [LHsType GhcPs]
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCDefaultDecl GhcPs
EpAnn [AddEpAnn]
an

  exact :: DefaultDecl GhcPs -> Annotated ()
exact (DefaultDecl XCDefaultDecl GhcPs
an [LHsType GhcPs]
tys) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCDefaultDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDefault
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCDefaultDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenP
    [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCDefaultDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseP

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

instance ExactPrint (AnnDecl GhcPs) where
  getAnnotationEntry :: AnnDecl GhcPs -> Entry
getAnnotationEntry (HsAnnotation XHsAnnotation GhcPs
an SourceText
_ AnnProvenance GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_) = EpAnn AnnPragma -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XHsAnnotation GhcPs
EpAnn AnnPragma
an

  exact :: AnnDecl GhcPs -> Annotated ()
exact (HsAnnotation XHsAnnotation GhcPs
an SourceText
src AnnProvenance GhcPs
prov XRec GhcPs (HsExpr GhcPs)
e) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP XHsAnnotation GhcPs
EpAnn AnnPragma
an SourceText
src String
"{-# ANN"
    case AnnProvenance GhcPs
prov of
      (ValueAnnProvenance LIdP GhcPs
n) -> LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
      (TypeAnnProvenance LIdP GhcPs
n) -> do
        EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL XHsAnnotation GhcPs
EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnType
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
      AnnProvenance GhcPs
ModuleAnnProvenance -> EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL XHsAnnotation GhcPs
EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnModule

    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP XHsAnnotation GhcPs
EpAnn AnnPragma
an

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

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

  exact :: BooleanFormula (LocatedN RdrName) -> Annotated ()
exact (BF.Var LocatedN RdrName
x)  = do
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
x
  exact (BF.Or [LBooleanFormula (LocatedN RdrName)]
ls)  = [LBooleanFormula (LocatedN RdrName)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LBooleanFormula (LocatedN RdrName)]
ls
  exact (BF.And [LBooleanFormula (LocatedN RdrName)]
ls) = do
    [LBooleanFormula (LocatedN RdrName)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LBooleanFormula (LocatedN RdrName)]
ls
  exact (BF.Parens LBooleanFormula (LocatedN RdrName)
x)  = do
    LBooleanFormula (LocatedN RdrName) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LBooleanFormula (LocatedN RdrName)
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
  exact :: HsWildCardBndrs GhcPs body -> Annotated ()
exact (HsWC XHsWC GhcPs body
_ body
ty) = body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated body
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 ast. HasEntry ast => ast -> Entry
fromAnn XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an

  exact :: GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> Annotated ()
exact (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an [GuardLStmt GhcPs]
guards GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"GRHS comments:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ EpAnnComments -> String
forall a. Outputable a => a -> String
showGhc (EpAnn GrhsAnn -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an)
    EpAnn GrhsAnn
-> (GrhsAnn -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an GrhsAnn -> Maybe EpaLocation
ga_vbar AnnKeywordId
AnnVbar
    [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
guards
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"GRHS before matchSeparator"
    EpAnn GrhsAnn -> (GrhsAnn -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an GrhsAnn -> AddEpAnn
ga_sep -- Mark the matchSeparator for these GRHSs
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"GRHS after matchSeparator"
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated GenLocated SrcSpanAnnA (HsExpr GhcPs)
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 ast. HasEntry ast => ast -> Entry
fromAnn XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
EpAnn GrhsAnn
ann

  exact :: GRHS GhcPs (LocatedA (HsCmd GhcPs)) -> Annotated ()
exact (GRHS XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
an [GuardLStmt GhcPs]
guards LocatedA (HsCmd GhcPs)
expr) = do
    EpAnn GrhsAnn
-> (GrhsAnn -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
EpAnn GrhsAnn
an GrhsAnn -> Maybe EpaLocation
ga_vbar AnnKeywordId
AnnVbar
    [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
guards
    EpAnn GrhsAnn -> (GrhsAnn -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
EpAnn GrhsAnn
an GrhsAnn -> AddEpAnn
ga_sep -- Mark the matchSeparator for these GRHSs
    LocatedA (HsCmd GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedA (HsCmd GhcPs)
expr

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

instance ExactPrint (HsExpr GhcPs) where
  getAnnotationEntry :: HsExpr GhcPs -> Entry
getAnnotationEntry (HsVar{})                    = Entry
NoEntryVal
  getAnnotationEntry (HsUnboundVar XUnboundVar GhcPs
an OccName
_)          = EpAnn EpAnnUnboundVar -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XUnboundVar GhcPs
EpAnn EpAnnUnboundVar
an
  getAnnotationEntry (HsConLikeOut{})             = Entry
NoEntryVal
  getAnnotationEntry (HsRecFld{})                 = Entry
NoEntryVal
  getAnnotationEntry (HsOverLabel XOverLabel GhcPs
an FastString
_)           = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XOverLabel GhcPs
EpAnnCO
an
  getAnnotationEntry (HsIPVar XIPVar GhcPs
an HsIPName
_)               = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XIPVar GhcPs
EpAnnCO
an
  getAnnotationEntry (HsOverLit XOverLitE GhcPs
an HsOverLit GhcPs
_)             = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XOverLitE GhcPs
EpAnnCO
an
  getAnnotationEntry (HsLit XLitE GhcPs
an HsLit GhcPs
_)                 = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XLitE GhcPs
EpAnnCO
an
  getAnnotationEntry (HsLam XLam GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_)                  = Entry
NoEntryVal
  getAnnotationEntry (HsLamCase XLamCase GhcPs
an MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_)             = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XLamCase GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsApp XApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_)               = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XApp GhcPs
EpAnnCO
an
  getAnnotationEntry (HsAppType XAppTypeE GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ LHsWcType (NoGhcTc GhcPs)
_)            = Entry
NoEntryVal
  getAnnotationEntry (OpApp XOpApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_)             = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XOpApp GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (NegApp XNegApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ SyntaxExpr GhcPs
_)              = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XNegApp GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsPar XPar GhcPs
an XRec GhcPs (HsExpr GhcPs)
_)                 = EpAnn AnnParen -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XPar GhcPs
EpAnn AnnParen
an
  getAnnotationEntry (SectionL XSectionL GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_)            = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSectionL GhcPs
EpAnnCO
an
  getAnnotationEntry (SectionR XSectionR GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_)            = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSectionR GhcPs
EpAnnCO
an
  getAnnotationEntry (ExplicitTuple XExplicitTuple GhcPs
an [HsTupArg GhcPs]
_ Boxity
_)       = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XExplicitTuple GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ExplicitSum XExplicitSum GhcPs
an Int
_ Int
_ XRec GhcPs (HsExpr GhcPs)
_)       = EpAnn AnnExplicitSum -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XExplicitSum GhcPs
EpAnn AnnExplicitSum
an
  getAnnotationEntry (HsCase XCase GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_)              = EpAnn EpAnnHsCase -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCase GhcPs
EpAnn EpAnnHsCase
an
  getAnnotationEntry (HsIf XIf GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_)              = EpAnn AnnsIf -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XIf GhcPs
EpAnn AnnsIf
an
  getAnnotationEntry (HsMultiIf XMultiIf GhcPs
an [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
_)             = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XMultiIf GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsLet XLet GhcPs
an HsLocalBinds GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_)               = EpAnn AnnsLet -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XLet GhcPs
EpAnn AnnsLet
an
  getAnnotationEntry (HsDo XDo GhcPs
an HsStmtContext (HsDoRn GhcPs)
_ XRec GhcPs [GuardLStmt GhcPs]
_)                = EpAnn AnnList -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XDo GhcPs
EpAnn AnnList
an
  getAnnotationEntry (ExplicitList XExplicitList GhcPs
an [XRec GhcPs (HsExpr GhcPs)]
_)          = EpAnn AnnList -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XExplicitList GhcPs
EpAnn AnnList
an
  getAnnotationEntry (RecordCon XRecordCon GhcPs
an XRec GhcPs (ConLikeP GhcPs)
_ HsRecordBinds GhcPs
_)           = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XRecordCon GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (RecordUpd XRecordUpd GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
_)           = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XRecordUpd GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsGetField XGetField GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ Located (HsFieldLabel GhcPs)
_)          = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XGetField GhcPs
EpAnnCO
an
  getAnnotationEntry (HsProjection XProjection GhcPs
an [Located (HsFieldLabel GhcPs)]
_)          = EpAnn AnnProjection -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XProjection GhcPs
EpAnn AnnProjection
an
  getAnnotationEntry (ExprWithTySig XExprWithTySig GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ LHsSigWcType (NoGhcTc GhcPs)
_)       = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XExprWithTySig GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ArithSeq XArithSeq GhcPs
an Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
_)            = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsBracket XBracket GhcPs
an HsBracket GhcPs
_)             = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XBracket GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsRnBracketOut{})           = Entry
NoEntryVal
  getAnnotationEntry (HsTcBracketOut{})           = Entry
NoEntryVal
  getAnnotationEntry (HsSpliceE XSpliceE GhcPs
an HsSplice GhcPs
_)             = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSpliceE GhcPs
EpAnnCO
an
  getAnnotationEntry (HsProc XProc GhcPs
an LPat GhcPs
_ LHsCmdTop GhcPs
_)              = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XProc GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsStatic XStatic GhcPs
an XRec GhcPs (HsExpr GhcPs)
_)              = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XStatic GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsTick {})                  = Entry
NoEntryVal
  getAnnotationEntry (HsBinTick {})               = Entry
NoEntryVal
  getAnnotationEntry (HsPragE{})                  = Entry
NoEntryVal


  exact :: HsExpr GhcPs -> Annotated ()
exact (HsVar XVar GhcPs
_ LIdP GhcPs
n) = LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
  exact x :: HsExpr GhcPs
x@(HsUnboundVar XUnboundVar GhcPs
an OccName
_v) = do
    case XUnboundVar GhcPs
an of
      XUnboundVar GhcPs
EpAnn EpAnnUnboundVar
EpAnnNotUsed -> HsExpr GhcPs -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr HsExpr GhcPs
x
      EpAnn Anchor
_ (EpAnnUnboundVar (EpaLocation
ob,EpaLocation
cb) EpaLocation
l) EpAnnComments
_ -> do
        EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
ob String
"`"
        EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
l  String
"_"
        EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
cb String
"`"
  -- exact x@(HsConLikeOut{})             = withPpr x
  -- exact x@(HsRecFld{})                 = withPpr x
  exact x :: HsExpr GhcPs
x@(HsOverLabel XOverLabel GhcPs
_ FastString
_) = HsExpr GhcPs -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr HsExpr GhcPs
x

  exact (HsIPVar XIPVar GhcPs
_ (HsIPName FastString
n))
    = String -> Annotated ()
printStringAdvance (String
"?" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FastString -> String
unpackFS FastString
n)

  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
    -- markExternalSourceText l str ""
    case SourceText
str of
      SourceText String
s -> String -> Annotated ()
printStringAdvance String
s
      SourceText
NoSourceText -> HsExpr GhcPs -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr HsExpr GhcPs
x

  exact (HsLit XLitE GhcPs
_an HsLit GhcPs
lit) = HsLit GhcPs -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr HsLit GhcPs
lit
  exact (HsLam XLam GhcPs
_ (MG XMG GhcPs (XRec GhcPs (HsExpr GhcPs))
_ (L SrcSpanAnnL
_ [GenLocated
  SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match]) Origin
_)) = do
    GenLocated
  SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated GenLocated
  SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match
  exact (HsLam XLam GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsLam with other than one match"

  exact (HsLamCase XLamCase GhcPs
an MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XLamCase GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnLam
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XLamCase GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCase
    MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mg

  exact (HsApp XApp GhcPs
_an XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2) = do
    Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsApp entered. p=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
p
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2
  exact (HsAppType XAppTypeE GhcPs
ss XRec GhcPs (HsExpr GhcPs)
fun LHsWcType (NoGhcTc GhcPs)
arg) = do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
fun
    SrcSpan -> String -> Annotated ()
printStringAtSs XAppTypeE GhcPs
SrcSpan
ss String
"@"
    HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
LHsWcType (NoGhcTc GhcPs)
arg
  exact (OpApp XOpApp GhcPs
_an XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 XRec GhcPs (HsExpr GhcPs)
e3) = do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e3

  exact (NegApp XNegApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
e SyntaxExpr GhcPs
_) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XNegApp GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnMinus
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e

  exact (HsPar XPar GhcPs
an XRec GhcPs (HsExpr GhcPs)
e) = do
    EpAnn AnnParen -> Annotated ()
markOpeningParen XPar GhcPs
EpAnn AnnParen
an
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsPar closing paren"
    EpAnn AnnParen -> Annotated ()
markClosingParen XPar GhcPs
EpAnn AnnParen
an
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsPar done"

  exact (SectionL XSectionL GhcPs
_an XRec GhcPs (HsExpr GhcPs)
expr XRec GhcPs (HsExpr GhcPs)
op) = do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op

  exact (SectionR XSectionR GhcPs
_an XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
expr) = do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr

  exact (ExplicitTuple XExplicitTuple GhcPs
an [HsTupArg GhcPs]
args Boxity
b) = do
    if Boxity
b Boxity -> Boxity -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity
Boxed then EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitTuple GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenP
                  else EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitTuple GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenPH

    (HsTupArg GhcPs -> Annotated ())
-> [HsTupArg GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HsTupArg GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [HsTupArg GhcPs]
args

    if Boxity
b Boxity -> Boxity -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity
Boxed then EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitTuple GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseP
                  else EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitTuple GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnClosePH
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"ExplicitTuple done"

  exact (ExplicitSum XExplicitSum GhcPs
an Int
_alt Int
_arity XRec GhcPs (HsExpr GhcPs)
expr) = do
    EpAnn AnnExplicitSum
-> (AnnExplicitSum -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XExplicitSum GhcPs
EpAnn AnnExplicitSum
an AnnExplicitSum -> EpaLocation
aesOpen AnnKeywordId
AnnOpenPH
    EpAnn AnnExplicitSum
-> (AnnExplicitSum -> [EpaLocation])
-> AnnKeywordId
-> Annotated ()
forall a.
EpAnn a -> (a -> [EpaLocation]) -> AnnKeywordId -> Annotated ()
markAnnKwAll XExplicitSum GhcPs
EpAnn AnnExplicitSum
an AnnExplicitSum -> [EpaLocation]
aesBarsBefore AnnKeywordId
AnnVbar
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    EpAnn AnnExplicitSum
-> (AnnExplicitSum -> [EpaLocation])
-> AnnKeywordId
-> Annotated ()
forall a.
EpAnn a -> (a -> [EpaLocation]) -> AnnKeywordId -> Annotated ()
markAnnKwAll XExplicitSum GhcPs
EpAnn AnnExplicitSum
an AnnExplicitSum -> [EpaLocation]
aesBarsAfter AnnKeywordId
AnnVbar
    EpAnn AnnExplicitSum
-> (AnnExplicitSum -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XExplicitSum GhcPs
EpAnn AnnExplicitSum
an AnnExplicitSum -> EpaLocation
aesClose AnnKeywordId
AnnClosePH

  exact (HsCase XCase GhcPs
an XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
alts) = do
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> EpaLocation
hsCaseAnnCase AnnKeywordId
AnnCase
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> EpaLocation
hsCaseAnnOf AnnKeywordId
AnnOf
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' XCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> [AddEpAnn]
hsCaseAnnsRest AnnKeywordId
AnnOpenC
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll XCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> [AddEpAnn]
hsCaseAnnsRest AnnKeywordId
AnnSemi
    Annotated () -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutBoth (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
alts
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' XCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> [AddEpAnn]
hsCaseAnnsRest AnnKeywordId
AnnCloseC

  exact (HsIf XIf GhcPs
an XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 XRec GhcPs (HsExpr GhcPs)
e3) = do
    EpAnn AnnsIf
-> (AnnsIf -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XIf GhcPs
EpAnn AnnsIf
an AnnsIf -> EpaLocation
aiIf AnnKeywordId
AnnIf
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
    EpAnn AnnsIf
-> (AnnsIf -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM XIf GhcPs
EpAnn AnnsIf
an AnnsIf -> Maybe EpaLocation
aiThenSemi AnnKeywordId
AnnSemi
    EpAnn AnnsIf
-> (AnnsIf -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XIf GhcPs
EpAnn AnnsIf
an AnnsIf -> EpaLocation
aiThen AnnKeywordId
AnnThen
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2
    EpAnn AnnsIf
-> (AnnsIf -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM XIf GhcPs
EpAnn AnnsIf
an AnnsIf -> Maybe EpaLocation
aiElseSemi AnnKeywordId
AnnSemi
    EpAnn AnnsIf
-> (AnnsIf -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XIf GhcPs
EpAnn AnnsIf
an AnnsIf -> EpaLocation
aiElse AnnKeywordId
AnnElse
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e3

  exact (HsMultiIf XMultiIf GhcPs
an [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
mg) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XMultiIf GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnIf
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XMultiIf GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC -- optional
    [GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
mg
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XMultiIf GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC -- optional

  exact (HsLet XLet GhcPs
an HsLocalBinds GhcPs
binds XRec GhcPs (HsExpr GhcPs)
e) = do
    Annotated () -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutBoth (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do -- Make sure the 'in' gets indented too
      EpAnn AnnsLet
-> (AnnsLet -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XLet GhcPs
EpAnn AnnsLet
an AnnsLet -> EpaLocation
alLet AnnKeywordId
AnnLet
      String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HSlet:binds coming"
      Annotated () -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutBoth (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsLocalBinds GhcPs
binds
      String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HSlet:binds done"
      EpAnn AnnsLet
-> (AnnsLet -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XLet GhcPs
EpAnn AnnsLet
an AnnsLet -> EpaLocation
alIn AnnKeywordId
AnnIn
      String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HSlet:expr coming"
      GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e

  exact (HsDo XDo GhcPs
an HsStmtContext (HsDoRn GhcPs)
do_or_list_comp XRec GhcPs [GuardLStmt GhcPs]
stmts) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsDo"
    Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
True XDo GhcPs
EpAnn AnnList
an (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn AnnList
-> HsStmtContext GhcRn
-> LocatedL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall body any.
ExactPrint body =>
EpAnn AnnList -> HsStmtContext any -> body -> Annotated ()
exactDo XDo GhcPs
EpAnn AnnList
an HsStmtContext (HsDoRn GhcPs)
HsStmtContext GhcRn
do_or_list_comp XRec GhcPs [GuardLStmt GhcPs]
LocatedL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts

  exact (ExplicitList XExplicitList GhcPs
an [XRec GhcPs (HsExpr GhcPs)]
es) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"ExplicitList start"
    EpAnn AnnList -> (AnnList -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA XExplicitList GhcPs
EpAnn AnnList
an AnnList -> Maybe AddEpAnn
al_open
    [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [XRec GhcPs (HsExpr GhcPs)]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
es
    EpAnn AnnList -> (AnnList -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA XExplicitList GhcPs
EpAnn AnnList
an AnnList -> Maybe AddEpAnn
al_close
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"ExplicitList end"
  exact (RecordCon XRecordCon GhcPs
an XRec GhcPs (ConLikeP GhcPs)
con_id HsRecordBinds GhcPs
binds) = do
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con_id
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XRecordCon GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC
    HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsRecordBinds GhcPs
HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
binds
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XRecordCon GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC
  exact (RecordUpd XRecordUpd GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fields) = do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XRecordUpd GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC
    Either
  [GenLocated
     SrcSpanAnnA
     (HsRecField'
        (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
  [GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
Either
  [GenLocated
     SrcSpanAnnA
     (HsRecField'
        (AmbiguousFieldOcc GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
  [GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldLabelStrings GhcPs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
fields
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XRecordUpd GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC
  exact (HsGetField XGetField GhcPs
_an XRec GhcPs (HsExpr GhcPs)
expr Located (HsFieldLabel GhcPs)
field) = do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    Located (HsFieldLabel GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located (HsFieldLabel GhcPs)
field
  exact (HsProjection XProjection GhcPs
an [Located (HsFieldLabel GhcPs)]
flds) = do
    EpAnn AnnProjection
-> (AnnProjection -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XProjection GhcPs
EpAnn AnnProjection
an AnnProjection -> EpaLocation
apOpen AnnKeywordId
AnnOpenP
    [Located (HsFieldLabel GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [Located (HsFieldLabel GhcPs)]
flds
    EpAnn AnnProjection
-> (AnnProjection -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XProjection GhcPs
EpAnn AnnProjection
an AnnProjection -> EpaLocation
apClose AnnKeywordId
AnnCloseP
  exact (ExprWithTySig XExprWithTySig GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr LHsSigWcType (NoGhcTc GhcPs)
sig) = do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExprWithTySig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType (NoGhcTc GhcPs)
sig
  exact (ArithSeq XArithSeq GhcPs
an Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
seqInfo) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenS -- '['
    case ArithSeqInfo GhcPs
seqInfo of
        From XRec GhcPs (HsExpr GhcPs)
e -> do
          GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDotdot
        FromTo XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 -> do
          GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDotdot
          GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2
        FromThen XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 -> do
          GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnComma
          GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDotdot
        FromThenTo XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 XRec GhcPs (HsExpr GhcPs)
e3 -> do
          GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnComma
          GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDotdot
          GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e3
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XArithSeq GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseS -- ']'


  exact (HsBracket XBracket GhcPs
an (ExpBr XExpBr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e)) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenEQ -- "[|"
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenE  -- "[e|" -- optional
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseQ -- "|]"
  exact (HsBracket XBracket GhcPs
an (PatBr XPatBr GhcPs
_ LPat GhcPs
e)) = do
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XBracket GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
"[p|")
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
e
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseQ -- "|]"
  exact (HsBracket XBracket GhcPs
an (DecBrL XDecBrL GhcPs
_ [LHsDecl GhcPs]
e)) = do

    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XBracket GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
"[d|")
    -- See https://gitlab.haskell.org/ghc/ghc/-/issues/20257, we need
    -- to mark braces here for the time being
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC -- "{"
    [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
e
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC -- "}"
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseQ -- "|]"
  -- -- exact (HsBracket an (DecBrG _ _)) =
  -- --   traceM "warning: DecBrG introduced after renamer"
  exact (HsBracket XBracket GhcPs
an (TypBr XTypBr GhcPs
_ LHsType GhcPs
e)) = do
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XBracket GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
"[t|")
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
e
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseQ -- "|]"
  exact (HsBracket XBracket GhcPs
an (VarBr XVarBr GhcPs
_ Bool
b LIdP GhcPs
e)) = do
    if Bool
b
      then do
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnSimpleQuote
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
e
      else do
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBracket GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnThTyQuote
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
e
  exact (HsBracket XBracket GhcPs
an (TExpBr XTExpBr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e)) = do
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XBracket GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen (String -> Maybe String
forall a. a -> Maybe a
Just String
"[||")
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XBracket GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpenE (String -> Maybe String
forall a. a -> Maybe a
Just String
"[e||")
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XBracket GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"||]")


  -- exact x@(HsRnBracketOut{})           = withPpr x
  -- exact x@(HsTcBracketOut{})           = withPpr x
  exact (HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
sp) = HsSplice GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsSplice GhcPs
sp

  exact (HsProc XProc GhcPs
an LPat GhcPs
p LHsCmdTop GhcPs
c) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsProc start"
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XProc GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnProc
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XProc GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnRarrow
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsProc after AnnRarrow"
    GenLocated SrcSpan (HsCmdTop GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsCmdTop GhcPs
GenLocated SrcSpan (HsCmdTop GhcPs)
c

  exact (HsStatic XStatic GhcPs
an XRec GhcPs (HsExpr GhcPs)
e) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XStatic GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnStatic
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e

  -- exact x@(HsTick {})                  = withPpr x
  -- exact x@(HsBinTick {})               = withPpr x
  exact (HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag XRec GhcPs (HsExpr GhcPs)
e) = do
    HsPragE GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsPragE GhcPs
prag
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
  exact HsExpr GhcPs
x = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
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 :: (ExactPrint body)
        => EpAnn AnnList -> (HsStmtContext any) -> body -> EPP ()
exactDo :: forall body any.
ExactPrint body =>
EpAnn AnnList -> HsStmtContext any -> body -> Annotated ()
exactDo EpAnn AnnList
an (DoExpr Maybe ModuleName
m)    body
stmts = EpAnn AnnList -> Maybe ModuleName -> AnnKeywordId -> Annotated ()
exactMdo EpAnn AnnList
an Maybe ModuleName
m AnnKeywordId
AnnDo             Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotatedWithLayout body
stmts
exactDo EpAnn AnnList
an HsStmtContext any
GhciStmtCtxt  body
stmts = EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn AnnList
an AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnDo Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotatedWithLayout body
stmts
exactDo EpAnn AnnList
an HsStmtContext any
ArrowExpr     body
stmts = EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn AnnList
an AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnDo Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotatedWithLayout body
stmts
exactDo EpAnn AnnList
an (MDoExpr Maybe ModuleName
m)   body
stmts = EpAnn AnnList -> Maybe ModuleName -> AnnKeywordId -> Annotated ()
exactMdo EpAnn AnnList
an Maybe ModuleName
m AnnKeywordId
AnnMdo            Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotatedWithLayout body
stmts
exactDo EpAnn AnnList
_  HsStmtContext any
ListComp      body
stmts = body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotatedWithLayout body
stmts
exactDo EpAnn AnnList
_  HsStmtContext any
MonadComp     body
stmts = body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotatedWithLayout body
stmts
exactDo EpAnn AnnList
_  HsStmtContext any
_             body
_     = String -> Annotated ()
forall a. String -> a
panic String
"pprDo" -- PatGuard, ParStmtCxt

exactMdo :: EpAnn AnnList -> Maybe ModuleName -> AnnKeywordId -> EPP ()
exactMdo :: EpAnn AnnList -> Maybe ModuleName -> AnnKeywordId -> Annotated ()
exactMdo EpAnn AnnList
an Maybe ModuleName
Nothing            AnnKeywordId
kw = EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL  EpAnn AnnList
an AnnList -> [AddEpAnn]
al_rest AnnKeywordId
kw
exactMdo EpAnn AnnList
an (Just ModuleName
module_name) AnnKeywordId
kw = EpAnn AnnList
-> (AnnList -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn AnnList
an AnnList -> [AddEpAnn]
al_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]
++ (KeywordId -> String
keywordToString (AnnKeywordId -> KeywordId
G AnnKeywordId
kw))


-- ---------------------------------------------------------------------
instance ExactPrint (HsPragE GhcPs) where
  getAnnotationEntry :: HsPragE GhcPs -> Entry
getAnnotationEntry HsPragSCC{}  = Entry
NoEntryVal

  exact :: HsPragE GhcPs -> Annotated ()
exact (HsPragSCC XSCC GhcPs
an SourceText
st StringLiteral
sl) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP XSCC GhcPs
EpAnn AnnPragma
an SourceText
st String
"{-# SCC"
    let txt :: String
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)
    EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XSCC GhcPs
EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnVal    (String -> Maybe String
forall a. a -> Maybe a
Just String
txt) -- optional
    EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XSCC GhcPs
EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnValStr (String -> Maybe String
forall a. a -> Maybe a
Just String
txt) -- optional
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP XSCC GhcPs
EpAnn AnnPragma
an


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

instance ExactPrint (HsSplice GhcPs) where
  getAnnotationEntry :: HsSplice GhcPs -> Entry
getAnnotationEntry (HsTypedSplice XTypedSplice GhcPs
an SpliceDecoration
_ IdP GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_)   = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XTypedSplice GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsUntypedSplice XUntypedSplice GhcPs
an SpliceDecoration
_ IdP GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XUntypedSplice GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
_ IdP GhcPs
_ SrcSpan
_ FastString
_)   = Entry
NoEntryVal
  getAnnotationEntry (HsSpliced XSpliced GhcPs
_ ThModFinalizers
_ HsSplicedThing GhcPs
_)          = Entry
NoEntryVal

  exact :: HsSplice GhcPs -> Annotated ()
exact (HsTypedSplice XTypedSplice GhcPs
an SpliceDecoration
DollarSplice IdP GhcPs
_n XRec GhcPs (HsExpr GhcPs)
e) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XTypedSplice GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDollarDollar
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e

  exact (HsUntypedSplice XUntypedSplice GhcPs
an SpliceDecoration
decoration IdP GhcPs
_n XRec GhcPs (HsExpr GhcPs)
b) = do
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpliceDecoration
decoration SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
DollarSplice) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XUntypedSplice GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDollar
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b

  exact (HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
_ IdP GhcPs
q SrcSpan
ss FastString
fs) = do
    -- The quasiquote string does not honour layout offsets. Store
    -- the colOffset for now.
    -- TODO: use local?
    LayoutStartCol
oldOffset <- RWST
  (PrintOptions Identity String)
  (EPWriter String)
  EPState
  Identity
  LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
    EPState{Bool
pMarkLayout :: Bool
pMarkLayout :: EPState -> Bool
pMarkLayout} <- RWST
  (PrintOptions Identity String)
  (EPWriter String)
  EPState
  Identity
  EPState
forall s (m :: * -> *). MonadState s m => m s
get
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pMarkLayout (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LayoutStartCol -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LayoutStartCol -> EP w m ()
setLayoutOffsetP LayoutStartCol
0
    String -> Annotated ()
printStringAdvance
            -- Note: Lexer.x does not provide unicode alternative. 2017-02-26
            (String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe IdP GhcPs
RdrName
q) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (FastString -> String
unpackFS FastString
fs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|]")
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pMarkLayout (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LayoutStartCol -> Annotated ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LayoutStartCol -> EP w m ()
setLayoutOffsetP LayoutStartCol
oldOffset
    Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsQuasiQuote:after:(p,ss)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, (Pos, Pos)) -> String
forall a. Show a => a -> String
show (Pos
p,SrcSpan -> (Pos, Pos)
ss2range SrcSpan
ss)

  exact HsSplice GhcPs
x = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"exact HsSplice for:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsSplice GhcPs -> String
forall a. Data a => a -> String
showAst HsSplice GhcPs
x

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

-- 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
  exact :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Annotated ()
exact (MG XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
matches Origin
_) = do
    -- TODO:AZ use SortKey, in MG ann.
    GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
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
  exact :: MatchGroup GhcPs (LocatedA (HsCmd GhcPs)) -> Annotated ()
exact (MG XMG GhcPs (LocatedA (HsCmd GhcPs))
_ XRec GhcPs [LMatch GhcPs (LocatedA (HsCmd GhcPs))]
matches Origin
_) = do
    -- TODO:AZ use SortKey, in MG ann.
    GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs [LMatch GhcPs (LocatedA (HsCmd GhcPs))]
GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsCmd GhcPs)))]
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
  exact :: HsRecFields GhcPs body -> Annotated ()
exact (HsRecFields [LHsRecField GhcPs body]
fields Maybe (Located Int)
mdot) = do
    [GenLocated SrcSpanAnnA (HsRecField' (FieldOcc GhcPs) body)]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsRecField GhcPs body]
[GenLocated SrcSpanAnnA (HsRecField' (FieldOcc GhcPs) body)]
fields
    case Maybe (Located Int)
mdot of
      Maybe (Located Int)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (L SrcSpan
ss Int
_) ->
        SrcSpan -> String -> Annotated ()
printStringAtSs SrcSpan
ss String
".."
      -- Note: mdot contains the SrcSpan where the ".." appears, if present

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

instance (ExactPrint body)
    => ExactPrint (HsRecField' (FieldOcc GhcPs) body) where
  getAnnotationEntry :: HsRecField' (FieldOcc GhcPs) body -> Entry
getAnnotationEntry HsRecField' (FieldOcc GhcPs) body
x = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (HsRecField' (FieldOcc GhcPs) body -> XHsRecField (FieldOcc GhcPs)
forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldAnn HsRecField' (FieldOcc GhcPs) body
x)
  exact :: HsRecField' (FieldOcc GhcPs) body -> Annotated ()
exact (HsRecField XHsRecField (FieldOcc GhcPs)
an Located (FieldOcc GhcPs)
f body
arg Bool
isPun) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsRecField"
    Located (FieldOcc GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located (FieldOcc GhcPs)
f
    if Bool
isPun then () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             else do
      EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XHsRecField (FieldOcc GhcPs)
EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual
      body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated body
arg

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

instance (ExactPrint body)
    => ExactPrint (HsRecField' (FieldLabelStrings GhcPs) body) where
  getAnnotationEntry :: HsRecField' (FieldLabelStrings GhcPs) body -> Entry
getAnnotationEntry HsRecField' (FieldLabelStrings GhcPs) body
x = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (HsRecField' (FieldLabelStrings GhcPs) body
-> XHsRecField (FieldLabelStrings GhcPs)
forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldAnn HsRecField' (FieldLabelStrings GhcPs) body
x)
  exact :: HsRecField' (FieldLabelStrings GhcPs) body -> Annotated ()
exact (HsRecField XHsRecField (FieldLabelStrings GhcPs)
an Located (FieldLabelStrings GhcPs)
f body
arg Bool
isPun) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsRecField FieldLabelStrings"
    Located (FieldLabelStrings GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located (FieldLabelStrings GhcPs)
f
    if Bool
isPun then () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             else do
      EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XHsRecField (FieldLabelStrings GhcPs)
EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual
      body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated body
arg

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

instance (ExactPrint (LocatedA body))
    => ExactPrint (HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body)) where
  getAnnotationEntry :: HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body) -> Entry
getAnnotationEntry HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body)
x = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body)
-> XHsRecField (AmbiguousFieldOcc GhcPs)
forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldAnn HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body)
x)
  exact :: HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body)
-> Annotated ()
exact (HsRecField XHsRecField (AmbiguousFieldOcc GhcPs)
an Located (AmbiguousFieldOcc GhcPs)
f LocatedA body
arg Bool
isPun) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsRecUpdField"
    Located (AmbiguousFieldOcc GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located (AmbiguousFieldOcc GhcPs)
f
    if Bool
isPun then () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             else EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XHsRecField (AmbiguousFieldOcc GhcPs)
EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcSpanAnnA -> SrcSpan) -> SrcSpanAnnA -> SrcSpan
forall a b. (a -> b) -> a -> b
$ LocatedA body -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedA body
arg) SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
noSrcSpan ) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LocatedA body -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedA body
arg

-- ---------------------------------------------------------------------
instance
    (ExactPrint (HsRecField' (a GhcPs) body),
     ExactPrint (HsRecField' (b GhcPs) body))
    => ExactPrint
         (Either [LocatedA (HsRecField' (a GhcPs) body)]
                 [LocatedA (HsRecField' (b GhcPs) body)]) where
  getAnnotationEntry :: Either
  [LocatedA (HsRecField' (a GhcPs) body)]
  [LocatedA (HsRecField' (b GhcPs) body)]
-> Entry
getAnnotationEntry = Entry
-> Either
     [LocatedA (HsRecField' (a GhcPs) body)]
     [LocatedA (HsRecField' (b GhcPs) body)]
-> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: Either
  [LocatedA (HsRecField' (a GhcPs) body)]
  [LocatedA (HsRecField' (b GhcPs) body)]
-> Annotated ()
exact (Left [LocatedA (HsRecField' (a GhcPs) body)]
rbinds) = [LocatedA (HsRecField' (a GhcPs) body)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LocatedA (HsRecField' (a GhcPs) body)]
rbinds
  exact (Right [LocatedA (HsRecField' (b GhcPs) body)]
pbinds) = [LocatedA (HsRecField' (b GhcPs) body)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LocatedA (HsRecField' (b GhcPs) body)]
pbinds

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

instance ExactPrint (FieldLabelStrings GhcPs) where
  getAnnotationEntry :: FieldLabelStrings GhcPs -> Entry
getAnnotationEntry = Entry -> FieldLabelStrings GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: FieldLabelStrings GhcPs -> Annotated ()
exact (FieldLabelStrings [Located (HsFieldLabel GhcPs)]
fs) = [Located (HsFieldLabel GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [Located (HsFieldLabel GhcPs)]
fs

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

instance ExactPrint (HsFieldLabel GhcPs) where
  getAnnotationEntry :: HsFieldLabel GhcPs -> Entry
getAnnotationEntry (HsFieldLabel XCHsFieldLabel GhcPs
an Located FastString
_) = EpAnn AnnFieldLabel -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCHsFieldLabel GhcPs
EpAnn AnnFieldLabel
an

  exact :: HsFieldLabel GhcPs -> Annotated ()
exact (HsFieldLabel XCHsFieldLabel GhcPs
an Located FastString
fs) = do
    EpAnn AnnFieldLabel
-> (AnnFieldLabel -> Maybe EpaLocation)
-> AnnKeywordId
-> Annotated ()
forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM XCHsFieldLabel GhcPs
EpAnn AnnFieldLabel
an AnnFieldLabel -> Maybe EpaLocation
afDot  AnnKeywordId
AnnDot
    Located FastString -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Located FastString
fs

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

instance ExactPrint (HsTupArg GhcPs) where
  getAnnotationEntry :: HsTupArg GhcPs -> Entry
getAnnotationEntry (Present XPresent GhcPs
an XRec GhcPs (HsExpr GhcPs)
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XPresent GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (Missing XMissing GhcPs
an)   = EpAnn EpaLocation -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XMissing GhcPs
EpAnn EpaLocation
an

  exact :: HsTupArg GhcPs -> Annotated ()
exact (Present XPresent GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e

  exact (Missing XMissing GhcPs
EpAnn EpaLocation
EpAnnNotUsed) = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  exact (Missing XMissing GhcPs
_) = String -> Annotated ()
printStringAdvance String
","

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

instance ExactPrint (HsCmdTop GhcPs) where
  getAnnotationEntry :: HsCmdTop GhcPs -> Entry
getAnnotationEntry = Entry -> HsCmdTop GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: HsCmdTop GhcPs -> Annotated ()
exact (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd) = LocatedA (HsCmd GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
cmd

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

instance ExactPrint (HsCmd GhcPs) where
  getAnnotationEntry :: HsCmd GhcPs -> Entry
getAnnotationEntry (HsCmdArrApp XCmdArrApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
_ HsArrAppType
_ Bool
_)   = EpAnn AddEpAnn -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdArrApp GhcPs
EpAnn AddEpAnn
an
  getAnnotationEntry (HsCmdArrForm XCmdArrForm GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ LexicalFixity
_ Maybe Fixity
_ [LHsCmdTop GhcPs]
_ ) = EpAnn AnnList -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdArrForm GhcPs
EpAnn AnnList
an
  getAnnotationEntry (HsCmdApp XCmdApp GhcPs
an LHsCmd GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ )         = EpAnnCO -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdApp GhcPs
EpAnnCO
an
  getAnnotationEntry (HsCmdLam {})              = Entry
NoEntryVal
  getAnnotationEntry (HsCmdPar XCmdPar GhcPs
an LHsCmd GhcPs
_)            = EpAnn AnnParen -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdPar GhcPs
EpAnn AnnParen
an
  getAnnotationEntry (HsCmdCase XCmdCase GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ MatchGroup GhcPs (LHsCmd GhcPs)
_)         = EpAnn EpAnnHsCase -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdCase GhcPs
EpAnn EpAnnHsCase
an
  getAnnotationEntry (HsCmdLamCase XCmdLamCase GhcPs
an MatchGroup GhcPs (LHsCmd GhcPs)
_)        = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdLamCase GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsCmdIf XCmdIf GhcPs
an SyntaxExpr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ LHsCmd GhcPs
_ LHsCmd GhcPs
_)       = EpAnn AnnsIf -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdIf GhcPs
EpAnn AnnsIf
an
  getAnnotationEntry (HsCmdLet XCmdLet GhcPs
an HsLocalBinds GhcPs
_ LHsCmd GhcPs
_)          = EpAnn AnnsLet -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdLet GhcPs
EpAnn AnnsLet
an
  getAnnotationEntry (HsCmdDo XCmdDo GhcPs
an XRec GhcPs [CmdLStmt GhcPs]
_)             = EpAnn AnnList -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCmdDo GhcPs
EpAnn AnnList
an



  exact :: HsCmd GhcPs -> Annotated ()
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
        GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arr
        AddEpAnn -> Annotated ()
markKw (EpAnn AddEpAnn -> AddEpAnn
forall ann. EpAnn ann -> ann
anns XCmdArrApp GhcPs
EpAnn AddEpAnn
an)
        GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
      else do
        GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
        AddEpAnn -> Annotated ()
markKw (EpAnn AddEpAnn -> AddEpAnn
forall ann. EpAnn ann -> ann
anns XCmdArrApp GhcPs
EpAnn AddEpAnn
an)
        GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arr

  exact (HsCmdArrForm XCmdArrForm GhcPs
an XRec GhcPs (HsExpr GhcPs)
e LexicalFixity
fixity Maybe Fixity
_mf [LHsCmdTop GhcPs]
cs) = do
    EpAnn AnnList -> (AnnList -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA XCmdArrForm GhcPs
EpAnn AnnList
an AnnList -> Maybe AddEpAnn
al_open
    case (LexicalFixity
fixity, [LHsCmdTop GhcPs]
[GenLocated SrcSpan (HsCmdTop GhcPs)]
cs) of
      (LexicalFixity
Infix, (GenLocated SrcSpan (HsCmdTop GhcPs)
arg1:[GenLocated SrcSpan (HsCmdTop GhcPs)]
argrest)) -> do
        GenLocated SrcSpan (HsCmdTop GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated GenLocated SrcSpan (HsCmdTop GhcPs)
arg1
        GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
        [GenLocated SrcSpan (HsCmdTop GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GenLocated SrcSpan (HsCmdTop GhcPs)]
argrest
      (LexicalFixity
Prefix, [GenLocated SrcSpan (HsCmdTop GhcPs)]
_) -> do
        GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
        [GenLocated SrcSpan (HsCmdTop GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsCmdTop GhcPs]
[GenLocated SrcSpan (HsCmdTop GhcPs)]
cs
      (LexicalFixity
Infix, []) -> String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"Not possible"
    EpAnn AnnList -> (AnnList -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA XCmdArrForm GhcPs
EpAnn AnnList
an AnnList -> Maybe AddEpAnn
al_close

  exact (HsCmdApp XCmdApp GhcPs
_an LHsCmd GhcPs
e1 XRec GhcPs (HsExpr GhcPs)
e2) = do
    LocatedA (HsCmd GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
e1
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e2

  exact (HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
match) = MatchGroup GhcPs (LocatedA (HsCmd GhcPs)) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
match

  exact (HsCmdPar XCmdPar GhcPs
an LHsCmd GhcPs
e) = do
    EpAnn AnnParen -> Annotated ()
markOpeningParen XCmdPar GhcPs
EpAnn AnnParen
an
    LocatedA (HsCmd GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
e
    EpAnn AnnParen -> Annotated ()
markClosingParen XCmdPar GhcPs
EpAnn AnnParen
an

  exact (HsCmdCase XCmdCase GhcPs
an XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
alts) = do
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCmdCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> EpaLocation
hsCaseAnnCase AnnKeywordId
AnnCase
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCmdCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> EpaLocation
hsCaseAnnOf AnnKeywordId
AnnOf
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' XCmdCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> [AddEpAnn]
hsCaseAnnsRest AnnKeywordId
AnnOpenC
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll XCmdCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> [AddEpAnn]
hsCaseAnnsRest AnnKeywordId
AnnSemi
    MatchGroup GhcPs (LocatedA (HsCmd GhcPs)) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
alts
    EpAnn EpAnnHsCase
-> (EpAnnHsCase -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' XCmdCase GhcPs
EpAnn EpAnnHsCase
an EpAnnHsCase -> [AddEpAnn]
hsCaseAnnsRest AnnKeywordId
AnnCloseC

  exact (HsCmdLamCase XCmdLamCase GhcPs
an MatchGroup GhcPs (LHsCmd GhcPs)
matches) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCmdLamCase GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnLam
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCmdLamCase GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCase
    MatchGroup GhcPs (LocatedA (HsCmd GhcPs)) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
matches

  exact (HsCmdIf XCmdIf GhcPs
an SyntaxExpr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e1 LHsCmd GhcPs
e2 LHsCmd GhcPs
e3) = do
    EpAnn AnnsIf
-> (AnnsIf -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCmdIf GhcPs
EpAnn AnnsIf
an AnnsIf -> EpaLocation
aiIf AnnKeywordId
AnnIf
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
    EpAnn AnnsIf
-> (AnnsIf -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM XCmdIf GhcPs
EpAnn AnnsIf
an AnnsIf -> Maybe EpaLocation
aiThenSemi AnnKeywordId
AnnSemi
    EpAnn AnnsIf
-> (AnnsIf -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCmdIf GhcPs
EpAnn AnnsIf
an AnnsIf -> EpaLocation
aiThen AnnKeywordId
AnnThen
    LocatedA (HsCmd GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
e2
    EpAnn AnnsIf
-> (AnnsIf -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKwM XCmdIf GhcPs
EpAnn AnnsIf
an AnnsIf -> Maybe EpaLocation
aiElseSemi AnnKeywordId
AnnSemi
    EpAnn AnnsIf
-> (AnnsIf -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCmdIf GhcPs
EpAnn AnnsIf
an AnnsIf -> EpaLocation
aiElse AnnKeywordId
AnnElse
    LocatedA (HsCmd GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
e3

  exact (HsCmdLet XCmdLet GhcPs
an HsLocalBinds GhcPs
binds LHsCmd GhcPs
e) = do
    EpAnn AnnsLet
-> (AnnsLet -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCmdLet GhcPs
EpAnn AnnsLet
an AnnsLet -> EpaLocation
alLet AnnKeywordId
AnnLet
    HsLocalBinds GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsLocalBinds GhcPs
binds
    EpAnn AnnsLet
-> (AnnsLet -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XCmdLet GhcPs
EpAnn AnnsLet
an AnnsLet -> EpaLocation
alIn AnnKeywordId
AnnIn
    LocatedA (HsCmd GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
e

  exact (HsCmdDo XCmdDo GhcPs
an XRec GhcPs [CmdLStmt GhcPs]
es) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsCmdDo"
    EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnn' XCmdDo GhcPs
EpAnn AnnList
an AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnDo
    GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs [CmdLStmt GhcPs]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
es

  -- exact x = error $ "exact HsCmd for:" ++ showAst x

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

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 (LastStmt XLastStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LocatedA (body GhcPs)
_ Maybe Bool
_ SyntaxExpr GhcPs
_)             = Entry
NoEntryVal
  getAnnotationEntry (BindStmt XBindStmt GhcPs GhcPs (LocatedA (body GhcPs))
an LPat GhcPs
_ LocatedA (body GhcPs)
_)              = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XBindStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ApplicativeStmt XApplicativeStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ [(SyntaxExpr GhcPs, ApplicativeArg GhcPs)]
_ Maybe (SyntaxExpr GhcPs)
_)        = Entry
NoEntryVal
  getAnnotationEntry (BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LocatedA (body GhcPs)
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)             = Entry
NoEntryVal
  getAnnotationEntry (LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
an HsLocalBinds GhcPs
_)                 = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ParStmt XParStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
_ HsExpr GhcPs
_ SyntaxExpr GhcPs
_)              = Entry
NoEntryVal
  getAnnotationEntry (TransStmt XTransStmt GhcPs GhcPs (LocatedA (body GhcPs))
an TransForm
_ [GuardLStmt GhcPs]
_ [(IdP GhcPs, IdP GhcPs)]
_ XRec GhcPs (HsExpr GhcPs)
_ Maybe (XRec GhcPs (HsExpr GhcPs))
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ HsExpr GhcPs
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XTransStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn [AddEpAnn]
an
  getAnnotationEntry (RecStmt XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
an XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA (body GhcPs))]
_ [IdP GhcPs]
_ [IdP GhcPs]
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)       = EpAnn AnnList -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn AnnList
an

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

  exact :: StmtLR GhcPs GhcPs (LocatedA (body GhcPs)) -> Annotated ()
exact (LastStmt XLastStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LocatedA (body GhcPs)
body Maybe Bool
_ SyntaxExpr GhcPs
_) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LastStmt"
    LocatedA (body GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedA (body GhcPs)
body

  exact (BindStmt XBindStmt GhcPs GhcPs (LocatedA (body GhcPs))
an LPat GhcPs
pat LocatedA (body GhcPs)
body) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"BindStmt"
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBindStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn [AddEpAnn]
an AnnKeywordId
AnnLarrow
    LocatedA (body GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedA (body GhcPs)
body

  exact (ApplicativeStmt XApplicativeStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ [(SyntaxExpr GhcPs, ApplicativeArg GhcPs)]
_body Maybe (SyntaxExpr GhcPs)
_) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"ApplicativeStmt"
    -- TODO: ApplicativeStmt
    -- markAnnotated body
    String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"need to complete ApplicativeStmt"

  exact (BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ LocatedA (body GhcPs)
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"BodyStmt"
    LocatedA (body GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedA (body GhcPs)
body

  exact (LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
an HsLocalBinds GhcPs
binds) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LetStmt"
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn [AddEpAnn]
an AnnKeywordId
AnnLet
    HsLocalBinds GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsLocalBinds GhcPs
binds

  exact (ParStmt XParStmt GhcPs GhcPs (LocatedA (body GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
pbs HsExpr GhcPs
_ SyntaxExpr GhcPs
_) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"ParStmt"
    [ParStmtBlock GhcPs GhcPs] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [ParStmtBlock GhcPs GhcPs]
pbs


  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
_ SyntaxExpr GhcPs
_ HsExpr GhcPs
_) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"TransStmt"
    [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
    EpAnn [AddEpAnn]
-> Maybe (XRec GhcPs (HsExpr GhcPs))
-> XRec GhcPs (HsExpr GhcPs)
-> TransForm
-> Annotated ()
exactTransStmt XTransStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn [AddEpAnn]
an Maybe (XRec GhcPs (HsExpr GhcPs))
by XRec GhcPs (HsExpr GhcPs)
using TransForm
form


  exact (RecStmt XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
an XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA (body GhcPs))]
stmts [IdP GhcPs]
_ [IdP GhcPs]
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"RecStmt"
    EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn AnnList
an AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnRec
    Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
True XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpAnn AnnList
an (LocatedL
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA (body GhcPs))]
LocatedL
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))]
stmts)

  -- exact x = error $ "exact CmdLStmt for:" ++ showAst x
  -- exact x = error $ "exact CmdLStmt for:"


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

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
  exact :: ParStmtBlock GhcPs GhcPs -> Annotated ()
exact (ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [GuardLStmt GhcPs]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_) = [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts

exactTransStmt :: EpAnn [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm -> EPP ()
exactTransStmt :: EpAnn [AddEpAnn]
-> Maybe (XRec GhcPs (HsExpr GhcPs))
-> XRec GhcPs (HsExpr GhcPs)
-> TransForm
-> Annotated ()
exactTransStmt EpAnn [AddEpAnn]
an Maybe (XRec GhcPs (HsExpr GhcPs))
by XRec GhcPs (HsExpr GhcPs)
using TransForm
ThenForm = do
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"exactTransStmt:ThenForm"
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnThen
  GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
using
  case Maybe (XRec GhcPs (HsExpr GhcPs))
by of
    Maybe (XRec GhcPs (HsExpr GhcPs))
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just XRec GhcPs (HsExpr GhcPs)
b -> do
      EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnBy
      GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b
exactTransStmt EpAnn [AddEpAnn]
an Maybe (XRec GhcPs (HsExpr GhcPs))
by XRec GhcPs (HsExpr GhcPs)
using TransForm
GroupForm = do
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"exactTransStmt:GroupForm"
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnThen
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnGroup
  case Maybe (XRec GhcPs (HsExpr GhcPs))
by of
    Just XRec GhcPs (HsExpr GhcPs)
b -> do
      EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnBy
      GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b
    Maybe (XRec GhcPs (HsExpr GhcPs))
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnUsing
  GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
using

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

instance ExactPrint (TyClDecl GhcPs) where
  getAnnotationEntry :: TyClDecl GhcPs -> Entry
getAnnotationEntry (FamDecl   { })                      = Entry
NoEntryVal
  getAnnotationEntry (SynDecl   { tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
tcdSExt = XSynDecl GhcPs
an })         = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSynDecl GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (DataDecl  { tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
tcdDExt = XDataDecl GhcPs
an })         = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XDataDecl GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ClassDecl { tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCExt = (EpAnn [AddEpAnn]
an, AnnSortKey
_, LayoutInfo
_) }) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn EpAnn [AddEpAnn]
an

  exact :: TyClDecl GhcPs -> Annotated ()
exact (FamDecl XFamDecl GhcPs
_ FamilyDecl GhcPs
decl) = do
    FamilyDecl GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated FamilyDecl GhcPs
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
    [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToComments (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns XSynDecl GhcPs
EpAnn [AddEpAnn]
an) [AnnKeywordId
AnnOpenP,AnnKeywordId
AnnCloseP]
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XSynDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnType

    LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> Annotated ()
exactVanillaDeclHead LIdP GhcPs
LocatedN RdrName
ltycon LHsQTyVars GhcPs
tyvars LexicalFixity
fixity Maybe (LHsContext GhcPs)
forall a. Maybe a
Nothing
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XSynDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs

  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 }) =
    EpAnn [AddEpAnn]
-> (Maybe (LHsContext GhcPs) -> Annotated ())
-> HsDataDefn GhcPs
-> Annotated ()
exactDataDefn XDataDecl GhcPs
EpAnn [AddEpAnn]
an (LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> Annotated ()
exactVanillaDeclHead LIdP GhcPs
LocatedN RdrName
ltycon LHsQTyVars GhcPs
tyvars LexicalFixity
fixity) HsDataDefn GhcPs
defn

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

  exact (ClassDecl {tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCExt = (EpAnn [AddEpAnn]
an, AnnSortKey
sortKey, LayoutInfo
_),
                    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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null [LFamilyDecl GhcPs]
[LocatedAn AnnListItem (FamilyDecl GhcPs)]
ats Bool -> Bool -> Bool
&& [LocatedAn AnnListItem (TyFamInstDecl GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LTyFamInstDecl GhcPs]
[LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
at_defs -- No "where" part
      = do
          Annotated ()
top_matter
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC

      | Bool
otherwise       -- Laid out
      = do
          Annotated ()
top_matter
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC
          EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnSemi
          AnnSortKey -> [(RealSrcSpan, Annotated ())] -> Annotated ()
withSortKey AnnSortKey
sortKey
                               ([LocatedAn AnnListItem (Sig GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA [LSig GhcPs]
[LocatedAn AnnListItem (Sig GhcPs)]
sigs
                             [(RealSrcSpan, Annotated ())]
-> [(RealSrcSpan, Annotated ())] -> [(RealSrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LocatedAn AnnListItem (HsBind GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA (Bag (LocatedAn AnnListItem (HsBind GhcPs))
-> [LocatedAn AnnListItem (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
Bag (LocatedAn AnnListItem (HsBind GhcPs))
methods)
                             [(RealSrcSpan, Annotated ())]
-> [(RealSrcSpan, Annotated ())] -> [(RealSrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LocatedAn AnnListItem (FamilyDecl GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA [LFamilyDecl GhcPs]
[LocatedAn AnnListItem (FamilyDecl GhcPs)]
ats
                             [(RealSrcSpan, Annotated ())]
-> [(RealSrcSpan, Annotated ())] -> [(RealSrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
-> [(RealSrcSpan, Annotated ())]
forall an a.
ExactPrint (LocatedAn an a) =>
[LocatedAn an a] -> [(RealSrcSpan, Annotated ())]
prepareListAnnotationA [LTyFamInstDecl GhcPs]
[LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
at_defs
                             -- ++ prepareListAnnotation docs
                               )
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC
      where
        top_matter :: Annotated ()
top_matter = do
          [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToComments (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
an)  [AnnKeywordId
AnnOpenP, AnnKeywordId
AnnCloseP]
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnClass
          LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> Annotated ()
exactVanillaDeclHead LIdP GhcPs
LocatedN RdrName
lclas LHsQTyVars GhcPs
tyvars LexicalFixity
fixity Maybe (LHsContext GhcPs)
context
          Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (FunDep GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsFunDep GhcPs]
[GenLocated SrcSpanAnnA (FunDep GhcPs)]
fds) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
            EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnVbar
            [GenLocated SrcSpanAnnA (FunDep GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsFunDep GhcPs]
[GenLocated SrcSpanAnnA (FunDep GhcPs)]
fds
          EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnWhere

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

instance ExactPrint (FunDep GhcPs) where
  getAnnotationEntry :: FunDep GhcPs -> Entry
getAnnotationEntry (FunDep XCFunDep GhcPs
an [LIdP GhcPs]
_ [LIdP GhcPs]
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCFunDep GhcPs
EpAnn [AddEpAnn]
an

  exact :: FunDep GhcPs -> Annotated ()
exact (FunDep XCFunDep GhcPs
an [LIdP GhcPs]
ls [LIdP GhcPs]
rs') = do
    [LocatedN RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
ls
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFunDep GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnRarrow
    [LocatedN RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
rs'

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

instance ExactPrint (FamilyDecl GhcPs) where
  getAnnotationEntry :: FamilyDecl GhcPs -> Entry
getAnnotationEntry (FamilyDecl { fdExt :: forall pass. FamilyDecl pass -> XCFamilyDecl pass
fdExt = XCFamilyDecl GhcPs
an }) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an

  exact :: FamilyDecl GhcPs -> Annotated ()
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 SrcSpan
_ FamilyResultSig GhcPs
result
                    , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn GhcPs)
mb_inj }) = do
    -- = vcat [ pprFlavour info <+> pp_top_level <+>
    --          pp_vanilla_decl_head ltycon tyvars fixity Nothing <+>
    --          pp_kind <+> pp_inj <+> pp_where
    --        , nest 2 $ pp_eqns ]
    EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> Annotated ()
exactFlavour XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an FamilyInfo GhcPs
info
    Annotated ()
exact_top_level
    EpAnn [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToCommentsA XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an [AnnKeywordId
AnnOpenP,AnnKeywordId
AnnCloseP]
    LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> Annotated ()
exactVanillaDeclHead LIdP GhcPs
LocatedN RdrName
ltycon LHsQTyVars GhcPs
tyvars LexicalFixity
fixity Maybe (LHsContext GhcPs)
forall a. Maybe a
Nothing
    Annotated ()
exact_kind
    case Maybe (LInjectivityAnn GhcPs)
mb_inj of
      Maybe (LInjectivityAnn GhcPs)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just LInjectivityAnn GhcPs
inj -> do
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnVbar
        GenLocated SrcSpan (InjectivityAnn GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LInjectivityAnn GhcPs
GenLocated SrcSpan (InjectivityAnn GhcPs)
inj
    case FamilyInfo GhcPs
info of
      ClosedTypeFamily Maybe [LTyFamInstEqn GhcPs]
mb_eqns -> do
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnWhere
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC
        case Maybe [LTyFamInstEqn GhcPs]
mb_eqns of
          Maybe [LTyFamInstEqn GhcPs]
Nothing -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDotdot
          Just [LTyFamInstEqn GhcPs]
eqns -> [GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LTyFamInstEqn GhcPs]
[GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
eqns
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC
      FamilyInfo GhcPs
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
      exact_top_level :: Annotated ()
exact_top_level = case TopLevelFlag
top_level of
                          TopLevelFlag
TopLevel    -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnFamily
                          TopLevelFlag
NotTopLevel -> do
                            -- It seems that in some kind of legacy
                            -- mode the 'family' keyword is still
                            -- accepted.
                            EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnFamily
                            () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      exact_kind :: Annotated ()
exact_kind = case FamilyResultSig GhcPs
result of
                     NoSig    XNoSig GhcPs
_         -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     KindSig  XCKindSig GhcPs
_ LHsType GhcPs
kind    -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
kind
                     TyVarSig XTyVarSig GhcPs
_ LHsTyVarBndr () GhcPs
tv_bndr -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCFamilyDecl GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsTyVarBndr () GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
tv_bndr


exactFlavour :: EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> EPP ()
exactFlavour :: EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> Annotated ()
exactFlavour EpAnn [AddEpAnn]
an FamilyInfo GhcPs
DataFamily            = EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnData
exactFlavour EpAnn [AddEpAnn]
an FamilyInfo GhcPs
OpenTypeFamily        = EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnType
exactFlavour EpAnn [AddEpAnn]
an (ClosedTypeFamily {}) = EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnType

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

data DataDefnWithContext
  = DataDefnWithContext
  { DataDefnWithContext -> EpAnn [AddEpAnn]
ddwc_an :: EpAnn [AddEpAnn]
  , DataDefnWithContext -> Maybe (LHsContext GhcPs) -> Annotated ()
ddwc_hdr:: (Maybe (LHsContext GhcPs) -> EPP ()) -- Printing the header
  , DataDefnWithContext -> HsDataDefn GhcPs
ddwc_defn:: HsDataDefn GhcPs
  }

instance ExactPrint DataDefnWithContext where
  getAnnotationEntry :: DataDefnWithContext -> Entry
getAnnotationEntry DataDefnWithContext{ddwc_an :: DataDefnWithContext -> EpAnn [AddEpAnn]
ddwc_an = EpAnn [AddEpAnn]
an} = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn EpAnn [AddEpAnn]
an

  exact :: DataDefnWithContext -> Annotated ()
exact (DataDefnWithContext EpAnn [AddEpAnn]
an Maybe (LHsContext GhcPs) -> Annotated ()
exactHdr HsDataDefn GhcPs
defn)
    = EpAnn [AddEpAnn]
-> (Maybe (LHsContext GhcPs) -> Annotated ())
-> HsDataDefn GhcPs
-> Annotated ()
exactDataDefn EpAnn [AddEpAnn]
an Maybe (LHsContext GhcPs) -> Annotated ()
exactHdr HsDataDefn GhcPs
defn

exactDataDefn :: EpAnn [AddEpAnn]
              -> (Maybe (LHsContext GhcPs) -> EPP ()) -- Printing the header
              -> HsDataDefn GhcPs
              -> EPP ()
exactDataDefn :: EpAnn [AddEpAnn]
-> (Maybe (LHsContext GhcPs) -> Annotated ())
-> HsDataDefn GhcPs
-> Annotated ()
exactDataDefn EpAnn [AddEpAnn]
an Maybe (LHsContext GhcPs) -> Annotated ()
exactHdr
                 (HsDataDefn { dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ND = NewOrData
new_or_data, 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 -> [LConDecl pass]
dd_cons = [LConDecl GhcPs]
condecls, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs = HsDeriving GhcPs
derivings }) = do
  [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToComments (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
an) [AnnKeywordId
AnnOpenP, AnnKeywordId
AnnCloseP]
  if NewOrData
new_or_data NewOrData -> NewOrData -> Bool
forall a. Eq a => a -> a -> Bool
== NewOrData
DataType
    then EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnData
    else EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnNewtype
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnInstance -- optional
  (GenLocated SrcSpanAnnP CType -> Annotated ())
-> Maybe (GenLocated SrcSpanAnnP CType) -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnP CType -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (XRec GhcPs CType)
Maybe (GenLocated SrcSpanAnnP CType)
mb_ct
  Maybe (LHsContext GhcPs) -> Annotated ()
exactHdr Maybe (LHsContext GhcPs)
context
  case Maybe (LHsType GhcPs)
mb_sig of
    Maybe (LHsType GhcPs)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just LHsType GhcPs
kind -> do
      EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
      GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
kind
  Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LConDecl GhcPs] -> Bool
forall (p :: Pass). [LConDecl (GhcPass p)] -> Bool
isGadt [LConDecl GhcPs]
condecls) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnWhere
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC
  EpAnn [AddEpAnn] -> [LConDecl GhcPs] -> Annotated ()
exact_condecls EpAnn [AddEpAnn]
an [LConDecl GhcPs]
condecls
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC
  (GenLocated SrcSpan (HsDerivingClause GhcPs) -> Annotated ())
-> [GenLocated SrcSpan (HsDerivingClause GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpan (HsDerivingClause GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsDeriving GhcPs
[GenLocated SrcSpan (HsDerivingClause GhcPs)]
derivings
  () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


exactVanillaDeclHead :: LocatedN RdrName
                     -> LHsQTyVars GhcPs
                     -> LexicalFixity
                     -> Maybe (LHsContext GhcPs)
                     -> EPP ()
exactVanillaDeclHead :: LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> Annotated ()
exactVanillaDeclHead LocatedN RdrName
thing (HsQTvs { hsq_explicit :: forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit = [LHsTyVarBndr () GhcPs]
tyvars }) LexicalFixity
fixity Maybe (LHsContext GhcPs)
context = do
  let
    exact_tyvars :: [LHsTyVarBndr () GhcPs] -> EPP ()
    exact_tyvars :: [LHsTyVarBndr () GhcPs] -> Annotated ()
exact_tyvars (LHsTyVarBndr () GhcPs
varl:[LHsTyVarBndr () GhcPs]
varsr)
      | LexicalFixity
fixity LexicalFixity -> LexicalFixity -> Bool
forall a. Eq a => a -> a -> Bool
== LexicalFixity
Infix Bool -> Bool -> Bool
&& [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
varsr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = do
          GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsTyVarBndr () GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
varl
          LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
thing
          GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
forall a. [a] -> a
head [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
varsr)
          [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall a. [a] -> [a]
tail [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
varsr)
          () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | LexicalFixity
fixity LexicalFixity -> LexicalFixity -> Bool
forall a. Eq a => a -> a -> Bool
== LexicalFixity
Infix = do
          GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsTyVarBndr () GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
varl
          LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
thing
          [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
varsr
          () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = do
          LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
thing
          (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Annotated ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated (LHsTyVarBndr () GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
varlGenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall a. a -> [a] -> [a]
:[LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
varsr)
          () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    exact_tyvars [] = do
      LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
thing
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> Annotated ())
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
context
  [LHsTyVarBndr () GhcPs] -> Annotated ()
exact_tyvars [LHsTyVarBndr () GhcPs]
tyvars

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

instance ExactPrint (InjectivityAnn GhcPs) where
  getAnnotationEntry :: InjectivityAnn GhcPs -> Entry
getAnnotationEntry (InjectivityAnn XCInjectivityAnn GhcPs
an LIdP GhcPs
_ [LIdP GhcPs]
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XCInjectivityAnn GhcPs
EpAnn [AddEpAnn]
an
  exact :: InjectivityAnn GhcPs -> Annotated ()
exact (InjectivityAnn XCInjectivityAnn GhcPs
an LIdP GhcPs
lhs [LIdP GhcPs]
rhs) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCInjectivityAnn GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnVbar
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
lhs
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCInjectivityAnn GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnRarrow
    (LocatedN RdrName -> Annotated ())
-> [LocatedN RdrName] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
rhs

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

class Typeable flag => ExactPrintTVFlag flag where
  exactTVDelimiters :: EpAnn [AddEpAnn] -> flag -> Annotated () -> Annotated ()

instance ExactPrintTVFlag () where
  exactTVDelimiters :: EpAnn [AddEpAnn] -> () -> Annotated () -> Annotated ()
exactTVDelimiters EpAnn [AddEpAnn]
an ()
_ Annotated ()
thing_inside = do
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpenP
    Annotated ()
thing_inside
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnCloseP

instance ExactPrintTVFlag Specificity where
  exactTVDelimiters :: EpAnn [AddEpAnn] -> Specificity -> Annotated () -> Annotated ()
exactTVDelimiters EpAnn [AddEpAnn]
an Specificity
s Annotated ()
thing_inside = do
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
open
    Annotated ()
thing_inside
    EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
close
    where
      (AnnKeywordId
open, AnnKeywordId
close) = case Specificity
s of
        Specificity
SpecifiedSpec -> (AnnKeywordId
AnnOpenP, AnnKeywordId
AnnCloseP)
        Specificity
InferredSpec  -> (AnnKeywordId
AnnOpenC, AnnKeywordId
AnnCloseC)

instance ExactPrintTVFlag flag => ExactPrint (HsTyVarBndr flag GhcPs) where
  getAnnotationEntry :: HsTyVarBndr flag GhcPs -> Entry
getAnnotationEntry (UserTyVar XUserTyVar GhcPs
an flag
_ LIdP GhcPs
_)     = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XUserTyVar GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (KindedTyVar XKindedTyVar GhcPs
an flag
_ LIdP GhcPs
_ LHsType GhcPs
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XKindedTyVar GhcPs
EpAnn [AddEpAnn]
an

  exact :: HsTyVarBndr flag GhcPs -> Annotated ()
exact (UserTyVar XUserTyVar GhcPs
an flag
flag LIdP GhcPs
n) =
    EpAnn [AddEpAnn] -> flag -> Annotated () -> Annotated ()
forall flag.
ExactPrintTVFlag flag =>
EpAnn [AddEpAnn] -> flag -> Annotated () -> Annotated ()
exactTVDelimiters XUserTyVar GhcPs
EpAnn [AddEpAnn]
an flag
flag (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
  exact (KindedTyVar XKindedTyVar GhcPs
an flag
flag LIdP GhcPs
n LHsType GhcPs
k) = EpAnn [AddEpAnn] -> flag -> Annotated () -> Annotated ()
forall flag.
ExactPrintTVFlag flag =>
EpAnn [AddEpAnn] -> flag -> Annotated () -> Annotated ()
exactTVDelimiters XKindedTyVar GhcPs
EpAnn [AddEpAnn]
an flag
flag (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XKindedTyVar GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
k

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

instance ExactPrint (HsType GhcPs) where
  getAnnotationEntry :: HsType GhcPs -> Entry
getAnnotationEntry (HsForAllTy XForAllTy GhcPs
_ HsForAllTelescope GhcPs
_ LHsType GhcPs
_)        = Entry
NoEntryVal
  getAnnotationEntry (HsQualTy XQualTy GhcPs
_ Maybe (LHsContext GhcPs)
_ LHsType GhcPs
_)          = Entry
NoEntryVal
  getAnnotationEntry (HsTyVar XTyVar GhcPs
an PromotionFlag
_ LIdP GhcPs
_)          = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XTyVar GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
_ LHsType GhcPs
_)           = Entry
NoEntryVal
  getAnnotationEntry (HsAppKindTy XAppKindTy GhcPs
_ LHsType GhcPs
_ LHsType GhcPs
_)       = Entry
NoEntryVal
  getAnnotationEntry (HsFunTy XFunTy GhcPs
an HsArrow GhcPs
_ LHsType GhcPs
_ LHsType GhcPs
_)        = EpAnn TrailingAnn -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XFunTy GhcPs
EpAnn TrailingAnn
an
  getAnnotationEntry (HsListTy XListTy GhcPs
an LHsType GhcPs
_)           = EpAnn AnnParen -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XListTy GhcPs
EpAnn AnnParen
an
  getAnnotationEntry (HsTupleTy XTupleTy GhcPs
an HsTupleSort
_ [LHsType GhcPs]
_)        = EpAnn AnnParen -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XTupleTy GhcPs
EpAnn AnnParen
an
  getAnnotationEntry (HsSumTy XSumTy GhcPs
an [LHsType GhcPs]
_)            = EpAnn AnnParen -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSumTy GhcPs
EpAnn AnnParen
an
  getAnnotationEntry (HsOpTy XOpTy GhcPs
_ LHsType GhcPs
_ LIdP GhcPs
_ LHsType GhcPs
_)          = Entry
NoEntryVal
  getAnnotationEntry (HsParTy XParTy GhcPs
an LHsType GhcPs
_)            = EpAnn AnnParen -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XParTy GhcPs
EpAnn AnnParen
an
  getAnnotationEntry (HsIParamTy XIParamTy GhcPs
an XRec GhcPs HsIPName
_ LHsType GhcPs
_)       = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XIParamTy GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsStarTy XStarTy GhcPs
_ Bool
_)            = Entry
NoEntryVal
  getAnnotationEntry (HsKindSig XKindSig GhcPs
an LHsType GhcPs
_ LHsType GhcPs
_)        = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XKindSig GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsSpliceTy XSpliceTy GhcPs
_ HsSplice GhcPs
_)          = Entry
NoEntryVal
  getAnnotationEntry (HsDocTy XDocTy GhcPs
an LHsType GhcPs
_ LHsDocString
_)          = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XDocTy GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsBangTy XBangTy GhcPs
an HsSrcBang
_ LHsType GhcPs
_)         = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XBangTy GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsRecTy XRecTy GhcPs
an [LConDeclField GhcPs]
_)            = EpAnn AnnList -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XRecTy GhcPs
EpAnn AnnList
an
  getAnnotationEntry (HsExplicitListTy XExplicitListTy GhcPs
an PromotionFlag
_ [LHsType GhcPs]
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XExplicitListTy GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsExplicitTupleTy XExplicitTupleTy GhcPs
an [LHsType GhcPs]
_)  = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XExplicitTupleTy GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (HsTyLit XTyLit GhcPs
_ HsTyLit
_)             = Entry
NoEntryVal
  getAnnotationEntry (HsWildCardTy XWildCardTy GhcPs
_)          = Entry
NoEntryVal
  getAnnotationEntry (XHsType XXType GhcPs
_)               = Entry
NoEntryVal


  exact :: HsType GhcPs -> Annotated ()
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
    HsForAllTelescope GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsForAllTelescope GhcPs
tele
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty

  exact (HsQualTy XQualTy GhcPs
_ Maybe (LHsContext GhcPs)
ctxt LHsType GhcPs
ty) = do
    Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
ctxt
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
  exact (HsTyVar XTyVar GhcPs
an PromotionFlag
promoted LIdP GhcPs
name) = do
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PromotionFlag
promoted PromotionFlag -> PromotionFlag -> Bool
forall a. Eq a => a -> a -> Bool
== PromotionFlag
IsPromoted) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XTyVar GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnSimpleQuote
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
name

  exact (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
t1 LHsType GhcPs
t2) = GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1 Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2
  exact (HsAppKindTy XAppKindTy GhcPs
ss LHsType GhcPs
ty LHsType GhcPs
ki) = do
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    SrcSpan -> String -> Annotated ()
printStringAtSs XAppKindTy GhcPs
SrcSpan
ss String
"@"
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ki
  exact (HsFunTy XFunTy GhcPs
an HsArrow GhcPs
mult LHsType GhcPs
ty1 LHsType GhcPs
ty2) = do
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty1
    EpAnn TrailingAnn -> HsArrow GhcPs -> Annotated ()
markArrow XFunTy GhcPs
EpAnn TrailingAnn
an HsArrow GhcPs
mult
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty2
  exact (HsListTy XListTy GhcPs
an LHsType GhcPs
tys) = do
    EpAnn AnnParen -> Annotated ()
markOpeningParen XListTy GhcPs
EpAnn AnnParen
an
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
tys
    EpAnn AnnParen -> Annotated ()
markClosingParen XListTy GhcPs
EpAnn AnnParen
an
  exact (HsTupleTy XTupleTy GhcPs
an HsTupleSort
_con [LHsType GhcPs]
tys) = do
    EpAnn AnnParen -> Annotated ()
markOpeningParen XTupleTy GhcPs
EpAnn AnnParen
an
    [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
    EpAnn AnnParen -> Annotated ()
markClosingParen XTupleTy GhcPs
EpAnn AnnParen
an
  exact (HsSumTy XSumTy GhcPs
an [LHsType GhcPs]
tys) = do
    EpAnn AnnParen -> Annotated ()
markOpeningParen XSumTy GhcPs
EpAnn AnnParen
an
    [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
    EpAnn AnnParen -> Annotated ()
markClosingParen XSumTy GhcPs
EpAnn AnnParen
an
  exact (HsOpTy XOpTy GhcPs
_an LHsType GhcPs
t1 LIdP GhcPs
lo LHsType GhcPs
t2) = do
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
lo
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t2
  exact (HsParTy XParTy GhcPs
an LHsType GhcPs
ty) = do
    EpAnn AnnParen -> Annotated ()
markOpeningParen XParTy GhcPs
EpAnn AnnParen
an
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    EpAnn AnnParen -> Annotated ()
markClosingParen XParTy GhcPs
EpAnn AnnParen
an
  exact (HsIParamTy XIParamTy GhcPs
an XRec GhcPs HsIPName
n LHsType GhcPs
t) = do
      GenLocated SrcSpan HsIPName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs HsIPName
GenLocated SrcSpan HsIPName
n
      EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIParamTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
      GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t
  exact (HsStarTy XStarTy GhcPs
_an Bool
isUnicode)
    = if Bool
isUnicode
        then String -> Annotated ()
printStringAdvance String
"\x2605" -- Unicode star
        else String -> Annotated ()
printStringAdvance String
"*"
  exact (HsKindSig XKindSig GhcPs
an LHsType GhcPs
ty LHsType GhcPs
k) = do
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XKindSig GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
k
  exact (HsSpliceTy XSpliceTy GhcPs
_ HsSplice GhcPs
splice) = do
    HsSplice GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsSplice GhcPs
splice
  -- exact x@(HsDocTy an _ _)          = withPpr x
  exact (HsBangTy XBangTy GhcPs
an (HsSrcBang SourceText
mt SrcUnpackedness
_up SrcStrictness
str) LHsType GhcPs
ty) = do
    case SourceText
mt of
      SourceText
NoSourceText -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      SourceText String
src -> do
        String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsBangTy: src=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Data a => a -> String
showAst String
src
        EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XBangTy GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnOpen  (String -> Maybe String
forall a. a -> Maybe a
Just String
src)
        EpAnn [AddEpAnn]
-> ([AddEpAnn] -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS XBangTy GhcPs
EpAnn [AddEpAnn]
an [AddEpAnn] -> [AddEpAnn]
forall a. a -> a
id AnnKeywordId
AnnClose (String -> Maybe String
forall a. a -> Maybe a
Just String
"#-}")
        String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"HsBangTy: done unpackedness"
    case SrcStrictness
str of
      SrcStrictness
SrcLazy     -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBangTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnTilde
      SrcStrictness
SrcStrict   -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBangTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnBang
      SrcStrictness
NoSrcStrict -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
  -- exact x@(HsRecTy an _)            = withPpr x
  exact (HsExplicitListTy XExplicitListTy GhcPs
an PromotionFlag
prom [LHsType GhcPs]
tys) = do
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PromotionFlag -> Bool
isPromoted PromotionFlag
prom) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitListTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnSimpleQuote
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitListTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenS
    [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitListTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseS
  exact (HsExplicitTupleTy XExplicitTupleTy GhcPs
an [LHsType GhcPs]
tys) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitTupleTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnSimpleQuote
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitTupleTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenP
    [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XExplicitTupleTy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseP
  exact (HsTyLit XTyLit GhcPs
_ HsTyLit
lit) = do
    case HsTyLit
lit of
      (HsNumTy SourceText
src Integer
v) -> SourceText -> String -> Annotated ()
printSourceText SourceText
src (Integer -> String
forall a. Show a => a -> String
show Integer
v)
      (HsStrTy SourceText
src FastString
v) -> SourceText -> String -> Annotated ()
printSourceText SourceText
src (FastString -> String
forall a. Show a => a -> String
show FastString
v)
      (HsCharTy SourceText
src Char
v) -> SourceText -> String -> Annotated ()
printSourceText SourceText
src (Char -> String
forall a. Show a => a -> String
show Char
v)
  exact (HsWildCardTy XWildCardTy GhcPs
_) = String -> Annotated ()
printStringAdvance String
"_"
  exact HsType GhcPs
x = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
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 ast. HasEntry ast => ast -> Entry
fromAnn XHsForAllVis GhcPs
EpAnnForallTy
an
  getAnnotationEntry (HsForAllInvis XHsForAllInvis GhcPs
an [LHsTyVarBndr Specificity GhcPs]
_) = EpAnnForallTy -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XHsForAllInvis GhcPs
EpAnnForallTy
an

  exact :: HsForAllTelescope GhcPs -> Annotated ()
exact (HsForAllVis XHsForAllVis GhcPs
an [LHsTyVarBndr () GhcPs]
bndrs)   = do
    EpAnnForallTy -> ((AddEpAnn, AddEpAnn) -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XHsForAllVis GhcPs
EpAnnForallTy
an (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> a
fst -- AnnForall
    [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
bndrs
    EpAnnForallTy -> ((AddEpAnn, AddEpAnn) -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XHsForAllVis GhcPs
EpAnnForallTy
an (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> b
snd -- AnnRarrow

  exact (HsForAllInvis XHsForAllInvis GhcPs
an [LHsTyVarBndr Specificity GhcPs]
bndrs) = do
    EpAnnForallTy -> ((AddEpAnn, AddEpAnn) -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XHsForAllInvis GhcPs
EpAnnForallTy
an (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> a
fst -- AnnForall
    [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
bndrs
    EpAnnForallTy -> ((AddEpAnn, AddEpAnn) -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XHsForAllInvis GhcPs
EpAnnForallTy
an (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> b
snd -- AnnDot

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

instance ExactPrint (HsDerivingClause GhcPs) where
  getAnnotationEntry :: HsDerivingClause GhcPs -> Entry
getAnnotationEntry d :: HsDerivingClause GhcPs
d@(HsDerivingClause{}) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (HsDerivingClause GhcPs -> XCHsDerivingClause GhcPs
forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_ext HsDerivingClause GhcPs
d)

  exact :: HsDerivingClause GhcPs -> Annotated ()
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
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XCHsDerivingClause GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDeriving
    Annotated ()
exact_strat_before
    GenLocated SrcSpanAnnC (DerivClauseTys GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LDerivClauseTys GhcPs
GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
dct
    Annotated ()
exact_strat_after
      where
        -- -- This complexity is to distinguish between
        -- --    deriving Show
        -- --    deriving (Show)
        -- pp_dct [HsIB { hsib_body = ty }]
        --          = ppr (parenthesizeHsType appPrec ty)
        -- pp_dct _ = parens (interpp'SP dct)

        -- @via@ is unique in that in comes /after/ the class being derived,
        -- so we must special-case it.
        (Annotated ()
exact_strat_before, Annotated ()
exact_strat_after) =
          case Maybe (LDerivStrategy GhcPs)
dcs of
            Just v :: LDerivStrategy GhcPs
v@(L SrcSpan
_ ViaStrategy{}) -> (() -> Annotated ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), GenLocated SrcSpan (DerivStrategy GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LDerivStrategy GhcPs
GenLocated SrcSpan (DerivStrategy GhcPs)
v)
            Maybe (LDerivStrategy GhcPs)
_                          -> ((GenLocated SrcSpan (DerivStrategy GhcPs) -> Annotated ())
-> Maybe (GenLocated SrcSpan (DerivStrategy GhcPs)) -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpan (DerivStrategy GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LDerivStrategy GhcPs)
Maybe (GenLocated SrcSpan (DerivStrategy GhcPs))
dcs, () -> Annotated ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

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

instance ExactPrint (DerivStrategy GhcPs) where
  getAnnotationEntry :: DerivStrategy GhcPs -> Entry
getAnnotationEntry (StockStrategy XStockStrategy GhcPs
an)    = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XStockStrategy GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (AnyclassStrategy XAnyClassStrategy GhcPs
an) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XAnyClassStrategy GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (NewtypeStrategy XNewtypeStrategy GhcPs
an)  = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XNewtypeStrategy GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ViaStrategy (XViaStrategyPs EpAnn [AddEpAnn]
an  LHsSigType GhcPs
_)) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn EpAnn [AddEpAnn]
an

  exact :: DerivStrategy GhcPs -> Annotated ()
exact (StockStrategy XStockStrategy GhcPs
an)    = EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XStockStrategy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnStock
  exact (AnyclassStrategy XAnyClassStrategy GhcPs
an) = EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XAnyClassStrategy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnAnyclass
  exact (NewtypeStrategy XNewtypeStrategy GhcPs
an)  = EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XNewtypeStrategy GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnNewtype
  exact (ViaStrategy (XViaStrategyPs EpAnn [AddEpAnn]
an LHsSigType GhcPs
ty))
    = EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnVia Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty

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

instance (ExactPrint a) => ExactPrint (LocatedC a) where
  getAnnotationEntry :: LocatedC a -> Entry
getAnnotationEntry (L SrcSpanAnnC
sann a
_) = SrcSpanAnnC -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn SrcSpanAnnC
sann

  exact :: LocatedC a -> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnContext
EpAnnNotUsed SrcSpan
_) a
a) = a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated a
a
  exact (L (SrcSpanAnn (EpAnn Anchor
_ (AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
ma [EpaLocation]
opens [EpaLocation]
closes) EpAnnComments
_) SrcSpan
_) a
a) = do
    (EpaLocation -> Annotated ()) -> [EpaLocation] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnOpenP) ([EpaLocation] -> [EpaLocation]
forall a. Ord a => [a] -> [a]
sort [EpaLocation]
opens)
    a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated a
a
    (EpaLocation -> Annotated ()) -> [EpaLocation] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnCloseP) ([EpaLocation] -> [EpaLocation]
forall a. Ord a => [a] -> [a]
sort [EpaLocation]
closes)
    case Maybe (IsUnicodeSyntax, EpaLocation)
ma of
      Just (IsUnicodeSyntax
UnicodeSyntax, EpaLocation
r) -> AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnDarrowU EpaLocation
r
      Just (IsUnicodeSyntax
NormalSyntax,  EpaLocation
r) -> AnnKeywordId -> EpaLocation -> Annotated ()
markKwA AnnKeywordId
AnnDarrow  EpaLocation
r
      Maybe (IsUnicodeSyntax, EpaLocation)
Nothing -> () -> Annotated ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

instance ExactPrint (DerivClauseTys GhcPs) where
  getAnnotationEntry :: DerivClauseTys GhcPs -> Entry
getAnnotationEntry = Entry -> DerivClauseTys GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: DerivClauseTys GhcPs -> Annotated ()
exact (DctSingle XDctSingle GhcPs
_ LHsSigType GhcPs
ty) = GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
  exact (DctMulti XDctMulti GhcPs
_ [LHsSigType GhcPs]
tys) = do
    [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsSigType GhcPs]
[GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys

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

instance ExactPrint (HsSigType GhcPs) where
  getAnnotationEntry :: HsSigType GhcPs -> Entry
getAnnotationEntry = Entry -> HsSigType GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: HsSigType GhcPs -> Annotated ()
exact (HsSig XHsSig GhcPs
_ HsOuterSigTyVarBndrs GhcPs
bndrs LHsType GhcPs
ty) = do
    HsOuterSigTyVarBndrs GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsOuterSigTyVarBndrs GhcPs
bndrs
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty

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

instance ExactPrint (LocatedN RdrName) where
  getAnnotationEntry :: LocatedN RdrName -> Entry
getAnnotationEntry (L SrcSpanAnnN
sann RdrName
_) = SrcSpanAnnN -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn SrcSpanAnnN
sann

  exact :: LocatedN RdrName -> Annotated ()
exact (L (SrcSpanAnn EpAnn NameAnn
EpAnnNotUsed SrcSpan
l) RdrName
n) = do
    Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedN RdrName:NOANN: (p,l,str)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, (Pos, Pos), String) -> String
forall a. Show a => a -> String
show (Pos
p,SrcSpan -> (Pos, Pos)
ss2range SrcSpan
l, RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe RdrName
n)
    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 (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"∀" else String
"forall"
                String
s -> String
s
    SrcSpan -> String -> Annotated ()
printStringAtSs SrcSpan
l String
str
  exact (L (SrcSpanAnn (EpAnn Anchor
_anchor NameAnn
ann EpAnnComments
_cs) SrcSpan
_ll) RdrName
n) = do
    case NameAnn
ann of
      NameAnn NameAdornment
a EpaLocation
o EpaLocation
l EpaLocation
c [TrailingAnn]
t -> do
        NameAdornment
-> EpaLocation
-> Maybe (EpaLocation, RdrName)
-> EpaLocation
-> Annotated ()
markName NameAdornment
a EpaLocation
o ((EpaLocation, RdrName) -> Maybe (EpaLocation, RdrName)
forall a. a -> Maybe a
Just (EpaLocation
l,RdrName
n)) EpaLocation
c
        [TrailingAnn] -> Annotated ()
markTrailing [TrailingAnn]
t
      NameAnnCommas NameAdornment
a EpaLocation
o [EpaLocation]
cs EpaLocation
c [TrailingAnn]
t -> do
        let (AnnKeywordId
kwo,AnnKeywordId
kwc) = NameAdornment -> (AnnKeywordId, AnnKeywordId)
adornments NameAdornment
a
        AddEpAnn -> Annotated ()
markKw (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kwo EpaLocation
o)
        [EpaLocation] -> (EpaLocation -> Annotated ()) -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [EpaLocation]
cs (\EpaLocation
loc -> AddEpAnn -> Annotated ()
markKw (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnComma EpaLocation
loc))
        AddEpAnn -> Annotated ()
markKw (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kwc EpaLocation
c)
        [TrailingAnn] -> Annotated ()
markTrailing [TrailingAnn]
t
      NameAnnOnly NameAdornment
a EpaLocation
o EpaLocation
c [TrailingAnn]
t -> do
        NameAdornment
-> EpaLocation
-> Maybe (EpaLocation, RdrName)
-> EpaLocation
-> Annotated ()
markName NameAdornment
a EpaLocation
o Maybe (EpaLocation, RdrName)
forall a. Maybe a
Nothing EpaLocation
c
        [TrailingAnn] -> Annotated ()
markTrailing [TrailingAnn]
t
      NameAnnRArrow EpaLocation
nl [TrailingAnn]
t -> do
        AddEpAnn -> Annotated ()
markKw (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnRarrow EpaLocation
nl)
        [TrailingAnn] -> Annotated ()
markTrailing [TrailingAnn]
t
      NameAnnQuote EpaLocation
q SrcSpanAnnN
name [TrailingAnn]
t -> do
        String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"NameAnnQuote"
        AddEpAnn -> Annotated ()
markKw (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnSimpleQuote EpaLocation
q)
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
name RdrName
n)
        [TrailingAnn] -> Annotated ()
markTrailing [TrailingAnn]
t
      NameAnnTrailing [TrailingAnn]
t -> do
        String -> Annotated ()
printStringAdvance (RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe RdrName
n)
        [TrailingAnn] -> Annotated ()
markTrailing [TrailingAnn]
t

markName :: NameAdornment
         -> EpaLocation -> Maybe (EpaLocation,RdrName) -> EpaLocation -> EPP ()
markName :: NameAdornment
-> EpaLocation
-> Maybe (EpaLocation, RdrName)
-> EpaLocation
-> Annotated ()
markName NameAdornment
adorn EpaLocation
open Maybe (EpaLocation, RdrName)
mname EpaLocation
close = do
  let (AnnKeywordId
kwo,AnnKeywordId
kwc) = NameAdornment -> (AnnKeywordId, AnnKeywordId)
adornments NameAdornment
adorn
  AddEpAnn -> Annotated ()
markKw (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kwo EpaLocation
open)
  case Maybe (EpaLocation, RdrName)
mname of
    Maybe (EpaLocation, RdrName)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (EpaLocation
name, RdrName
a) -> EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
name (RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe RdrName
a)
  AddEpAnn -> Annotated ()
markKw (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kwc EpaLocation
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 :: [TrailingAnn] -> EPP ()
markTrailing :: [TrailingAnn] -> Annotated ()
markTrailing [TrailingAnn]
ts = do
  Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"markTrailing:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, [TrailingAnn]) -> String
forall a. Outputable a => a -> String
showPprUnsafe (Pos
p,[TrailingAnn]
ts)
  (TrailingAnn -> Annotated ()) -> [TrailingAnn] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TrailingAnn -> Annotated ()
markKwT ([TrailingAnn] -> [TrailingAnn]
forall a. Ord a => [a] -> [a]
sort [TrailingAnn]
ts)

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

-- based on pp_condecls in Decls.hs
exact_condecls :: EpAnn [AddEpAnn] -> [LConDecl GhcPs] -> EPP ()
exact_condecls :: EpAnn [AddEpAnn] -> [LConDecl GhcPs] -> Annotated ()
exact_condecls EpAnn [AddEpAnn]
an [LConDecl GhcPs]
cs
  | Bool
gadt_syntax                  -- In GADT syntax
  = do
      (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Annotated ())
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
cs
  | Bool
otherwise                    -- In H98 syntax
  = do
      EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnEqual
      (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Annotated ())
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
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 x :: ConDecl GhcPs
x@(ConDeclGADT{}) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (ConDecl GhcPs -> XConDeclGADT GhcPs
forall pass. ConDecl pass -> XConDeclGADT pass
con_g_ext ConDecl GhcPs
x)
  getAnnotationEntry x :: ConDecl GhcPs
x@(ConDeclH98{})  = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (ConDecl GhcPs -> XConDeclH98 GhcPs
forall pass. ConDecl pass -> XConDeclH98 pass
con_ext ConDecl GhcPs
x)

-- based on pprConDecl
  exact :: ConDecl GhcPs -> Annotated ()
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 LHsDocString
con_doc = Maybe LHsDocString
doc }) = do
    (LHsDocString -> Annotated ())
-> Maybe LHsDocString -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsDocString -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe LHsDocString
doc
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_forall (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XConDeclH98 GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnForall
    (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> Annotated ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
ex_tvs
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_forall (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XConDeclH98 GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDot
    (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> Annotated ())
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mcxt
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mcxt) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XConDeclH98 GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDarrow

    HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> Annotated ()
exact_details HsConDeclH98Details GhcPs
HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
args

    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
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> Annotated ()
exact_details (InfixCon HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t1 HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t2) = do
        HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t1
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
con
        HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t2
      exact_details (PrefixCon [Void]
tyargs [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
tys) = do
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
con
        [Void] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [Void]
tyargs
        [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
tys
      exact_details (RecCon GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields) = do
        LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
con
        GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields

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

  exact (ConDeclGADT { con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_g_ext = XConDeclGADT GhcPs
an
                     , con_names :: forall pass. ConDecl pass -> [LIdP pass]
con_names = [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 LHsDocString
con_doc = Maybe LHsDocString
doc }) = do
    (LHsDocString -> Annotated ())
-> Maybe LHsDocString -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsDocString -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe LHsDocString
doc
    (LocatedN RdrName -> Annotated ())
-> [LocatedN RdrName] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIdP GhcPs]
[LocatedN RdrName]
cons
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XConDeclGADT GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    [AddEpAnn] -> [AnnKeywordId] -> Annotated ()
annotationsToComments (EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns XConDeclGADT GhcPs
EpAnn [AddEpAnn]
an)  [AnnKeywordId
AnnOpenP, AnnKeywordId
AnnCloseP]
    GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
bndrs
    (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> Annotated ())
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mcxt
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
mcxt) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XConDeclGADT GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDarrow
    case HsConDeclGADTDetails GhcPs
args of
        (PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
args') -> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Annotated ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HsScaled GhcPs (LHsType GhcPs) -> Annotated ()
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Annotated ()
markScaled [HsScaled GhcPs (LHsType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
args'
        (RecConGADT XRec GhcPs [LConDeclField GhcPs]
fields)   -> GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fields
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
res_ty

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

instance ExactPrint Void where
  getAnnotationEntry :: Void -> Entry
getAnnotationEntry = Entry -> Void -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: Void -> Annotated ()
exact Void
_ = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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 ast. HasEntry ast => ast -> Entry
fromAnn XHsOuterExplicit GhcPs flag
EpAnnForallTy
an

  exact :: HsOuterTyVarBndrs flag GhcPs -> Annotated ()
exact (HsOuterImplicit XHsOuterImplicit GhcPs
_) = () -> Annotated ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  exact (HsOuterExplicit XHsOuterExplicit GhcPs flag
an [LHsTyVarBndr flag (NoGhcTc GhcPs)]
bndrs) = do
    EpAnnForallTy -> ((AddEpAnn, AddEpAnn) -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XHsOuterExplicit GhcPs flag
EpAnnForallTy
an (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> a
fst -- "forall"
    [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LHsTyVarBndr flag (NoGhcTc GhcPs)]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
bndrs
    EpAnnForallTy -> ((AddEpAnn, AddEpAnn) -> AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> AddEpAnn) -> Annotated ()
markLocatedAA XHsOuterExplicit GhcPs flag
EpAnnForallTy
an (AddEpAnn, AddEpAnn) -> AddEpAnn
forall a b. (a, b) -> b
snd -- "."

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

instance ExactPrint (ConDeclField GhcPs) where
  getAnnotationEntry :: ConDeclField GhcPs -> Entry
getAnnotationEntry f :: ConDeclField GhcPs
f@(ConDeclField{}) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (ConDeclField GhcPs -> XConDeclField GhcPs
forall pass. ConDeclField pass -> XConDeclField pass
cd_fld_ext ConDeclField GhcPs
f)

  exact :: ConDeclField GhcPs -> Annotated ()
exact (ConDeclField XConDeclField GhcPs
an [LFieldOcc GhcPs]
names LHsType GhcPs
ftype Maybe LHsDocString
mdoc) = do
    [Located (FieldOcc GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LFieldOcc GhcPs]
[Located (FieldOcc GhcPs)]
names
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XConDeclField GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ftype
    (LHsDocString -> Annotated ())
-> Maybe LHsDocString -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsDocString -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated Maybe LHsDocString
mdoc

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

instance ExactPrint (FieldOcc GhcPs) where
  getAnnotationEntry :: FieldOcc GhcPs -> Entry
getAnnotationEntry = Entry -> FieldOcc GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: FieldOcc GhcPs -> Annotated ()
exact (FieldOcc XCFieldOcc GhcPs
_ LocatedN RdrName
n) = LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
n

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

instance ExactPrint (AmbiguousFieldOcc GhcPs) where
  getAnnotationEntry :: AmbiguousFieldOcc GhcPs -> Entry
getAnnotationEntry = Entry -> AmbiguousFieldOcc GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal
  exact :: AmbiguousFieldOcc GhcPs -> Annotated ()
exact (Unambiguous XUnambiguous GhcPs
_ LocatedN RdrName
n) = LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
n
  exact (Ambiguous   XAmbiguous GhcPs
_ LocatedN RdrName
n) = LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
n

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

markScaled :: (HsScaled GhcPs (LBangType GhcPs)) -> Annotated ()
markScaled :: HsScaled GhcPs (LHsType GhcPs) -> Annotated ()
markScaled (HsScaled HsArrow GhcPs
arr (L SrcSpanAnnA
l HsType GhcPs
c)) =
  LocatedA (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated ((SrcSpanAnnA
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> LocatedA
     (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsArrow GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled HsArrow GhcPs
arr (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) HsType GhcPs
c)))
                 :: LocatedA (HsScaled GhcPs (LBangType GhcPs)))

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
  exact :: HsScaled GhcPs a -> Annotated ()
exact (HsScaled HsArrow GhcPs
arr a
t) = do
    a -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated a
t
    EpAnn TrailingAnn -> HsArrow GhcPs -> Annotated ()
markArrow EpAnn TrailingAnn
forall ann. EpAnn ann
EpAnnNotUsed HsArrow GhcPs
arr

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

instance ExactPrint (LocatedP CType) where
  getAnnotationEntry :: GenLocated SrcSpanAnnP CType -> Entry
getAnnotationEntry = GenLocated SrcSpanAnnP CType -> Entry
forall ann a. LocatedAn ann a -> Entry
entryFromLocatedA

  exact :: GenLocated SrcSpanAnnP CType -> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnPragma
EpAnnNotUsed SrcSpan
_) CType
ct) = CType -> Annotated ()
forall a. Outputable a => a -> Annotated ()
withPpr CType
ct
  exact (L (SrcSpanAnn EpAnn AnnPragma
an SrcSpan
_ll)
         (CType SourceText
stp Maybe Header
mh (SourceText
stct,FastString
ct))) = do
    EpAnn AnnPragma -> SourceText -> String -> Annotated ()
markAnnOpenP EpAnn AnnPragma
an SourceText
stp String
"{-# CTYPE"
    case Maybe Header
mh of
      Maybe Header
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (Header SourceText
srcH FastString
_h) ->
         EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_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
""))
    EpAnn AnnPragma
-> (AnnPragma -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
forall a.
EpAnn a
-> (a -> [AddEpAnn])
-> AnnKeywordId
-> Maybe String
-> Annotated ()
markLocatedAALS EpAnn AnnPragma
an AnnPragma -> [AddEpAnn]
apr_rest AnnKeywordId
AnnVal (String -> Maybe String
forall a. a -> Maybe a
Just (SourceText -> String -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
stct (FastString -> String
unpackFS FastString
ct) String
""))
    EpAnn AnnPragma -> Annotated ()
markAnnCloseP EpAnn AnnPragma
an

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

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

  exact :: (SourceText, FastString) -> Annotated ()
exact (SourceText
st, FastString
rn)
    = String -> Annotated ()
printStringAdvance (SourceText -> String -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
st (FastString -> String
unpackFS FastString
rn) String
"")


-- =====================================================================
-- 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 :: LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)] -> Entry
getAnnotationEntry = LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)] -> Entry
forall ann a. LocatedAn ann a -> Entry
entryFromLocatedA

  exact :: LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)] -> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnList
ann SrcSpan
_) [GenLocated SrcSpanAnnA (IE GhcPs)]
ies) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LIE"
    EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL EpAnn AnnList
ann AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnHiding
    Pos
p <- EP String Identity Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LIE:p=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Outputable a => a -> String
showPprUnsafe Pos
p
    Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
True EpAnn AnnList
ann ([GenLocated SrcSpanAnnA (IE GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GenLocated SrcSpanAnnA (IE GhcPs)]
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. LocatedAn ann a -> Entry
entryFromLocatedA
  exact :: LocatedL [LocatedA (Match GhcPs (LocatedA body))] -> Annotated ()
exact (L SrcSpanAnnL
la [LocatedA (Match GhcPs (LocatedA body))]
a) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LMatch"
    -- TODO: markAnnList?
    EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll (SrcSpanAnnL -> EpAnn AnnList
forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnL
la) AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnWhere
    EpAnn AnnList -> (AnnList -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA (SrcSpanAnnL -> EpAnn AnnList
forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnL
la) AnnList -> Maybe AddEpAnn
al_open
    EpAnn AnnList
-> (AnnList -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markEpAnnAll (SrcSpanAnnL -> EpAnn AnnList
forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnL
la) AnnList -> [AddEpAnn]
al_rest AnnKeywordId
AnnSemi
    [LocatedA (Match GhcPs (LocatedA body))] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LocatedA (Match GhcPs (LocatedA body))]
a
    EpAnn AnnList -> (AnnList -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA (SrcSpanAnnL -> EpAnn AnnList
forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnL
la) AnnList -> Maybe AddEpAnn
al_close

-- instance ExactPrint (LocatedL [ExprLStmt GhcPs]) where
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 a. LocatedL a -> Entry
entryFromLocatedAFixed
  exact :: LocatedL
  [GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnList
an' SrcSpan
_) [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts) = do
    let an :: EpAnn AnnList
an = EpAnn AnnList -> EpAnn AnnList
fixAnnListAnn EpAnn AnnList
an'
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [ExprLStmt"
    Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
True EpAnn AnnList
an (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      -- markLocatedMAA an al_open
      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 -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [ExprLStmt: snocView"
          GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
ls
          [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
initStmts
        Maybe
  ([GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))],
   GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
_ -> [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
        -- x -> error $ "pprDo:ListComp" ++ showAst x
      -- markLocatedMAA an al_close

-- instance ExactPrint (LocatedL [CmdLStmt GhcPs]) where
instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]) where
  getAnnotationEntry :: GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Entry
getAnnotationEntry = GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Entry
forall a. LocatedL a -> Entry
entryFromLocatedAFixed
  exact :: GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnList
ann' SrcSpan
_) [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
es) = do
    let ann :: EpAnn AnnList
ann = EpAnn AnnList -> EpAnn AnnList
fixAnnListAnn EpAnn AnnList
ann'
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [CmdLStmt"
    EpAnn AnnList -> (AnnList -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA EpAnn AnnList
ann AnnList -> Maybe AddEpAnn
al_open
    (GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))
 -> Annotated ())
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
-> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]
es
    EpAnn AnnList -> (AnnList -> Maybe AddEpAnn) -> Annotated ()
forall a. EpAnn a -> (a -> Maybe AddEpAnn) -> Annotated ()
markLocatedMAA EpAnn AnnList
ann AnnList -> Maybe AddEpAnn
al_close

instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where
  getAnnotationEntry :: GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Entry
getAnnotationEntry = GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Entry
forall ann a. LocatedAn ann a -> Entry
entryFromLocatedA
  exact :: GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnList
an SrcSpan
_) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fs) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LConDeclField"
    Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
True EpAnn AnnList
an ((GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> Annotated ())
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
fs) -- AZ:TODO get rid of mapM_

instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
  getAnnotationEntry :: LBooleanFormula (LocatedN RdrName) -> Entry
getAnnotationEntry = LBooleanFormula (LocatedN RdrName) -> Entry
forall ann a. LocatedAn ann a -> Entry
entryFromLocatedA
  exact :: LBooleanFormula (LocatedN RdrName) -> Annotated ()
exact (L (SrcSpanAnn EpAnn AnnList
an SrcSpan
_) BooleanFormula (LocatedN RdrName)
bf) = do
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LBooleanFormula"
    Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
True EpAnn AnnList
an (BooleanFormula (LocatedN RdrName) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated BooleanFormula (LocatedN RdrName)
bf)

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

instance ExactPrint (IE GhcPs) where
  getAnnotationEntry :: IE GhcPs -> Entry
getAnnotationEntry (IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
_)            = Entry
NoEntryVal
  getAnnotationEntry (IEThingAbs XIEThingAbs GhcPs
an LIEWrappedName (IdP GhcPs)
_)      = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XIEThingAbs GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (IEThingAll XIEThingAll GhcPs
an LIEWrappedName (IdP GhcPs)
_)      = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XIEThingAll GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (IEThingWith XIEThingWith GhcPs
an LIEWrappedName (IdP GhcPs)
_ IEWildcard
_ [LIEWrappedName (IdP GhcPs)]
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XIEThingWith GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (IEModuleContents XIEModuleContents GhcPs
an XRec GhcPs ModuleName
_)= EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XIEModuleContents GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (IEGroup XIEGroup GhcPs
_ Int
_ HsDocString
_)        = Entry
NoEntryVal
  getAnnotationEntry (IEDoc XIEDoc GhcPs
_ HsDocString
_)            = Entry
NoEntryVal
  getAnnotationEntry (IEDocNamed XIEDocNamed GhcPs
_ String
_)       = Entry
NoEntryVal

  exact :: IE GhcPs -> Annotated ()
exact (IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
ln) = LIEWrappedName RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
ln
  exact (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
thing) = LIEWrappedName RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
thing
  exact (IEThingAll XIEThingAll GhcPs
an LIEWrappedName (IdP GhcPs)
thing) = do
    LIEWrappedName RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
thing
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIEThingAll GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenP
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIEThingAll GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDotdot
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIEThingAll GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseP

  exact (IEThingWith XIEThingWith GhcPs
an LIEWrappedName (IdP GhcPs)
thing IEWildcard
wc [LIEWrappedName (IdP GhcPs)]
withs) = do
    LIEWrappedName RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
thing
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIEThingWith GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenP
    case IEWildcard
wc of
      IEWildcard
NoIEWildcard -> [LIEWrappedName RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
withs
      IEWildcard Int
pos -> do
        let ([LIEWrappedName RdrName]
bs, [LIEWrappedName RdrName]
as) = Int
-> [LIEWrappedName RdrName]
-> ([LIEWrappedName RdrName], [LIEWrappedName RdrName])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
withs
        [LIEWrappedName RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIEWrappedName RdrName]
bs
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIEThingWith GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDotdot
        EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIEThingWith GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnComma
        [LIEWrappedName RdrName] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LIEWrappedName RdrName]
as
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIEThingWith GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseP

  exact (IEModuleContents XIEModuleContents GhcPs
an (L SrcSpan
lm ModuleName
mn)) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XIEModuleContents GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnModule
    SrcSpan -> String -> Annotated ()
printStringAtSs SrcSpan
lm (ModuleName -> String
moduleNameString ModuleName
mn)

  -- exact (IEGroup _ _ _)          = NoEntryVal
  -- exact (IEDoc _ _)              = NoEntryVal
  -- exact (IEDocNamed _ _)         = NoEntryVal
  exact IE GhcPs
x = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"missing match for IE:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IE GhcPs -> String
forall a. Data a => a -> String
showAst IE GhcPs
x

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

instance ExactPrint (IEWrappedName RdrName) where
  getAnnotationEntry :: IEWrappedName RdrName -> Entry
getAnnotationEntry = Entry -> IEWrappedName RdrName -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: IEWrappedName RdrName -> Annotated ()
exact (IEName LocatedN RdrName
n) = LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
n
  exact (IEPattern EpaLocation
r LocatedN RdrName
n) = do
    EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
r String
"pattern"
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
n
  exact (IEType EpaLocation
r LocatedN RdrName
n) = do
    EpaLocation -> String -> Annotated ()
printStringAtAA EpaLocation
r String
"type"
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LocatedN RdrName
n

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

instance ExactPrint (Pat GhcPs) where
  getAnnotationEntry :: Pat GhcPs -> Entry
getAnnotationEntry (WildPat XWildPat GhcPs
_)              = Entry
NoEntryVal
  getAnnotationEntry (VarPat XVarPat GhcPs
_ LIdP GhcPs
_)             = Entry
NoEntryVal
  getAnnotationEntry (LazyPat XLazyPat GhcPs
an LPat GhcPs
_)           = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XLazyPat GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (AsPat XAsPat GhcPs
an LIdP GhcPs
_ LPat GhcPs
_)           = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XAsPat GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ParPat XParPat GhcPs
an LPat GhcPs
_)            = EpAnn AnnParen -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XParPat GhcPs
EpAnn AnnParen
an
  getAnnotationEntry (BangPat XBangPat GhcPs
an LPat GhcPs
_)           = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XBangPat GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ListPat XListPat GhcPs
an [LPat GhcPs]
_)           = EpAnn AnnList -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XListPat GhcPs
EpAnn AnnList
an
  getAnnotationEntry (TuplePat XTuplePat GhcPs
an [LPat GhcPs]
_ Boxity
_)        = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XTuplePat GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (SumPat XSumPat GhcPs
an LPat GhcPs
_ Int
_ Int
_)        = EpAnn EpAnnSumPat -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSumPat GhcPs
EpAnn EpAnnSumPat
an
  getAnnotationEntry (ConPat XConPat GhcPs
an XRec GhcPs (ConLikeP GhcPs)
_ HsConPatDetails GhcPs
_)          = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XConPat GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (ViewPat XViewPat GhcPs
an XRec GhcPs (HsExpr GhcPs)
_ LPat GhcPs
_)         = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XViewPat GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
_)          = Entry
NoEntryVal
  getAnnotationEntry (LitPat XLitPat GhcPs
_ HsLit GhcPs
_)             = Entry
NoEntryVal
  getAnnotationEntry (NPat XNPat GhcPs
an XRec GhcPs (HsOverLit GhcPs)
_ Maybe (SyntaxExpr GhcPs)
_ SyntaxExpr GhcPs
_)          = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XNPat GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (NPlusKPat XNPlusKPat GhcPs
an LIdP GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
_ HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XNPlusKPat GhcPs
EpAnn [AddEpAnn]
an
  getAnnotationEntry (SigPat XSigPat GhcPs
an LPat GhcPs
_ HsPatSigType (NoGhcTc GhcPs)
_)          = EpAnn [AddEpAnn] -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn XSigPat GhcPs
EpAnn [AddEpAnn]
an

  exact :: Pat GhcPs -> Annotated ()
exact (WildPat XWildPat GhcPs
_) = do
    RealSrcSpan
anchor <- EP String Identity RealSrcSpan
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU
    String -> Annotated ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"WildPat:anchor=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ RealSrcSpan -> String
forall a. Show a => a -> String
show RealSrcSpan
anchor
    RealSrcSpan -> String -> Annotated ()
printStringAtRs RealSrcSpan
anchor String
"_"
  exact (VarPat XVarPat GhcPs
_ 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"
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
  exact (LazyPat XLazyPat GhcPs
an LPat GhcPs
pat) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XLazyPat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnTilde
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
  exact (AsPat XAsPat GhcPs
an LIdP GhcPs
n LPat GhcPs
pat) = do
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XAsPat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnAt
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
  exact (ParPat XParPat GhcPs
an LPat GhcPs
pat) = do
    EpAnn AnnParen
-> (AnnParen -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XParPat GhcPs
EpAnn AnnParen
an AnnParen -> EpaLocation
ap_open AnnKeywordId
AnnOpenP
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
    EpAnn AnnParen
-> (AnnParen -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XParPat GhcPs
EpAnn AnnParen
an AnnParen -> EpaLocation
ap_close AnnKeywordId
AnnCloseP

  exact (BangPat XBangPat GhcPs
an LPat GhcPs
pat) = do
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XBangPat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnBang
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat

  exact (ListPat XListPat GhcPs
an [LPat GhcPs]
pats) = Bool -> EpAnn AnnList -> Annotated () -> Annotated ()
markAnnList Bool
True XListPat GhcPs
EpAnn AnnList
an ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats)

  exact (TuplePat XTuplePat GhcPs
an [LPat GhcPs]
pats Boxity
boxity) = do
    case Boxity
boxity of
      Boxity
Boxed   -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XTuplePat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenP
      Boxity
Unboxed -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XTuplePat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenPH
    [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
    case Boxity
boxity of
      Boxity
Boxed   -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XTuplePat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseP
      Boxity
Unboxed -> EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XTuplePat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnClosePH

  exact (SumPat XSumPat GhcPs
an LPat GhcPs
pat Int
_alt Int
_arity) = do
    EpAnn EpAnnSumPat
-> (EpAnnSumPat -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL XSumPat GhcPs
EpAnn EpAnnSumPat
an EpAnnSumPat -> [AddEpAnn]
sumPatParens AnnKeywordId
AnnOpenPH
    EpAnn EpAnnSumPat
-> (EpAnnSumPat -> [EpaLocation]) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> [EpaLocation]) -> AnnKeywordId -> Annotated ()
markAnnKwAll XSumPat GhcPs
EpAnn EpAnnSumPat
an EpAnnSumPat -> [EpaLocation]
sumPatVbarsBefore AnnKeywordId
AnnVbar
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
    EpAnn EpAnnSumPat
-> (EpAnnSumPat -> [EpaLocation]) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> [EpaLocation]) -> AnnKeywordId -> Annotated ()
markAnnKwAll XSumPat GhcPs
EpAnn EpAnnSumPat
an EpAnnSumPat -> [EpaLocation]
sumPatVbarsAfter AnnKeywordId
AnnVbar
    EpAnn EpAnnSumPat
-> (EpAnnSumPat -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
forall ann.
EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> Annotated ()
markLocatedAAL XSumPat GhcPs
EpAnn EpAnnSumPat
an EpAnnSumPat -> [AddEpAnn]
sumPatParens AnnKeywordId
AnnClosePH

  -- | ConPat an con args)
  exact (ConPat XConPat GhcPs
an XRec GhcPs (ConLikeP GhcPs)
con HsConPatDetails GhcPs
details) = EpAnn [AddEpAnn]
-> LocatedN RdrName -> HsConPatDetails GhcPs -> Annotated ()
forall con.
ExactPrint con =>
EpAnn [AddEpAnn] -> con -> HsConPatDetails GhcPs -> Annotated ()
exactUserCon XConPat GhcPs
EpAnn [AddEpAnn]
an XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con HsConPatDetails GhcPs
details
  exact (ViewPat XViewPat GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr LPat GhcPs
pat) = do
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XViewPat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnRarrow
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
  exact (SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
splice) = HsSplice GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsSplice GhcPs
splice
  exact (LitPat XLitPat GhcPs
_ HsLit GhcPs
lit) = String -> Annotated ()
printStringAdvance (HsLit GhcPs -> String
hsLit2String HsLit GhcPs
lit)
  exact (NPat XNPat GhcPs
an XRec GhcPs (HsOverLit GhcPs)
ol Maybe (SyntaxExpr GhcPs)
mn SyntaxExpr GhcPs
_) = do
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe NoExtField -> Bool
forall a. Maybe a -> Bool
isJust Maybe (SyntaxExpr GhcPs)
Maybe NoExtField
mn) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XNPat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnMinus
    GenLocated SrcSpan (HsOverLit GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsOverLit GhcPs)
GenLocated SrcSpan (HsOverLit GhcPs)
ol

  -- | NPlusKPat an n lit1 lit2 _ _)
  exact (NPlusKPat XNPlusKPat GhcPs
an LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
k HsOverLit GhcPs
lit2 SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = do
    LocatedN RdrName -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    -- We need a fix for
    -- https://gitlab.haskell.org/ghc/ghc/-/issues/20243 to complete
    -- this
    GenLocated SrcSpan (HsOverLit GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated XRec GhcPs (HsOverLit GhcPs)
GenLocated SrcSpan (HsOverLit GhcPs)
k

  exact (SigPat XSigPat GhcPs
an LPat GhcPs
pat HsPatSigType (NoGhcTc GhcPs)
sig) = do
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
    EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn XSigPat GhcPs
EpAnn [AddEpAnn]
an AnnKeywordId
AnnDcolon
    HsPatSigType GhcPs -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsPatSigType GhcPs
HsPatSigType (NoGhcTc GhcPs)
sig
  -- exact x = error $ "missing match for Pat:" ++ showAst x

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

instance ExactPrint (HsPatSigType GhcPs) where
  getAnnotationEntry :: HsPatSigType GhcPs -> Entry
getAnnotationEntry = Entry -> HsPatSigType GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: HsPatSigType GhcPs -> Annotated ()
exact (HsPS XHsPS GhcPs
an LHsType GhcPs
ty) = do
    EpAnn EpaLocation
-> (EpaLocation -> EpaLocation) -> AnnKeywordId -> Annotated ()
forall a.
EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> Annotated ()
markAnnKw XHsPS GhcPs
EpAnn EpaLocation
an EpaLocation -> EpaLocation
forall a. a -> a
id AnnKeywordId
AnnAt
    GenLocated SrcSpanAnnA (HsType GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty

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

instance ExactPrint (HsOverLit GhcPs) where
  getAnnotationEntry :: HsOverLit GhcPs -> Entry
getAnnotationEntry = Entry -> HsOverLit GhcPs -> Entry
forall a b. a -> b -> a
const Entry
NoEntryVal

  exact :: HsOverLit GhcPs -> Annotated ()
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 String
s -> String -> Annotated ()
printStringAdvance String
s
        SourceText
NoSourceText -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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
""
    -- It should be included here
    -- https://github.com/ghc/ghc/blob/master/compiler/parser/Lexer.x#L1471
    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
""
    HsInt64Prim  XHsInt64Prim GhcPs
src Integer
v   -> SourceText -> Integer -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix XHsInt64Prim 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
"##"
    -- (XLit x) -> error $ "got XLit for:" ++ showPprUnsafe x

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 String
txt) a
_alt String
suffix = String
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 String
txt) String
_ = String
txt

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

exactUserCon :: (ExactPrint con) => EpAnn [AddEpAnn] -> con -> HsConPatDetails GhcPs -> EPP ()
exactUserCon :: forall con.
ExactPrint con =>
EpAnn [AddEpAnn] -> con -> HsConPatDetails GhcPs -> Annotated ()
exactUserCon EpAnn [AddEpAnn]
_  con
c (InfixCon LPat GhcPs
p1 LPat GhcPs
p2) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1 Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> con -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated con
c Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p2
exactUserCon EpAnn [AddEpAnn]
an con
c HsConPatDetails GhcPs
details          = do
  con -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated con
c
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnOpenC
  HsConPatDetails GhcPs -> Annotated ()
exactConArgs HsConPatDetails GhcPs
details
  EpAnn [AddEpAnn] -> AnnKeywordId -> Annotated ()
markEpAnn EpAnn [AddEpAnn]
an AnnKeywordId
AnnCloseC


exactConArgs ::HsConPatDetails GhcPs -> EPP ()
exactConArgs :: HsConPatDetails GhcPs -> Annotated ()
exactConArgs (PrefixCon [HsPatSigType (NoGhcTc GhcPs)]
tyargs [LPat GhcPs]
pats) = [HsPatSigType GhcPs] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [HsPatSigType GhcPs]
[HsPatSigType (NoGhcTc GhcPs)]
tyargs Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
exactConArgs (InfixCon LPat GhcPs
p1 LPat GhcPs
p2) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1 Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (Pat GhcPs) -> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p2
exactConArgs (RecCon HsRecFields GhcPs (LPat GhcPs)
rpats)   = HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
-> Annotated ()
forall a. ExactPrint a => a -> Annotated ()
markAnnotated HsRecFields GhcPs (LPat GhcPs)
HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
rpats

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

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

-- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256
entryFromLocatedAFixed :: LocatedL a -> Entry
entryFromLocatedAFixed :: forall a. LocatedL a -> Entry
entryFromLocatedAFixed (L SrcSpanAnnL
la a
_)
  = SrcSpanAnnL -> Entry
forall ast. HasEntry ast => ast -> Entry
fromAnn (SrcSpanAnnL -> SrcSpanAnnL
fixSrcAnnL SrcSpanAnnL
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
  Pos
p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  LayoutStartCol
colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
  if DeltaPos -> LayoutStartCol -> Bool
isGoodDeltaWithOffset DeltaPos
cl LayoutStartCol
colOffset
    then do
      Pos -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Pos -> String -> EP w m ()
printStringAt (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
cl LayoutStartCol
colOffset) String
s
        EP w m () -> String -> EP w m ()
forall c. c -> String -> c
`debug` (String
"printStringAtLsDelta:(pos,s):" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, String) -> String
forall a. Show a => a -> String
show (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
cl LayoutStartCol
colOffset,String
s))
    else () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () EP w m () -> String -> EP w m ()
forall c. c -> String -> c
`debug` (String
"printStringAtLsDelta:bad delta for (mc,s):" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (DeltaPos, String) -> String
forall a. Show a => a -> String
show (DeltaPos
cl,String
s))

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

isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool
isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool
isGoodDeltaWithOffset DeltaPos
dp LayoutStartCol
colOffset = DeltaPos -> Bool
isGoodDelta (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

printQueuedComment :: (Monad m, Monoid w) => RealSrcSpan -> Comment -> DeltaPos -> EP w m ()
printQueuedComment :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RealSrcSpan -> Comment -> DeltaPos -> EP w m ()
printQueuedComment RealSrcSpan
loc Comment{String
commentContents :: Comment -> String
commentContents :: String
commentContents} DeltaPos
dp = do
  Pos
p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  LayoutStartCol
colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
  let (Int
dr,Int
dc) = Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta (Int
0,Int
0) DeltaPos
dp LayoutStartCol
colOffset
  -- do not lose comments against the left margin
  Bool -> EP w m () -> EP w m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DeltaPos -> Bool
isGoodDelta (Int -> Int -> DeltaPos
deltaPos Int
dr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
dc))) (EP w m () -> EP w m ()) -> EP w m () -> EP w m ()
forall a b. (a -> b) -> a -> b
$ do
    Pos -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Pos -> String -> EP w m ()
printCommentAt (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
dp LayoutStartCol
colOffset) String
commentContents
    Bool -> RealSrcSpan -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> RealSrcSpan -> EP w m ()
setPriorEndASTD Bool
False RealSrcSpan
loc
  Pos
p' <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  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
"printQueuedComment: (p,p',dp,colOffset,undelta)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos, DeltaPos, LayoutStartCol, Pos) -> String
forall a. Show a => a -> String
show (Pos
p,Pos
p',DeltaPos
dp,LayoutStartCol
colOffset,Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
dp LayoutStartCol
colOffset)

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

setLayoutBoth :: (Monad m, Monoid w) => EP w m () -> EP w m ()
setLayoutBoth :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutBoth EP w m ()
k = do
  LayoutStartCol
oldLHS <- (EPState -> LayoutStartCol)
-> RWST (PrintOptions m w) (EPWriter w) EPState m LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> LayoutStartCol
dLHS
  LayoutStartCol
oldAnchorOffset <- RWST (PrintOptions m w) (EPWriter w) EPState m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
  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
"setLayoutBoth: (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) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
a -> EPState
a { dMarkLayout :: Bool
dMarkLayout = Bool
True
                  , pMarkLayout :: Bool
pMarkLayout = Bool
True } )
  let reset :: EP w m ()
reset = 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
"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) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
a -> EPState
a { dMarkLayout :: Bool
dMarkLayout = Bool
False
                        , dLHS :: LayoutStartCol
dLHS = LayoutStartCol
oldLHS
                        , pMarkLayout :: Bool
pMarkLayout = Bool
False
                        , pLHS :: LayoutStartCol
pLHS = LayoutStartCol
oldAnchorOffset} )
  EP w m ()
k EP w m () -> EP w m () -> EP w m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* EP w m ()
reset

-- Use 'local', designed for this
setLayoutTopLevelP :: (Monad m, Monoid w) => EP w m () -> EP w m ()
setLayoutTopLevelP :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m () -> EP w m ()
setLayoutTopLevelP EP w m ()
k = 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
"setLayoutTopLevelP entered"
  LayoutStartCol
oldAnchorOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
  (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
a -> EPState
a { pMarkLayout :: Bool
pMarkLayout = Bool
False
                  , pLHS :: LayoutStartCol
pLHS = LayoutStartCol
0} )
  EP w m ()
k
  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
"setLayoutTopLevelP:resetting"
  LayoutStartCol -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LayoutStartCol -> EP w m ()
setLayoutOffsetP LayoutStartCol
oldAnchorOffset

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

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 (PrintOptions 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
  -- debugM $ "setPosP:" ++ show l
  (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s {epPos :: Pos
epPos = Pos
l})

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 (PrintOptions 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 -> 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
"setExtraDP:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Anchor -> String
forall a. Show a => a -> String
show Maybe Anchor
md
  (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s {uExtraDP :: Maybe Anchor
uExtraDP = Maybe Anchor
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 (PrintOptions 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 (PrintOptions m w) (EPWriter w) EPState m RealSrcSpan
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> RealSrcSpan
uAnchorSpan

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
  -- setLayoutStartIfNeededD (snd pe)
  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 -> 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
"setPriorEndNoLayout:pe=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
pe
  (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { dPriorEndPosition :: Pos
dPriorEndPosition = Pos
pe })

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

setPriorEndASTPD :: (Monad m, Monoid w) => Bool -> (Pos,Pos) -> EP w m ()
setPriorEndASTPD :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> (Pos, Pos) -> EP w m ()
setPriorEndASTPD Bool
layout pe :: (Pos, Pos)
pe@(Pos
fm,Pos
to) = 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
"setPriorEndASTD:pe=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Show a => a -> String
show (Pos, Pos)
pe
  Bool -> EP w m () -> EP w m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
layout (EP w m () -> EP w m ()) -> EP w m () -> EP w m ()
forall a b. (a -> b) -> a -> b
$ Int -> EP w 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) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { dPriorEndPosition :: Pos
dPriorEndPosition = Pos
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{Bool
dMarkLayout :: Bool
dMarkLayout :: EPState -> Bool
dMarkLayout} <- RWST (PrintOptions m w) (EPWriter w) EPState m EPState
forall s (m :: * -> *). MonadState s m => m s
get
  Bool -> EP w m () -> EP w m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
dMarkLayout (EP w m () -> EP w m ()) -> EP w m () -> EP w m ()
forall a b. (a -> b) -> a -> b
$ 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
"setLayoutStartD: setting dLHS=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
p
    (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { dMarkLayout :: Bool
dMarkLayout = Bool
False
                    , dLHS :: LayoutStartCol
dLHS = Int -> LayoutStartCol
LayoutStartCol Int
p})

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 -> 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
"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) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { uAnchorSpan :: RealSrcSpan
uAnchorSpan = RealSrcSpan
rss })

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 (PrintOptions 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 (PrintOptions m w) (EPWriter w) EPState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { epComments :: [Comment]
epComments = [Comment]
cs } )

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 (PrintOptions 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 -> 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
"setLayoutOffsetP:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LayoutStartCol -> String
forall a. Show a => a -> String
show LayoutStartCol
c
  (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { pLHS :: LayoutStartCol
pLHS = LayoutStartCol
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
  Pos
p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  LayoutStartCol
colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
  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
"advance:(p,dp,colOffset,ws)=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, DeltaPos, LayoutStartCol, Pos) -> String
forall a. Show a => a -> String
show (Pos
p,DeltaPos
dp,LayoutStartCol
colOffset,Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
dp LayoutStartCol
colOffset)
  Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
dp LayoutStartCol
colOffset)

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

adjustDeltaForOffsetM :: DeltaPos -> EPP DeltaPos
adjustDeltaForOffsetM :: DeltaPos -> EPP DeltaPos
adjustDeltaForOffsetM DeltaPos
dp = do
  LayoutStartCol
colOffset <- (EPState -> LayoutStartCol)
-> RWST
     (PrintOptions Identity String)
     (EPWriter String)
     EPState
     Identity
     LayoutStartCol
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EPState -> LayoutStartCol
dLHS
  DeltaPos -> EPP DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset Int
0 LayoutStartCol
colOffset DeltaPos
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 :: EPState -> Pos
epPos = (Int
_,Int
c), Bool
pMarkLayout :: Bool
pMarkLayout :: EPState -> Bool
pMarkLayout} <- RWST (PrintOptions m w) (EPWriter w) EPState m EPState
forall s (m :: * -> *). MonadState s m => m s
get
  PrintOptions{String -> m w
epTokenPrint :: String -> m w
epTokenPrint :: forall (m :: * -> *) a. PrintOptions m a -> String -> m a
epTokenPrint, String -> m w
epWhitespacePrint :: String -> m w
epWhitespacePrint :: forall (m :: * -> *) a. PrintOptions m a -> String -> m a
epWhitespacePrint} <- RWST (PrintOptions m w) (EPWriter w) EPState m (PrintOptions m w)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Bool -> EP w m () -> EP w m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
pMarkLayout Bool -> Bool -> Bool
&& Bool
layout) (EP w m () -> EP w m ()) -> EP w m () -> EP w m ()
forall a b. (a -> b) -> a -> b
$ 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
"printString: setting pLHS to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c
    (EPState -> EPState) -> EP w m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EPState
s -> EPState
s { pLHS :: LayoutStartCol
pLHS = Int -> LayoutStartCol
LayoutStartCol Int
c, pMarkLayout :: Bool
pMarkLayout = Bool
False } )

  -- Advance position, taking care of any newlines in the string
  let strDP :: DeltaPos
strDP = String -> DeltaPos
dpFromString String
str
      cr :: Int
cr = DeltaPos -> Int
getDeltaLine DeltaPos
strDP
  Pos
p <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
  LayoutStartCol
colOffset <- EP w m LayoutStartCol
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EP w m LayoutStartCol
getLayoutOffsetP
  -- debugM $ "printString:(p,colOffset,strDP,cr)="  ++ show (p,colOffset,strDP,cr)
  if Int
cr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPosP (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
strDP LayoutStartCol
colOffset)
    else Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPosP (Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta Pos
p DeltaPos
strDP LayoutStartCol
1)

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

  --
  if Bool -> Bool
not Bool
layout Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then m w -> RWST (PrintOptions m w) (EPWriter w) EPState m w
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m w
epWhitespacePrint String
str) RWST (PrintOptions m w) (EPWriter w) EPState m w
-> (w -> EP w m ()) -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \w
s -> EPWriter w -> EP w m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell EPWriter { output :: w
output = w
s}
    else m w -> RWST (PrintOptions m w) (EPWriter w) EPState m w
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m w
epTokenPrint      String
str) RWST (PrintOptions m w) (EPWriter w) EPState m w
-> (w -> EP w m ()) -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \w
s -> EPWriter w -> EP w m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell EPWriter { output :: w
output = w
s}

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

printStringAdvance :: String -> EPP ()
printStringAdvance :: String -> Annotated ()
printStringAdvance String
str = do
  RealSrcSpan
ss <- EP String Identity RealSrcSpan
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU
  RealSrcSpan -> String -> Annotated ()
printStringAtKw' RealSrcSpan
ss String
str

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

newLine :: (Monad m, Monoid w) => EP w m ()
newLine :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m ()
newLine = do
    (Int
l,Int
_) <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    Bool -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
False String
"\n"
    Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
setPosP (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
1)

padUntil :: (Monad m, Monoid w) => Pos -> EP w m ()
padUntil :: forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
padUntil (Int
l,Int
c) = do
    (Int
l1,Int
c1) <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    if | Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c -> Bool -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
False (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c1) Char
' '
       | Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l             -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m ()
newLine EP w m () -> EP w m () -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
padUntil (Int
l,Int
c)
       | Bool
otherwise          -> () -> EP w m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

printWhitespace :: (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace :: 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 -> 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
"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 -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace Pos
p EP w m () -> EP w m () -> EP w m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
False String
str

printStringAt :: (Monad m, Monoid w) => Pos -> String -> EP w m ()
printStringAt :: 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 (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