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

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

  -- * Configuration
  , EPOptions(epTokenPrint, epWhitespacePrint)
  , stringOptions
  , epOptions
  , deltaOptions

  -- * Utility
  , setAnchorAn
  ) where

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


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

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

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

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

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

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

-- | Transform concrete annotations into relative annotations.
-- This should be unnecessary from GHC 9.10
makeDeltaAst :: ExactPrint ast => ast -> ast
makeDeltaAst :: forall ast. ExactPrint ast => ast -> ast
makeDeltaAst ast
ast = (ast, ()) -> ast
forall a b. (a, b) -> a
fst ((ast, ()) -> ast) -> (ast, ()) -> ast
forall a b. (a -> b) -> a -> b
$ Identity (ast, ()) -> (ast, ())
forall a. Identity a -> a
runIdentity (EPOptions Identity () -> EP () Identity ast -> Identity (ast, ())
forall (m :: * -> *) w a.
Monad m =>
EPOptions m w -> EP w m a -> m (a, w)
runEP EPOptions Identity ()
deltaOptions (ast -> EP () Identity ast
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ast
ast))

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

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

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

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

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


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

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

-- | Helper to create a 'EPOptions'
epOptions :: (String -> m a)
          -> (String -> m a)
          -> EPOptions m a
epOptions :: forall (m :: * -> *) a.
(String -> m a) -> (String -> m a) -> EPOptions m a
epOptions String -> m a
tokenPrint String -> m a
wsPrint = EPOptions
             { epWhitespacePrint :: String -> m a
epWhitespacePrint = String -> m a
wsPrint
             , epTokenPrint :: String -> m a
epTokenPrint = String -> m a
tokenPrint
             }

-- | Options which can be used to print as a normal String.
stringOptions :: EPOptions Identity String
stringOptions :: EPOptions Identity String
stringOptions = (String -> Identity String)
-> (String -> Identity String) -> EPOptions Identity String
forall (m :: * -> *) a.
(String -> m a) -> (String -> m a) -> EPOptions m a
epOptions String -> Identity String
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String -> Identity String
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return

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

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 EpaLocation
uExtraDP :: !(Maybe EpaLocation) -- ^ Used to anchor a
                                                -- list
             , EPState -> Maybe (SrcSpan, DeltaPos)
uExtraDPReturn :: !(Maybe (SrcSpan, DeltaPos))
                  -- ^ Used to return Delta version of uExtraDP
             , EPState -> Bool
pAcceptSpan :: Bool -- ^ When we have processed an
                                   -- entry of EpaDelta, accept the
                                   -- next `EpaSpan` start as the
                                   -- current output position. i.e. do
                                   -- not advance epPos. Achieved by
                                   -- setting dPriorEndPosition to the
                                   -- end of the span.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance HasTrailing AnnContext where
  trailing :: AnnContext -> [TrailingAnn]
trailing (AnnContext Maybe TokDarrow
ma [EpToken "("]
_opens [EpToken ")"]
_closes)
    = case Maybe TokDarrow
ma of
      Just TokDarrow
r -> [TokDarrow -> TrailingAnn
AddDarrowAnn TokDarrow
r]
      Maybe TokDarrow
_ -> []

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance HasTrailing (TokForall, EpToken ".") where
  trailing :: (TokForall, EpToken ".") -> [TrailingAnn]
trailing (TokForall, EpToken ".")
_ = []
  setTrailing :: (TokForall, EpToken ".")
-> [TrailingAnn] -> (TokForall, EpToken ".")
setTrailing (TokForall, EpToken ".")
a [TrailingAnn]
_ = (TokForall, EpToken ".")
a

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  -- Update original anchor, comments based on the printing process
  -- TODO:AZ: probably need to put something appropriate in instead of noSrcSpan
  let newAnchor = case EpaLocation
anchor' of
          EpaSpan SrcSpan
s -> SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
s         DeltaPos
edp []
          EpaLocation
_         -> SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan DeltaPos
edp []
  let r = case CanUpdateAnchor
canUpdateAnchor of
            CanUpdateAnchor
CanUpdateAnchor -> a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a
forall a.
ExactPrint a =>
a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a
setAnnotationAnchor a
a' EpaLocation
newAnchor [TrailingAnn]
trailing' ([Comment] -> [Comment] -> EpAnnComments
mkEpaComments [Comment]
priorCs [Comment]
postCs)
            CanUpdateAnchor
CanUpdateAnchorOnly -> a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a
forall a.
ExactPrint a =>
a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a
setAnnotationAnchor a
a' EpaLocation
newAnchor [] EpAnnComments
emptyComments
            CanUpdateAnchor
NoCanUpdateAnchor -> a
a'
  return r

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

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

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

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

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

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

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

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

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

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

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

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

epTokensToComments :: (Monad m, Monoid w)
  => String -> [EpToken tok] -> EP w m ()
epTokensToComments :: forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
kw [EpToken tok]
toks
  = Bool -> [Comment] -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> [Comment] -> EP w m ()
addComments Bool
True ((EpToken tok -> [Comment]) -> [EpToken tok] -> [Comment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\EpToken tok
tok ->
                                   case EpToken tok
tok of
                                     EpTok EpaLocation
ss -> [String -> EpaLocation' NoComments -> Comment
mkKWComment String
kw (EpaLocation -> EpaLocation' NoComments
epaToNoCommentsLocation EpaLocation
ss)]
                                     EpToken tok
NoEpTok -> []) [EpToken tok]
toks)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

markLensBracketsO' :: (Monad m, Monoid w)
  => a -> Lens a AnnListBrackets -> EP w m a
markLensBracketsO' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AnnListBrackets -> EP w m a
markLensBracketsO' a
a Lens a AnnListBrackets
l =
  case Getting a AnnListBrackets -> a -> AnnListBrackets
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a AnnListBrackets
Lens a AnnListBrackets
l a
a of
    ListParens EpToken "("
o EpToken ")"
c -> do
      o' <- EpToken "(" -> EP w m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "("
o
      return (set l (ListParens o' c) a)
    ListBraces EpToken "{"
o EpToken "}"
c -> do
      o' <- EpToken "{" -> EP w m (EpToken "{")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "{"
o
      return (set l (ListBraces o' c) a)
    ListSquare EpToken "["
o EpToken "]"
c -> do
      o' <- EpToken "[" -> EP w m (EpToken "[")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "["
o
      return (set l (ListSquare o' c) a)
    ListBanana EpUniToken "(|" "\10631"
o EpUniToken "|)" "\10632"
c -> do
      o' <- EpUniToken "(|" "\10631" -> EP w m (EpUniToken "(|" "\10631")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken EpUniToken "(|" "\10631"
o
      return (set l (ListBanana o' c) a)
    AnnListBrackets
ListNone -> a -> EP w m a
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lens a AnnListBrackets -> AnnListBrackets -> a -> a
forall a b. Lens a b -> b -> a -> a
set (AnnListBrackets -> f AnnListBrackets) -> a -> f a
Lens a AnnListBrackets
l AnnListBrackets
ListNone a
a)

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

markLensBracketsC' :: (Monad m, Monoid w)
  => a -> Lens a AnnListBrackets -> EP w m a
markLensBracketsC' :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AnnListBrackets -> EP w m a
markLensBracketsC' a
a Lens a AnnListBrackets
l =
  case Getting a AnnListBrackets -> a -> AnnListBrackets
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a AnnListBrackets
Lens a AnnListBrackets
l a
a of
    ListParens EpToken "("
o EpToken ")"
c -> do
      c' <- EpToken ")" -> EP w m (EpToken ")")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken ")"
c
      return (set l (ListParens o c') a)
    ListBraces EpToken "{"
o EpToken "}"
c -> do
      c' <- EpToken "}" -> EP w m (EpToken "}")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "}"
c
      return (set l (ListBraces o c') a)
    ListSquare EpToken "["
o EpToken "]"
c -> do
      c' <- EpToken "]" -> EP w m (EpToken "]")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "]"
c
      return (set l (ListSquare o c') a)
    ListBanana EpUniToken "(|" "\10631"
o EpUniToken "|)" "\10632"
c -> do
      c' <- EpUniToken "|)" "\10632" -> EP w m (EpUniToken "|)" "\10632")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken EpUniToken "|)" "\10632"
c
      return (set l (ListBanana o c') a)
    AnnListBrackets
ListNone -> a -> EP w m a
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lens a AnnListBrackets -> AnnListBrackets -> a -> a
forall a b. Lens a b -> b -> a -> a
set (AnnListBrackets -> f AnnListBrackets) -> a -> f a
Lens a AnnListBrackets
l AnnListBrackets
ListNone a
a)
-- -------------------------------------

-- markEpTokenM :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
--   => Maybe (EpToken tok) -> EP w m (Maybe (EpToken tok))

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

markEpToken1 :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
  => [EpToken tok] -> EP w m [EpToken tok]
markEpToken1 :: forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
[EpToken tok] -> EP w m [EpToken tok]
markEpToken1 [] = [EpToken tok]
-> RWST (EPOptions m w) (EPWriter w) EPState m [EpToken tok]
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
markEpToken1 (EpToken tok
h:[EpToken tok]
t) = do
  h' <- EpToken tok -> EP w m (EpToken tok)
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken tok
h
  return (h':t)

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

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

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

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

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

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

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

markOpeningParen, markClosingParen :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen
markOpeningParen :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen AnnParen
an = AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markParenO AnnParen
an
markClosingParen :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markClosingParen AnnParen
an = AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markParenC AnnParen
an

markParenO :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen
markParenO :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markParenO (AnnParens EpToken "("
o EpToken ")"
c) = do
  o' <- EpToken "(" -> EP w m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "("
o
  return (AnnParens o' c)
markParenO (AnnParensHash EpToken "(#"
o EpToken "#)"
c) = do
  o' <- EpToken "(#" -> EP w m (EpToken "(#")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "(#"
o
  return (AnnParensHash o' c)
markParenO (AnnParensSquare EpToken "["
o EpToken "]"
c) = do
  o' <- EpToken "[" -> EP w m (EpToken "[")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "["
o
  return (AnnParensSquare o' c)

markParenC :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen
markParenC :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markParenC (AnnParens EpToken "("
o EpToken ")"
c) = do
  c' <- EpToken ")" -> EP w m (EpToken ")")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken ")"
c
  return (AnnParens o c')
markParenC (AnnParensHash EpToken "(#"
o EpToken "#)"
c) = do
  c' <- EpToken "#)" -> EP w m (EpToken "#)")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "#)"
c
  return (AnnParensHash o c')
markParenC (AnnParensSquare EpToken "["
o EpToken "]"
c) = do
  c' <- EpToken "]" -> EP w m (EpToken "]")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "]"
c
  return (AnnParensSquare o c')

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

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

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

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

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

{-
Question: How do I combine lenses?

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

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

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

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

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

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

-- data AnnsModule
--   = AnnsModule {
--     am_sig :: Maybe (EpToken "signature"),
--     am_mod :: Maybe (EpToken "module"),
--     am_where :: Maybe (EpToken "where"),
--     am_decls :: [TrailingAnn],
--     am_cs    :: [LEpaComment],
--     am_eof   :: Maybe (RealSrcSpan, RealSrcSpan)
--     } deriving (Data, Eq)

lam_mod :: Lens AnnsModule (EpToken "module")
lam_mod :: Lens AnnsModule (EpToken "module")
lam_mod EpToken "module" -> f (EpToken "module")
k AnnsModule
annsModule = (EpToken "module" -> AnnsModule)
-> f (EpToken "module") -> f AnnsModule
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\EpToken "module"
newAnns -> AnnsModule
annsModule { am_mod = newAnns })
                            (EpToken "module" -> f (EpToken "module")
k (AnnsModule -> EpToken "module"
am_mod AnnsModule
annsModule))

lam_where :: Lens AnnsModule (EpToken "where")
lam_where :: Lens AnnsModule (EpToken "where")
lam_where EpToken "where" -> f (EpToken "where")
k AnnsModule
annsModule = (EpToken "where" -> AnnsModule)
-> f (EpToken "where") -> f AnnsModule
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\EpToken "where"
newAnns -> AnnsModule
annsModule { am_where = newAnns })
                              (EpToken "where" -> f (EpToken "where")
k (AnnsModule -> EpToken "where"
am_where AnnsModule
annsModule))

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


-- data EpAnnImportDecl = EpAnnImportDecl
--   { importDeclAnnImport    :: EpToken "import" -- ^ The location of the @import@ keyword
--   , importDeclAnnPragma    :: Maybe (EpaLocation, EpToken "#-}") -- ^ The locations of @{-# SOURCE@ and @#-}@ respectively
--   , importDeclAnnSafe      :: Maybe (EpToken "safe") -- ^ The location of the @safe@ keyword
--   , importDeclAnnQualified :: Maybe (EpToken "qualified") -- ^ The location of the @qualified@ keyword
--   , importDeclAnnPackage   :: Maybe EpaLocation -- ^ The location of the package name (when using @-XPackageImports@)
--   , importDeclAnnAs        :: Maybe (EpToken "as") -- ^ The location of the @as@ keyword
--   } deriving (Data)

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

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

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

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

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

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

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

-- data AnnList
--   = AnnList {
--       al_anchor    :: Maybe Anchor, -- ^ start point of a list having layout
--       al_brackets  :: !AnnListBrackets,
--       al_semis     :: [EpToken ";"], -- decls
--       al_rest      :: !a,
--       al_trailing  :: [TrailingAnn] -- ^ items appearing after the
--                                     -- list, such as '=>' for a
--                                     -- context
--       } deriving (Data,Eq)

lal_brackets :: Lens (AnnList l) AnnListBrackets
lal_brackets :: forall l (f :: * -> *).
Functor f =>
(AnnListBrackets -> f AnnListBrackets)
-> AnnList l -> f (AnnList l)
lal_brackets AnnListBrackets -> f AnnListBrackets
k AnnList l
parent = (AnnListBrackets -> AnnList l)
-> f AnnListBrackets -> f (AnnList l)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AnnListBrackets
new -> AnnList l
parent { al_brackets = new })
                           (AnnListBrackets -> f AnnListBrackets
k (AnnList l -> AnnListBrackets
forall a. AnnList a -> AnnListBrackets
al_brackets AnnList l
parent))

lal_semis :: Lens (AnnList l) [EpToken ";"]
lal_semis :: forall l (f :: * -> *).
Functor f =>
([EpToken ";"] -> f [EpToken ";"]) -> AnnList l -> f (AnnList l)
lal_semis [EpToken ";"] -> f [EpToken ";"]
k AnnList l
parent = ([EpToken ";"] -> AnnList l) -> f [EpToken ";"] -> f (AnnList l)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[EpToken ";"]
new -> AnnList l
parent { al_semis = new })
                           ([EpToken ";"] -> f [EpToken ";"]
k (AnnList l -> [EpToken ";"]
forall a. AnnList a -> [EpToken ";"]
al_semis AnnList l
parent))

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

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

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

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

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

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

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

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

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

-- -------------------------------------
-- data AnnFieldLabel
--   = AnnFieldLabel {
--       afDot :: Maybe (EpToken ".")
--       } deriving Data

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

-- -------------------------------------
-- data AnnProjection
--   = AnnProjection {
--       apOpen  :: EpToken "(",
--       apClose :: EpToken ")"
--       } deriving Data

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

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

-- -------------------------------------
-- data AnnsIf
--   = AnnsIf {
--       aiIf       :: EpToken "if",
--       aiThen     :: EpToken "then",
--       aiElse     :: EpToken "else",
--       aiThenSemi :: Maybe (EpToken ";"),
--       aiElseSemi :: Maybe (EpToken ";")
--       } deriving Data

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

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

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

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

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

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

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

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

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

-- -------------------------------------
-- data EpAnnHsCase = EpAnnHsCase
--       { hsCaseAnnCase :: EpToken "case"
--       , hsCaseAnnOf   :: EpToken "of"
--       } deriving Data

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

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

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

-- data HsRuleAnn
--   = HsRuleAnn
--        { ra_tyanns :: Maybe (TokForall, EpToken ".")
--        , ra_tmanns :: Maybe (TokForall, EpToken ".")
--        , ra_equal  :: EpToken "="
--        , ra_rest :: ActivationAnn
--        } deriving (Data, Eq)

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

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


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

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

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

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

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

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

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

lra_equal :: Lens HsRuleAnn (EpToken "=")
lra_equal :: Lens HsRuleAnn (EpToken "=")
lra_equal EpToken "=" -> f (EpToken "=")
k HsRuleAnn
parent = (EpToken "=" -> HsRuleAnn) -> f (EpToken "=") -> f HsRuleAnn
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\EpToken "="
new -> HsRuleAnn
parent { ra_equal = new })
                                (EpToken "=" -> f (EpToken "=")
k (HsRuleAnn -> EpToken "="
ra_equal HsRuleAnn
parent))

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


-- ---------------------------------------------------------------------
-- data GrhsAnn
--   = GrhsAnn {
--       ga_vbar :: Maybe (EpToken "|"),
--       ga_sep  :: Either (EpToken "=") TokRarrow -- ^ Match separator location, `=` or `->`
--       } deriving (Data)

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

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

-- ---------------------------------------------------------------------
-- data EpAnnSumPat = EpAnnSumPat
--       { sumPatParens      :: (EpaLocation, EpaLocation)
--       , sumPatVbarsBefore :: [EpToken "|"]
--       , sumPatVbarsAfter  :: [EpToken "|"]
--       } deriving Data

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

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

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

-- ---------------------------------------------------------------------
-- data EpAnnLam = EpAnnLam
--       { epl_lambda :: EpToken "\\"      -- ^ Location of '\' keyword
--       , epl_case   :: Maybe EpaLocation -- ^ Location of 'case' or
--                                         -- 'cases' keyword, depending
--                                         -- on related 'HsLamVariant'.
--       } deriving Data

lepl_lambda :: Lens EpAnnLam (EpToken "\\")
lepl_lambda :: Lens EpAnnLam (EpToken "\\")
lepl_lambda EpToken "\\" -> f (EpToken "\\")
k EpAnnLam
parent = (EpToken "\\" -> EpAnnLam) -> f (EpToken "\\") -> f EpAnnLam
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\EpToken "\\"
new -> EpAnnLam
parent { epl_lambda = new })
                            (EpToken "\\" -> f (EpToken "\\")
k (EpAnnLam -> EpToken "\\"
epl_lambda EpAnnLam
parent))

lepl_case :: Lens EpAnnLam (Maybe EpaLocation)
lepl_case :: Lens EpAnnLam (Maybe EpaLocation)
lepl_case Maybe EpaLocation -> f (Maybe EpaLocation)
k EpAnnLam
parent = (Maybe EpaLocation -> EpAnnLam)
-> f (Maybe EpaLocation) -> f EpAnnLam
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe EpaLocation
new -> EpAnnLam
parent { epl_case = new })
                          (Maybe EpaLocation -> f (Maybe EpaLocation)
k (EpAnnLam -> Maybe EpaLocation
epl_case EpAnnLam
parent))


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

-- markLensKw' :: (Monad m, Monoid w)
--   => EpAnn a -> Lens a EpaLocation -> AnnKeywordId -> EP w m (EpAnn a)
-- markLensKw' (EpAnn anc a cs) l kw = do
--   loc <- markKwA kw (view l a)
--   return (EpAnn anc (set l loc a) cs)

-- markLensKw :: (Monad m, Monoid w)
--   => a -> Lens a EpaLocation -> AnnKeywordId -> EP w m a
-- markLensKw a l kw = do
--   loc <- markKwA kw (view l a)
--   return (set l loc a)


-- markLensKwM :: (Monad m, Monoid w)
--   => EpAnn a -> Lens a (Maybe EpaLocation) -> AnnKeywordId -> EP w m (EpAnn a)
-- markLensKwM (EpAnn anc a cs) l kw = do
--   new <- go (view l a)
--   return (EpAnn anc (set l new a) cs)
--   where
--     go Nothing = return Nothing
--     go (Just s) = Just <$> markKwA kw s

-- markLensKwM' :: (Monad m, Monoid w)
--   => a -> Lens a (Maybe EpaLocation) -> AnnKeywordId -> EP w m a
-- markLensKwM' a l kw = do
--   loc <- mapM (markKwA kw) (view l a)
--   return (set l loc a)

markLensTok :: (Monad m, Monoid w, KnownSymbol sym)
  => EpAnn a -> Lens a (EpToken sym) -> EP w m (EpAnn a)
markLensTok :: forall (m :: * -> *) w (sym :: Symbol) a.
(Monad m, Monoid w, KnownSymbol sym) =>
EpAnn a -> Lens a (EpToken sym) -> EP w m (EpAnn a)
markLensTok (EpAnn EpaLocation
anc a
a EpAnnComments
cs) Lens a (EpToken sym)
l = do
  new <- EpToken sym -> EP w m (EpToken sym)
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken (Getting a (EpToken sym) -> a -> EpToken sym
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a (EpToken sym)
Lens a (EpToken sym)
l a
a)
  return (EpAnn anc (set l new a) cs)

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

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

markLensFun :: (Monad m, Monoid w)
  => ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun :: forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun ann
a Lens ann t
l t -> EP w m t
f = do
  t' <- t -> EP w m t
f (Getting ann t -> ann -> t
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting ann t
Lens ann t
l ann
a)
  return (set l t' a)

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

markEpAnnAllLT :: (Monad m, Monoid w, KnownSymbol tok)
  => EpAnn ann -> Lens ann [EpToken tok] -> EP w m (EpAnn ann)
markEpAnnAllLT :: forall (m :: * -> *) w (tok :: Symbol) ann.
(Monad m, Monoid w, KnownSymbol tok) =>
EpAnn ann -> Lens ann [EpToken tok] -> EP w m (EpAnn ann)
markEpAnnAllLT (EpAnn EpaLocation
anc ann
a EpAnnComments
cs) Lens ann [EpToken tok]
l = do
  anns <- (EpToken tok
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken tok))
-> [EpToken tok]
-> RWST (EPOptions m w) (EPWriter w) EPState m [EpToken tok]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken tok
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken tok)
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken (Getting ann [EpToken tok] -> ann -> [EpToken tok]
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting ann [EpToken tok]
Lens ann [EpToken tok]
l ann
a)
  return (EpAnn anc (set l anns a) cs)

markEpAnnAllLT' :: (Monad m, Monoid w, KnownSymbol tok)
  => ann -> Lens ann [EpToken tok] -> EP w m ann
markEpAnnAllLT' :: forall (m :: * -> *) w (tok :: Symbol) ann.
(Monad m, Monoid w, KnownSymbol tok) =>
ann -> Lens ann [EpToken tok] -> EP w m ann
markEpAnnAllLT' ann
a Lens ann [EpToken tok]
l = do
  anns <- (EpToken tok
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken tok))
-> [EpToken tok]
-> RWST (EPOptions m w) (EPWriter w) EPState m [EpToken tok]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken tok
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken tok)
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken (Getting ann [EpToken tok] -> ann -> [EpToken tok]
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting ann [EpToken tok]
Lens ann [EpToken tok]
l ann
a)
  return (set l anns a)

markEpaLocationAll :: (Monad m, Monoid w)
  => [EpaLocation] -> String -> EP w m [EpaLocation]
markEpaLocationAll :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[EpaLocation] -> String -> EP w m [EpaLocation]
markEpaLocationAll [EpaLocation]
locs String
str = (EpaLocation
 -> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation)
-> [EpaLocation]
-> RWST (EPOptions m w) (EPWriter w) EPState m [EpaLocation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\EpaLocation
l -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l String
str) [EpaLocation]
locs

-- | Print a keyword encoded in a 'TrailingAnn'
markKwT :: (Monad m, Monoid w) => TrailingAnn -> EP w m TrailingAnn
markKwT :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
TrailingAnn -> EP w m TrailingAnn
markKwT (AddSemiAnn EpToken ";"
tok)    = EpToken ";" -> TrailingAnn
AddSemiAnn    (EpToken ";" -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";")
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken ";"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken ";"
tok
markKwT (AddCommaAnn EpToken ","
tok)   = EpToken "," -> TrailingAnn
AddCommaAnn   (EpToken "," -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ",")
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken ","
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ",")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken ","
tok
markKwT (AddVbarAnn EpToken "|"
tok)    = EpToken "|" -> TrailingAnn
AddVbarAnn    (EpToken "|" -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|")
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "|"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "|"
tok
markKwT (AddDarrowAnn TokDarrow
tok)  = TokDarrow -> TrailingAnn
AddDarrowAnn  (TokDarrow -> TrailingAnn)
-> RWST (EPOptions m w) (EPWriter w) EPState m TokDarrow
-> RWST (EPOptions m w) (EPWriter w) EPState m TrailingAnn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokDarrow -> RWST (EPOptions m w) (EPWriter w) EPState m TokDarrow
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken TokDarrow
tok

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

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

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

markAnnListA :: (Monad m, Monoid w)
  => EpAnn (AnnList l)
  -> (EpAnn (AnnList l) -> EP w m (EpAnn (AnnList l), a))
  -> EP w m (EpAnn (AnnList l), a)
markAnnListA :: forall (m :: * -> *) w l a.
(Monad m, Monoid w) =>
EpAnn (AnnList l)
-> (EpAnn (AnnList l) -> EP w m (EpAnn (AnnList l), a))
-> EP w m (EpAnn (AnnList l), a)
markAnnListA EpAnn (AnnList l)
an EpAnn (AnnList l) -> EP w m (EpAnn (AnnList l), a)
action = do
  an0 <- EpAnn (AnnList l)
-> Lens (AnnList l) AnnListBrackets -> EP w m (EpAnn (AnnList l))
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
EpAnn a -> Lens a AnnListBrackets -> EP w m (EpAnn a)
markLensBracketsO EpAnn (AnnList l)
an (AnnListBrackets -> f AnnListBrackets)
-> AnnList l -> f (AnnList l)
forall l (f :: * -> *).
Functor f =>
(AnnListBrackets -> f AnnListBrackets)
-> AnnList l -> f (AnnList l)
Lens (AnnList l) AnnListBrackets
lal_brackets
  an1 <- markEpAnnAllLT an0 lal_semis
  (an2, r) <- action an1
  an3 <- markLensBracketsC an2 lal_brackets
  return (an3, r)

markAnnListA' :: (Monad m, Monoid w)
  => AnnList l
  -> (AnnList l -> EP w m (AnnList l, a))
  -> EP w m (AnnList l , a)
markAnnListA' :: forall (m :: * -> *) w l a.
(Monad m, Monoid w) =>
AnnList l
-> (AnnList l -> EP w m (AnnList l, a)) -> EP w m (AnnList l, a)
markAnnListA' AnnList l
an AnnList l -> EP w m (AnnList l, a)
action = do
  an0 <- AnnList l -> Lens (AnnList l) AnnListBrackets -> EP w m (AnnList l)
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AnnListBrackets -> EP w m a
markLensBracketsO' AnnList l
an (AnnListBrackets -> f AnnListBrackets)
-> AnnList l -> f (AnnList l)
forall l (f :: * -> *).
Functor f =>
(AnnListBrackets -> f AnnListBrackets)
-> AnnList l -> f (AnnList l)
Lens (AnnList l) AnnListBrackets
lal_brackets
  an1 <- markEpAnnAllLT' an0 lal_semis
  (an2, r) <- action an1
  an3 <- markLensBracketsC' an2 lal_brackets
  return (an3, r)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    (an0, mmn' , mdeprec', mexports') <-
      case Maybe (XRec GhcPs ModuleName)
mmn of
        Maybe (XRec GhcPs ModuleName)
Nothing -> (EpAnn AnnsModule, Maybe (GenLocated SrcSpanAnnA ModuleName),
 Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)),
 Maybe
   (GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpAnn AnnsModule, Maybe (GenLocated SrcSpanAnnA ModuleName),
      Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)),
      Maybe
        (GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn AnnsModule
an, Maybe (XRec GhcPs ModuleName)
Maybe (GenLocated SrcSpanAnnA ModuleName)
mmn, Maybe (LWarningTxt GhcPs)
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
mdeprec, Maybe (XRec GhcPs [LIE GhcPs])
Maybe (GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)])
mexports)
        Just XRec GhcPs ModuleName
m -> do
          an0 <- EpAnn AnnsModule
-> Lens AnnsModule (EpToken "module") -> EP w m (EpAnn AnnsModule)
forall (m :: * -> *) w (sym :: Symbol) a.
(Monad m, Monoid w, KnownSymbol sym) =>
EpAnn a -> Lens a (EpToken sym) -> EP w m (EpAnn a)
markLensTok EpAnn AnnsModule
an (EpToken "module" -> f (EpToken "module"))
-> AnnsModule -> f AnnsModule
Lens AnnsModule (EpToken "module")
lam_mod
          m' <- markAnnotated m

          mdeprec' <- setLayoutTopLevelP $ markAnnotated mdeprec

          mexports' <- setLayoutTopLevelP $ markAnnotated mexports

          an1 <- setLayoutTopLevelP $ markLensTok an0 lam_where

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

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

    am_decls' <- markTrailing (am_decls $ anns an0)

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

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

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

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

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

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

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

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


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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated SrcSpanAnnP (WarningTxt GhcPs)
-> EP w m (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "["
os,EpToken "]"
cs) EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
css) (WarningTxt Maybe (LocatedE InWarningCategory)
mb_cat SourceText
src [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
ws)) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# WARNING"
    mb_cat' <- markAnnotated mb_cat
    os' <- markEpToken os
    ws' <- markAnnotated ws
    cs' <- markEpToken cs
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (WarningTxt mb_cat' src ws'))

  exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "["
os,EpToken "]"
cs) EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
css) (DeprecatedTxt SourceText
src [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
ws)) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# DEPRECATED"
    os' <- markEpToken os
    ws' <- markAnnotated ws
    cs' <- markEpToken cs
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (DeprecatedTxt src ws'))

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

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

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

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

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

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

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

    ann0 <- EpAnn EpAnnImportDecl
-> Lens EpAnnImportDecl (EpToken "import")
-> (EpToken "import" -> EP w m (EpToken "import"))
-> EP w m (EpAnn EpAnnImportDecl)
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
EpAnn ann -> Lens ann t -> (t -> EP w m t) -> EP w m (EpAnn ann)
markLensFun' EpAnn EpAnnImportDecl
ann (EpToken "import" -> f (EpToken "import"))
-> EpAnnImportDecl -> f EpAnnImportDecl
Lens EpAnnImportDecl (EpToken "import")
limportDeclAnnImport EpToken "import" -> EP w m (EpToken "import")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    let (EpAnn _anc an _cs) = ann0

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

    ann4 <-
      case qualFlag of
        ImportDeclQualifiedStyle
QualifiedPost  -- 'qualified' appears in postpositive position.
          -> EpAnn EpAnnImportDecl
-> Lens EpAnnImportDecl (Maybe (EpToken "qualified"))
-> (Maybe (EpToken "qualified")
    -> EP w m (Maybe (EpToken "qualified")))
-> EP w m (EpAnn EpAnnImportDecl)
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
EpAnn ann -> Lens ann t -> (t -> EP w m t) -> EP w m (EpAnn ann)
markLensFun' EpAnn EpAnnImportDecl
ann3 (Maybe (EpToken "qualified") -> f (Maybe (EpToken "qualified")))
-> EpAnnImportDecl -> f EpAnnImportDecl
Lens EpAnnImportDecl (Maybe (EpToken "qualified"))
limportDeclAnnQualified (\Maybe (EpToken "qualified")
ml -> (EpToken "qualified"
 -> RWST
      (EPOptions m w) (EPWriter w) EPState m (EpToken "qualified"))
-> Maybe (EpToken "qualified")
-> EP w m (Maybe (EpToken "qualified"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "qualified"
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (EpToken "qualified")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "qualified")
ml)
        ImportDeclQualifiedStyle
_ -> EpAnn EpAnnImportDecl -> EP w m (EpAnn EpAnnImportDecl)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnn EpAnnImportDecl
ann3

    (importDeclAnnAs', mAs') <-
      case mAs of
        Maybe (XRec GhcPs ModuleName)
Nothing -> (Maybe (EpToken "as"), Maybe (GenLocated SrcSpanAnnA ModuleName))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (EpToken "as"), Maybe (GenLocated SrcSpanAnnA ModuleName))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnnImportDecl -> Maybe (EpToken "as")
importDeclAnnAs EpAnnImportDecl
an, Maybe (GenLocated SrcSpanAnnA ModuleName)
forall a. Maybe a
Nothing)
        Just XRec GhcPs ModuleName
m0 -> do
          a <- (EpToken "as"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "as"))
-> Maybe (EpToken "as")
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (EpToken "as"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "as"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "as")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken (EpAnnImportDecl -> Maybe (EpToken "as")
importDeclAnnAs EpAnnImportDecl
an)
          m'' <- markAnnotated m0
          return (a, Just m'')

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

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

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


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

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

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


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


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

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

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

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

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

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

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

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


  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
InstDecl GhcPs -> EP w m (InstDecl GhcPs)
exact (ClsInstD     XClsInstD GhcPs
a  ClsInstDecl GhcPs
cid) = do
    cid' <- ClsInstDecl GhcPs -> EP w m (ClsInstDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated ClsInstDecl GhcPs
cid
    return (ClsInstD     a  cid')
  exact (DataFamInstD XDataFamInstD GhcPs
a DataFamInstDecl GhcPs
decl) = do
    decl' <- DataFamInstDecl GhcPs -> EP w m (DataFamInstDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated DataFamInstDecl GhcPs
decl
    return (DataFamInstD a decl')
  exact (TyFamInstD XTyFamInstD GhcPs
a TyFamInstDecl GhcPs
eqn) = do
    eqn' <- TyFamInstDecl GhcPs -> EP w m (TyFamInstDecl GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated TyFamInstDecl GhcPs
eqn
    return (TyFamInstD a eqn')

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

instance ExactPrint (DataFamInstDecl GhcPs) where
  getAnnotationEntry :: DataFamInstDecl GhcPs -> Entry
getAnnotationEntry DataFamInstDecl GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: DataFamInstDecl GhcPs
-> EpaLocation
-> [TrailingAnn]
-> EpAnnComments
-> DataFamInstDecl GhcPs
setAnnotationAnchor DataFamInstDecl GhcPs
a EpaLocation
_ [TrailingAnn]
_ EpAnnComments
_ = DataFamInstDecl GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DataFamInstDecl GhcPs -> EP w m (DataFamInstDecl GhcPs)
exact DataFamInstDecl GhcPs
d = do
    d' <- DataFamInstDecl GhcPs -> EP w m (DataFamInstDecl GhcPs)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DataFamInstDecl GhcPs -> EP w m (DataFamInstDecl GhcPs)
exactDataFamInstDecl DataFamInstDecl GhcPs
d
    return d'

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

exactDataFamInstDecl :: (Monad m, Monoid w)
                     => DataFamInstDecl GhcPs
                     -> EP w m (DataFamInstDecl GhcPs)
exactDataFamInstDecl :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DataFamInstDecl GhcPs -> EP w m (DataFamInstDecl GhcPs)
exactDataFamInstDecl
  (DataFamInstDecl (FamEqn { feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_ext    = ([EpToken "("]
ops, [EpToken ")"]
cps, EpToken "="
eq)
                           , feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon  = LIdP GhcPs
tycon
                           , feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_bndrs  = HsOuterFamEqnTyVarBndrs GhcPs
bndrs
                           , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_pats   = HsFamEqnPats GhcPs
pats
                           , feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_fixity = LexicalFixity
fixity
                           , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs    = HsDataDefn GhcPs
defn })) = do
    ((ops', cps'), tycon', bndrs', pats', defn') <- (Maybe (LHsContext GhcPs)
 -> EP
      w
      m
      (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
       HsOuterFamEqnTyVarBndrs GhcPs,
       [HsArg
          GhcPs
          (GenLocated SrcSpanAnnA (HsType GhcPs))
          (GenLocated SrcSpanAnnA (HsType GhcPs))],
       Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP
     w
     m
     (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs,
      [HsArg
         GhcPs
         (GenLocated SrcSpanAnnA (HsType GhcPs))
         (GenLocated SrcSpanAnnA (HsType GhcPs))],
      HsDataDefn GhcPs)
forall (m :: * -> *) w r a b.
(Monad m, Monoid w) =>
(Maybe (LHsContext GhcPs)
 -> EP w m (r, LocatedN RdrName, a, b, Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP w m (r, LocatedN RdrName, a, b, HsDataDefn GhcPs)
exactDataDefn Maybe (LHsContext GhcPs)
-> EP
     w
     m
     (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs, HsFamEqnPats GhcPs,
      Maybe (LHsContext GhcPs))
Maybe (LHsContext GhcPs)
-> EP
     w
     m
     (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs,
      [HsArg
         GhcPs
         (GenLocated SrcSpanAnnA (HsType GhcPs))
         (GenLocated SrcSpanAnnA (HsType GhcPs))],
      Maybe (LHsContext GhcPs))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe (LHsContext GhcPs)
-> EP
     w
     m
     (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs, HsFamEqnPats GhcPs,
      Maybe (LHsContext GhcPs))
pp_hdr HsDataDefn GhcPs
defn
    return
      (DataFamInstDecl ( FamEqn { feqn_ext    = (ops', cps', eq)
                                , feqn_tycon  = tycon'
                                , feqn_bndrs  = bndrs'
                                , feqn_pats   = pats'
                                , feqn_fixity = fixity
                                , feqn_rhs    = defn' }))
                    `debug` ("exactDataFamInstDecl: defn' derivs:" ++ showAst (dd_derivs defn'))
  where
    pp_hdr :: (Monad m, Monoid w)
           => Maybe (LHsContext GhcPs)
           -> EP w m ( ([EpToken "("], [EpToken ")"] )
                     , LocatedN RdrName
                     , HsOuterTyVarBndrs () GhcPs
                     , HsFamEqnPats GhcPs
                     , Maybe (LHsContext GhcPs))
    pp_hdr :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Maybe (LHsContext GhcPs)
-> EP
     w
     m
     (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs, HsFamEqnPats GhcPs,
      Maybe (LHsContext GhcPs))
pp_hdr Maybe (LHsContext GhcPs)
mctxt = [EpToken "("]
-> [EpToken ")"]
-> LocatedN RdrName
-> HsOuterFamEqnTyVarBndrs GhcPs
-> HsFamEqnPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs, HsFamEqnPats GhcPs,
      Maybe (LHsContext GhcPs))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[EpToken "("]
-> [EpToken ")"]
-> LocatedN RdrName
-> HsOuterFamEqnTyVarBndrs GhcPs
-> HsFamEqnPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs, HsFamEqnPats GhcPs,
      Maybe (LHsContext GhcPs))
exactHsFamInstLHS [EpToken "("]
ops [EpToken ")"]
cps LIdP GhcPs
LocatedN RdrName
tycon HsOuterFamEqnTyVarBndrs GhcPs
bndrs HsFamEqnPats GhcPs
pats LexicalFixity
fixity Maybe (LHsContext GhcPs)
mctxt

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DerivDecl GhcPs -> EP w m (DerivDecl GhcPs)
exact (DerivDecl (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
mw, (EpToken "deriving"
td,EpToken "instance"
ti)) LHsSigWcType GhcPs
typ Maybe (LDerivStrategy GhcPs)
ms Maybe (XRec GhcPs OverlapMode)
mov) = do
    td' <- EpToken "deriving" -> EP w m (EpToken "deriving")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "deriving"
td
    ms' <- mapM markAnnotated ms
    ti' <- markEpToken ti
    mw' <- mapM markAnnotated mw
    mov' <- mapM markAnnotated mov
    typ' <- markAnnotated typ
    return (DerivDecl (mw', (td',ti')) typ' ms' mov')

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ForeignDecl GhcPs -> EP w m (ForeignDecl GhcPs)
exact (ForeignImport (EpToken "foreign"
tf,EpToken "import"
ti,EpUniToken "::" "\8759"
td) LIdP GhcPs
n LHsSigType GhcPs
ty ForeignImport GhcPs
fimport) = do
    tf' <- EpToken "foreign" -> EP w m (EpToken "foreign")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "foreign"
tf
    ti' <- markEpToken ti

    fimport' <- markAnnotated fimport

    n' <- markAnnotated n
    td' <- markEpUniToken td
    ty' <- markAnnotated ty
    return (ForeignImport (tf',ti',td') n' ty' fimport')

  exact (ForeignExport (EpToken "foreign"
tf,EpToken "export"
te,EpUniToken "::" "\8759"
td) LIdP GhcPs
n LHsSigType GhcPs
ty ForeignExport GhcPs
fexport) = do
    tf' <- EpToken "foreign" -> EP w m (EpToken "foreign")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "foreign"
tf
    te' <- markEpToken te
    fexport' <- markAnnotated fexport
    n' <- markAnnotated n
    td' <- markEpUniToken td
    ty' <- markAnnotated ty
    return (ForeignExport (tf',te',td') n' ty' fexport')

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

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

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

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

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
WarnDecls GhcPs -> EP w m (WarnDecls GhcPs)
exact (Warnings ((EpaLocation
o,EpToken "#-}"
c),SourceText
src) [LWarnDecl GhcPs]
warns) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# WARNING" -- Note: might be {-# DEPRECATED
    warns' <- markAnnotated warns
    c' <- markEpToken c
    return (Warnings ((o',c'),src) warns')

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
WarnDecl GhcPs -> EP w m (WarnDecl GhcPs)
exact (Warning (NamespaceSpecifier
ns_spec, (EpToken "["
o,EpToken "]"
c)) [LIdP GhcPs]
lns  (WarningTxt Maybe (LocatedE InWarningCategory)
mb_cat SourceText
src [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
ls )) = do
    mb_cat' <- Maybe (LocatedE InWarningCategory)
-> EP w m (Maybe (LocatedE InWarningCategory))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (LocatedE InWarningCategory)
mb_cat
    ns_spec' <- exactNsSpec ns_spec
    lns' <- markAnnotated lns
    o' <- markEpToken o
    ls' <- markAnnotated ls
    c' <- markEpToken c
    return (Warning (ns_spec', (o',c')) lns'  (WarningTxt mb_cat' src ls'))

  exact (Warning (NamespaceSpecifier
ns_spec, (EpToken "["
o,EpToken "]"
c)) [LIdP GhcPs]
lns (DeprecatedTxt SourceText
src [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
ls)) = do
    ns_spec' <- NamespaceSpecifier -> EP w m NamespaceSpecifier
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NamespaceSpecifier -> EP w m NamespaceSpecifier
exactNsSpec NamespaceSpecifier
ns_spec
    lns' <- markAnnotated lns
    o' <- markEpToken o
    ls' <- markAnnotated ls
    c' <- markEpToken c
    return (Warning (ns_spec', (o',c')) lns' (DeprecatedTxt src ls'))

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

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

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

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

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

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

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

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

instance ExactPrint (RuleDecls GhcPs) where
  getAnnotationEntry :: RuleDecls GhcPs -> Entry
getAnnotationEntry RuleDecls GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: RuleDecls GhcPs
-> EpaLocation -> [TrailingAnn] -> EpAnnComments -> RuleDecls GhcPs
setAnnotationAnchor RuleDecls GhcPs
a EpaLocation
_ [TrailingAnn]
_ EpAnnComments
_ = RuleDecls GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RuleDecls GhcPs -> EP w m (RuleDecls GhcPs)
exact (HsRules ((EpaLocation
o,EpToken "#-}"
c), SourceText
src) [LRuleDecl GhcPs]
rules) = do
    o' <-
      case SourceText
src of
        SourceText
NoSourceText      -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
o String
"{-# RULES"
        SourceText FastString
srcTxt -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
o (FastString -> String
unpackFS FastString
srcTxt)
    rules' <- markAnnotated rules
    c' <- markEpToken c
    return (HsRules ((o',c'),src) rules')

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RuleDecl GhcPs -> EP w m (RuleDecl GhcPs)
exact (HsRule (HsRuleAnn
an,SourceText
nsrc) (L EpAnn NoEpAnns
ln FastString
n) Activation
act Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
mtybndrs [LRuleBndr GhcPs]
termbndrs XRec GhcPs (HsExpr GhcPs)
lhs XRec GhcPs (HsExpr GhcPs)
rhs) = do
    (L ln' _) <- GenLocated (EpAnn NoEpAnns) (SourceText, FastString)
-> EP w m (GenLocated (EpAnn NoEpAnns) (SourceText, FastString))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated (EpAnn NoEpAnns
-> (SourceText, FastString)
-> GenLocated (EpAnn NoEpAnns) (SourceText, FastString)
forall l e. l -> e -> GenLocated l e
L EpAnn NoEpAnns
ln (SourceText
nsrc, FastString
n))
    an0 <- markActivationL an lra_rest act
    (an1, mtybndrs') <-
      case mtybndrs of
        Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
Nothing -> (HsRuleAnn, Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (HsRuleAnn, Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)])
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsRuleAnn
an0, Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
forall a. Maybe a
Nothing)
        Just [LHsTyVarBndr () (NoGhcTc GhcPs)]
bndrs -> do
          an1 <-  HsRuleAnn
-> Lens HsRuleAnn (Maybe TokForall)
-> (Maybe TokForall -> EP w m (Maybe TokForall))
-> EP w m HsRuleAnn
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun HsRuleAnn
an0 (Maybe TokForall -> f (Maybe TokForall))
-> HsRuleAnn -> f HsRuleAnn
Lens HsRuleAnn (Maybe TokForall)
lra_tyanns_fst (\Maybe TokForall
mt -> (TokForall
 -> RWST (EPOptions m w) (EPWriter w) EPState m TokForall)
-> Maybe TokForall -> EP w m (Maybe TokForall)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM TokForall -> RWST (EPOptions m w) (EPWriter w) EPState m TokForall
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken Maybe TokForall
mt)  -- AnnForall
          bndrs' <- mapM markAnnotated bndrs
          an2 <- markLensFun an1 lra_tyanns_snd (\Maybe (EpToken ".")
mt -> (EpToken "."
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "."))
-> Maybe (EpToken ".") -> EP w m (Maybe (EpToken "."))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "."
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ".")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken ".")
mt)  -- AnnDot
          return (an2, Just bndrs')

    an2 <- markLensFun an1 lra_tmanns_fst (\Maybe TokForall
mt -> (TokForall
 -> RWST (EPOptions m w) (EPWriter w) EPState m TokForall)
-> Maybe TokForall -> EP w m (Maybe TokForall)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM TokForall -> RWST (EPOptions m w) (EPWriter w) EPState m TokForall
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken Maybe TokForall
mt) -- AnnForall
    termbndrs' <- mapM markAnnotated termbndrs
    an3 <- markLensFun an2 lra_tmanns_snd (\Maybe (EpToken ".")
mt -> (EpToken "."
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "."))
-> Maybe (EpToken ".") -> EP w m (Maybe (EpToken "."))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "."
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ".")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken ".")
mt)  -- AnnDot

    lhs' <- markAnnotated lhs
    an4 <- markLensFun an3 lra_equal markEpToken
    rhs' <- markAnnotated rhs
    return (HsRule (an4,nsrc) (L ln' n) act mtybndrs' termbndrs' lhs' rhs')


markActivationL :: (Monad m, Monoid w)
  => a -> Lens a ActivationAnn -> Activation -> EP w m a
markActivationL :: forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a ActivationAnn -> Activation -> EP w m a
markActivationL a
a Lens a ActivationAnn
l Activation
act = do
  new <- ActivationAnn -> Activation -> EP w m ActivationAnn
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ActivationAnn -> Activation -> EP w m ActivationAnn
markActivation (Getting a ActivationAnn -> a -> ActivationAnn
forall s (m :: * -> *) a. MonadReader s m => Getting s a -> m a
view Getting a ActivationAnn
Lens a ActivationAnn
l a
a) Activation
act
  return (set l new a)

markActivation :: (Monad m, Monoid w)
  => ActivationAnn -> Activation -> EP w m ActivationAnn
markActivation :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ActivationAnn -> Activation -> EP w m ActivationAnn
markActivation (ActivationAnn EpToken "["
o EpToken "]"
c Maybe (EpToken "~")
t Maybe EpaLocation
v) Activation
act = do
  case Activation
act of
    ActiveBefore SourceText
src Int
phase -> do
      o' <- EpToken "[" -> EP w m (EpToken "[")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "["
o --  '['
      t' <- mapM markEpToken t -- ~
      v' <- mapM (\EpaLocation
val -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
val (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
"")) v
      c' <- markEpToken c -- ']'
      return (ActivationAnn o' c' t' v')
    ActiveAfter SourceText
src Int
phase -> do
      o' <- EpToken "[" -> EP w m (EpToken "[")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "["
o --  '['
      v' <- mapM (\EpaLocation
val -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
val (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
"")) v
      c' <- markEpToken c -- ']'
      return (ActivationAnn o' c' t v')
    Activation
NeverActive -> do
      o' <- EpToken "[" -> EP w m (EpToken "[")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "["
o --  '['
      t' <- mapM markEpToken t -- ~
      c' <- markEpToken c -- ']'
      return (ActivationAnn o' c' t' v)
    Activation
_ -> ActivationAnn -> EP w m ActivationAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpToken "["
-> EpToken "]"
-> Maybe (EpToken "~")
-> Maybe EpaLocation
-> ActivationAnn
ActivationAnn EpToken "["
o EpToken "]"
c Maybe (EpToken "~")
t Maybe EpaLocation
v)

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RoleAnnotDecl GhcPs -> EP w m (RoleAnnotDecl GhcPs)
exact (RoleAnnotDecl (EpToken "type"
tt,EpToken "role"
tr) LIdP GhcPs
ltycon [XRec GhcPs (Maybe Role)]
roles) = do
    tt' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
tt
    tr' <- markEpToken tr
    ltycon' <- markAnnotated ltycon
    let markRole (L EpAnn ann
l (Just a
r)) = do
          (L l' r') <- GenLocated (EpAnn ann) a -> EP w m (GenLocated (EpAnn ann) a)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated (EpAnn ann -> a -> GenLocated (EpAnn ann) a
forall l e. l -> e -> GenLocated l e
L EpAnn ann
l a
r)
          return (L l' (Just r'))
        markRole (L EpAnn ann
l Maybe a
Nothing) = do
          e' <- EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA  (EpAnn ann -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry EpAnn ann
l) String
"_"
          return (L (l { entry = e'}) Nothing)
    roles' <- mapM markRole roles
    return (RoleAnnotDecl (tt',tr') ltycon' roles')

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
RuleBndr GhcPs -> EP w m (RuleBndr GhcPs)
exact (RuleBndr XCRuleBndr GhcPs
x LIdP GhcPs
ln) = do
    ln' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
ln
    return (RuleBndr x ln')
  exact (RuleBndrSig (AnnTyVarBndr [EpaLocation]
os [EpaLocation]
cs EpToken "'"
ap EpUniToken "::" "\8759"
dc) LIdP GhcPs
ln (HsPS XHsPS GhcPs
x LHsType GhcPs
ty)) = do
    os' <- [EpaLocation] -> String -> EP w m [EpaLocation]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[EpaLocation] -> String -> EP w m [EpaLocation]
markEpaLocationAll [EpaLocation]
os String
"("
    ln' <- markAnnotated ln
    dc' <- markEpUniToken dc
    ty' <- markAnnotated ty
    cs' <- markEpaLocationAll cs ")"
    return (RuleBndrSig (AnnTyVarBndr os' cs' ap dc') ln' (HsPS x ty'))

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

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

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

exactHsFamInstLHS ::
      (Monad m, Monoid w)
   => [EpToken "("]
   -> [EpToken ")"]
   -> LocatedN RdrName
   -> HsOuterTyVarBndrs () GhcPs
   -> HsFamEqnPats GhcPs
   -> LexicalFixity
   -> Maybe (LHsContext GhcPs)
   -> EP w m ( ([EpToken "("], [EpToken ")"])
             , LocatedN RdrName
             , HsOuterTyVarBndrs () GhcPs
             , HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
exactHsFamInstLHS :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[EpToken "("]
-> [EpToken ")"]
-> LocatedN RdrName
-> HsOuterFamEqnTyVarBndrs GhcPs
-> HsFamEqnPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     (([EpToken "("], [EpToken ")"]), LocatedN RdrName,
      HsOuterFamEqnTyVarBndrs GhcPs, HsFamEqnPats GhcPs,
      Maybe (LHsContext GhcPs))
exactHsFamInstLHS [EpToken "("]
ops [EpToken ")"]
cps LocatedN RdrName
thing HsOuterFamEqnTyVarBndrs GhcPs
bndrs HsFamEqnPats GhcPs
typats LexicalFixity
fixity Maybe (LHsContext GhcPs)
mb_ctxt = do
  -- TODO:AZ: do these ans exist? They are in the binders now
  -- an0 <- markEpAnnL an lidl AnnForall
  bndrs' <- HsOuterFamEqnTyVarBndrs GhcPs
-> EP w m (HsOuterFamEqnTyVarBndrs GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsOuterFamEqnTyVarBndrs GhcPs
bndrs
  -- an1 <- markEpAnnL an0 lidl AnnDot
  mb_ctxt' <- mapM markAnnotated mb_ctxt
  (ops', cps', thing', typats') <- exact_pats ops cps typats
  return ((ops', cps'), thing', bndrs', typats', mb_ctxt')
  where
    exact_pats :: (Monad m, Monoid w)
      => [EpToken "("] -> [EpToken ")"] -> HsFamEqnPats GhcPs
      -> EP w m ([EpToken "("], [EpToken ")"], LocatedN RdrName, HsFamEqnPats GhcPs)
    exact_pats :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[EpToken "("]
-> [EpToken ")"]
-> HsFamEqnPats GhcPs
-> EP
     w
     m
     ([EpToken "("], [EpToken ")"], LocatedN RdrName,
      HsFamEqnPats GhcPs)
exact_pats [EpToken "("]
ops1 [EpToken ")"]
cps1 (LHsTypeArg GhcPs
patl:LHsTypeArg GhcPs
patr:HsFamEqnPats GhcPs
pats)
      | LexicalFixity
Infix <- LexicalFixity
fixity
      = let exact_op_app :: RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([EpToken "("], [EpToken ")"], LocatedN RdrName,
   [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))])
exact_op_app = do
              ops' <- (EpToken "("
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "("))
-> [EpToken "("]
-> RWST (EPOptions m w) (EPWriter w) EPState m [EpToken "("]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken "("
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken [EpToken "("]
ops1
              patl' <- markAnnotated patl
              thing' <- markAnnotated thing
              patr' <- markAnnotated patr
              cps' <- mapM markEpToken cps1
              return (ops', cps', thing', [patl',patr'])
        in case HsFamEqnPats GhcPs
pats of
             [] -> EP
  w
  m
  ([EpToken "("], [EpToken ")"], LocatedN RdrName,
   HsFamEqnPats GhcPs)
RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([EpToken "("], [EpToken ")"], LocatedN RdrName,
   [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))])
exact_op_app
             HsFamEqnPats GhcPs
_  -> do
               (ops', cps', thing', p) <- RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  ([EpToken "("], [EpToken ")"], LocatedN RdrName,
   [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))])
exact_op_app
               pats' <- mapM markAnnotated pats
               return (ops', cps', thing', p++pats')

    exact_pats [EpToken "("]
ops0 [EpToken ")"]
cps0 HsFamEqnPats GhcPs
pats = do
      ops' <- (EpToken "("
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "("))
-> [EpToken "("]
-> RWST (EPOptions m w) (EPWriter w) EPState m [EpToken "("]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken "("
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken [EpToken "("]
ops0
      thing' <- markAnnotated thing
      pats' <- markAnnotated pats
      cps' <- mapM markEpToken cps0
      return (ops', cps', thing', pats')

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ClsInstDecl GhcPs -> EP w m (ClsInstDecl GhcPs)
exact (ClsInstDecl { cid_ext :: forall pass. ClsInstDecl pass -> XCClsInstDecl pass
cid_ext = (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
mbWarn, AnnClsInstDecl EpToken "instance"
i EpToken "where"
w EpToken "{"
oc [EpToken ";"]
semis EpToken "}"
cc, AnnSortKey DeclTag
sortKey)
                     , cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType GhcPs
inst_ty, cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds = LHsBinds GhcPs
binds
                     , cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_sigs = [LSig GhcPs]
sigs, cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts = [LTyFamInstDecl GhcPs]
ats
                     , cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
cid_overlap_mode = Maybe (XRec GhcPs OverlapMode)
mbOverlap
                     , cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl GhcPs]
adts })
      = do
          (mbWarn', i', w', mbOverlap', inst_ty') <- RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)),
   EpToken "instance", EpToken "where",
   Maybe (GenLocated SrcSpanAnnP OverlapMode),
   GenLocated SrcSpanAnnA (HsSigType GhcPs))
top_matter
          oc' <- markEpToken oc
          semis' <- mapM markEpToken semis
          (sortKey', ds) <- withSortKey sortKey
                               [(ClsAtTag, prepareListAnnotationA ats),
                                (ClsAtdTag, prepareListAnnotationF adts),
                                (ClsMethodTag, prepareListAnnotationA binds),
                                (ClsSigTag, prepareListAnnotationA sigs)
                               ]
          cc' <- markEpToken cc
          let
            ats'   = [Dynamic] -> [LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            adts'  = [Dynamic] -> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            binds' = [Dynamic] -> [LocatedAn AnnListItem (HsBind GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            sigs'  = [Dynamic] -> [LocatedAn AnnListItem (Sig GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
          return (ClsInstDecl { cid_ext = (mbWarn', AnnClsInstDecl i' w' oc' semis' cc', sortKey')
                              , cid_poly_ty = inst_ty', cid_binds = binds'
                              , cid_sigs = sigs', cid_tyfam_insts = ats'
                              , cid_overlap_mode = mbOverlap'
                              , cid_datafam_insts = adts' })

      where
        top_matter :: RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)),
   EpToken "instance", EpToken "where",
   Maybe (GenLocated SrcSpanAnnP OverlapMode),
   GenLocated SrcSpanAnnA (HsSigType GhcPs))
top_matter = do
          i' <- EpToken "instance" -> EP w m (EpToken "instance")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "instance"
i
          mw <- mapM markAnnotated mbWarn
          mo <- mapM markAnnotated mbOverlap
          it <- markAnnotated inst_ty
          w' <- markEpToken w -- Optional
          return (mw, i', w', mo,it)

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
TyFamInstDecl GhcPs -> EP w m (TyFamInstDecl GhcPs)
exact d :: TyFamInstDecl GhcPs
d@(TyFamInstDecl { tfid_xtn :: forall pass. TyFamInstDecl pass -> XCTyFamInstDecl pass
tfid_xtn = (EpToken "type"
tt,EpToken "instance"
ti), tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = TyFamInstEqn GhcPs
eqn }) = do
    tt' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
tt
    ti' <- markEpToken ti
    eqn' <- markAnnotated eqn
    return (d { tfid_xtn = (tt',ti'), tfid_eqn = eqn' })

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

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

  -- NOTE: NoOverlap is only used in the typechecker
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated SrcSpanAnnP OverlapMode
-> EP w m (GenLocated SrcSpanAnnP OverlapMode)
exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
cs) (NoOverlap SourceText
src)) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# NO_OVERLAP"
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (NoOverlap src))

  exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
cs) (Overlappable SourceText
src)) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# OVERLAPPABLE"
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlappable src))

  exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
cs) (Overlapping SourceText
src)) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# OVERLAPPING"
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlapping src))

  exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
cs) (Overlaps SourceText
src)) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# OVERLAPS"
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlaps src))

  exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
cs) (Incoherent SourceText
src)) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# INCOHERENT"
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src))

  exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
cs) (NonCanonical SourceText
src)) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# INCOHERENT"
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src))

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

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
PatSynBind GhcPs GhcPs -> EP w m (PatSynBind GhcPs GhcPs)
exact (PSB{ psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_ext = AnnPSB EpToken "pattern"
ap Maybe (EpToken "{")
ao Maybe (EpToken "}")
ac Maybe (EpUniToken "<-" "\8592")
al Maybe (EpToken "=")
ae
            , 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
    ap' <- EpToken "pattern" -> EP w m (EpToken "pattern")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "pattern"
ap
    (ao', ac', psyn', details') <-
      case details of
        InfixCon LIdP GhcPs
v1 LIdP GhcPs
v2 -> do
          v1' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
v1
          psyn' <- markAnnotated psyn
          v2' <- markAnnotated v2
          return (ao, ac, psyn',InfixCon v1' v2')
        PrefixCon [Void]
tvs [LIdP GhcPs]
vs -> do
          psyn' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
psyn
          tvs' <- markAnnotated tvs
          vs' <- markAnnotated vs
          return (ao, ac, psyn', PrefixCon tvs' vs')
        RecCon [RecordPatSynField GhcPs]
vs -> do
          psyn' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
psyn
          ao' <- mapM markEpToken ao
          vs' <- markAnnotated vs
          ac' <- mapM markEpToken ac
          return (ao', ac', psyn', RecCon vs')

    (al', ae', pat', dir') <-
      case dir of
        HsPatSynDir GhcPs
Unidirectional           -> do
          al' <- (EpUniToken "<-" "\8592"
 -> RWST
      (EPOptions m w) (EPWriter w) EPState m (EpUniToken "<-" "\8592"))
-> Maybe (EpUniToken "<-" "\8592")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (EpUniToken "<-" "\8592"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpUniToken "<-" "\8592"
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (EpUniToken "<-" "\8592")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken Maybe (EpUniToken "<-" "\8592")
al
          pat' <- markAnnotated pat
          return (al', ae, pat', dir)
        HsPatSynDir GhcPs
ImplicitBidirectional    -> do
          ae' <- (EpToken "="
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "="))
-> Maybe (EpToken "=")
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (EpToken "="))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "="
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "=")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "=")
ae
          pat' <- markAnnotated pat
          return (al, ae', pat', dir)
        ExplicitBidirectional MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg -> do
          al' <- (EpUniToken "<-" "\8592"
 -> RWST
      (EPOptions m w) (EPWriter w) EPState m (EpUniToken "<-" "\8592"))
-> Maybe (EpUniToken "<-" "\8592")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (EpUniToken "<-" "\8592"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpUniToken "<-" "\8592"
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (EpUniToken "<-" "\8592")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken Maybe (EpUniToken "<-" "\8592")
al
          pat' <- markAnnotated pat
          mg' <- markAnnotated mg
          return (al', ae, pat', ExplicitBidirectional mg')

    return (PSB{ psb_ext = AnnPSB ap' ao' ac' al' ae'
               , psb_id = psyn', psb_args = details'
               , psb_def = pat'
               , psb_dir = dir' })


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

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

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

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

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

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

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

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

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

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

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

  (mctxt', pats') <-
    case HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt of
      FunRhs LIdP (NoGhcTc GhcPs)
fun LexicalFixity
fixity SrcStrictness
strictness (AnnFunRhs EpToken "!"
strict [EpToken "("]
opens [EpToken ")"]
closes) -> do
        String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"exact Match FunRhs:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LocatedN RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe LIdP (NoGhcTc GhcPs)
LocatedN RdrName
fun
        strict' <- EpToken "!" -> EP w m (EpToken "!")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "!"
strict
        case fixity of
          LexicalFixity
Prefix -> do
            String
-> [EpToken "("] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
"(" [EpToken "("]
opens
            String
-> [EpToken ")"] -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
")" [EpToken ")"]
closes
            fun' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP (NoGhcTc GhcPs)
LocatedN RdrName
fun
            pats' <- markAnnotated pats
            return (FunRhs fun' fixity strictness (AnnFunRhs strict' [] []), pats')
          LexicalFixity
Infix ->
            case XRec GhcPs [LPat GhcPs]
pats of
              L EpaLocation
l (GenLocated SrcSpanAnnA (Pat GhcPs)
p1:GenLocated SrcSpanAnnA (Pat GhcPs)
p2:[GenLocated SrcSpanAnnA (Pat GhcPs)]
rest)
                | [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (Pat GhcPs)]
rest -> do
                    p1'  <- GenLocated SrcSpanAnnA (Pat GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated GenLocated SrcSpanAnnA (Pat GhcPs)
p1
                    fun' <- markAnnotated fun
                    p2'  <- markAnnotated p2
                    return (FunRhs fun' fixity strictness (AnnFunRhs strict' [] []), L l [p1',p2'])
                | Bool
otherwise -> do
                    opens' <- [EpToken "("] -> EP w m [EpToken "("]
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
[EpToken tok] -> EP w m [EpToken tok]
markEpToken1 [EpToken "("]
opens
                    p1'  <- markAnnotated p1
                    fun' <- markAnnotated fun
                    p2'  <- markAnnotated p2
                    closes' <- markEpToken1 closes
                    rest' <- mapM markAnnotated rest
                    return (FunRhs fun' fixity strictness (AnnFunRhs strict' opens' closes'), L l (p1':p2':rest'))
              XRec GhcPs [LPat GhcPs]
_ -> String
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (HsMatchContext (LocatedN RdrName),
      GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)])
forall a. HasCallStack => String -> a
panic String
"FunRhs"

      LamAlt HsLamVariant
v -> do
        pats' <- GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> EP
     w m (GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs [LPat GhcPs]
GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
        return (LamAlt v, pats')

      HsMatchContext (LIdP (NoGhcTc GhcPs))
CaseAlt -> do
        pats' <- GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> EP
     w m (GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs [LPat GhcPs]
GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
        return (CaseAlt, pats')

      HsMatchContext (LIdP (NoGhcTc GhcPs))
_ -> do
        mctxt' <- HsMatchContext (LocatedN RdrName)
-> EP w m (HsMatchContext (LocatedN RdrName))
forall (m :: * -> *) w a.
(Monad m, Monoid w, Outputable a) =>
a -> EP w m a
withPpr HsMatchContext (LIdP (NoGhcTc GhcPs))
HsMatchContext (LocatedN RdrName)
mctxt
        return (mctxt', pats)

  grhss' <- markAnnotated grhss

  return (Match an mctxt' pats' grhss')

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

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

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


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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsLocalBinds GhcPs -> EP w m (HsLocalBinds GhcPs)
exact (HsValBinds XHsValBinds GhcPs GhcPs
an HsValBindsLR GhcPs GhcPs
valbinds) = do
    an0 <- SrcSpanAnnLW
-> Lens (AnnList (EpToken "where")) (EpToken "where")
-> (EpToken "where" -> EP w m (EpToken "where"))
-> EP w m SrcSpanAnnLW
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
EpAnn ann -> Lens ann t -> (t -> EP w m t) -> EP w m (EpAnn ann)
markLensFun' XHsValBinds GhcPs GhcPs
SrcSpanAnnLW
an (EpToken "where" -> f (EpToken "where"))
-> AnnList (EpToken "where") -> f (AnnList (EpToken "where"))
forall l (f :: * -> *).
Functor f =>
(l -> f l) -> AnnList l -> f (AnnList l)
Lens (AnnList (EpToken "where")) (EpToken "where")
lal_rest EpToken "where" -> EP w m (EpToken "where")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken -- 'where'

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

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

  exact (HsIPBinds XHsIPBinds GhcPs GhcPs
an HsIPBinds GhcPs
bs) = do
    (an2,bs') <- SrcSpanAnnLW
-> (SrcSpanAnnLW -> EP w m (SrcSpanAnnLW, HsIPBinds GhcPs))
-> EP w m (SrcSpanAnnLW, HsIPBinds GhcPs)
forall (m :: * -> *) w l a.
(Monad m, Monoid w) =>
EpAnn (AnnList l)
-> (EpAnn (AnnList l) -> EP w m (EpAnn (AnnList l), a))
-> EP w m (EpAnn (AnnList l), a)
markAnnListA XHsIPBinds GhcPs GhcPs
SrcSpanAnnLW
an ((SrcSpanAnnLW -> EP w m (SrcSpanAnnLW, HsIPBinds GhcPs))
 -> EP w m (SrcSpanAnnLW, HsIPBinds GhcPs))
-> (SrcSpanAnnLW -> EP w m (SrcSpanAnnLW, HsIPBinds GhcPs))
-> EP w m (SrcSpanAnnLW, HsIPBinds GhcPs)
forall a b. (a -> b) -> a -> b
$ \SrcSpanAnnLW
an0 -> do
                           an1 <- SrcSpanAnnLW
-> Lens (AnnList (EpToken "where")) (EpToken "where")
-> (EpToken "where" -> EP w m (EpToken "where"))
-> EP w m SrcSpanAnnLW
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
EpAnn ann -> Lens ann t -> (t -> EP w m t) -> EP w m (EpAnn ann)
markLensFun' SrcSpanAnnLW
an0 (EpToken "where" -> f (EpToken "where"))
-> AnnList (EpToken "where") -> f (AnnList (EpToken "where"))
forall l (f :: * -> *).
Functor f =>
(l -> f l) -> AnnList l -> f (AnnList l)
Lens (AnnList (EpToken "where")) (EpToken "where")
lal_rest EpToken "where" -> EP w m (EpToken "where")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
                           bs' <- markAnnotated bs
                           return (an1, bs')
    return (HsIPBinds an2 bs')
  exact b :: HsLocalBinds GhcPs
b@(EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) = HsLocalBinds GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsLocalBinds GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsLocalBinds GhcPs
b


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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Sig GhcPs -> EP w m (Sig GhcPs)
exact (TypeSig (AnnSig EpUniToken "::" "\8759"
dc Maybe (EpToken "pattern")
mp Maybe (EpToken "default")
md) [LIdP GhcPs]
vars LHsSigWcType GhcPs
ty)  = do
    (dc', vars', ty') <- EpUniToken "::" "\8759"
-> [LocatedN RdrName]
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> EP
     w
     m
     (EpUniToken "::" "\8759", [LocatedN RdrName],
      HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
EpUniToken "::" "\8759"
-> [LocatedN RdrName]
-> a
-> EP w m (EpUniToken "::" "\8759", [LocatedN RdrName], a)
exactVarSig EpUniToken "::" "\8759"
dc [LIdP GhcPs]
[LocatedN RdrName]
vars LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
ty
    return (TypeSig (AnnSig dc' mp md) vars' ty')

  exact (PatSynSig (AnnSig EpUniToken "::" "\8759"
dc Maybe (EpToken "pattern")
mp Maybe (EpToken "default")
md) [LIdP GhcPs]
lns LHsSigType GhcPs
typ) = do
    mp' <- (EpToken "pattern"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "pattern"))
-> Maybe (EpToken "pattern")
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (EpToken "pattern"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "pattern"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "pattern")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "pattern")
mp
    lns' <- markAnnotated lns
    dc' <- markEpUniToken dc
    typ' <- markAnnotated typ
    return (PatSynSig (AnnSig dc' mp' md) lns' typ')

  exact (ClassOpSig (AnnSig EpUniToken "::" "\8759"
dc Maybe (EpToken "pattern")
mp Maybe (EpToken "default")
md) Bool
is_deflt [LIdP GhcPs]
vars LHsSigType GhcPs
ty)
    | Bool
is_deflt  = do
        md' <- (EpToken "default"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "default"))
-> Maybe (EpToken "default")
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (EpToken "default"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "default"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "default")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "default")
md
        (dc', vars',ty') <- exactVarSig dc vars ty
        return (ClassOpSig (AnnSig dc' mp md') is_deflt vars' ty')
    | Bool
otherwise = do
        (dc', vars',ty') <- EpUniToken "::" "\8759"
-> [LocatedN RdrName]
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> EP
     w
     m
     (EpUniToken "::" "\8759", [LocatedN RdrName],
      GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
EpUniToken "::" "\8759"
-> [LocatedN RdrName]
-> a
-> EP w m (EpUniToken "::" "\8759", [LocatedN RdrName], a)
exactVarSig EpUniToken "::" "\8759"
dc [LIdP GhcPs]
[LocatedN RdrName]
vars LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
        return (ClassOpSig (AnnSig dc' mp md) is_deflt vars' ty')

  exact (FixSig ((EpaLocation
af, Maybe EpaLocation
ma),SourceText
src) (FixitySig XFixitySig GhcPs
ns [LIdP GhcPs]
names (Fixity 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"
    af' <- EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
af String
fixstr
    ma' <- mapM (\EpaLocation
l -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l (SourceText -> ShowS
sourceTextToString SourceText
src (Int -> String
forall a. Show a => a -> String
show Int
v))) ma
    ns' <- markAnnotated ns
    names' <- markAnnotated names
    return (FixSig ((af',ma'),src) (FixitySig ns' names' (Fixity v fdir)))

  exact (InlineSig (EpaLocation
o,EpToken "#-}"
c,ActivationAnn
act) LIdP GhcPs
ln InlinePragma
inl) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o (InlinePragma -> SourceText
inl_src InlinePragma
inl) String
"{-# INLINE"
    act' <- markActivation act (inl_act inl)
    ln' <- markAnnotated ln
    c' <- markEpToken c
    return (InlineSig (o', c', act') ln' inl)

  exact (SpecSig (AnnSpecSig EpaLocation
o EpToken "#-}"
c EpUniToken "::" "\8759"
dc ActivationAnn
act) LIdP GhcPs
ln [LHsSigType GhcPs]
typs InlinePragma
inl) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o (InlinePragma -> SourceText
inl_src InlinePragma
inl) String
"{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE
    act' <- markActivation act (inl_act inl)
    ln' <- markAnnotated ln
    dc' <- markEpUniToken dc
    typs' <- markAnnotated typs
    c' <- markEpToken c
    return (SpecSig (AnnSpecSig o' c' dc' act') ln' typs' inl)

  exact (SpecInstSig ((EpaLocation
o,EpToken "instance"
i,EpToken "#-}"
c),SourceText
src) LHsSigType GhcPs
typ) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# SPECIALISE"
    i' <- markEpToken i
    typ' <- markAnnotated typ
    c' <- markEpToken c
    return (SpecInstSig ((o',i',c'),src) typ')

  exact (MinimalSig ((EpaLocation
o,EpToken "#-}"
c),SourceText
src) LBooleanFormula (LIdP GhcPs)
formula) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# MINIMAL"
    formula' <- markAnnotated formula
    c' <- markEpToken c
    return (MinimalSig ((o',c'),src) formula')

  exact (SCCFunSig ((EpaLocation
o,EpToken "#-}"
c),SourceText
src) LIdP GhcPs
ln Maybe (XRec GhcPs StringLiteral)
ml) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# SCC"
    ln' <- markAnnotated ln
    ml' <- markAnnotated ml
    c' <- markEpToken c
    return (SCCFunSig ((o',c'),src) ln' ml')

  exact (CompleteMatchSig ((EpaLocation
o,Maybe (EpUniToken "::" "\8759")
md,EpToken "#-}"
c),SourceText
src) [LIdP GhcPs]
cs Maybe (LIdP GhcPs)
mty) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# COMPLETE"
    cs' <- mapM markAnnotated cs
    (md', mty') <-
      case mty of
        Maybe (LIdP GhcPs)
Nothing -> (Maybe (EpUniToken "::" "\8759"), Maybe (LocatedN RdrName))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (EpUniToken "::" "\8759"), Maybe (LocatedN RdrName))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EpUniToken "::" "\8759")
md, Maybe (LIdP GhcPs)
Maybe (LocatedN RdrName)
mty)
        Just LIdP GhcPs
ty -> do
          md' <- (EpUniToken "::" "\8759" -> EP w m (EpUniToken "::" "\8759"))
-> Maybe (EpUniToken "::" "\8759")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (EpUniToken "::" "\8759"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpUniToken "::" "\8759" -> EP w m (EpUniToken "::" "\8759")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken Maybe (EpUniToken "::" "\8759")
md
          ty' <- markAnnotated ty
          return (md', Just ty')
    c' <- markEpToken c
    return (CompleteMatchSig ((o',md',c'),src) cs' mty')

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

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

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

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

exactVarSig :: (Monad m, Monoid w, ExactPrint a)
  => TokDcolon -> [LocatedN RdrName] -> a -> EP w m (TokDcolon, [LocatedN RdrName], a)
exactVarSig :: forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
EpUniToken "::" "\8759"
-> [LocatedN RdrName]
-> a
-> EP w m (EpUniToken "::" "\8759", [LocatedN RdrName], a)
exactVarSig EpUniToken "::" "\8759"
dc [LocatedN RdrName]
vars a
ty = do
  vars' <- (LocatedN RdrName
 -> RWST (EPOptions m w) (EPWriter w) EPState m (LocatedN RdrName))
-> [LocatedN RdrName]
-> RWST (EPOptions m w) (EPWriter w) EPState m [LocatedN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LocatedN RdrName
-> RWST (EPOptions m w) (EPWriter w) EPState m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LocatedN RdrName]
vars
  dc' <- markEpUniToken dc
  ty' <- markAnnotated ty
  return (dc', vars', ty')

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
StandaloneKindSig GhcPs -> EP w m (StandaloneKindSig GhcPs)
exact (StandaloneKindSig (EpToken "type"
tt,EpUniToken "::" "\8759"
td) LIdP GhcPs
vars LHsSigType GhcPs
sig) = do
    tt' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
tt
    vars' <- markAnnotated vars
    td' <- markEpUniToken td
    sig' <- markAnnotated sig
    return (StandaloneKindSig (tt',td') vars' sig')

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DefaultDecl GhcPs -> EP w m (DefaultDecl GhcPs)
exact (DefaultDecl (EpToken "default"
d,EpToken "("
op,EpToken ")"
cp) Maybe (LIdP GhcPs)
cl [LHsType GhcPs]
tys) = do
    d' <- EpToken "default" -> EP w m (EpToken "default")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "default"
d
    op' <- markEpToken op
    cl' <- markAnnotated cl
    tys' <- markAnnotated tys
    cp' <- markEpToken cp
    return (DefaultDecl (d',op',cp') cl' tys')

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnDecl GhcPs -> EP w m (AnnDecl GhcPs)
exact (HsAnnotation (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m, SourceText
src) AnnProvenance GhcPs
prov XRec GhcPs (HsExpr GhcPs)
e) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
src String
"{-# ANN"
    (t', m', prov') <-
      case prov of
        (ValueAnnProvenance LIdP GhcPs
n) -> do
          n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
          return (t, m, ValueAnnProvenance n')
        (TypeAnnProvenance LIdP GhcPs
n) -> do
          t' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
t
          n' <- markAnnotated n
          return (t', m, TypeAnnProvenance n')
        AnnProvenance GhcPs
ModuleAnnProvenance -> do
          m' <- EpToken "module" -> EP w m (EpToken "module")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "module"
m
          return (t, m', prov)

    e' <- markAnnotated e
    c' <- markEpToken c
    return (HsAnnotation (AnnPragma o' c' s l1 l2 t' m',src) prov' e')

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> EP w m (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
exact (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
an [GuardLStmt GhcPs]
guards GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr) = do
    an0 <- if [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
guards
             then EpAnn GrhsAnn
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpAnn GrhsAnn)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an
             else EpAnn GrhsAnn
-> Lens GrhsAnn (Maybe (EpToken "|"))
-> (Maybe (EpToken "|") -> EP w m (Maybe (EpToken "|")))
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpAnn GrhsAnn)
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
EpAnn ann -> Lens ann t -> (t -> EP w m t) -> EP w m (EpAnn ann)
markLensFun' XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
an (Maybe (EpToken "|") -> f (Maybe (EpToken "|")))
-> GrhsAnn -> f GrhsAnn
Lens GrhsAnn (Maybe (EpToken "|"))
lga_vbar (\Maybe (EpToken "|")
mt -> (EpToken "|"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|"))
-> Maybe (EpToken "|") -> EP w m (Maybe (EpToken "|"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "|"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "|")
mt)
    guards' <- markAnnotated guards
    -- Mark the matchSeparator for these GRHSs
    an1 <- markLensFun' an0 lga_sep (\Either (EpToken "=") TokRarrow
s -> case Either (EpToken "=") TokRarrow
s of
                                       Left  EpToken "="
tok -> EpToken "=" -> Either (EpToken "=") TokRarrow
forall a b. a -> Either a b
Left  (EpToken "=" -> Either (EpToken "=") TokRarrow)
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "=")
-> EP w m (Either (EpToken "=") TokRarrow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "="
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "=")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "="
tok
                                       Right TokRarrow
tok -> TokRarrow -> Either (EpToken "=") TokRarrow
forall a b. b -> Either a b
Right (TokRarrow -> Either (EpToken "=") TokRarrow)
-> RWST (EPOptions m w) (EPWriter w) EPState m TokRarrow
-> EP w m (Either (EpToken "=") TokRarrow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokRarrow -> RWST (EPOptions m w) (EPWriter w) EPState m TokRarrow
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken TokRarrow
tok)
    expr' <- markAnnotated expr
    return (GRHS an1 guards' expr')

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GRHS GhcPs (LocatedA (HsCmd GhcPs))
-> EP w m (GRHS GhcPs (LocatedA (HsCmd GhcPs)))
exact (GRHS XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
an [GuardLStmt GhcPs]
guards LocatedA (HsCmd GhcPs)
expr) = do
    an0 <- EpAnn GrhsAnn
-> Lens GrhsAnn (Maybe (EpToken "|"))
-> (Maybe (EpToken "|") -> EP w m (Maybe (EpToken "|")))
-> EP w m (EpAnn GrhsAnn)
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
EpAnn ann -> Lens ann t -> (t -> EP w m t) -> EP w m (EpAnn ann)
markLensFun' XCGRHS GhcPs (LocatedA (HsCmd GhcPs))
EpAnn GrhsAnn
an (Maybe (EpToken "|") -> f (Maybe (EpToken "|")))
-> GrhsAnn -> f GrhsAnn
Lens GrhsAnn (Maybe (EpToken "|"))
lga_vbar (\Maybe (EpToken "|")
mt -> (EpToken "|"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|"))
-> Maybe (EpToken "|") -> EP w m (Maybe (EpToken "|"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "|"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "|")
mt)
    guards' <- markAnnotated guards
    -- Mark the matchSeparator for these GRHSs
    an1 <- markLensFun' an0 lga_sep (\Either (EpToken "=") TokRarrow
s -> case Either (EpToken "=") TokRarrow
s of
                                       Left  EpToken "="
tok -> EpToken "=" -> Either (EpToken "=") TokRarrow
forall a b. a -> Either a b
Left  (EpToken "=" -> Either (EpToken "=") TokRarrow)
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "=")
-> EP w m (Either (EpToken "=") TokRarrow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "="
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "=")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "="
tok
                                       Right TokRarrow
tok -> TokRarrow -> Either (EpToken "=") TokRarrow
forall a b. b -> Either a b
Right (TokRarrow -> Either (EpToken "=") TokRarrow)
-> RWST (EPOptions m w) (EPWriter w) EPState m TokRarrow
-> EP w m (Either (EpToken "=") TokRarrow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokRarrow -> RWST (EPOptions m w) (EPWriter w) EPState m TokRarrow
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken TokRarrow
tok)
    expr' <- markAnnotated expr
    return (GRHS an1 guards' expr')

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

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

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

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

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

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

  exact (HsLam XLam GhcPs
an HsLamVariant
lam_variant MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg) = do
    an0 <- EpAnnLam
-> Lens EpAnnLam (EpToken "\\")
-> (EpToken "\\" -> EP w m (EpToken "\\"))
-> EP w m EpAnnLam
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XLam GhcPs
EpAnnLam
an (EpToken "\\" -> f (EpToken "\\")) -> EpAnnLam -> f EpAnnLam
Lens EpAnnLam (EpToken "\\")
lepl_lambda EpToken "\\" -> EP w m (EpToken "\\")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    an1 <- case lam_variant of
             HsLamVariant
LamSingle -> EpAnnLam -> EP w m EpAnnLam
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnnLam
an0
             HsLamVariant
LamCase  -> EpAnnLam
-> Lens EpAnnLam (Maybe EpaLocation)
-> (Maybe EpaLocation -> EP w m (Maybe EpaLocation))
-> EP w m EpAnnLam
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun EpAnnLam
an0 (Maybe EpaLocation -> f (Maybe EpaLocation))
-> EpAnnLam -> f EpAnnLam
Lens EpAnnLam (Maybe EpaLocation)
lepl_case (\Maybe EpaLocation
ml -> (EpaLocation
 -> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation)
-> Maybe EpaLocation -> EP w m (Maybe EpaLocation)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (\EpaLocation
l -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l String
"case") Maybe EpaLocation
ml)
             HsLamVariant
LamCases -> EpAnnLam
-> Lens EpAnnLam (Maybe EpaLocation)
-> (Maybe EpaLocation -> EP w m (Maybe EpaLocation))
-> EP w m EpAnnLam
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun EpAnnLam
an0 (Maybe EpaLocation -> f (Maybe EpaLocation))
-> EpAnnLam -> f EpAnnLam
Lens EpAnnLam (Maybe EpaLocation)
lepl_case (\Maybe EpaLocation
ml -> (EpaLocation
 -> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation)
-> Maybe EpaLocation -> EP w m (Maybe EpaLocation)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (\EpaLocation
l -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l String
"cases") Maybe EpaLocation
ml)
    mg' <- markAnnotated mg
    return (HsLam an1 lam_variant mg')

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

  exact (NegApp XNegApp GhcPs
an XRec GhcPs (HsExpr GhcPs)
e SyntaxExpr GhcPs
s) = do
    an0 <- EpToken "-" -> EP w m (EpToken "-")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XNegApp GhcPs
EpToken "-"
an
    e' <- markAnnotated e
    return (NegApp an0 e' s)

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

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

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

  exact (ExplicitTuple (EpaLocation
o,EpaLocation
c) [HsTupArg GhcPs]
args Boxity
b) = do
    o0 <- if Boxity
b Boxity -> Boxity -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity
Boxed then EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
o String
"("
                        else EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
o String
"(#"

    args' <- mapM markAnnotated args

    c0 <- if b == Boxed then printStringAtAA c ")"
                        else printStringAtAA c "#)"
    debugM $ "ExplicitTuple done"
    return (ExplicitTuple (o0,c0) args' b)

  exact (ExplicitSum XExplicitSum GhcPs
an Int
alt Int
arity XRec GhcPs (HsExpr GhcPs)
expr) = do
    an0 <- AnnExplicitSum
-> Lens AnnExplicitSum EpaLocation
-> (EpaLocation
    -> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation)
-> EP w m AnnExplicitSum
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XExplicitSum GhcPs
AnnExplicitSum
an (EpaLocation -> f EpaLocation)
-> AnnExplicitSum -> f AnnExplicitSum
Lens AnnExplicitSum EpaLocation
laesOpen (\EpaLocation
loc -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
loc String
"(#")
    an1 <- markLensFun an0 laesBarsBefore (\[EpToken "|"]
locs -> (EpToken "|"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|"))
-> [EpToken "|"] -> EP w m [EpToken "|"]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken "|"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken [EpToken "|"]
locs)
    expr' <- markAnnotated expr
    an2 <- markLensFun an1 laesBarsAfter (\[EpToken "|"]
locs -> (EpToken "|"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|"))
-> [EpToken "|"] -> EP w m [EpToken "|"]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken "|"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken [EpToken "|"]
locs)
    an3 <- markLensFun an2 laesClose (\EpaLocation
loc -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
loc String
"#)")
    return (ExplicitSum an3 alt arity expr')

  exact (HsCase XCase GhcPs
an XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
alts) = do
    an0 <- EpAnnHsCase
-> Lens EpAnnHsCase (EpToken "case")
-> (EpToken "case" -> EP w m (EpToken "case"))
-> EP w m EpAnnHsCase
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XCase GhcPs
EpAnnHsCase
an (EpToken "case" -> f (EpToken "case"))
-> EpAnnHsCase -> f EpAnnHsCase
Lens EpAnnHsCase (EpToken "case")
lhsCaseAnnCase EpToken "case" -> EP w m (EpToken "case")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    e' <- markAnnotated e
    an1 <- markLensFun an0 lhsCaseAnnOf markEpToken
    alts' <- setLayoutBoth $ markAnnotated alts
    return (HsCase an1 e' alts')

  exact (HsIf XIf GhcPs
an XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 XRec GhcPs (HsExpr GhcPs)
e3) = do
    an0 <- AnnsIf
-> Lens AnnsIf (EpToken "if")
-> (EpToken "if" -> EP w m (EpToken "if"))
-> EP w m AnnsIf
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XIf GhcPs
AnnsIf
an (EpToken "if" -> f (EpToken "if")) -> AnnsIf -> f AnnsIf
Lens AnnsIf (EpToken "if")
laiIf EpToken "if" -> EP w m (EpToken "if")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    e1' <- markAnnotated e1
    an1 <- markLensFun an0 laiThenSemi (\Maybe (EpToken ";")
mt -> (EpToken ";"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";"))
-> Maybe (EpToken ";") -> EP w m (Maybe (EpToken ";"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken ";"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken ";")
mt)
    an2 <- markLensFun an1 laiThen markEpToken
    e2' <- markAnnotated e2
    an3 <- markLensFun an2 laiElseSemi (\Maybe (EpToken ";")
mt -> (EpToken ";"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";"))
-> Maybe (EpToken ";") -> EP w m (Maybe (EpToken ";"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken ";"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken ";")
mt)
    an4 <- markLensFun an3 laiElse markEpToken
    e3' <- markAnnotated e3
    return (HsIf an4 e1' e2' e3')

  exact (HsMultiIf (EpToken "if"
i,EpToken "{"
o,EpToken "}"
c) [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
mg) = do
    i0 <- EpToken "if" -> EP w m (EpToken "if")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "if"
i
    o0 <- markEpToken o
    mg' <- markAnnotated mg
    c0 <- markEpToken c
    return (HsMultiIf (i0,o0,c0) mg')

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

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

  exact (ExplicitList XExplicitList GhcPs
an [XRec GhcPs (HsExpr GhcPs)]
es) = do
    String -> EP w m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ String
"ExplicitList start"
    an0 <- AnnList ()
-> Lens (AnnList ()) AnnListBrackets -> EP w m (AnnList ())
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
a -> Lens a AnnListBrackets -> EP w m a
markLensBracketsO' XExplicitList GhcPs
AnnList ()
an (AnnListBrackets -> f AnnListBrackets)
-> AnnList () -> f (AnnList ())
forall l (f :: * -> *).
Functor f =>
(AnnListBrackets -> f AnnListBrackets)
-> AnnList l -> f (AnnList l)
Lens (AnnList ()) AnnListBrackets
lal_brackets
    es' <- markAnnotated es
    an1 <- markLensBracketsC' an0 lal_brackets
    debugM $ "ExplicitList end"
    return (ExplicitList an1 es')
  exact (RecordCon (Maybe (EpToken "{")
open, Maybe (EpToken "}")
close) XRec GhcPs (ConLikeP GhcPs)
con_id HsRecordBinds GhcPs
binds) = do
    con_id' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con_id
    open' <- mapM markEpToken open
    binds' <- markAnnotated binds
    close' <- mapM markEpToken close
    return (RecordCon (open',close') con_id' binds')
  exact (RecordUpd (Maybe (EpToken "{")
open, Maybe (EpToken "}")
close) XRec GhcPs (HsExpr GhcPs)
expr LHsRecUpdFields GhcPs
fields) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    open' <- mapM markEpToken open
    fields' <- markAnnotated fields
    close' <- mapM markEpToken close
    return (RecordUpd (open', close') expr' fields')
  exact (HsGetField XGetField GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr XRec GhcPs (DotFieldOcc GhcPs)
field) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    field' <- markAnnotated field
    return (HsGetField an expr' field')
  exact (HsProjection XProjection GhcPs
an NonEmpty (DotFieldOcc GhcPs)
flds) = do
    an0 <- AnnProjection
-> Lens AnnProjection (EpToken "(")
-> (EpToken "(" -> EP w m (EpToken "("))
-> EP w m AnnProjection
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XProjection GhcPs
AnnProjection
an (EpToken "(" -> f (EpToken "("))
-> AnnProjection -> f AnnProjection
Lens AnnProjection (EpToken "(")
lapOpen EpToken "(" -> EP w m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    flds' <- mapM markAnnotated flds
    an1 <- markLensFun an0 lapClose markEpToken
    return (HsProjection an1 flds')
  exact (ExprWithTySig XExprWithTySig GhcPs
an XRec GhcPs (HsExpr GhcPs)
expr LHsSigWcType (NoGhcTc GhcPs)
sig) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    an0 <- markEpUniToken an
    sig' <- markAnnotated sig
    return (ExprWithTySig an0 expr' sig')
  exact (ArithSeq (AnnArithSeq EpToken "["
o Maybe (EpToken ",")
mc EpToken ".."
dd EpToken "]"
c) Maybe (SyntaxExpr GhcPs)
s ArithSeqInfo GhcPs
seqInfo) = do
    o' <- EpToken "[" -> EP w m (EpToken "[")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "["
o
    (mc', dd', seqInfo') <-
      case seqInfo of
        From XRec GhcPs (HsExpr GhcPs)
e -> do
          e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
          dd' <- markEpToken dd
          return (mc, dd', From e')
        FromTo XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 -> do
          e1' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          dd' <- markEpToken dd
          e2' <- markAnnotated e2
          return (mc, dd', FromTo e1' e2')
        FromThen XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 -> do
          e1' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          mc' <- mapM markEpToken mc
          e2' <- markAnnotated e2
          dd' <- markEpToken dd
          return (mc', dd', FromThen e1' e2')
        FromThenTo XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2 XRec GhcPs (HsExpr GhcPs)
e3 -> do
          e1' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e1
          mc' <- mapM markEpToken mc
          e2' <- markAnnotated e2
          dd' <- markEpToken dd
          e3' <- markAnnotated e3
          return (mc', dd', FromThenTo e1' e2' e3')
    c' <- markEpToken c
    return (ArithSeq (AnnArithSeq o' mc' dd' c') s seqInfo')


  exact (HsTypedBracket (BracketAnn (EpToken "[||") (EpToken "[e||")
o,EpToken "||]"
c) XRec GhcPs (HsExpr GhcPs)
e) = do
    o' <- case BracketAnn (EpToken "[||") (EpToken "[e||")
o of
      BracketNoE  EpToken "[||"
t -> EpToken "[||" -> BracketAnn (EpToken "[||") (EpToken "[e||")
forall noE hasE. noE -> BracketAnn noE hasE
BracketNoE  (EpToken "[||" -> BracketAnn (EpToken "[||") (EpToken "[e||"))
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "[||")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (BracketAnn (EpToken "[||") (EpToken "[e||"))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "[||"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "[||")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "[||"
t
      BracketHasE EpToken "[e||"
t -> EpToken "[e||" -> BracketAnn (EpToken "[||") (EpToken "[e||")
forall noE hasE. hasE -> BracketAnn noE hasE
BracketHasE (EpToken "[e||" -> BracketAnn (EpToken "[||") (EpToken "[e||"))
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "[e||")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (BracketAnn (EpToken "[||") (EpToken "[e||"))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "[e||"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "[e||")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "[e||"
t
    e' <- markAnnotated e
    c' <- markEpToken c
    return (HsTypedBracket (o',c') e')

  exact (HsUntypedBracket XUntypedBracket GhcPs
a (ExpBr (BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|")
o,EpUniToken "|]" "\10215"
c) XRec GhcPs (HsExpr GhcPs)
e)) = do
    o' <- case BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|")
o of
      BracketNoE  EpUniToken "[|" "\10214"
t -> EpUniToken "[|" "\10214"
-> BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|")
forall noE hasE. noE -> BracketAnn noE hasE
BracketNoE  (EpUniToken "[|" "\10214"
 -> BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|"))
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (EpUniToken "[|" "\10214")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|"))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpUniToken "[|" "\10214"
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (EpUniToken "[|" "\10214")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken EpUniToken "[|" "\10214"
t
      BracketHasE EpToken "[e|"
t -> EpToken "[e|"
-> BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|")
forall noE hasE. hasE -> BracketAnn noE hasE
BracketHasE (EpToken "[e|"
 -> BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|"))
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "[e|")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|"))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "[e|"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "[e|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "[e|"
t
    e' <- markAnnotated e
    c' <- markEpUniToken c
    return (HsUntypedBracket a (ExpBr (o',c') e'))

  exact (HsUntypedBracket XUntypedBracket GhcPs
a (PatBr (EpToken "[p|"
o,EpUniToken "|]" "\10215"
c) LPat GhcPs
e)) = do
    o' <- EpToken "[p|" -> EP w m (EpToken "[p|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "[p|"
o
    e' <- markAnnotated e
    c' <- markEpUniToken c
    return (HsUntypedBracket a (PatBr (o',c') e'))

  exact (HsUntypedBracket XUntypedBracket GhcPs
a (DecBrL (EpToken "[d|"
o,EpUniToken "|]" "\10215"
c, (EpToken "{"
oc,EpToken "}"
cc)) [LHsDecl GhcPs]
e)) = do
    o' <- EpToken "[d|" -> EP w m (EpToken "[d|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "[d|"
o
    oc' <- markEpToken oc
    e' <- markAnnotated e
    cc' <- markEpToken cc
    c' <- markEpUniToken c
    return (HsUntypedBracket a (DecBrL (o',c',(oc',cc')) e'))

  exact (HsUntypedBracket XUntypedBracket GhcPs
a (TypBr (EpToken "[t|"
o,EpUniToken "|]" "\10215"
c) LHsType GhcPs
e)) = do
    o' <- EpToken "[t|" -> EP w m (EpToken "[t|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "[t|"
o
    e' <- markAnnotated e
    c' <- markEpUniToken c
    return (HsUntypedBracket a (TypBr (o',c') e'))

  exact (HsUntypedBracket XUntypedBracket GhcPs
a (VarBr XVarBr GhcPs
an Bool
b LIdP GhcPs
e)) = do
    (an0, e') <- if Bool
b
      then do
        an' <- EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA XVarBr GhcPs
EpaLocation
an String
"'"
        e' <- markAnnotated e
        return (an', e')
      else do
        an' <- EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA XVarBr GhcPs
EpaLocation
an String
"''"
        e' <- markAnnotated e
        return (an', e')
    return (HsUntypedBracket a (VarBr an0 b e'))

  exact (HsTypedSplice XTypedSplice GhcPs
an XRec GhcPs (HsExpr GhcPs)
s)   = do
    an0 <- EpToken "$$" -> EP w m (EpToken "$$")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XTypedSplice GhcPs
EpToken "$$"
an
    s' <- markAnnotated s
    return (HsTypedSplice an0 s')

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

  exact (HsProc (EpToken "proc"
pr,TokRarrow
r) LPat GhcPs
p LHsCmdTop GhcPs
c) = do
    String -> EP w m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ String
"HsProc start"
    pr' <- EpToken "proc" -> EP w m (EpToken "proc")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "proc"
pr
    p' <- markAnnotated p
    r' <- markEpUniToken r
    c' <- markAnnotated c
    return (HsProc (pr',r') p' c')

  exact (HsStatic XStatic GhcPs
an XRec GhcPs (HsExpr GhcPs)
e) = do
    an0 <- EpToken "static" -> EP w m (EpToken "static")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XStatic GhcPs
EpToken "static"
an
    e' <- markAnnotated e
    return (HsStatic an0 e')

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

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

  exact (HsFunArr XFunArr GhcPs
_ HsArrowOf (XRec GhcPs (HsExpr GhcPs)) GhcPs
mult XRec GhcPs (HsExpr GhcPs)
arg XRec GhcPs (HsExpr GhcPs)
res) = do
    arg' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
    mult' <- markArrow mult
    res' <- markAnnotated res
    return (HsFunArr noExtField mult' arg' res')

  exact (HsForAll XForAll GhcPs
_ HsForAllTelescope GhcPs
tele XRec GhcPs (HsExpr GhcPs)
body) = do
    tele' <- HsForAllTelescope GhcPs -> EP w m (HsForAllTelescope GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsForAllTelescope GhcPs
tele
    body' <- markAnnotated body
    return (HsForAll noExtField tele' body')

  exact (HsQual XQual GhcPs
_ XRec GhcPs [XRec GhcPs (HsExpr GhcPs)]
ctxt XRec GhcPs (HsExpr GhcPs)
body) = do
    ctxt' <- GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> EP
     w
     m
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs [XRec GhcPs (HsExpr GhcPs)]
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
ctxt
    body' <- markAnnotated body
    return (HsQual noExtField ctxt' body')

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

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

exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
        => AnnList EpaLocation -> HsDoFlavour -> LocatedAn an a
        -> EP w m (AnnList EpaLocation, LocatedAn an a)
exactDo :: forall (m :: * -> *) w an a.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList EpaLocation
-> HsDoFlavour
-> LocatedAn an a
-> EP w m (AnnList EpaLocation, LocatedAn an a)
exactDo AnnList EpaLocation
an (DoExpr Maybe ModuleName
m)    LocatedAn an a
stmts = AnnList EpaLocation
-> Maybe ModuleName -> String -> EP w m (AnnList EpaLocation)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnList EpaLocation
-> Maybe ModuleName -> String -> EP w m (AnnList EpaLocation)
exactMdo AnnList EpaLocation
an Maybe ModuleName
m String
"do"          EP w m (AnnList EpaLocation)
-> (AnnList EpaLocation
    -> RWST
         (EPOptions m w)
         (EPWriter w)
         EPState
         m
         (AnnList EpaLocation, LocatedAn an a))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnList EpaLocation, LocatedAn an a)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> (a -> RWST (EPOptions m w) (EPWriter w) EPState m b)
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AnnList EpaLocation
an0 -> AnnList EpaLocation
-> LocatedAn an a
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnList EpaLocation, LocatedAn an a)
forall (m :: * -> *) w an a l.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList l -> LocatedAn an a -> EP w m (AnnList l, LocatedAn an a)
markMaybeDodgyStmts AnnList EpaLocation
an0 LocatedAn an a
stmts
exactDo AnnList EpaLocation
an HsDoFlavour
GhciStmtCtxt  LocatedAn an a
stmts = AnnList EpaLocation
-> Lens (AnnList EpaLocation) EpaLocation
-> (EpaLocation -> EP w m EpaLocation)
-> EP w m (AnnList EpaLocation)
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun AnnList EpaLocation
an (EpaLocation -> f EpaLocation)
-> AnnList EpaLocation -> f (AnnList EpaLocation)
forall l (f :: * -> *).
Functor f =>
(l -> f l) -> AnnList l -> f (AnnList l)
Lens (AnnList EpaLocation) EpaLocation
lal_rest (\EpaLocation
l -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l String
"do") EP w m (AnnList EpaLocation)
-> (AnnList EpaLocation
    -> RWST
         (EPOptions m w)
         (EPWriter w)
         EPState
         m
         (AnnList EpaLocation, LocatedAn an a))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnList EpaLocation, LocatedAn an a)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> (a -> RWST (EPOptions m w) (EPWriter w) EPState m b)
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                 \AnnList EpaLocation
an0 -> AnnList EpaLocation
-> LocatedAn an a
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnList EpaLocation, LocatedAn an a)
forall (m :: * -> *) w an a l.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList l -> LocatedAn an a -> EP w m (AnnList l, LocatedAn an a)
markMaybeDodgyStmts AnnList EpaLocation
an0 LocatedAn an a
stmts
exactDo AnnList EpaLocation
an (MDoExpr Maybe ModuleName
m)   LocatedAn an a
stmts = AnnList EpaLocation
-> Maybe ModuleName -> String -> EP w m (AnnList EpaLocation)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnList EpaLocation
-> Maybe ModuleName -> String -> EP w m (AnnList EpaLocation)
exactMdo AnnList EpaLocation
an Maybe ModuleName
m  String
"mdo" EP w m (AnnList EpaLocation)
-> (AnnList EpaLocation
    -> RWST
         (EPOptions m w)
         (EPWriter w)
         EPState
         m
         (AnnList EpaLocation, LocatedAn an a))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnList EpaLocation, LocatedAn an a)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> (a -> RWST (EPOptions m w) (EPWriter w) EPState m b)
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AnnList EpaLocation
an0 -> AnnList EpaLocation
-> LocatedAn an a
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnList EpaLocation, LocatedAn an a)
forall (m :: * -> *) w an a l.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList l -> LocatedAn an a -> EP w m (AnnList l, LocatedAn an a)
markMaybeDodgyStmts AnnList EpaLocation
an0 LocatedAn an a
stmts
exactDo AnnList EpaLocation
an HsDoFlavour
ListComp      LocatedAn an a
stmts = AnnList EpaLocation
-> LocatedAn an a
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnList EpaLocation, LocatedAn an a)
forall (m :: * -> *) w an a l.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList l -> LocatedAn an a -> EP w m (AnnList l, LocatedAn an a)
markMaybeDodgyStmts AnnList EpaLocation
an LocatedAn an a
stmts
exactDo AnnList EpaLocation
an HsDoFlavour
MonadComp     LocatedAn an a
stmts = AnnList EpaLocation
-> LocatedAn an a
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnList EpaLocation, LocatedAn an a)
forall (m :: * -> *) w an a l.
(Monad m, Monoid w, ExactPrint (LocatedAn an a)) =>
AnnList l -> LocatedAn an a -> EP w m (AnnList l, LocatedAn an a)
markMaybeDodgyStmts AnnList EpaLocation
an LocatedAn an a
stmts

exactMdo :: (Monad m, Monoid w)
  => AnnList EpaLocation -> Maybe ModuleName -> String -> EP w m (AnnList EpaLocation)
exactMdo :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnList EpaLocation
-> Maybe ModuleName -> String -> EP w m (AnnList EpaLocation)
exactMdo AnnList EpaLocation
an Maybe ModuleName
Nothing            String
kw = AnnList EpaLocation
-> Lens (AnnList EpaLocation) EpaLocation
-> (EpaLocation -> EP w m EpaLocation)
-> EP w m (AnnList EpaLocation)
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun AnnList EpaLocation
an (EpaLocation -> f EpaLocation)
-> AnnList EpaLocation -> f (AnnList EpaLocation)
forall l (f :: * -> *).
Functor f =>
(l -> f l) -> AnnList l -> f (AnnList l)
Lens (AnnList EpaLocation) EpaLocation
lal_rest (\EpaLocation
l -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l String
kw)
exactMdo AnnList EpaLocation
an (Just ModuleName
module_name) String
kw = AnnList EpaLocation
-> Lens (AnnList EpaLocation) EpaLocation
-> (EpaLocation -> EP w m EpaLocation)
-> EP w m (AnnList EpaLocation)
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun AnnList EpaLocation
an (EpaLocation -> f EpaLocation)
-> AnnList EpaLocation -> f (AnnList EpaLocation)
forall l (f :: * -> *).
Functor f =>
(l -> f l) -> AnnList l -> f (AnnList l)
Lens (AnnList EpaLocation) EpaLocation
lal_rest (\EpaLocation
l -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l 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]
++ String
kw

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsPragE GhcPs -> EP w m (HsPragE GhcPs)
exact (HsPragSCC (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m,SourceText
st) StringLiteral
sl) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
st  String
"{-# SCC"
    l1' <- printStringAtAA l1 (sourceTextToString (sl_st sl) (unpackFS $ sl_fs sl))
    c' <- markEpToken c
    return (HsPragSCC (AnnPragma o' c' s l1' l2 t m,st) sl)


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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsUntypedSplice GhcPs -> EP w m (HsUntypedSplice GhcPs)
exact (HsUntypedSpliceExpr XUntypedSpliceExpr GhcPs
an XRec GhcPs (HsExpr GhcPs)
e) = do
    an0 <- EpToken "$" -> EP w m (EpToken "$")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XUntypedSpliceExpr GhcPs
EpToken "$"
an
    e' <- markAnnotated e
    return (HsUntypedSpliceExpr an0 e')

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DotFieldOcc GhcPs -> EP w m (DotFieldOcc GhcPs)
exact (DotFieldOcc XCDotFieldOcc GhcPs
an (L SrcSpanAnnN
loc (FieldLabelString FastString
fs))) = do
    an0 <- AnnFieldLabel
-> Lens AnnFieldLabel (Maybe (EpToken "."))
-> (Maybe (EpToken ".") -> EP w m (Maybe (EpToken ".")))
-> EP w m AnnFieldLabel
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XCDotFieldOcc GhcPs
AnnFieldLabel
an (Maybe (EpToken ".") -> f (Maybe (EpToken ".")))
-> AnnFieldLabel -> f AnnFieldLabel
Lens AnnFieldLabel (Maybe (EpToken "."))
lafDot (\Maybe (EpToken ".")
ml -> (EpToken "."
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "."))
-> Maybe (EpToken ".") -> EP w m (Maybe (EpToken "."))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "."
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ".")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken ".")
ml)
    -- The field name has a SrcSpanAnnN, print it as a
    -- LocatedN RdrName
    L loc' _ <- markAnnotated (L loc (mkVarUnqual fs))
    return (DotFieldOcc an0 (L loc' (FieldLabelString fs)))

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

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsCmd GhcPs -> EP w m (HsCmd GhcPs)
exact (HsCmdArrApp (IsUnicodeSyntax
isU, EpaLocation
l) XRec GhcPs (HsExpr GhcPs)
arr XRec GhcPs (HsExpr GhcPs)
arg HsArrAppType
HsFirstOrderApp Bool
True) = do
    arr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arr
    l' <- case isU of
      IsUnicodeSyntax
UnicodeSyntax -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l  String
"⤙"
      IsUnicodeSyntax
NormalSyntax -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l  String
"-<"
    arg' <- markAnnotated arg
    return (HsCmdArrApp (isU, l') arr' arg' HsFirstOrderApp True)
  exact (HsCmdArrApp (IsUnicodeSyntax
isU, EpaLocation
l) XRec GhcPs (HsExpr GhcPs)
arr XRec GhcPs (HsExpr GhcPs)
arg HsArrAppType
HsFirstOrderApp Bool
False) = do
    arg' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
    l' <- case isU of
      IsUnicodeSyntax
UnicodeSyntax -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l  String
"⤚"
      IsUnicodeSyntax
NormalSyntax -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l  String
">-"
    arr' <- markAnnotated arr
    return (HsCmdArrApp (isU, l') arr' arg' HsFirstOrderApp False)
  exact (HsCmdArrApp (IsUnicodeSyntax
isU, EpaLocation
l) XRec GhcPs (HsExpr GhcPs)
arr XRec GhcPs (HsExpr GhcPs)
arg HsArrAppType
HsHigherOrderApp Bool
True) = do
    arr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arr
    l' <- case isU of
      IsUnicodeSyntax
UnicodeSyntax -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l  String
"⤛"
      IsUnicodeSyntax
NormalSyntax -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l  String
"-<<"
    arg' <- markAnnotated arg
    return (HsCmdArrApp (isU, l') arr' arg' HsHigherOrderApp True)
  exact (HsCmdArrApp (IsUnicodeSyntax
isU, EpaLocation
l) XRec GhcPs (HsExpr GhcPs)
arr XRec GhcPs (HsExpr GhcPs)
arg HsArrAppType
HsHigherOrderApp Bool
False) = do
    arg' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
    l' <- case isU of
      IsUnicodeSyntax
UnicodeSyntax -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l  String
"⤜"
      IsUnicodeSyntax
NormalSyntax -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l  String
">>-"
    arr' <- markAnnotated arr
    return (HsCmdArrApp (isU, l') arr' arg' HsHigherOrderApp False)

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

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

  exact (HsCmdLam XCmdLamCase GhcPs
an HsLamVariant
lam_variant MatchGroup GhcPs (LHsCmd GhcPs)
matches) = do
    an0 <- EpAnnLam
-> Lens EpAnnLam (EpToken "\\")
-> (EpToken "\\" -> EP w m (EpToken "\\"))
-> EP w m EpAnnLam
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XCmdLamCase GhcPs
EpAnnLam
an (EpToken "\\" -> f (EpToken "\\")) -> EpAnnLam -> f EpAnnLam
Lens EpAnnLam (EpToken "\\")
lepl_lambda EpToken "\\" -> EP w m (EpToken "\\")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    an1 <- case lam_variant of
             HsLamVariant
LamSingle -> EpAnnLam -> EP w m EpAnnLam
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnnLam
an0
             HsLamVariant
LamCase -> EpAnnLam
-> Lens EpAnnLam (Maybe EpaLocation)
-> (Maybe EpaLocation -> EP w m (Maybe EpaLocation))
-> EP w m EpAnnLam
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun EpAnnLam
an0 (Maybe EpaLocation -> f (Maybe EpaLocation))
-> EpAnnLam -> f EpAnnLam
Lens EpAnnLam (Maybe EpaLocation)
lepl_case (\Maybe EpaLocation
ml -> (EpaLocation
 -> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation)
-> Maybe EpaLocation -> EP w m (Maybe EpaLocation)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (\EpaLocation
l -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l String
"case") Maybe EpaLocation
ml)
             HsLamVariant
LamCases -> EpAnnLam
-> Lens EpAnnLam (Maybe EpaLocation)
-> (Maybe EpaLocation -> EP w m (Maybe EpaLocation))
-> EP w m EpAnnLam
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun EpAnnLam
an0 (Maybe EpaLocation -> f (Maybe EpaLocation))
-> EpAnnLam -> f EpAnnLam
Lens EpAnnLam (Maybe EpaLocation)
lepl_case (\Maybe EpaLocation
ml -> (EpaLocation
 -> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation)
-> Maybe EpaLocation -> EP w m (Maybe EpaLocation)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (\EpaLocation
l -> EpaLocation
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l String
"cases") Maybe EpaLocation
ml)
    matches' <- markAnnotated matches
    return (HsCmdLam an1 lam_variant matches')

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

  exact (HsCmdCase XCmdCase GhcPs
an XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
alts) = do
    an0 <- EpAnnHsCase
-> Lens EpAnnHsCase (EpToken "case")
-> (EpToken "case" -> EP w m (EpToken "case"))
-> EP w m EpAnnHsCase
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XCmdCase GhcPs
EpAnnHsCase
an (EpToken "case" -> f (EpToken "case"))
-> EpAnnHsCase -> f EpAnnHsCase
Lens EpAnnHsCase (EpToken "case")
lhsCaseAnnCase EpToken "case" -> EP w m (EpToken "case")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    e' <- markAnnotated e
    an1 <- markLensFun an0 lhsCaseAnnOf markEpToken
    alts' <- markAnnotated alts
    return (HsCmdCase an1 e' alts')

  exact (HsCmdIf XCmdIf GhcPs
an SyntaxExpr GhcPs
a XRec GhcPs (HsExpr GhcPs)
e1 LHsCmd GhcPs
e2 LHsCmd GhcPs
e3) = do
    an0 <- AnnsIf
-> Lens AnnsIf (EpToken "if")
-> (EpToken "if" -> EP w m (EpToken "if"))
-> EP w m AnnsIf
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XCmdIf GhcPs
AnnsIf
an (EpToken "if" -> f (EpToken "if")) -> AnnsIf -> f AnnsIf
Lens AnnsIf (EpToken "if")
laiIf EpToken "if" -> EP w m (EpToken "if")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    e1' <- markAnnotated e1
    an1 <- markLensFun an0 laiThenSemi (\Maybe (EpToken ";")
mt -> (EpToken ";"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";"))
-> Maybe (EpToken ";") -> EP w m (Maybe (EpToken ";"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken ";"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken ";")
mt)
    an2 <- markLensFun an1 laiThen markEpToken
    e2' <- markAnnotated e2
    an3 <- markLensFun an2 laiElseSemi (\Maybe (EpToken ";")
mt -> (EpToken ";"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";"))
-> Maybe (EpToken ";") -> EP w m (Maybe (EpToken ";"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken ";"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken ";")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken ";")
mt)
    an4 <- markLensFun an3 laiElse markEpToken
    e3' <- markAnnotated e3
    return (HsCmdIf an4 a e1' e2' e3')

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

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

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

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

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

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

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

  exact (LetStmt XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
tlet HsLocalBinds GhcPs
binds) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LetStmt"
    tlet' <- EpToken "let" -> EP w m (EpToken "let")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XLetStmt GhcPs GhcPs (LocatedA (body GhcPs))
EpToken "let"
tlet
    binds' <- markAnnotated binds
    return (LetStmt tlet' binds')

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

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

  exact (RecStmt XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
an XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA (body GhcPs))]
stmts [IdP GhcPs]
a [IdP GhcPs]
b SyntaxExpr GhcPs
c SyntaxExpr GhcPs
d SyntaxExpr GhcPs
e) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"RecStmt"
    an0 <- AnnList (EpToken "rec")
-> Lens (AnnList (EpToken "rec")) (EpToken "rec")
-> (EpToken "rec" -> EP w m (EpToken "rec"))
-> EP w m (AnnList (EpToken "rec"))
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XRecStmt GhcPs GhcPs (LocatedA (body GhcPs))
AnnList (EpToken "rec")
an (EpToken "rec" -> f (EpToken "rec"))
-> AnnList (EpToken "rec") -> f (AnnList (EpToken "rec"))
forall l (f :: * -> *).
Functor f =>
(l -> f l) -> AnnList l -> f (AnnList l)
Lens (AnnList (EpToken "rec")) (EpToken "rec")
lal_rest EpToken "rec" -> EP w m (EpToken "rec")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    (an1, stmts') <- markAnnList' an0 (markAnnotated stmts)
    return (RecStmt an1 stmts' a b c d e)

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

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

exactTransStmt :: (Monad m, Monoid w)
  => AnnTransStmt -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm
  -> EP w m (AnnTransStmt, Maybe (LHsExpr GhcPs), (LHsExpr GhcPs))
exactTransStmt :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnTransStmt
-> Maybe (XRec GhcPs (HsExpr GhcPs))
-> XRec GhcPs (HsExpr GhcPs)
-> TransForm
-> EP
     w
     m
     (AnnTransStmt, Maybe (XRec GhcPs (HsExpr GhcPs)),
      XRec GhcPs (HsExpr GhcPs))
exactTransStmt (AnnTransStmt EpToken "then"
at Maybe (EpToken "group")
ag Maybe (EpToken "by")
ab Maybe (EpToken "using")
au) Maybe (XRec GhcPs (HsExpr GhcPs))
by XRec GhcPs (HsExpr GhcPs)
using TransForm
ThenForm = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"exactTransStmt:ThenForm"
  at' <- EpToken "then" -> EP w m (EpToken "then")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "then"
at
  using' <- markAnnotated using
  case by of
    Maybe (XRec GhcPs (HsExpr GhcPs))
Nothing -> (AnnTransStmt, Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
 GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (AnnTransStmt, Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)),
      GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpToken "then"
-> Maybe (EpToken "group")
-> Maybe (EpToken "by")
-> Maybe (EpToken "using")
-> AnnTransStmt
AnnTransStmt EpToken "then"
at' Maybe (EpToken "group")
ag Maybe (EpToken "by")
ab Maybe (EpToken "using")
au, Maybe (XRec GhcPs (HsExpr GhcPs))
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
by, GenLocated SrcSpanAnnA (HsExpr GhcPs)
using')
    Just XRec GhcPs (HsExpr GhcPs)
b -> do
      ab' <- (EpToken "by"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "by"))
-> Maybe (EpToken "by")
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (EpToken "by"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "by"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "by")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "by")
ab
      b' <- markAnnotated b
      return ((AnnTransStmt at' ag ab' au), Just b', using')
exactTransStmt (AnnTransStmt EpToken "then"
at Maybe (EpToken "group")
ag Maybe (EpToken "by")
ab Maybe (EpToken "using")
au) Maybe (XRec GhcPs (HsExpr GhcPs))
by XRec GhcPs (HsExpr GhcPs)
using TransForm
GroupForm = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"exactTransStmt:GroupForm"
  at' <- EpToken "then" -> EP w m (EpToken "then")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "then"
at
  ag' <- mapM markEpToken ag
  (ab', by') <- case by of
    Maybe (XRec GhcPs (HsExpr GhcPs))
Nothing -> (Maybe (EpToken "by"),
 Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (EpToken "by"),
      Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EpToken "by")
ab, Maybe (XRec GhcPs (HsExpr GhcPs))
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
by)
    Just XRec GhcPs (HsExpr GhcPs)
b -> do
      ab0 <- (EpToken "by"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "by"))
-> Maybe (EpToken "by")
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (EpToken "by"))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "by"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "by")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "by")
ab
      b' <- markAnnotated b
      return (ab0, Just b')
  au' <- mapM markEpToken au
  using' <- markAnnotated using
  return (AnnTransStmt at' ag' ab' au', by', using')

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

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

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

  exact (SynDecl { tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
tcdSExt = AnnSynDecl [EpToken "("]
ops [EpToken ")"]
cps EpToken "type"
t EpToken "="
eq
                 , tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcPs
ltycon, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcPs
tyvars, tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity = LexicalFixity
fixity
                 , tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType GhcPs
rhs }) = do
    -- There may be arbitrary parens around parts of the constructor
    -- that are infix.  Turn these into comments so that they feed
    -- into the right place automatically
    -- TODO: no longer sorting on insert. What now?
    String -> [EpToken "("] -> EP w m ()
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
"(" [EpToken "("]
ops
    String -> [EpToken ")"] -> EP w m ()
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
")" [EpToken ")"]
cps
    t' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
t

    (_,ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing
    eq' <- markEpToken eq
    rhs' <- markAnnotated rhs
    return (SynDecl { tcdSExt = AnnSynDecl [] [] t' eq'
                    , tcdLName = ltycon', tcdTyVars = tyvars', tcdFixity = fixity
                    , tcdRhs = rhs' })

  exact (DataDecl { tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
tcdDExt = XDataDecl GhcPs
x, tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcPs
ltycon, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcPs
tyvars
                  , tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity = LexicalFixity
fixity, tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcPs
defn }) = do
    (_,ltycon', tyvars', _, defn') <-
      (Maybe (LHsContext GhcPs)
 -> EP
      w
      m
      ((), LocatedN RdrName, LHsQTyVars GhcPs, (),
       Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP
     w m ((), LocatedN RdrName, LHsQTyVars GhcPs, (), HsDataDefn GhcPs)
forall (m :: * -> *) w r a b.
(Monad m, Monoid w) =>
(Maybe (LHsContext GhcPs)
 -> EP w m (r, LocatedN RdrName, a, b, Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP w m (r, LocatedN RdrName, a, b, HsDataDefn GhcPs)
exactDataDefn (LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ((), LocatedN RdrName, LHsQTyVars GhcPs, (),
      Maybe (LHsContext GhcPs))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
-> EP
     w
     m
     ((), LocatedN RdrName, LHsQTyVars GhcPs, (),
      Maybe (LHsContext GhcPs))
exactVanillaDeclHead LIdP GhcPs
LocatedN RdrName
ltycon LHsQTyVars GhcPs
tyvars LexicalFixity
fixity) HsDataDefn GhcPs
defn
    return (DataDecl { tcdDExt = x, tcdLName = ltycon', tcdTyVars = tyvars'
                     , tcdFixity = fixity, tcdDataDefn = defn' })

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

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

      | Bool
otherwise       -- Laid out
      = do
          (c', w', vb', fds', lclas', tyvars',context') <- RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  (EpToken "class", EpToken "where", EpToken "|",
   [GenLocated SrcSpanAnnA (FunDep GhcPs)], LocatedN RdrName,
   LHsQTyVars GhcPs,
   Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
top_matter
          oc' <- markEpToken oc
          semis' <- mapM markEpToken semis
          (sortKey', ds) <- withSortKey sortKey
                               [(ClsSigTag, prepareListAnnotationA sigs),
                                (ClsMethodTag, prepareListAnnotationA methods),
                                (ClsAtTag, prepareListAnnotationA ats),
                                (ClsAtdTag, prepareListAnnotationA at_defs)
                             -- ++ prepareListAnnotation docs
                               ]
          cc' <- markEpToken cc
          let
            sigs'    = [Dynamic] -> [LocatedAn AnnListItem (Sig GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            methods' = [Dynamic] -> [LocatedAn AnnListItem (HsBind GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            ats'     = [Dynamic] -> [LocatedAn AnnListItem (FamilyDecl GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
            at_defs' = [Dynamic] -> [LocatedAn AnnListItem (TyFamInstDecl GhcPs)]
forall a. Typeable a => [Dynamic] -> [a]
undynamic [Dynamic]
ds
          return (ClassDecl {tcdCExt = (AnnClassDecl c' [] [] vb' w' oc' cc' semis', lo, sortKey'),
                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',
                             tcdFixity = fixity,
                             tcdFDs  = fds',
                             tcdSigs = sigs', tcdMeths = methods',
                             tcdATs = ats', tcdATDefs = at_defs',
                             tcdDocs = _docs})
      where
        top_matter :: RWST
  (EPOptions m w)
  (EPWriter w)
  EPState
  m
  (EpToken "class", EpToken "where", EpToken "|",
   [GenLocated SrcSpanAnnA (FunDep GhcPs)], LocatedN RdrName,
   LHsQTyVars GhcPs,
   Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]))
top_matter = do
          String -> [EpToken "("] -> EP w m ()
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
"(" [EpToken "("]
ops
          String -> [EpToken ")"] -> EP w m ()
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
")" [EpToken ")"]
cps
          c' <- EpToken "class" -> EP w m (EpToken "class")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "class"
c
          (_,lclas', tyvars',_,context') <- exactVanillaDeclHead lclas tyvars fixity context
          (vb', fds') <- if (null fds)
            then return (vb, fds)
            else do
              vb' <- markEpToken vb
              fds' <- markAnnotated fds
              return (vb', fds')
          w' <- markEpToken w
          return (c', w', vb', fds', lclas', tyvars',context')


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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
FamilyDecl GhcPs -> EP w m (FamilyDecl GhcPs)
exact (FamilyDecl { fdExt :: forall pass. FamilyDecl pass -> XCFamilyDecl pass
fdExt = AnnFamilyDecl [EpToken "("]
ops [EpToken ")"]
cps EpToken "type"
t EpToken "data"
d EpToken "family"
f EpUniToken "::" "\8759"
dc EpToken "="
eq EpToken "|"
vb EpToken "where"
w EpToken "{"
oc EpToken ".."
dd EpToken "}"
cc
                    , fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo GhcPs
info
                    , fdTopLevel :: forall pass. FamilyDecl pass -> TopLevelFlag
fdTopLevel = TopLevelFlag
top_level
                    , fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName = LIdP GhcPs
ltycon
                    , fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars = LHsQTyVars GhcPs
tyvars
                    , fdFixity :: forall pass. FamilyDecl pass -> LexicalFixity
fdFixity = LexicalFixity
fixity
                    , fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L EpAnn NoEpAnns
lr FamilyResultSig GhcPs
result
                    , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn GhcPs)
mb_inj }) = do
    (d',t') <- (EpToken "data", EpToken "type")
-> FamilyInfo GhcPs -> EP w m (EpToken "data", EpToken "type")
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
(EpToken "data", EpToken "type")
-> FamilyInfo GhcPs -> EP w m (EpToken "data", EpToken "type")
exactFlavour (EpToken "data"
d,EpToken "type"
t) FamilyInfo GhcPs
info
    f' <- exact_top_level f

    epTokensToComments "(" ops
    epTokensToComments ")" cps
    (_,ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing
    (dc', eq', result') <- exact_kind (dc, eq)
    (vb', mb_inj') <-
      case mb_inj of
        Maybe (LInjectivityAnn GhcPs)
Nothing -> (EpToken "|",
 Maybe (GenLocated (EpAnn NoEpAnns) (InjectivityAnn GhcPs)))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpToken "|",
      Maybe (GenLocated (EpAnn NoEpAnns) (InjectivityAnn GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpToken "|"
vb, Maybe (LInjectivityAnn GhcPs)
Maybe (GenLocated (EpAnn NoEpAnns) (InjectivityAnn GhcPs))
mb_inj)
        Just LInjectivityAnn GhcPs
inj -> do
          vb' <- EpToken "|" -> EP w m (EpToken "|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "|"
vb
          inj' <- markAnnotated inj
          return (vb', Just inj')
    (w', oc', dd', cc', info') <-
             case info of
               ClosedTypeFamily Maybe [LTyFamInstEqn GhcPs]
mb_eqns -> do
                 w' <- EpToken "where" -> EP w m (EpToken "where")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "where"
w
                 oc' <- markEpToken oc
                 (dd', mb_eqns') <-
                   case mb_eqns of
                     Maybe [LTyFamInstEqn GhcPs]
Nothing -> do
                       dd' <- EpToken ".." -> EP w m (EpToken "..")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken ".."
dd
                       return (dd', mb_eqns)
                     Just [LTyFamInstEqn GhcPs]
eqns -> do
                       eqns' <- [GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> EP
     w
     m
     [GenLocated
        SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LTyFamInstEqn GhcPs]
[GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
eqns
                       return (dd, Just eqns')
                 cc' <- markEpToken cc
                 return (w',oc',dd',cc', ClosedTypeFamily mb_eqns')
               FamilyInfo GhcPs
_ -> (EpToken "where", EpToken "{", EpToken "..", EpToken "}",
 FamilyInfo GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpToken "where", EpToken "{", EpToken "..", EpToken "}",
      FamilyInfo GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpToken "where"
w,EpToken "{"
oc,EpToken ".."
dd,EpToken "}"
cc, FamilyInfo GhcPs
info)
    return (FamilyDecl { fdExt = AnnFamilyDecl [] [] t' d' f' dc' eq' vb' w' oc' dd' cc'
                       , fdInfo = info'
                       , fdTopLevel = top_level
                       , fdLName = ltycon'
                       , fdTyVars = tyvars'
                       , fdFixity = fixity
                       , fdResultSig = L lr result'
                       , fdInjectivityAnn = mb_inj' })
    where
      exact_top_level :: EpToken "family" -> EP w m (EpToken "family")
exact_top_level EpToken "family"
tfamily =
        case TopLevelFlag
top_level of
          TopLevelFlag
TopLevel    -> EpToken "family" -> EP w m (EpToken "family")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "family"
tfamily
          TopLevelFlag
NotTopLevel -> do
            -- It seems that in some kind of legacy
            -- mode the 'family' keyword is still
            -- accepted.
            EpToken "family" -> EP w m (EpToken "family")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "family"
tfamily

      exact_kind :: (EpUniToken "::" "\8759", EpToken "=")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpUniToken "::" "\8759", EpToken "=", FamilyResultSig GhcPs)
exact_kind (EpUniToken "::" "\8759"
tdcolon, EpToken "="
tequal) =
        case FamilyResultSig GhcPs
result of
          NoSig    XNoSig GhcPs
_         -> (EpUniToken "::" "\8759", EpToken "=", FamilyResultSig GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpUniToken "::" "\8759", EpToken "=", FamilyResultSig GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpUniToken "::" "\8759"
tdcolon, EpToken "="
tequal, FamilyResultSig GhcPs
result)
          KindSig  XCKindSig GhcPs
x LHsType GhcPs
kind    -> do
            tdcolon' <- EpUniToken "::" "\8759" -> EP w m (EpUniToken "::" "\8759")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken EpUniToken "::" "\8759"
tdcolon
            kind' <- markAnnotated kind
            return (tdcolon', tequal, KindSig  x kind')
          TyVarSig XTyVarSig GhcPs
x LHsTyVarBndr () GhcPs
tv_bndr -> do
            tequal' <- EpToken "=" -> EP w m (EpToken "=")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "="
tequal
            tv_bndr' <- markAnnotated tv_bndr
            return (tdcolon, tequal', TyVarSig x tv_bndr')


exactFlavour :: (Monad m, Monoid w) => (EpToken "data", EpToken "type") -> FamilyInfo GhcPs -> EP w m (EpToken "data", EpToken "type")
exactFlavour :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
(EpToken "data", EpToken "type")
-> FamilyInfo GhcPs -> EP w m (EpToken "data", EpToken "type")
exactFlavour (EpToken "data"
td,EpToken "type"
tt) FamilyInfo GhcPs
DataFamily            = (\EpToken "data"
td' -> (EpToken "data"
td',EpToken "type"
tt)) (EpToken "data" -> (EpToken "data", EpToken "type"))
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "data")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpToken "data", EpToken "type")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "data"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "data")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "data"
td
exactFlavour (EpToken "data"
td,EpToken "type"
tt) FamilyInfo GhcPs
OpenTypeFamily        = (EpToken "data"
td,)              (EpToken "type" -> (EpToken "data", EpToken "type"))
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "type")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpToken "data", EpToken "type")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "type"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
tt
exactFlavour (EpToken "data"
td,EpToken "type"
tt) (ClosedTypeFamily {}) = (EpToken "data"
td,)              (EpToken "type" -> (EpToken "data", EpToken "type"))
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "type")
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpToken "data", EpToken "type")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "type"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
tt

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

exactDataDefn
  :: (Monad m, Monoid w)
  => (Maybe (LHsContext GhcPs) -> EP w m (r
                                         , LocatedN RdrName
                                         , a
                                         , b
                                         , Maybe (LHsContext GhcPs))) -- Printing the header
  -> HsDataDefn GhcPs
  -> EP w m ( r -- ^ from exactHdr
            , LocatedN RdrName, a, b, HsDataDefn GhcPs)
exactDataDefn :: forall (m :: * -> *) w r a b.
(Monad m, Monoid w) =>
(Maybe (LHsContext GhcPs)
 -> EP w m (r, LocatedN RdrName, a, b, Maybe (LHsContext GhcPs)))
-> HsDataDefn GhcPs
-> EP w m (r, LocatedN RdrName, a, b, HsDataDefn GhcPs)
exactDataDefn Maybe (LHsContext GhcPs)
-> EP w m (r, LocatedN RdrName, a, b, Maybe (LHsContext GhcPs))
exactHdr
                 (HsDataDefn { dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn pass
dd_ext = AnnDataDefn [EpToken "("]
ops [EpToken ")"]
cps EpToken "type"
t EpToken "newtype"
nt EpToken "data"
d EpToken "instance"
i EpUniToken "::" "\8759"
dc EpToken "where"
w EpToken "{"
oc EpToken "}"
cc EpToken "="
eq
                             , dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ctxt = Maybe (LHsContext GhcPs)
context
                             , dd_cType :: forall pass. HsDataDefn pass -> Maybe (XRec pass CType)
dd_cType = Maybe (XRec GhcPs CType)
mb_ct
                             , dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (LHsType GhcPs)
mb_sig
                             , dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons = DataDefnCons (LConDecl GhcPs)
condecls, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs = HsDeriving GhcPs
derivings }) = do


  String -> [EpToken "("] -> EP w m ()
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
"(" [EpToken "("]
ops
  String -> [EpToken ")"] -> EP w m ()
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w) =>
String -> [EpToken tok] -> EP w m ()
epTokensToComments String
")" [EpToken ")"]
cps

  (t',nt',d') <- case DataDefnCons (LConDecl GhcPs)
condecls of
    DataTypeCons Bool
is_type_data [LConDecl GhcPs]
_ -> do
      t' <- if Bool
is_type_data
                then EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "type"
t
                else EpToken "type" -> EP w m (EpToken "type")
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpToken "type"
t
      d' <- markEpToken d
      return (t',nt,d')
    NewTypeCon   LConDecl GhcPs
_ -> do
      nt' <- EpToken "newtype" -> EP w m (EpToken "newtype")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "newtype"
nt
      return (t, nt', d)

  i' <- markEpToken i -- optional 'instance'
  mb_ct' <- mapM markAnnotated mb_ct
  (anx, ln', tvs', b, mctxt') <- exactHdr context
  (dc', mb_sig') <- case mb_sig of
    Maybe (LHsType GhcPs)
Nothing -> (EpUniToken "::" "\8759",
 Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (EpUniToken "::" "\8759",
      Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpUniToken "::" "\8759"
dc, Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. Maybe a
Nothing)
    Just LHsType GhcPs
kind -> do
      dc' <- EpUniToken "::" "\8759" -> EP w m (EpUniToken "::" "\8759")
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken EpUniToken "::" "\8759"
dc
      kind' <- markAnnotated kind
      return (dc', Just kind')
  w' <- if (needsWhere condecls)
    then markEpToken w
    else return w
  oc' <- markEpToken oc
  (eq', condecls') <- exact_condecls eq (toList condecls)
  let condecls'' = case DataDefnCons (LConDecl GhcPs)
condecls of
        DataTypeCons Bool
td [LConDecl GhcPs]
_ -> Bool
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. Bool -> [a] -> DataDefnCons a
DataTypeCons Bool
td [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
condecls'
        NewTypeCon LConDecl GhcPs
_     -> case [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
condecls' of
          [GenLocated SrcSpanAnnA (ConDecl GhcPs)
decl] -> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. a -> DataDefnCons a
NewTypeCon GenLocated SrcSpanAnnA (ConDecl GhcPs)
decl
          [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
_ -> String -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. HasCallStack => String -> a
panic String
"exacprint NewTypeCon"
  cc' <- markEpToken cc
  derivings' <- mapM markAnnotated derivings
  return (anx, ln', tvs', b,
                 (HsDataDefn { dd_ext = AnnDataDefn [] [] t' nt' d' i' dc' w' oc' cc' eq'
                             , dd_ctxt = mctxt'
                             , dd_cType = mb_ct'
                             , dd_kindSig = mb_sig'
                             , dd_cons = condecls'', dd_derivs = derivings' }))


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

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

instance ExactPrint (InjectivityAnn GhcPs) where
  getAnnotationEntry :: InjectivityAnn GhcPs -> Entry
getAnnotationEntry InjectivityAnn GhcPs
_ = Entry
NoEntryVal
  setAnnotationAnchor :: InjectivityAnn GhcPs
-> EpaLocation
-> [TrailingAnn]
-> EpAnnComments
-> InjectivityAnn GhcPs
setAnnotationAnchor InjectivityAnn GhcPs
a EpaLocation
_ [TrailingAnn]
_ EpAnnComments
_ = InjectivityAnn GhcPs
a
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
InjectivityAnn GhcPs -> EP w m (InjectivityAnn GhcPs)
exact (InjectivityAnn XCInjectivityAnn GhcPs
rarrow LIdP GhcPs
lhs [LIdP GhcPs]
rhs) = do
    lhs' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
lhs
    rarrow' <- markEpUniToken rarrow
    rhs' <- mapM markAnnotated rhs
    return (InjectivityAnn rarrow' lhs' rhs')

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

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

instance ExactPrintTVFlag () where
  exactTVDelimiters :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnTyVarBndr
-> ()
-> EP w m (HsTyVarBndr () GhcPs)
-> EP w m (AnnTyVarBndr, (), HsTyVarBndr () GhcPs)
exactTVDelimiters (AnnTyVarBndr [EpaLocation]
os [EpaLocation]
cs EpToken "'"
ap EpUniToken "::" "\8759"
dc) ()
flag EP w m (HsTyVarBndr () GhcPs)
thing_inside = do
    os' <- [EpaLocation] -> String -> EP w m [EpaLocation]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[EpaLocation] -> String -> EP w m [EpaLocation]
markEpaLocationAll [EpaLocation]
os String
"("
    r <- thing_inside
    cs' <- markEpaLocationAll cs ")"
    return (AnnTyVarBndr os' cs' ap dc, flag, r)

instance ExactPrintTVFlag Specificity where
  exactTVDelimiters :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnTyVarBndr
-> Specificity
-> EP w m (HsTyVarBndr Specificity GhcPs)
-> EP
     w m (AnnTyVarBndr, Specificity, HsTyVarBndr Specificity GhcPs)
exactTVDelimiters (AnnTyVarBndr [EpaLocation]
os [EpaLocation]
cs EpToken "'"
ap EpUniToken "::" "\8759"
dc) Specificity
s EP w m (HsTyVarBndr Specificity GhcPs)
thing_inside = do
    os' <- [EpaLocation] -> String -> EP w m [EpaLocation]
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
[EpaLocation] -> String -> EP w m [EpaLocation]
markEpaLocationAll [EpaLocation]
os String
open
    r <- thing_inside
    cs' <- markEpaLocationAll cs close
    return (AnnTyVarBndr os' cs' ap dc, s, r)
    where
      (String
open, String
close) = case Specificity
s of
        Specificity
SpecifiedSpec -> (String
"(", String
")")
        Specificity
InferredSpec  -> (String
"{", String
"}")

instance ExactPrintTVFlag (HsBndrVis GhcPs) where
  exactTVDelimiters :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnTyVarBndr
-> HsBndrVis GhcPs
-> EP w m (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> EP
     w
     m
     (AnnTyVarBndr, HsBndrVis GhcPs,
      HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
exactTVDelimiters (AnnTyVarBndr [EpaLocation]
os [EpaLocation]
cs EpToken "'"
ap EpUniToken "::" "\8759"
dc) HsBndrVis GhcPs
bvis EP w m (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
thing_inside = do
    bvis' <- case HsBndrVis GhcPs
bvis of
      HsBndrRequired XBndrRequired GhcPs
_ -> HsBndrVis GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsBndrVis GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsBndrVis GhcPs
bvis
      HsBndrInvisible XBndrInvisible GhcPs
at -> EpToken "@" -> HsBndrVis GhcPs
XBndrInvisible GhcPs -> HsBndrVis GhcPs
forall pass. XBndrInvisible pass -> HsBndrVis pass
HsBndrInvisible (EpToken "@" -> HsBndrVis GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "@")
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsBndrVis GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpToken "@"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "@")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "@"
XBndrInvisible GhcPs
at
    os' <- markEpaLocationAll os "("
    r <- thing_inside
    cs' <- markEpaLocationAll cs ")"
    return (AnnTyVarBndr os' cs' ap dc, bvis', r)

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsTyVarBndr flag GhcPs -> EP w m (HsTyVarBndr flag GhcPs)
exact (HsTvb XTyVarBndr GhcPs
an flag
flag HsBndrVar GhcPs
n (HsBndrNoKind XBndrNoKind GhcPs
_)) = do
    r <- AnnTyVarBndr
-> flag
-> EP w m (HsTyVarBndr flag GhcPs)
-> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs)
forall flag (m :: * -> *) w.
(ExactPrintTVFlag flag, Monad m, Monoid w) =>
AnnTyVarBndr
-> flag
-> EP w m (HsTyVarBndr flag GhcPs)
-> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnTyVarBndr
-> flag
-> EP w m (HsTyVarBndr flag GhcPs)
-> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs)
exactTVDelimiters XTyVarBndr GhcPs
AnnTyVarBndr
an flag
flag (EP w m (HsTyVarBndr flag GhcPs)
 -> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs))
-> EP w m (HsTyVarBndr flag GhcPs)
-> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs)
forall a b. (a -> b) -> a -> b
$  do
           n' <- HsBndrVar GhcPs -> EP w m (HsBndrVar GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsBndrVar GhcPs
n
           return (HsTvb an flag n' (HsBndrNoKind noExtField))
    case r of
      (AnnTyVarBndr
an', flag
flag', HsTvb XTyVarBndr GhcPs
_ flag
_ HsBndrVar GhcPs
n'' HsBndrKind GhcPs
k'') -> HsTyVarBndr flag GhcPs -> EP w m (HsTyVarBndr flag GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTyVarBndr GhcPs
-> flag
-> HsBndrVar GhcPs
-> HsBndrKind GhcPs
-> HsTyVarBndr flag GhcPs
forall flag pass.
XTyVarBndr pass
-> flag
-> HsBndrVar pass
-> HsBndrKind pass
-> HsTyVarBndr flag pass
HsTvb XTyVarBndr GhcPs
AnnTyVarBndr
an' flag
flag' HsBndrVar GhcPs
n'' HsBndrKind GhcPs
k'')

  exact (HsTvb an :: XTyVarBndr GhcPs
an@(AnnTyVarBndr [EpaLocation]
os [EpaLocation]
cs EpToken "'"
ap EpUniToken "::" "\8759"
dc) flag
flag HsBndrVar GhcPs
n (HsBndrKind XBndrKind GhcPs
_ LHsType GhcPs
k)) = do
    r <- AnnTyVarBndr
-> flag
-> EP w m (HsTyVarBndr flag GhcPs)
-> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs)
forall flag (m :: * -> *) w.
(ExactPrintTVFlag flag, Monad m, Monoid w) =>
AnnTyVarBndr
-> flag
-> EP w m (HsTyVarBndr flag GhcPs)
-> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs)
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnTyVarBndr
-> flag
-> EP w m (HsTyVarBndr flag GhcPs)
-> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs)
exactTVDelimiters XTyVarBndr GhcPs
AnnTyVarBndr
an flag
flag (EP w m (HsTyVarBndr flag GhcPs)
 -> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs))
-> EP w m (HsTyVarBndr flag GhcPs)
-> EP w m (AnnTyVarBndr, flag, HsTyVarBndr flag GhcPs)
forall a b. (a -> b) -> a -> b
$ do
          n' <- HsBndrVar GhcPs -> EP w m (HsBndrVar GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsBndrVar GhcPs
n
          dc' <- markEpUniToken dc
          k' <- markAnnotated k
          let an0 = [EpaLocation]
-> [EpaLocation]
-> EpToken "'"
-> EpUniToken "::" "\8759"
-> AnnTyVarBndr
AnnTyVarBndr [EpaLocation]
os [EpaLocation]
cs EpToken "'"
ap EpUniToken "::" "\8759"
dc'
          return (HsTvb an0 flag n' (HsBndrKind noExtField k'))
    case r of
      (AnnTyVarBndr
an',flag
flag', HsTvb XTyVarBndr GhcPs
an1 flag
_ HsBndrVar GhcPs
n'' HsBndrKind GhcPs
k'') -> HsTyVarBndr flag GhcPs -> EP w m (HsTyVarBndr flag GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTyVarBndr GhcPs
-> flag
-> HsBndrVar GhcPs
-> HsBndrKind GhcPs
-> HsTyVarBndr flag GhcPs
forall flag pass.
XTyVarBndr pass
-> flag
-> HsBndrVar pass
-> HsBndrKind pass
-> HsTyVarBndr flag pass
HsTvb (AnnTyVarBndr
an'{ atv_dcolon = atv_dcolon an1 }) flag
flag' HsBndrVar GhcPs
n'' HsBndrKind GhcPs
k'')

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsBndrVar GhcPs -> EP w m (HsBndrVar GhcPs)
exact (HsBndrVar XBndrVar GhcPs
x LIdP GhcPs
n) = do
    n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    return (HsBndrVar x n')
  exact (HsBndrWildCard XBndrWildCard GhcPs
t) = do
    t' <- EpToken "_" -> EP w m (EpToken "_")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "_"
XBndrWildCard GhcPs
t
    return (HsBndrWildCard t')

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

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

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

  exact (HsQualTy XQualTy GhcPs
an LHsContext GhcPs
ctxt LHsType GhcPs
ty) = do
    ctxt' <- GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> EP
     w
     m
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt
    ty' <- markAnnotated ty
    return (HsQualTy an ctxt' ty')
  exact (HsTyVar XTyVar GhcPs
an PromotionFlag
promoted LIdP GhcPs
name) = do
    an0 <- if (PromotionFlag
promoted PromotionFlag -> PromotionFlag -> Bool
forall a. Eq a => a -> a -> Bool
== PromotionFlag
IsPromoted)
             then EpToken "'" -> EP w m (EpToken "'")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XTyVar GhcPs
EpToken "'"
an
             else EpToken "'" -> EP w m (EpToken "'")
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return XTyVar GhcPs
EpToken "'"
an
    name' <- markAnnotated name
    return (HsTyVar an0 promoted name')
  exact (HsAppTy XAppTy GhcPs
an LHsType GhcPs
t1 LHsType GhcPs
t2) = do
    t1' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1
    t2' <- markAnnotated t2
    return (HsAppTy an t1' t2')
  exact (HsAppKindTy XAppKindTy GhcPs
at LHsType GhcPs
ty LHsType GhcPs
ki) = do
    ty' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    at' <- markEpToken at
    ki' <- markAnnotated ki
    return (HsAppKindTy at' ty' ki')
  exact (HsFunTy XFunTy GhcPs
an HsArrow GhcPs
mult LHsType GhcPs
ty1 LHsType GhcPs
ty2) = do
    ty1' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty1
    mult' <- markArrow mult
    ty2' <- markAnnotated ty2
    return (HsFunTy an mult' ty1' ty2')
  exact (HsListTy XListTy GhcPs
an LHsType GhcPs
tys) = do
    an0 <- AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen XListTy GhcPs
AnnParen
an
    tys' <- markAnnotated tys
    an1 <- markClosingParen an0
    return (HsListTy an1 tys')
  exact (HsTupleTy XTupleTy GhcPs
an HsTupleSort
con [LHsType GhcPs]
tys) = do
    an0 <- AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen XTupleTy GhcPs
AnnParen
an
    tys' <- markAnnotated tys
    an1 <- markClosingParen an0
    return (HsTupleTy an1 con tys')
  exact (HsSumTy XSumTy GhcPs
an [LHsType GhcPs]
tys) = do
    an0 <- AnnParen -> EP w m AnnParen
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
AnnParen -> EP w m AnnParen
markOpeningParen XSumTy GhcPs
AnnParen
an
    tys' <- markAnnotated tys
    an1 <- markClosingParen an0
    return (HsSumTy an1 tys')
  exact (HsOpTy XOpTy GhcPs
x PromotionFlag
promoted LHsType GhcPs
t1 LIdP GhcPs
lo LHsType GhcPs
t2) = do
    t1' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t1
    lo' <- markAnnotated lo
    t2' <- markAnnotated t2
    return (HsOpTy x promoted t1' lo' t2')
  exact (HsParTy (EpToken "("
o,EpToken ")"
c) LHsType GhcPs
ty) = do
    o' <- EpToken "(" -> EP w m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "("
o
    ty' <- markAnnotated ty
    c' <- markEpToken c
    return (HsParTy (o',c') ty')
  exact (HsIParamTy XIParamTy GhcPs
an XRec GhcPs HsIPName
n LHsType GhcPs
t) = do
    n' <- GenLocated (EpAnn NoEpAnns) HsIPName
-> EP w m (GenLocated (EpAnn NoEpAnns) HsIPName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs HsIPName
GenLocated (EpAnn NoEpAnns) HsIPName
n
    an0 <- markEpUniToken an
    t' <- markAnnotated t
    return (HsIParamTy an0 n' t')
  exact (HsStarTy XStarTy GhcPs
an Bool
isUnicode) = do
    if Bool
isUnicode
        then String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
"\x2605" -- Unicode star
        else String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
"*"
    HsType GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XStarTy GhcPs -> Bool -> HsType GhcPs
forall pass. XStarTy pass -> Bool -> HsType pass
HsStarTy XStarTy GhcPs
an Bool
isUnicode)
  exact (HsKindSig XKindSig GhcPs
an LHsType GhcPs
ty LHsType GhcPs
k) = do
    ty' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    an0 <- markEpUniToken an
    k' <- markAnnotated k
    return (HsKindSig an0 ty' k')
  exact (HsSpliceTy XSpliceTy GhcPs
a HsUntypedSplice GhcPs
splice) = do
    splice' <- HsUntypedSplice GhcPs -> EP w m (HsUntypedSplice GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsUntypedSplice GhcPs
splice
    return (HsSpliceTy a splice')
  exact (HsDocTy XDocTy GhcPs
an LHsType GhcPs
ty LHsDoc GhcPs
doc) = do
    ty' <- GenLocated SrcSpanAnnA (HsType GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    return (HsDocTy an ty' doc)
  exact (HsBangTy ((EpaLocation
o,EpToken "#-}"
c,EpaLocation
tk), SourceText
mt) (HsBang SrcUnpackedness
up SrcStrictness
str) LHsType GhcPs
ty) = do
    (o',c') <-
      case SourceText
mt of
        SourceText
NoSourceText -> (EpaLocation, EpToken "#-}")
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (EpaLocation, EpToken "#-}")
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpaLocation
o,EpToken "#-}"
c)
        SourceText FastString
src -> do
          String -> EP w m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> EP w m ()) -> String -> EP w m ()
forall a b. (a -> b) -> a -> b
$ String
"HsBangTy: src=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FastString -> String
forall a. Data a => a -> String
showAst FastString
src
          o' <- EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
o (FastString -> String
unpackFS FastString
src)
          c' <- markEpToken c
          return (o',c')
    tk' <-
      case str of
        SrcStrictness
SrcLazy     -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
tk String
"~"
        SrcStrictness
SrcStrict   -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
tk String
"!"
        SrcStrictness
NoSrcStrict -> EpaLocation -> EP w m EpaLocation
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpaLocation
tk
    ty' <- markAnnotated ty
    return (HsBangTy ((o',c',tk'), mt) (HsBang up str) ty')
  exact (HsExplicitListTy (EpToken "'"
sq,EpToken "["
o,EpToken "]"
c) PromotionFlag
prom [LHsType GhcPs]
tys) = do
    sq' <- if (PromotionFlag -> Bool
isPromoted PromotionFlag
prom)
             then EpToken "'" -> EP w m (EpToken "'")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "'"
sq
             else EpToken "'" -> EP w m (EpToken "'")
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpToken "'"
sq
    o' <- markEpToken o
    tys' <- markAnnotated tys
    c' <- markEpToken c
    return (HsExplicitListTy (sq',o',c') prom tys')
  exact (HsExplicitTupleTy (EpToken "'"
sq, EpToken "("
o, EpToken ")"
c) PromotionFlag
prom [LHsType GhcPs]
tys) = do
    sq' <- if (PromotionFlag -> Bool
isPromoted PromotionFlag
prom)
              then EpToken "'" -> EP w m (EpToken "'")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "'"
sq
              else EpToken "'" -> EP w m (EpToken "'")
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpToken "'"
sq
    o' <- markEpToken o
    tys' <- markAnnotated tys
    c' <- markEpToken c
    return (HsExplicitTupleTy (sq', o', c') prom tys')
  exact (HsTyLit XTyLit GhcPs
a HsTyLit GhcPs
lit) = do
    case HsTyLit GhcPs
lit of
      (HsNumTy XNumTy GhcPs
src Integer
v) -> SourceText -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceText XNumTy GhcPs
SourceText
src (Integer -> String
forall a. Show a => a -> String
show Integer
v)
      (HsStrTy XStrTy GhcPs
src FastString
v) -> SourceText -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceText XStrTy GhcPs
SourceText
src (FastString -> String
forall a. Show a => a -> String
show FastString
v)
      (HsCharTy XCharTy GhcPs
src Char
v) -> SourceText -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
SourceText -> String -> EP w m ()
printSourceText XCharTy GhcPs
SourceText
src (Char -> String
forall a. Show a => a -> String
show Char
v)
    HsType GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTyLit GhcPs -> HsTyLit GhcPs -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit GhcPs
a HsTyLit GhcPs
lit)
  exact t :: HsType GhcPs
t@(HsWildCardTy XWildCardTy GhcPs
_) = String -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
"_" EP w m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsType GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return HsType GhcPs
t
  exact HsType GhcPs
x = String
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a. HasCallStack => String -> a
error (String
 -> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs))
-> String
-> RWST (EPOptions m w) (EPWriter w) EPState m (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ String
"missing match for HsType:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsType GhcPs -> String
forall a. Data a => a -> String
showAst HsType GhcPs
x

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

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

  setAnnotationAnchor :: HsForAllTelescope GhcPs
-> EpaLocation
-> [TrailingAnn]
-> EpAnnComments
-> HsForAllTelescope GhcPs
setAnnotationAnchor (HsForAllVis XHsForAllVis GhcPs
an [LHsTyVarBndr () GhcPs]
a) EpaLocation
anc [TrailingAnn]
ts EpAnnComments
cs = XHsForAllVis GhcPs
-> [LHsTyVarBndr () GhcPs] -> HsForAllTelescope GhcPs
forall pass.
XHsForAllVis pass
-> [LHsTyVarBndr () pass] -> HsForAllTelescope pass
HsForAllVis (EpAnn (TokForall, TokRarrow)
-> EpaLocation
-> [TrailingAnn]
-> EpAnnComments
-> EpAnn (TokForall, TokRarrow)
forall an.
HasTrailing an =>
EpAnn an
-> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa XHsForAllVis GhcPs
EpAnn (TokForall, TokRarrow)
an EpaLocation
anc [TrailingAnn]
ts EpAnnComments
cs) [LHsTyVarBndr () GhcPs]
a
  setAnnotationAnchor (HsForAllInvis XHsForAllInvis GhcPs
an [LHsTyVarBndr Specificity GhcPs]
a) EpaLocation
anc [TrailingAnn]
ts EpAnnComments
cs = XHsForAllInvis GhcPs
-> [LHsTyVarBndr Specificity GhcPs] -> HsForAllTelescope GhcPs
forall pass.
XHsForAllInvis pass
-> [LHsTyVarBndr Specificity pass] -> HsForAllTelescope pass
HsForAllInvis (EpAnn (TokForall, EpToken ".")
-> EpaLocation
-> [TrailingAnn]
-> EpAnnComments
-> EpAnn (TokForall, EpToken ".")
forall an.
HasTrailing an =>
EpAnn an
-> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa XHsForAllInvis GhcPs
EpAnn (TokForall, EpToken ".")
an EpaLocation
anc [TrailingAnn]
ts EpAnnComments
cs) [LHsTyVarBndr Specificity GhcPs]
a

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsForAllTelescope GhcPs -> EP w m (HsForAllTelescope GhcPs)
exact (HsForAllVis (EpAnn EpaLocation
l (TokForall
f,TokRarrow
r) EpAnnComments
cs) [LHsTyVarBndr () GhcPs]
bndrs)   = do
    f' <- TokForall -> EP w m TokForall
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken TokForall
f
    bndrs' <- markAnnotated bndrs
    r' <- markEpUniToken r
    return (HsForAllVis (EpAnn l (f',r') cs) bndrs')

  exact (HsForAllInvis (EpAnn EpaLocation
l (TokForall
f,EpToken "."
d) EpAnnComments
cs) [LHsTyVarBndr Specificity GhcPs]
bndrs) = do
    f' <- TokForall -> EP w m TokForall
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken TokForall
f
    bndrs' <- markAnnotated bndrs
    d' <- markEpToken d
    return (HsForAllInvis (EpAnn l (f',d') cs) bndrs')

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsDerivingClause GhcPs -> EP w m (HsDerivingClause GhcPs)
exact (HsDerivingClause { deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_ext      = XCHsDerivingClause GhcPs
an
                          , deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy = Maybe (LDerivStrategy GhcPs)
dcs
                          , deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_tys      = LDerivClauseTys GhcPs
dct }) = do
    an0 <- EpToken "deriving" -> EP w m (EpToken "deriving")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XCHsDerivingClause GhcPs
EpToken "deriving"
an
    dcs0 <- case dcs of
            Just (L EpAnn NoEpAnns
_ ViaStrategy{}) -> Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LDerivStrategy GhcPs)
Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
dcs
            Maybe (LDerivStrategy GhcPs)
_ -> (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
-> Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (LDerivStrategy GhcPs)
Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
dcs
    dct' <- markAnnotated dct
    dcs1 <- case dcs0 of
            Just (L EpAnn NoEpAnns
_ ViaStrategy{}) -> (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
-> Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
dcs0
            Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
_ -> Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs)))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenLocated (EpAnn NoEpAnns) (DerivStrategy GhcPs))
dcs0
    return (HsDerivingClause { deriv_clause_ext      = an0
                             , deriv_clause_strategy = dcs1
                             , deriv_clause_tys      = dct' })

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
DerivStrategy GhcPs -> EP w m (DerivStrategy GhcPs)
exact (StockStrategy XStockStrategy GhcPs
an)    = do
    an0 <- EpToken "stock" -> EP w m (EpToken "stock")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XStockStrategy GhcPs
EpToken "stock"
an
    return (StockStrategy an0)
  exact (AnyclassStrategy XAnyClassStrategy GhcPs
an) = do
    an0 <- EpToken "anyclass" -> EP w m (EpToken "anyclass")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XAnyClassStrategy GhcPs
EpToken "anyclass"
an
    return (AnyclassStrategy an0)
  exact (NewtypeStrategy XNewtypeStrategy GhcPs
an)  = do
    an0 <- EpToken "newtype" -> EP w m (EpToken "newtype")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XNewtypeStrategy GhcPs
EpToken "newtype"
an
    return (NewtypeStrategy an0)
  exact (ViaStrategy (XViaStrategyPs EpToken "via"
an LHsSigType GhcPs
ty)) = do
    an0 <- EpToken "via" -> EP w m (EpToken "via")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "via"
an
    ty' <- markAnnotated ty
    return (ViaStrategy (XViaStrategyPs an0 ty'))

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedC a -> EP w m (LocatedC a)
exact (L (EpAnn EpaLocation
anc (AnnContext Maybe TokDarrow
ma [EpToken "("]
opens [EpToken ")"]
closes) EpAnnComments
cs) a
a) = do
    opens' <- (EpToken "("
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "("))
-> [EpToken "("]
-> RWST (EPOptions m w) (EPWriter w) EPState m [EpToken "("]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken "("
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken [EpToken "("]
opens
    a' <- markAnnotated a
    closes' <- mapM markEpToken closes
    return (L (EpAnn anc (AnnContext ma opens' closes') cs) a')

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedN RdrName -> EP w m (LocatedN RdrName)
exact (L (EpAnn EpaLocation
anc NameAnn
ann EpAnnComments
cs) RdrName
n) = do
    ann' <-
      case NameAnn
ann of
        NameAnn NameAdornment
a EpaLocation
l [TrailingAnn]
t -> do
          mn <- NameAdornment
-> Maybe (EpaLocation, RdrName)
-> EP w m (NameAdornment, Maybe (EpaLocation, RdrName))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment
-> Maybe (EpaLocation, RdrName)
-> EP w m (NameAdornment, Maybe (EpaLocation, RdrName))
markName NameAdornment
a ((EpaLocation, RdrName) -> Maybe (EpaLocation, RdrName)
forall a. a -> Maybe a
Just (EpaLocation
l,RdrName
n))
          case mn of
            (NameAdornment
a', (Just (EpaLocation
l',RdrName
_n))) -> do
              NameAnn -> RWST (EPOptions m w) (EPWriter w) EPState m NameAnn
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameAdornment -> EpaLocation -> [TrailingAnn] -> NameAnn
NameAnn NameAdornment
a' EpaLocation
l' [TrailingAnn]
t)
            (NameAdornment, Maybe (EpaLocation, RdrName))
_ -> String -> RWST (EPOptions m w) (EPWriter w) EPState m NameAnn
forall a. HasCallStack => String -> a
error String
"ExactPrint (LocatedN RdrName)"
        NameAnnCommas NameAdornment
a [EpToken ","]
commas [TrailingAnn]
t -> do
          a0 <- NameAdornment -> EP w m NameAdornment
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment -> EP w m NameAdornment
markNameAdornmentO NameAdornment
a
          commas' <- forM commas markEpToken
          a1 <- markNameAdornmentC a0
          return (NameAnnCommas a1 commas' t)
        NameAnnBars (EpToken "(#"
o,EpToken "#)"
c) [EpToken "|"]
bars [TrailingAnn]
t -> do
          o' <- EpToken "(#" -> EP w m (EpToken "(#")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "(#"
o
          bars' <- mapM markEpToken bars
          c' <- markEpToken c
          return (NameAnnBars (o',c') bars' t)
        NameAnnOnly NameAdornment
a [TrailingAnn]
t -> do
          (a',_) <- NameAdornment
-> Maybe (EpaLocation, RdrName)
-> EP w m (NameAdornment, Maybe (EpaLocation, RdrName))
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment
-> Maybe (EpaLocation, RdrName)
-> EP w m (NameAdornment, Maybe (EpaLocation, RdrName))
markName NameAdornment
a Maybe (EpaLocation, RdrName)
forall a. Maybe a
Nothing
          return (NameAnnOnly a' t)
        NameAnnRArrow Maybe (EpToken "(")
o TokRarrow
nl Maybe (EpToken ")")
c [TrailingAnn]
t -> do
          o' <- (EpToken "("
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "("))
-> Maybe (EpToken "(")
-> RWST
     (EPOptions m w) (EPWriter w) EPState m (Maybe (EpToken "("))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM EpToken "("
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken Maybe (EpToken "(")
o
          nl' <- markEpUniToken nl
          c' <- mapM markEpToken c
          return (NameAnnRArrow o' nl' c' t)
        NameAnnQuote EpToken "'"
q SrcSpanAnnN
name [TrailingAnn]
t -> do
          String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"NameAnnQuote"
          q' <- EpToken "'" -> EP w m (EpToken "'")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "'"
q
          (L name' _) <- markAnnotated (L name n)
          return (NameAnnQuote q' name' t)
        NameAnnTrailing [TrailingAnn]
t -> do
          _anc' <- EpaLocation -> RdrName -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> RdrName -> EP w m EpaLocation
printUnicode EpaLocation
anc RdrName
n
          return (NameAnnTrailing t)
    return (L (EpAnn anc ann' cs) n)


markNameAdornmentO :: (Monad m, Monoid w) => NameAdornment -> EP w m NameAdornment
markNameAdornmentO :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment -> EP w m NameAdornment
markNameAdornmentO (NameParens EpToken "("
o EpToken ")"
c) = do
  o' <- EpToken "(" -> EP w m (EpToken "(")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "("
o
  return (NameParens o' c)
markNameAdornmentO (NameParensHash EpToken "(#"
o EpToken "#)"
c) = do
  o' <- EpToken "(#" -> EP w m (EpToken "(#")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "(#"
o
  return (NameParensHash o' c)
markNameAdornmentO (NameBackquotes EpToken "`"
o EpToken "`"
c) = do
  o' <- EpToken "`" -> EP w m (EpToken "`")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "`"
o
  return (NameBackquotes o' c)
markNameAdornmentO (NameSquare EpToken "["
o EpToken "]"
c) = do
  o' <- EpToken "[" -> EP w m (EpToken "[")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "["
o
  return (NameSquare o' c)
markNameAdornmentO NameAdornment
NameNoAdornment      = NameAdornment
-> RWST (EPOptions m w) (EPWriter w) EPState m NameAdornment
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return NameAdornment
NameNoAdornment

markNameAdornmentC :: (Monad m, Monoid w) => NameAdornment -> EP w m NameAdornment
markNameAdornmentC :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment -> EP w m NameAdornment
markNameAdornmentC (NameParens EpToken "("
o EpToken ")"
c) = do
  c' <- EpToken ")" -> EP w m (EpToken ")")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken ")"
c
  return (NameParens o c')
markNameAdornmentC (NameParensHash EpToken "(#"
o EpToken "#)"
c) = do
  c' <- EpToken "#)" -> EP w m (EpToken "#)")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "#)"
c
  return (NameParensHash o c')
markNameAdornmentC (NameBackquotes EpToken "`"
o EpToken "`"
c) = do
  c' <- EpToken "`" -> EP w m (EpToken "`")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "`"
c
  return (NameBackquotes o c')
markNameAdornmentC (NameSquare EpToken "["
o EpToken "]"
c) = do
  c' <- EpToken "]" -> EP w m (EpToken "]")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "]"
c
  return (NameSquare o c')
markNameAdornmentC NameAdornment
NameNoAdornment      = NameAdornment
-> RWST (EPOptions m w) (EPWriter w) EPState m NameAdornment
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return NameAdornment
NameNoAdornment

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


markName :: (Monad m, Monoid w)
  => NameAdornment -> Maybe (EpaLocation,RdrName)
  -> EP w m (NameAdornment, Maybe (EpaLocation,RdrName))
markName :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment
-> Maybe (EpaLocation, RdrName)
-> EP w m (NameAdornment, Maybe (EpaLocation, RdrName))
markName NameAdornment
adorn Maybe (EpaLocation, RdrName)
mname = do
  adorn0 <- NameAdornment -> EP w m NameAdornment
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
NameAdornment -> EP w m NameAdornment
markNameAdornmentO NameAdornment
adorn
  mname' <-
    case mname of
      Maybe (EpaLocation, RdrName)
Nothing -> Maybe (EpaLocation, RdrName)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (Maybe (EpaLocation, RdrName))
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EpaLocation, RdrName)
forall a. Maybe a
Nothing
      Just (EpaLocation
name, RdrName
a) -> do
        name' <- CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
printStringAtAAC CaptureComments
CaptureComments EpaLocation
name (RdrName -> String
forall a. Outputable a => a -> String
showPprUnsafe RdrName
a)
        return (Just (name',a))
  adorn1 <- markNameAdornmentC adorn0
  return (adorn1, mname')

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

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

-- based on pp_condecls in Decls.hs
exact_condecls :: (Monad m, Monoid w)
  => EpToken "=" -> [LConDecl GhcPs] -> EP w m (EpToken "=",[LConDecl GhcPs])
exact_condecls :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpToken "="
-> [LConDecl GhcPs] -> EP w m (EpToken "=", [LConDecl GhcPs])
exact_condecls EpToken "="
eq [LConDecl GhcPs]
cs
  | Bool
gadt_syntax                  -- In GADT syntax
  = do
      cs' <- (GenLocated SrcSpanAnnA (ConDecl GhcPs)
 -> RWST
      (EPOptions m w)
      (EPWriter w)
      EPState
      m
      (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
cs
      return (eq, cs')
  | Bool
otherwise                    -- In H98 syntax
  = do
      eq0 <- EpToken "=" -> EP w m (EpToken "=")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken EpToken "="
eq
      cs' <- mapM markAnnotated cs
      return (eq0, cs')
  where
    gadt_syntax :: Bool
gadt_syntax = case [LConDecl GhcPs]
cs of
      []                      -> Bool
False
      (L SrcSpanAnnA
_ ConDeclH98{}  : [LConDecl GhcPs]
_) -> Bool
False
      (L SrcSpanAnnA
_ ConDeclGADT{} : [LConDecl GhcPs]
_) -> Bool
True

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

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

-- based on pprConDecl
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
ConDecl GhcPs -> EP w m (ConDecl GhcPs)
exact (ConDeclH98 { con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_ext = AnnConDeclH98 TokForall
tforall EpToken "."
tdot TokDarrow
tdarrow
                    , con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = LIdP GhcPs
con
                    , con_forall :: forall pass. ConDecl pass -> Bool
con_forall = Bool
has_forall
                    , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity GhcPs]
ex_tvs
                    , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcPs)
mcxt
                    , con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details GhcPs
args
                    , con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_doc = Maybe (LHsDoc GhcPs)
doc }) = do
    tforall' <- if Bool
has_forall
      then TokForall -> EP w m TokForall
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken TokForall
tforall
      else TokForall -> EP w m TokForall
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return TokForall
tforall
    ex_tvs' <- mapM markAnnotated ex_tvs
    tdot' <- if has_forall
      then markEpToken tdot
      else return tdot
    mcxt' <- mapM markAnnotated mcxt
    tdarrow' <- if (isJust mcxt)
      then markEpUniToken tdarrow
      else return tdarrow

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

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

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

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
HsOuterTyVarBndrs flag GhcPs
-> EP w m (HsOuterTyVarBndrs flag GhcPs)
exact b :: HsOuterTyVarBndrs flag GhcPs
b@(HsOuterImplicit XHsOuterImplicit GhcPs
_) = HsOuterTyVarBndrs flag GhcPs
-> RWST
     (EPOptions m w)
     (EPWriter w)
     EPState
     m
     (HsOuterTyVarBndrs flag GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsOuterTyVarBndrs flag GhcPs
b
  exact (HsOuterExplicit (EpAnn EpaLocation
l (TokForall
f,EpToken "."
d) EpAnnComments
cs) [LHsTyVarBndr flag (NoGhcTc GhcPs)]
bndrs) = do
    f' <- TokForall -> EP w m TokForall
forall (m :: * -> *) w (tok :: Symbol) (utok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok) =>
EpUniToken tok utok -> EP w m (EpUniToken tok utok)
markEpUniToken TokForall
f
    bndrs' <- markAnnotated bndrs
    d' <- markEpToken d
    return (HsOuterExplicit (EpAnn l (f',d') cs) bndrs')

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

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

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

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated SrcSpanAnnP CType
-> EP w m (GenLocated SrcSpanAnnP CType)
exact (L (EpAnn EpaLocation
l (AnnPragma EpaLocation
o EpToken "#-}"
c (EpToken "[", EpToken "]")
s EpaLocation
l1 EpaLocation
l2 EpToken "type"
t EpToken "module"
m) EpAnnComments
cs) (CType SourceText
stp Maybe Header
mh (SourceText
stct,FastString
ct))) = do
    o' <- EpaLocation -> SourceText -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> SourceText -> String -> EP w m EpaLocation
markAnnOpen'' EpaLocation
o SourceText
stp String
"{-# CTYPE"
    l1' <- case mh of
             Maybe Header
Nothing -> EpaLocation -> EP w m EpaLocation
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpaLocation
l1
             Just (Header SourceText
srcH FastString
_h) ->
               EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
l1 (SourceText -> String -> ShowS
forall a. Show a => SourceText -> a -> ShowS
toSourceTextWithSuffix SourceText
srcH String
"" String
"")
    l2' <- printStringAtAA l2 (toSourceTextWithSuffix stct (unpackFS ct) "")
    c' <- markEpToken c
    return (L (EpAnn l (AnnPragma o' c' s l1' l2' t m) cs) (CType stp mh (stct,ct)))

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

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

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


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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)]
-> EP
     w m (GenLocated SrcSpanAnnLI [GenLocated SrcSpanAnnA (IE GhcPs)])
exact (L SrcSpanAnnLI
an [GenLocated SrcSpanAnnA (IE GhcPs)]
ies) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LIE"
    an0 <- SrcSpanAnnLI
-> Lens
     (AnnList (EpToken "hiding", [EpToken ","])) (EpToken "hiding")
-> (EpToken "hiding" -> EP w m (EpToken "hiding"))
-> EP w m SrcSpanAnnLI
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
EpAnn ann -> Lens ann t -> (t -> EP w m t) -> EP w m (EpAnn ann)
markLensFun' SrcSpanAnnLI
an (((EpToken "hiding", [EpToken ","])
 -> f (EpToken "hiding", [EpToken ","]))
-> AnnList (EpToken "hiding", [EpToken ","])
-> f (AnnList (EpToken "hiding", [EpToken ","]))
forall l (f :: * -> *).
Functor f =>
(l -> f l) -> AnnList l -> f (AnnList l)
lal_rest (((EpToken "hiding", [EpToken ","])
  -> f (EpToken "hiding", [EpToken ","]))
 -> AnnList (EpToken "hiding", [EpToken ","])
 -> f (AnnList (EpToken "hiding", [EpToken ","])))
-> ((EpToken "hiding" -> f (EpToken "hiding"))
    -> (EpToken "hiding", [EpToken ","])
    -> f (EpToken "hiding", [EpToken ","]))
-> (EpToken "hiding" -> f (EpToken "hiding"))
-> AnnList (EpToken "hiding", [EpToken ","])
-> f (AnnList (EpToken "hiding", [EpToken ","]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpToken "hiding" -> f (EpToken "hiding"))
-> (EpToken "hiding", [EpToken ","])
-> f (EpToken "hiding", [EpToken ","])
forall a b (f :: * -> *).
Functor f =>
(a -> f a) -> (a, b) -> f (a, b)
lfst) EpToken "hiding" -> EP w m (EpToken "hiding")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    p <- getPosP
    debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p
    (an1, ies') <- markAnnList an0 (markAnnotated (filter notIEDoc ies))
    return (L an1 ies')

instance (ExactPrint (Match GhcPs (LocatedA body)))
   => ExactPrint (LocatedLW [LocatedA (Match GhcPs (LocatedA body))]) where
  getAnnotationEntry :: LocatedLW [LocatedA (Match GhcPs (LocatedA body))] -> Entry
getAnnotationEntry = LocatedLW [LocatedA (Match GhcPs (LocatedA body))] -> Entry
forall ann a. HasTrailing ann => LocatedAn ann a -> Entry
entryFromLocatedA
  setAnnotationAnchor :: LocatedLW [LocatedA (Match GhcPs (LocatedA body))]
-> EpaLocation
-> [TrailingAnn]
-> EpAnnComments
-> LocatedLW [LocatedA (Match GhcPs (LocatedA body))]
setAnnotationAnchor = LocatedLW [LocatedA (Match GhcPs (LocatedA body))]
-> EpaLocation
-> [TrailingAnn]
-> EpAnnComments
-> LocatedLW [LocatedA (Match GhcPs (LocatedA body))]
forall an a.
HasTrailing an =>
LocatedAn an a
-> EpaLocation -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn
  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
LocatedLW [LocatedA (Match GhcPs (LocatedA body))]
-> EP w m (LocatedLW [LocatedA (Match GhcPs (LocatedA body))])
exact (L SrcSpanAnnLW
an [LocatedA (Match GhcPs (LocatedA body))]
a) = do
    String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"LocatedL [LMatch"
    -- TODO: markAnnList?
    an0 <- SrcSpanAnnLW
-> Lens (AnnList (EpToken "where")) (EpToken "where")
-> (EpToken "where" -> EP w m (EpToken "where"))
-> EP w m SrcSpanAnnLW
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
EpAnn ann -> Lens ann t -> (t -> EP w m t) -> EP w m (EpAnn ann)
markLensFun' SrcSpanAnnLW
an (EpToken "where" -> f (EpToken "where"))
-> AnnList (EpToken "where") -> f (AnnList (EpToken "where"))
forall l (f :: * -> *).
Functor f =>
(l -> f l) -> AnnList l -> f (AnnList l)
Lens (AnnList (EpToken "where")) (EpToken "where")
lal_rest EpToken "where" -> EP w m (EpToken "where")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken
    an1 <- markLensBracketsO an0 lal_brackets
    an2 <- markEpAnnAllLT an1 lal_semis
    a' <- markAnnotated a
    an3 <- markLensBracketsC an2 lal_brackets
    return (L an3 a')

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

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

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

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
IE GhcPs -> EP w m (IE GhcPs)
exact (IEVar XIEVar GhcPs
depr LIEWrappedName GhcPs
ln Maybe (LHsDoc GhcPs)
doc) = do
    depr' <- Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
XIEVar GhcPs
depr
    ln' <- markAnnotated ln
    doc' <- markAnnotated doc
    return (IEVar depr' ln' doc')
  exact (IEThingAbs XIEThingAbs GhcPs
depr LIEWrappedName GhcPs
thing Maybe (LHsDoc GhcPs)
doc) = do
    depr' <- Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
XIEThingAbs GhcPs
depr
    thing' <- markAnnotated thing
    doc' <- markAnnotated doc
    return (IEThingAbs depr' thing' doc')
  exact (IEThingAll (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
depr, (EpToken "("
op,EpToken ".."
dd,EpToken ")"
cp)) LIEWrappedName GhcPs
thing Maybe (LHsDoc GhcPs)
doc) = do
    depr' <- Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
depr
    thing' <- markAnnotated thing
    op' <- markEpToken op
    dd' <- markEpToken dd
    cp' <- markEpToken cp
    doc' <- markAnnotated doc
    return (IEThingAll (depr', (op',dd',cp')) thing' doc')

  exact (IEThingWith (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
depr, (EpToken "("
op,EpToken ".."
dd,EpToken ","
c,EpToken ")"
cp)) LIEWrappedName GhcPs
thing IEWildcard
wc [LIEWrappedName GhcPs]
withs Maybe (LHsDoc GhcPs)
doc) = do
    depr' <- Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
depr
    thing' <- markAnnotated thing
    op' <- markEpToken op
    (dd',c', wc', withs') <-
      case wc of
        IEWildcard
NoIEWildcard -> do
          withs'' <- [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
withs
          return (dd, c, wc, withs'')
        IEWildcard Int
pos -> do
          let ([GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
bs, [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
as) = Int
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> ([GenLocated SrcSpanAnnA (IEWrappedName GhcPs)],
    [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
withs
          bs' <- [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
bs
          dd' <- markEpToken dd
          c' <- markEpToken c
          as' <- markAnnotated as
          return (dd',c', wc, bs'++as')
    cp' <- markEpToken cp
    doc' <- markAnnotated doc
    return (IEThingWith (depr', (op',dd',c',cp')) thing' wc' withs' doc')

  exact (IEModuleContents (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
depr, EpToken "module"
an) XRec GhcPs ModuleName
m) = do
    depr' <- Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> EP w m (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs)))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
depr
    an0 <- markEpToken an
    m' <- markAnnotated m
    return (IEModuleContents (depr', an0) m')

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

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

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

  exact :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
IEWrappedName GhcPs -> EP w m (IEWrappedName GhcPs)
exact (IEName XIEName GhcPs
x LIdP GhcPs
n) = do
    n' <- LocatedN RdrName -> EP w m (LocatedN RdrName)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LIdP GhcPs
LocatedN RdrName
n
    return (IEName x n')
  exact (IEDefault XIEDefault GhcPs
r LIdP GhcPs
n) = do
    r' <- EpToken "default" -> EP w m (EpToken "default")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XIEDefault GhcPs
EpToken "default"
r
    n' <- markAnnotated n
    return (IEDefault r' n')
  exact (IEPattern XIEPattern GhcPs
r LIdP GhcPs
n) = do
    r' <- EpToken "pattern" -> EP w m (EpToken "pattern")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XIEPattern GhcPs
EpToken "pattern"
r
    n' <- markAnnotated n
    return (IEPattern r' n')
  exact (IEType XIEType GhcPs
r LIdP GhcPs
n) = do
    r' <- EpToken "type" -> EP w m (EpToken "type")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XIEType GhcPs
EpToken "type"
r
    n' <- markAnnotated n
    return (IEType r' n')

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

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

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

  exact (BangPat XBangPat GhcPs
an LPat GhcPs
pat) = do
    an0 <- EpToken "!" -> EP w m (EpToken "!")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XBangPat GhcPs
EpToken "!"
an
    pat' <- markAnnotated pat
    return (BangPat an0 pat')

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

  exact (TuplePat (EpaLocation
o,EpaLocation
c) [LPat GhcPs]
pats Boxity
boxity) = do
    o0 <- case Boxity
boxity of
             Boxity
Boxed   -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
o String
"("
             Boxity
Unboxed -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
o String
"(#"
    pats' <- markAnnotated pats
    c0 <- case boxity of
             Boxity
Boxed   -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
c String
")"
             Boxity
Unboxed -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
c String
"#)"
    return (TuplePat (o0,c0) pats' boxity)

  exact (SumPat XSumPat GhcPs
an LPat GhcPs
pat Int
alt Int
arity) = do
    an0 <- EpAnnSumPat
-> Lens EpAnnSumPat EpaLocation
-> (EpaLocation -> EP w m EpaLocation)
-> EP w m EpAnnSumPat
forall (m :: * -> *) w ann t.
(Monad m, Monoid w) =>
ann -> Lens ann t -> (t -> EP w m t) -> EP w m ann
markLensFun XSumPat GhcPs
EpAnnSumPat
an (((EpaLocation, EpaLocation) -> f (EpaLocation, EpaLocation))
-> EpAnnSumPat -> f EpAnnSumPat
Lens EpAnnSumPat (EpaLocation, EpaLocation)
lsumPatParens (((EpaLocation, EpaLocation) -> f (EpaLocation, EpaLocation))
 -> EpAnnSumPat -> f EpAnnSumPat)
-> ((EpaLocation -> f EpaLocation)
    -> (EpaLocation, EpaLocation) -> f (EpaLocation, EpaLocation))
-> (EpaLocation -> f EpaLocation)
-> EpAnnSumPat
-> f EpAnnSumPat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpaLocation -> f EpaLocation)
-> (EpaLocation, EpaLocation) -> f (EpaLocation, EpaLocation)
forall a b (f :: * -> *).
Functor f =>
(a -> f a) -> (a, b) -> f (a, b)
lfst) (\EpaLocation
loc -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
loc String
"(#")
    an1 <- markLensFun an0 lsumPatVbarsBefore (\[EpToken "|"]
locs -> (EpToken "|"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|"))
-> [EpToken "|"] -> EP w m [EpToken "|"]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken "|"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken [EpToken "|"]
locs)
    pat' <- markAnnotated pat
    an2 <- markLensFun an1 lsumPatVbarsAfter (\[EpToken "|"]
locs -> (EpToken "|"
 -> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|"))
-> [EpToken "|"] -> EP w m [EpToken "|"]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM EpToken "|"
-> RWST (EPOptions m w) (EPWriter w) EPState m (EpToken "|")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken [EpToken "|"]
locs)
    an3 <- markLensFun an2 (lsumPatParens . lsnd)  (\EpaLocation
loc -> EpaLocation -> String -> EP w m EpaLocation
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
EpaLocation -> String -> EP w m EpaLocation
printStringAtAA EpaLocation
loc String
"#)")
    return (SumPat an3 pat' alt arity)

  exact (OrPat XOrPat GhcPs
an NonEmpty (LPat GhcPs)
pats) = do
    pats' <- [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> EP w m [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LPat GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats)
    return (OrPat an (NE.fromList pats'))

  exact (ConPat XConPat GhcPs
an XRec GhcPs (ConLikeP GhcPs)
con HsConPatDetails GhcPs
details) = do
    (an', con', details') <- (Maybe (EpToken "{"), Maybe (EpToken "}"))
-> LocatedN RdrName
-> HsConPatDetails GhcPs
-> EP
     w
     m
     ((Maybe (EpToken "{"), Maybe (EpToken "}")), LocatedN RdrName,
      HsConPatDetails GhcPs)
forall (m :: * -> *) w con.
(Monad m, Monoid w, ExactPrint con) =>
(Maybe (EpToken "{"), Maybe (EpToken "}"))
-> con
-> HsConPatDetails GhcPs
-> EP
     w
     m
     ((Maybe (EpToken "{"), Maybe (EpToken "}")), con,
      HsConPatDetails GhcPs)
exactUserCon (Maybe (EpToken "{"), Maybe (EpToken "}"))
XConPat GhcPs
an XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con HsConPatDetails GhcPs
details
    return (ConPat an' con' details')
  exact (ViewPat XViewPat GhcPs
tokarr XRec GhcPs (HsExpr GhcPs)
expr LPat GhcPs
pat) = do
    expr' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
    an0 <- markEpUniToken tokarr
    pat' <- markAnnotated pat
    return (ViewPat an0 expr' pat')
  exact (SplicePat XSplicePat GhcPs
x HsUntypedSplice GhcPs
splice) = do
    splice' <- HsUntypedSplice GhcPs -> EP w m (HsUntypedSplice GhcPs)
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated HsUntypedSplice GhcPs
splice
    return (SplicePat x splice')
  exact p :: Pat GhcPs
p@(LitPat XLitPat GhcPs
_ HsLit GhcPs
lit) = String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance (HsLit GhcPs -> String
hsLit2String HsLit GhcPs
lit) RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m (Pat GhcPs)
-> RWST (EPOptions m w) (EPWriter w) EPState m (Pat GhcPs)
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pat GhcPs
-> RWST (EPOptions m w) (EPWriter w) EPState m (Pat GhcPs)
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pat GhcPs
p
  exact (NPat XNPat GhcPs
an XRec GhcPs (HsOverLit GhcPs)
ol Maybe (SyntaxExpr GhcPs)
mn SyntaxExpr GhcPs
z) = do
    an0 <- if (Maybe NoExtField -> Bool
forall a. Maybe a -> Bool
isJust Maybe NoExtField
Maybe (SyntaxExpr GhcPs)
mn)
      then EpToken "-" -> EP w m (EpToken "-")
forall (m :: * -> *) w (tok :: Symbol).
(Monad m, Monoid w, KnownSymbol tok) =>
EpToken tok -> EP w m (EpToken tok)
markEpToken XNPat GhcPs
EpToken "-"
an
      else EpToken "-" -> EP w m (EpToken "-")
forall a. a -> RWST (EPOptions m w) (EPWriter w) EPState m a
forall (m :: * -> *) a. Monad m => a -> m a
return XNPat GhcPs
EpToken "-"
an
    ol' <- markAnnotated ol
    return (NPat an0 ol' mn z)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

exactUserCon :: (Monad m, Monoid w, ExactPrint con)
  => (Maybe (EpToken "{"), Maybe (EpToken "}")) -> con -> HsConPatDetails GhcPs
  -> EP w m ((Maybe (EpToken "{"), Maybe (EpToken "}")), con, HsConPatDetails GhcPs)
exactUserCon :: forall (m :: * -> *) w con.
(Monad m, Monoid w, ExactPrint con) =>
(Maybe (EpToken "{"), Maybe (EpToken "}"))
-> con
-> HsConPatDetails GhcPs
-> EP
     w
     m
     ((Maybe (EpToken "{"), Maybe (EpToken "}")), con,
      HsConPatDetails GhcPs)
exactUserCon (Maybe (EpToken "{"), Maybe (EpToken "}"))
an con
c (InfixCon LPat GhcPs
p1 LPat GhcPs
p2) = do
  p1' <- GenLocated SrcSpanAnnA (Pat GhcPs)
-> EP w m (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p1
  c' <- markAnnotated c
  p2' <- markAnnotated p2
  return (an, c', InfixCon p1' p2')
exactUserCon (Maybe (EpToken "{")
open,Maybe (EpToken "}")
close) con
c HsConPatDetails GhcPs
details = do
  c' <- con -> EP w m con
forall (m :: * -> *) w a.
(Monad m, Monoid w, ExactPrint a) =>
a -> EP w m a
markAnnotated con
c
  open' <- mapM markEpToken open
  details' <- exactConArgs details
  close' <- mapM markEpToken close
  return ((open', close'), c', details')

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

printStringAdvance :: (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance :: forall (m :: * -> *) w. (Monad m, Monoid w) => String -> EP w m ()
printStringAdvance String
str = do
  ss <- EP w m RealSrcSpan
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m RealSrcSpan
getAnchorU
  _ <- printStringAtRs ss str
  return ()

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

newLine :: (Monad m, Monoid w) => EP w m ()
newLine :: forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m ()
newLine = do
    (l,_) <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    (ld,_) <- getPriorEndD
    printString False "\n"
    setPosP (l+1,1)
    setPriorEndNoLayoutD (ld+1,1)

padUntil :: (Monad m, Monoid w) => Pos -> EP w m ()
padUntil :: forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
padUntil (Int
l,Int
c) = do
    (l1,c1) <- EP w m Pos
forall (m :: * -> *) w. (Monad m, Monoid w) => EP w m Pos
getPosP
    if | l1 == l && c1 <= c -> printString False $ replicate (c - c1) ' '
       | l1 < l             -> newLine >> padUntil (l,c)
       | otherwise          -> return ()

printWhitespace :: (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace :: forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace = Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
padUntil

printCommentAt :: (Monad m, Monoid w) => Pos -> String -> EP w m ()
printCommentAt :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Pos -> String -> EP w m ()
printCommentAt Pos
p String
str = do
  String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> RWST (EPOptions m w) (EPWriter w) EPState m ())
-> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b. (a -> b) -> a -> b
$ String
"printCommentAt: (pos,str)" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pos, String) -> String
forall a. Show a => a -> String
show (Pos
p,String
str)
  Pos -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace Pos
p RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
-> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> String -> RWST (EPOptions m w) (EPWriter w) EPState m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
False String
str

printStringAt :: (Monad m, Monoid w) => Pos -> String -> EP w m ()
printStringAt :: forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Pos -> String -> EP w m ()
printStringAt Pos
p String
str = Pos -> EP w m ()
forall (m :: * -> *) w. (Monad m, Monoid w) => Pos -> EP w m ()
printWhitespace Pos
p EP w m () -> EP w m () -> EP w m ()
forall a b.
RWST (EPOptions m w) (EPWriter w) EPState m a
-> RWST (EPOptions m w) (EPWriter w) EPState m b
-> RWST (EPOptions m w) (EPWriter w) EPState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> String -> EP w m ()
forall (m :: * -> *) w.
(Monad m, Monoid w) =>
Bool -> String -> EP w m ()
printString Bool
True String
str