ghc-exactprint 1.2.0 → 1.3.0

raw patch · 49 files changed

+6382/−4119 lines, 49 filesdep ~ghcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc

API changes (from Hackage documentation)

Files

• ChangeLog +3/−0
• ghc-exactprint.cabal +3/−3
• src/Language/Haskell/GHC/ExactPrint.hs +3/−0
• src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs +5131/−3432
• src/Language/Haskell/GHC/ExactPrint/Lookup.hs +107/−110
• src/Language/Haskell/GHC/ExactPrint/Orphans.hs +108/−0
• src/Language/Haskell/GHC/ExactPrint/Parsers.hs +6/−6
• src/Language/Haskell/GHC/ExactPrint/Preprocess.hs +9/−9
• src/Language/Haskell/GHC/ExactPrint/Transform.hs +362/−59
• src/Language/Haskell/GHC/ExactPrint/Types.hs +6/−26
• src/Language/Haskell/GHC/ExactPrint/Utils.hs +159/−21
• tests/Test.hs +51/−142
• tests/Test/Common.hs +20/−38
• tests/Test/NoAnnotations.hs +1/−1
• tests/Test/Transform.hs +71/−69
• tests/examples/failing/TopLevelSemis.hs +0/−80
• tests/examples/failing/TopLevelSemis.hs.bad +0/−94
• tests/examples/failing/n-plus-k-patterns.hs +0/−11
• tests/examples/failing/n-plus-k-patterns.hs.bad +0/−11
• tests/examples/ghc710/Stmts.hs +9/−5
• tests/examples/ghc92/AdhocRule.hs +3/−0
• tests/examples/ghc92/BalanceComments1.hs +11/−0
• tests/examples/ghc92/CommentOrder.hs +7/−0
• tests/examples/ghc92/CommentPlacement3.hs +7/−0
• tests/examples/ghc92/ConPat.hs +5/−0
• tests/examples/ghc92/ConstructorComment.hs +7/−0
• tests/examples/ghc92/DataDecl.hs +9/−0
• tests/examples/ghc92/DependentStmt.hs +10/−0
• tests/examples/ghc92/Import.hs +10/−0
• tests/examples/ghc92/IndentedComments.hs +12/−0
• tests/examples/ghc92/LinePragmas.hs +7/−0
• tests/examples/ghc92/ListComments.hs +5/−0
• tests/examples/ghc92/Observer1.hs +10/−0
• tests/examples/ghc92/ParensGADT.hs +12/−0
• tests/examples/ghc92/PragmaSpans.hs +6/−0
• tests/examples/ghc92/Records.hs +14/−0
• tests/examples/ghc92/Records2.hs +14/−0
• tests/examples/ghc92/Retrie.hs +11/−0
• tests/examples/ghc92/RmDecl4.hs +9/−0
• tests/examples/ghc92/TH2.hs +8/−0
• tests/examples/ghc92/TH_reifyDecl1a.hs +12/−0
• tests/examples/ghc92/TopLevelSemis.hs +80/−0
• tests/examples/ghc92/TopLevelSemis1.hs +14/−0
• tests/examples/ghc92/TopLevelSemis2.hs +25/−0
• tests/examples/ghc92/TopLevelSemis3.hs +7/−0
• tests/examples/ghc92/TypeFamilies.hs +7/−0
• tests/examples/ghc92/n-plus-k-patterns.hs +11/−0
• tests/examples/transform/LocalDecls2.hs.expected +0/−2
• tests/examples/transform/RmDecl4.hs.expected +0/−0

@@ -1,3 +1,6 @@+2021-11-23 v1.3+	* Update for GHC 9.2.1 as released+	* Introduce makeDeltaAst command to convert all EpaSpan's to equivalent EpaDelta versions 2021-08-23 v1.2 	* Remove types and functions from previous version, now obsolete 2021-08-23 v1.1

@@ -1,5 +1,5 @@ name:                ghc-exactprint-version:             1.2.0+version:             1.3.0 synopsis:            ExactPrint for GHC description:         Using the API Annotations available from GHC 9.2.1, this                      library provides a means to round trip any code that can@@ -15,8 +15,7 @@ maintainer:          alan.zimm@gmail.com category:            Development build-type:          Simple--- tested-with:         GHC == 9.2.1-tested-with:         GHC == 9.2.0.20210821+tested-with:         GHC == 9.2.1 extra-source-files:  ChangeLog                      tests/examples/failing/*.hs                      tests/examples/ghc710-only/*.hs@@ -58,6 +57,7 @@   exposed-modules:     Language.Haskell.GHC.ExactPrint                      , Language.Haskell.GHC.ExactPrint.ExactPrint                      , Language.Haskell.GHC.ExactPrint.Lookup+                     , Language.Haskell.GHC.ExactPrint.Orphans                      , Language.Haskell.GHC.ExactPrint.Parsers                      , Language.Haskell.GHC.ExactPrint.Preprocess                      , Language.Haskell.GHC.ExactPrint.Transform

@@ -11,8 +11,11 @@         , module Language.Haskell.GHC.ExactPrint.Transform          -- * Printing+        , ExactPrint(..)         , exactPrint +        -- * Relativising+        , makeDeltaAst         ) where  import Language.Haskell.GHC.ExactPrint.ExactPrint

@@ -15,3438 +15,5137 @@   (     ExactPrint(..)   , exactPrint-  -- , exactPrintWithOptions-  ) where--import GHC-import GHC.Core.Coercion.Axiom (Role(..))-import GHC.Data.Bag-import qualified GHC.Data.BooleanFormula as BF-import GHC.Data.FastString-import GHC.Types.Basic hiding (EP)-import GHC.Types.Fixity-import GHC.Types.ForeignCall-import GHC.Types.SourceText-import GHC.Types.Var-import GHC.Utils.Outputable hiding ( (<>) )-import GHC.Unit.Module.Warnings-import GHC.Utils.Misc-import GHC.Utils.Panic--import Control.Monad.Identity-import Control.Monad.RWS-import Data.Data ( Data )-import Data.Foldable-import qualified Data.Set.Ordered as OSet-import Data.Typeable-import Data.List ( partition, sort, sortBy)-import Data.Maybe ( isJust )--import Data.Void--import Language.Haskell.GHC.ExactPrint.Lookup-import Language.Haskell.GHC.ExactPrint.Utils-import Language.Haskell.GHC.ExactPrint.Types---- import Debug.Trace---- -----------------------------------------------------------------------exactPrint :: ExactPrint ast => Located ast -> String-exactPrint ast = runIdentity (runEP stringOptions (markAnnotated ast))--type EP w m a = RWST (PrintOptions m w) (EPWriter w) EPState m a-type EPP a = EP String Identity a--runEP :: PrintOptions Identity String-      -> Annotated () -> Identity String-runEP epReader action =-  fmap (output . snd) .-    (\next -> execRWST next epReader defaultEPState)-    . xx $ action--xx :: Annotated () -> EP String Identity ()--- xx :: Annotated() -> RWST (PrintOptions m w) (EPWriter w) EPState m ()-xx = id---- -----------------------------------------------------------------------defaultEPState :: EPState-defaultEPState = EPState-             { epPos      = (1,1)-             , dLHS       = 0-             , pMarkLayout = False-             , pLHS = 0-             , dMarkLayout = False-             , dPriorEndPosition = (1,1)-             , uAnchorSpan = badRealSrcSpan-             , uExtraDP = Nothing-             , epComments = []-             }----- ------------------------------------------------------------------------ The EP monad and basic combinators---- | The R part of RWS. The environment. Updated via 'local' as we--- enter a new AST element, having a different anchor point.-data PrintOptions m a = PrintOptions-            {-              epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a-            , epTokenPrint :: String -> m a-            , epWhitespacePrint :: String -> m a-            , epRigidity :: Rigidity-            }---- | Helper to create a 'PrintOptions'-printOptions ::-      (forall ast . Data ast => GHC.Located ast -> a -> m a)-      -> (String -> m a)-      -> (String -> m a)-      -> Rigidity-      -> PrintOptions m a-printOptions astPrint tokenPrint wsPrint rigidity = PrintOptions-             {-               epAstPrint = astPrint-             , epWhitespacePrint = wsPrint-             , epTokenPrint = tokenPrint-             , epRigidity = rigidity-             }---- | Options which can be used to print as a normal String.-stringOptions :: PrintOptions Identity String-stringOptions = printOptions (\_ b -> return b) return return NormalLayout--data EPWriter a = EPWriter-              { output :: !a }--instance Monoid w => Semigroup (EPWriter w) where-  (EPWriter a) <> (EPWriter b) = EPWriter (a <> b)--instance Monoid w => Monoid (EPWriter w) where-  mempty = EPWriter mempty--data EPState = EPState-             { uAnchorSpan :: !RealSrcSpan -- ^ in pre-changed AST-                                          -- reference frame, from-                                          -- Annotation-             , uExtraDP :: !(Maybe Anchor) -- ^ Used to anchor a-                                             -- list--             -- Print phase-             , epPos        :: !Pos -- ^ Current output position-             , pMarkLayout  :: !Bool-             , pLHS   :: !LayoutStartCol--             -- Delta phase-             , dPriorEndPosition :: !Pos -- ^ End of Position reached-                                         -- when processing the-                                         -- preceding element-             , dMarkLayout :: !Bool-             , dLHS        :: !LayoutStartCol--             -- Shared-             , epComments :: ![Comment]-             }---- ------------------------------------------------------------------------- AZ:TODO: this can just be a function :: (EpAnn a) -> Entry-class HasEntry ast where-  fromAnn :: ast -> Entry---- ------------------------------------------------------------------------- type Annotated = FreeT AnnotationF Identity-type Annotated a = EP String Identity a---- ------------------------------------------------------------------------- | Key entry point.  Switches to an independent AST element with its--- own annotation, calculating new offsets, etc-markAnnotated :: ExactPrint a => a -> Annotated ()-markAnnotated a = enterAnn (getAnnotationEntry 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 (Eq, Show)--data Entry = Entry Anchor EpAnnComments FlushComments-           | NoEntryVal--instance HasEntry (SrcSpanAnn' (EpAnn an)) where-  fromAnn (SrcSpanAnn EpAnnNotUsed ss) = Entry (spanAsAnchor ss) emptyComments NoFlushComments-  fromAnn (SrcSpanAnn an _) = fromAnn an--instance HasEntry (EpAnn a) where-  fromAnn (EpAnn anchor _ cs) = Entry anchor cs NoFlushComments-  fromAnn EpAnnNotUsed = NoEntryVal---- -----------------------------------------------------------------------fromAnn' :: (HasEntry a) => a -> Entry-fromAnn' an = case fromAnn an of-  NoEntryVal -> NoEntryVal-  Entry a c _ -> Entry a c FlushComments---- -----------------------------------------------------------------------astId :: (Typeable a) => a -> String-astId a = show (typeOf a)---- | "Enter" an annotation, by using the associated 'anchor' field as--- the new reference point for calculating all DeltaPos positions.------ This is combination of the ghc=exactprint Delta.withAST and--- Print.exactPC functions and effectively does the delta processing--- immediately followed by the print processing.  JIT ghc-exactprint.-enterAnn :: (ExactPrint a) => Entry -> a -> Annotated ()-enterAnn NoEntryVal a = do-  p <- getPosP-  debugM $ "enterAnn:NO ANN:(p,a) =" ++ show (p, astId a) ++ " starting"-  exact a-  debugM $ "enterAnn:NO ANN:p =" ++ show (p, astId a) ++ " done"-enterAnn (Entry anchor' cs flush) a = do-  p <- getPosP-  debugM $ "enterAnn:(p,a) =" ++ show (p, astId a) ++ " starting"-  -- debugM $ "enterAnn:(cs) =" ++ showGhc (cs)-  let curAnchor = anchor anchor' -- As a base for the current AST element-  debugM $ "enterAnn:(curAnchor):=" ++ show (rs2range curAnchor)-  addCommentsA (priorComments cs)-  printComments curAnchor-  -- --------------------------  case anchor_op anchor' of-    MovedAnchor dp -> do-      debugM $ "enterAnn: MovedAnchor:" ++ show dp-      -- Set the original anchor as prior end, so the rest of this AST-      -- fragment has a reference-      -- BUT: this means the entry DP can be calculated incorrectly too,-      -- for immediately nested items.-      setPriorEndNoLayoutD (ss2pos curAnchor)-    _ -> do-      return ()-  -- --------------------------  setAnchorU curAnchor-  -- --------------------------------------------------------------------  -- The first part corresponds to the delta phase, so should only use-  -- delta phase variables-  -- ------------------------------------  -- Calculate offset required to get to the start of the SrcSPan-  off <- gets dLHS-  let spanStart = ss2pos curAnchor-  priorEndAfterComments <- getPriorEndD-  let edp' = adjustDeltaForOffset 0-               -- Use the propagated offset if one is set-               -- Note that we need to use the new offset if it has-               -- changed.-               off (ss2delta priorEndAfterComments curAnchor)-  debugM $ "enterAnn: (edp',off,priorEndAfterComments,curAnchor):" ++ show (edp',off,priorEndAfterComments,rs2range curAnchor)-  let edp'' = case anchor_op anchor' of-        MovedAnchor dp -> dp-        _ -> edp'-  -- ----------------------------------------------  -- let edp = edp''-  med <- getExtraDP-  setExtraDP Nothing-  let edp = case med of-        Nothing -> edp''-        Just (Anchor _ (MovedAnchor dp)) -> dp-                   -- Replace original with desired one. Allows all-                   -- list entry values to be DP (1,0)-        Just (Anchor r _) -> dp-          where-            dp = adjustDeltaForOffset 0-                   off (ss2delta priorEndAfterComments r)-  when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ show (med,edp)-  -- ----------------------------------------------  -- Preparation complete, perform the action-  when (priorEndAfterComments < spanStart) (do-    debugM $ "enterAnn.dPriorEndPosition:spanStart=" ++ show spanStart-    modify (\s -> s { dPriorEndPosition    = spanStart } ))--  debugM $ "enterAnn: (anchor_op, curAnchor):" ++ show (anchor_op anchor', rs2range curAnchor)-  debugM $ "enterAnn: (dLHS,spanStart,pec,edp)=" ++ show (off,spanStart,priorEndAfterComments,edp)--  -- end of delta phase processing-  -- --------------------------------------------------------------------  -- start of print phase processing--  let mflush = when (flush == FlushComments) $ do-        debugM $ "flushing comments in enterAnn"-        flushComments (getFollowingComments cs)-        -- flushComments []--  -- let-  --   st = annNone-  -- withOffset st (advance edp >> exact a >> mflush)-  (advance edp >> exact a >> mflush)--  when (flush == NoFlushComments) $ do-    when ((getFollowingComments cs) /= []) $ do-      debugM $ "starting trailing comments:" ++ showAst (getFollowingComments cs)-      mapM_ printOneComment (map tokComment $ getFollowingComments cs)-      debugM $ "ending trailing comments"---- -----------------------------------------------------------------------addCommentsA :: [LEpaComment] -> EPP ()-addCommentsA csNew = addComments (map tokComment csNew)--addComments :: [Comment] -> EPP ()-addComments csNew = do-  debugM $ "addComments:" ++ show csNew-  cs <- getUnallocatedComments-  -- Make sure we merge duplicates while sorting, needed until-  -- https://gitlab.haskell.org/ghc/ghc/-/issues/20239 is resolved-  let ocs = OSet.fromList cs-  let ncs = OSet.fromList csNew-  putUnallocatedComments (OSet.toAscList (ocs OSet.<>| ncs))----- ------------------------------------------------------------------------- | Just before we print out the EOF comments, flush the remaining--- ones in the state.-flushComments :: [LEpaComment] -> EPP ()-flushComments trailing = do-  addCommentsA trailing-  cs <- getUnallocatedComments-  -- Must compare without span filenames, for CPP injected comments with fake filename-  let cmp (Comment _ l1 _) (Comment _ l2 _) = compare (ss2pos $ anchor l1) (ss2pos $ anchor l2)-  debugM $ "flushing comments starting"-  mapM_ printOneComment (sortBy cmp cs)-  debugM $ "flushing comments done"---- ------------------------------------------------------------------------- |In order to interleave annotations into the stream, we turn them into--- comments.-annotationsToComments :: [AddEpAnn] -> [AnnKeywordId] -> EPP ()-annotationsToComments ans kws = do-  let-    getSpans _ [] = []-    getSpans k1 (AddEpAnn k2 ss:as)-      | k1 == k2 = ss : getSpans k1 as-      | otherwise = getSpans k1 as-    doOne :: AnnKeywordId -> EPP [Comment]-    doOne kw = do-      let sps =getSpans kw ans-      return $ map (mkKWComment kw ) sps-    -- TODO:AZ make sure these are sorted/merged properly when the invariant for-    -- allocateComments is re-established.-  newComments <- mapM doOne kws-  addComments (concat newComments)--annotationsToCommentsA :: EpAnn [AddEpAnn] -> [AnnKeywordId] -> EPP ()-annotationsToCommentsA EpAnnNotUsed _ = return ()-annotationsToCommentsA an kws = annotationsToComments (anns an) kws---- ------------------------------------------------------------------------- Temporary function to simply reproduce the "normal" pretty printer output-withPpr :: (Outputable a) => a -> Annotated ()-withPpr a = do-  ss <- getAnchorU-  debugM $ "withPpr: ss=" ++ show ss-  printStringAtKw' ss (showPprUnsafe a)---- ------------------------------------------------------------------------ Modeled on Outputable---- | An AST fragment with an annotation must be able to return the--- requirements for nesting another one, captured in an 'Entry', and--- to be able to use the rest of the exactprint machinery to print the--- element.  In the analogy to Outputable, 'exact' plays the role of--- 'ppr'.-class (Typeable a) => ExactPrint a where-  getAnnotationEntry :: a -> Entry-  exact :: a -> Annotated ()---- ------------------------------------------------------------------------- | Bare Located elements are simply stripped off without further--- processing.-instance (ExactPrint a) => ExactPrint (Located a) where-  getAnnotationEntry (L l _) = Entry (spanAsAnchor l) emptyComments NoFlushComments-  exact (L _ a) = markAnnotated a--instance (ExactPrint a) => ExactPrint (LocatedA a) where-  getAnnotationEntry = entryFromLocatedA-  exact (L la a) = do-    debugM $ "LocatedA a:la loc=" ++ show (ss2range $ locA la)-    markAnnotated a-    markALocatedA (ann la)--instance (ExactPrint a) => ExactPrint [a] where-  getAnnotationEntry = const NoEntryVal-  exact ls = mapM_ markAnnotated ls--instance (ExactPrint a) => ExactPrint (Maybe a) where-  getAnnotationEntry = const NoEntryVal-  exact Nothing = return ()-  exact (Just a) = markAnnotated a---- ------------------------------------------------------------------------- | 'Located (HsModule GhcPs)' corresponds to 'ParsedSource'-instance ExactPrint HsModule where-  getAnnotationEntry hsmod = fromAnn' (hsmodAnn hsmod)--  exact hsmod@(HsModule EpAnnNotUsed _ _ _ _ _ _ _) = withPpr hsmod-  exact (HsModule an _lo mmn mexports imports decls mdeprec mbDoc) = do--    markAnnotated mbDoc--    case mmn of-      Nothing -> return ()-      Just (L ln mn) -> do-        markEpAnn' an am_main AnnModule-        markAnnotated (L ln mn)--        -- forM_ mdeprec markLocated-        setLayoutTopLevelP $ markAnnotated mdeprec--        setLayoutTopLevelP $ markAnnotated mexports--        debugM $ "HsModule.AnnWhere coming"-        setLayoutTopLevelP $ markEpAnn' an am_main AnnWhere--    markAnnList' False (am_decls $ anns an) $ do-      markTopLevelList imports-      markTopLevelList decls---- ------------------------------------------------------------------------- TODO:AZ: do we *need* the following, or can we capture it in the AST?--- | We can have a list with its own entry point defined. Create a--- data structure to capture this, for defining an ExactPrint instance-data AnnotatedList a = AnnotatedList (Maybe Anchor) a-                     deriving (Eq,Show)--instance (ExactPrint a) => ExactPrint (AnnotatedList a) where-  getAnnotationEntry (AnnotatedList (Just anc) _) = Entry anc (EpaComments []) NoFlushComments-  getAnnotationEntry (AnnotatedList Nothing    _) = NoEntryVal--  exact (AnnotatedList an ls) = do-    debugM $ "AnnotatedList:an=" ++ show an-    markAnnotatedWithLayout ls----- ------------------------------------------------------------------------ Start of utility functions--- -----------------------------------------------------------------------printSourceText :: SourceText -> String -> EPP ()-printSourceText NoSourceText txt   =  printStringAdvance txt-printSourceText (SourceText txt) _ =  printStringAdvance txt---- -----------------------------------------------------------------------printStringAtRs :: RealSrcSpan -> String -> EPP ()-printStringAtRs ss str = printStringAtKw' ss str--printStringAtSs :: SrcSpan -> String -> EPP ()-printStringAtSs ss str = printStringAtKw' (realSrcSpan ss) str---- ------------------------------------------------------------------------- AZ:TODO get rid of this-printStringAtMkw :: Maybe EpaLocation -> String -> EPP ()-printStringAtMkw (Just aa) s = printStringAtAA aa s-printStringAtMkw Nothing s = printStringAtLsDelta (SameLine 1) s---printStringAtAA :: EpaLocation -> String -> EPP ()-printStringAtAA (EpaSpan r) s = printStringAtKw' r s-printStringAtAA (EpaDelta d) s = do-  pe <- getPriorEndD-  p1 <- getPosP-  printStringAtLsDelta d s-  p2 <- getPosP-  debugM $ "printStringAtAA:(pe,p1,p2)=" ++ show (pe,p1,p2)-  setPriorEndASTPD True (p1,p2)---- Based on Delta.addAnnotationWorker-printStringAtKw' :: RealSrcSpan -> String -> EPP ()-printStringAtKw' pa str = do-  printComments pa-  pe <- getPriorEndD-  debugM $ "printStringAtKw':pe=" ++ show pe-  let p = ss2delta pe pa-  p' <- adjustDeltaForOffsetM p-  printStringAtLsDelta p' str-  setPriorEndASTD True pa---- -----------------------------------------------------------------------markExternalSourceText :: SrcSpan -> SourceText -> String -> EPP ()-markExternalSourceText l NoSourceText txt   = printStringAtKw' (realSrcSpan l) txt-markExternalSourceText l (SourceText txt) _ = printStringAtKw' (realSrcSpan l) txt---- -----------------------------------------------------------------------markAddEpAnn :: AddEpAnn -> EPP ()-markAddEpAnn a@(AddEpAnn kw _) = mark [a] kw--markLocatedMAA :: EpAnn a -> (a -> Maybe AddEpAnn) -> EPP ()-markLocatedMAA EpAnnNotUsed  _  = return ()-markLocatedMAA (EpAnn _ a _) f =-  case f a of-    Nothing -> return ()-    Just aa -> markAddEpAnn aa--markLocatedAA :: EpAnn a -> (a -> AddEpAnn) -> EPP ()-markLocatedAA EpAnnNotUsed  _  = return ()-markLocatedAA (EpAnn _ a _) f = markKw (f a)--markLocatedAAL :: EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> EPP ()-markLocatedAAL EpAnnNotUsed  _ _ = return ()-markLocatedAAL (EpAnn _ a _) f kw = go (f a)-  where-    go [] = return ()-    go (aa@(AddEpAnn kw' _):as)-      | kw' == kw = mark [aa] kw-      | otherwise = go as--markLocatedAALS :: EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Maybe String -> EPP ()-markLocatedAALS an f kw Nothing = markLocatedAAL an f kw-markLocatedAALS EpAnnNotUsed  _ _ _ = return ()-markLocatedAALS (EpAnn _ a _) f kw (Just str) = go (f a)-  where-    go [] = return ()-    go (AddEpAnn kw' r:as)-      | kw' == kw = printStringAtAA r str-      | otherwise = go as---- -----------------------------------------------------------------------markArrow :: EpAnn TrailingAnn -> HsArrow GhcPs -> EPP ()-markArrow an arr = do-  case arr of-    HsUnrestrictedArrow _u ->-      return ()-    HsLinearArrow _u ma -> do-      mapM_ markAddEpAnn ma-    HsExplicitMult _u ma t  -> do-      mapM_ markAddEpAnn ma-      markAnnotated t--  case an of-    EpAnnNotUsed -> pure ()-    _ -> markKwT (anns an)---- -----------------------------------------------------------------------markAnnCloseP :: EpAnn AnnPragma -> EPP ()-markAnnCloseP an = markLocatedAALS an (pure . apr_close) AnnClose (Just "#-}")--markAnnOpenP :: EpAnn AnnPragma -> SourceText -> String -> EPP ()-markAnnOpenP an NoSourceText txt   = markLocatedAALS an (pure . apr_open) AnnOpen (Just txt)-markAnnOpenP an (SourceText txt) _ = markLocatedAALS an (pure . apr_open) AnnOpen (Just txt)--markAnnOpen :: EpAnn [AddEpAnn] -> SourceText -> String -> EPP ()-markAnnOpen an NoSourceText txt   = markLocatedAALS an id AnnOpen (Just txt)-markAnnOpen an (SourceText txt) _ = markLocatedAALS an id AnnOpen (Just txt)--markAnnOpen' :: Maybe EpaLocation -> SourceText -> String -> EPP ()-markAnnOpen' ms NoSourceText txt   = printStringAtMkw ms txt-markAnnOpen' ms (SourceText txt) _ = printStringAtMkw ms txt---- -----------------------------------------------------------------------markOpeningParen, markClosingParen :: EpAnn AnnParen -> EPP ()-markOpeningParen an = markParen an fst-markClosingParen an = markParen an snd--markParen :: EpAnn AnnParen -> (forall a. (a,a) -> a) -> EPP ()-markParen EpAnnNotUsed _ = return ()-markParen (EpAnn _ (AnnParen pt o c) _) f = markKwA (f $ kw pt) (f (o, c))-  where-    kw AnnParens       = (AnnOpenP,  AnnCloseP)-    kw AnnParensHash   = (AnnOpenPH, AnnClosePH)-    kw AnnParensSquare = (AnnOpenS, AnnCloseS)---markAnnKw :: EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> EPP ()-markAnnKw EpAnnNotUsed  _ _  = return ()-markAnnKw (EpAnn _ a _) f kw = markKwA kw (f a)--markAnnKwAll :: EpAnn a -> (a -> [EpaLocation]) -> AnnKeywordId -> EPP ()-markAnnKwAll EpAnnNotUsed  _ _  = return ()-markAnnKwAll (EpAnn _ a _) f kw = mapM_ (markKwA kw) (sort (f a))--markAnnKwM :: EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> EPP ()-markAnnKwM EpAnnNotUsed  _ _ = return ()-markAnnKwM (EpAnn _ a _) f kw = go (f a)-  where-    go Nothing = return ()-    go (Just s) = markKwA kw s--markALocatedA :: EpAnn AnnListItem -> EPP ()-markALocatedA EpAnnNotUsed  = return ()-markALocatedA (EpAnn _ a _) = markTrailing (lann_trailing a)--markEpAnn :: EpAnn [AddEpAnn] -> AnnKeywordId -> EPP ()-markEpAnn EpAnnNotUsed _ = return ()-markEpAnn (EpAnn _ a _) kw = mark a kw--markEpAnn' :: EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EPP ()-markEpAnn' EpAnnNotUsed _ _ = return ()-markEpAnn' (EpAnn _ a _) f kw = mark (f a) kw--markEpAnnAll :: EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EPP ()-markEpAnnAll EpAnnNotUsed _ _ = return ()-markEpAnnAll (EpAnn _ a _) f kw = mapM_ markKw (sort anns)-  where-    anns = filter (\(AddEpAnn ka _) -> ka == kw) (f a)--markAnnAll :: [AddEpAnn] -> AnnKeywordId -> EPP ()-markAnnAll a kw = mapM_ markKw (sort anns)-  where-    anns = filter (\(AddEpAnn ka _) -> ka == kw) a--mark :: [AddEpAnn] -> AnnKeywordId -> EPP ()-mark anns kw = do-  case find (\(AddEpAnn k _) -> k == kw) anns of-    Just aa -> markKw aa-    Nothing -> case find (\(AddEpAnn k _) -> k == (unicodeAnn kw)) anns of-      Just aau -> markKw aau-      Nothing -> return ()--markKwT :: TrailingAnn -> EPP ()-markKwT (AddSemiAnn ss)    = markKwA AnnSemi ss-markKwT (AddCommaAnn ss)   = markKwA AnnComma ss-markKwT (AddVbarAnn ss)    = markKwA AnnVbar ss-markKwT (AddRarrowAnn ss)  = markKwA AnnRarrow ss-markKwT (AddRarrowAnnU ss) = markKwA AnnRarrowU ss-markKwT (AddLollyAnnU ss)  = markKwA AnnLollyU ss--markKw :: AddEpAnn -> EPP ()-markKw (AddEpAnn kw ss) = markKwA kw ss---- | This should be the main driver of the process, managing comments-markKwA :: AnnKeywordId -> EpaLocation -> EPP ()-markKwA kw aa = printStringAtAA aa (keywordToString (G kw))---- -----------------------------------------------------------------------markAnnList :: Bool -> EpAnn AnnList -> EPP () -> EPP ()-markAnnList _ EpAnnNotUsed action = action-markAnnList reallyTrail (EpAnn _ ann _) action = markAnnList' reallyTrail ann action--markAnnList' :: Bool -> AnnList -> EPP () -> EPP ()-markAnnList' reallyTrail ann action = do-  p <- getPosP-  debugM $ "markAnnList : " ++ showPprUnsafe (p, ann)-  mapM_ markAddEpAnn (al_open ann)-  unless reallyTrail $ markTrailing (al_trailing ann) -- Only makes sense for HsModule.-  markAnnAll (sort $ al_rest ann) AnnSemi-  action-  mapM_ markAddEpAnn (al_close ann)-  debugM $ "markAnnList: calling markTrailing with:" ++ showPprUnsafe (al_trailing ann)-  when reallyTrail $ markTrailing (al_trailing ann) -- normal case---- -----------------------------------------------------------------------printComments :: RealSrcSpan -> EPP ()-printComments ss = do-  cs <- commentAllocation ss-  debugM $ "printComments: (ss): " ++ showPprUnsafe (rs2range ss)-  -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentAnchor cs)-  mapM_ printOneComment cs---- -----------------------------------------------------------------------printOneComment :: Comment -> EPP ()-printOneComment c@(Comment _str loc _mo) = do-  debugM $ "printOneComment:c=" ++ showGhc c-  dp <-case anchor_op loc of-    MovedAnchor dp -> return dp-    _ -> do-        pe <- getPriorEndD-        let dp = ss2delta pe (anchor loc)-        debugM $ "printOneComment:(dp,pe,anchor loc)=" ++ showGhc (dp,pe,ss2pos $ anchor loc)-        return dp-  dp'' <- adjustDeltaForOffsetM dp-  mep <- getExtraDP-  dp' <- case mep of-    Just (Anchor _ (MovedAnchor edp)) -> do-      debugM $ "printOneComment:edp=" ++ show edp-      return edp-    _ -> return dp''-  LayoutStartCol dOff <- gets dLHS-  debugM $ "printOneComment:(dp,dp',dp'',dOff)=" ++ showGhc (dp,dp',dp'',dOff)-  setPriorEndD (ss2posEnd (anchor loc))-  printQueuedComment (anchor loc) c dp'---- -----------------------------------------------------------------------commentAllocation :: RealSrcSpan -> EPP [Comment]-commentAllocation ss = do-  cs <- 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 _str loc _mo) -> (ss2pos $ anchor loc) <= (ss2pos ss)) cs-  putUnallocatedComments later-  -- debugM $ "commentAllocation:(ss,earlier,later)" ++ show (rs2range ss,earlier,later)-  return earlier---- ------------------------------------------------------------------------markAnnotatedWithLayout :: ExactPrint ast => ast -> EPP ()-markAnnotatedWithLayout a = setLayoutBoth $ markAnnotated a---- -----------------------------------------------------------------------markTopLevelList :: ExactPrint ast => [ast] -> EPP ()-markTopLevelList ls = mapM_ (\a -> setLayoutTopLevelP $ markAnnotated a) ls---- -----------------------------------------------------------------------instance ExactPrint ModuleName where-  getAnnotationEntry _ = NoEntryVal-  exact n = do-    debugM $ "ModuleName: " ++ showPprUnsafe n-    withPpr n---- -----------------------------------------------------------------------instance ExactPrint (LocatedP WarningTxt) where-  getAnnotationEntry = entryFromLocatedA-  exact (L (SrcSpanAnn an _) (WarningTxt (L _ src) ws)) = do-    markAnnOpenP an src "{-# WARNING"-    markLocatedAAL an apr_rest AnnOpenS-    markAnnotated ws-    markLocatedAAL an apr_rest AnnCloseS-    markAnnCloseP an--  exact (L (SrcSpanAnn an _) (DeprecatedTxt (L _ src) ws)) = do-    markAnnOpenP an src "{-# DEPRECATED"-    markLocatedAAL an apr_rest AnnOpenS-    markAnnotated ws-    markLocatedAAL an apr_rest AnnCloseS-    markAnnCloseP an---- -----------------------------------------------------------------------instance ExactPrint (ImportDecl GhcPs) where-  getAnnotationEntry idecl = fromAnn (ideclExt idecl)-  exact x@(ImportDecl EpAnnNotUsed _ _ _ _ _ _ _ _ _) = withPpr x-  exact (ImportDecl ann@(EpAnn _ an _) msrc (L lm modname) mpkg _src safeflag qualFlag _impl mAs hiding) = do--    markAnnKw ann importDeclAnnImport AnnImport--    -- "{-# SOURCE" and "#-}"-    case msrc of-      SourceText _txt -> do-        debugM $ "ImportDecl sourcetext"-        let mo = fmap fst $ importDeclAnnPragma an-        let mc = fmap snd $ importDeclAnnPragma an-        markAnnOpen' mo msrc "{-# SOURCE"-        printStringAtMkw mc "#-}"-      NoSourceText -> return ()-    when safeflag (markAnnKwM ann importDeclAnnSafe AnnSafe)-    case qualFlag of-      QualifiedPre  -- 'qualified' appears in prepositive position.-        -> printStringAtMkw (importDeclAnnQualified an) "qualified"-      _ -> return ()-    case mpkg of-     Just (StringLiteral src v _) ->-       printStringAtMkw (importDeclAnnPackage an) (sourceTextToString src (show v))-     _ -> return ()--    printStringAtKw' (realSrcSpan lm) (moduleNameString modname)--    case qualFlag of-      QualifiedPost  -- 'qualified' appears in postpositive position.-        -> printStringAtMkw (importDeclAnnQualified an) "qualified"-      _ -> return ()--    case mAs of-      Nothing -> return ()-      Just (L l mn) -> do-        printStringAtMkw (importDeclAnnAs an) "as"-        printStringAtKw' (realSrcSpan l) (moduleNameString mn)--    case hiding of-      Nothing -> return ()-      Just (_isHiding,lie) -> markAnnotated lie- --   markTrailingSemi----- -----------------------------------------------------------------------instance ExactPrint HsDocString where-  getAnnotationEntry _ = NoEntryVal-  exact = withPpr -- TODO:AZ use annotations---- -----------------------------------------------------------------------instance ExactPrint (HsDecl GhcPs) where-  getAnnotationEntry (TyClD      _ _) = NoEntryVal-  getAnnotationEntry (InstD      _ _) = NoEntryVal-  getAnnotationEntry (DerivD     _ _) = NoEntryVal-  getAnnotationEntry (ValD       _ _) = NoEntryVal-  getAnnotationEntry (SigD       _ _) = NoEntryVal-  getAnnotationEntry (KindSigD   _ _) = NoEntryVal-  getAnnotationEntry (DefD       _ _) = NoEntryVal-  getAnnotationEntry (ForD       _ _) = NoEntryVal-  getAnnotationEntry (WarningD   _ _) = NoEntryVal-  getAnnotationEntry (AnnD       _ _) = NoEntryVal-  getAnnotationEntry (RuleD      _ _) = NoEntryVal-  getAnnotationEntry (SpliceD    _ _) = NoEntryVal-  getAnnotationEntry (DocD       _ _) = NoEntryVal-  getAnnotationEntry (RoleAnnotD _ _) = NoEntryVal--  exact (TyClD       _ d) = markAnnotated d-  exact (InstD       _ d) = markAnnotated d-  exact (DerivD      _ d) = markAnnotated d-  exact (ValD        _ d) = markAnnotated d-  exact (SigD        _ d) = markAnnotated d-  exact (KindSigD    _ d) = markAnnotated d-  exact (DefD        _ d) = markAnnotated d-  exact (ForD        _ d) = markAnnotated d-  exact (WarningD    _ d) = markAnnotated d-  exact (AnnD        _ d) = markAnnotated d-  exact (RuleD       _ d) = markAnnotated d-  exact (SpliceD     _ d) = markAnnotated d-  exact (DocD        _ d) = markAnnotated d-  exact (RoleAnnotD  _ d) = markAnnotated d---- -----------------------------------------------------------------------instance ExactPrint (InstDecl GhcPs) where-  getAnnotationEntry (ClsInstD     _  _) = NoEntryVal-  getAnnotationEntry (DataFamInstD an _) = fromAnn an-  getAnnotationEntry (TyFamInstD   _  _) = NoEntryVal---  exact (ClsInstD     _  cid) = markAnnotated cid-  exact (DataFamInstD an decl) = do-    exactDataFamInstDecl an TopLevel decl-  exact (TyFamInstD _ eqn) = do-    markAnnotated eqn---- -----------------------------------------------------------------------exactDataFamInstDecl :: EpAnn [AddEpAnn] -> TopLevelFlag -> (DataFamInstDecl GhcPs) -> EPP ()-exactDataFamInstDecl an top_lvl-  (DataFamInstDecl ( FamEqn { feqn_ext    = an2-                            , feqn_tycon  = tycon-                            , feqn_bndrs  = bndrs-                            , feqn_pats   = pats-                            , feqn_fixity = fixity-                            , feqn_rhs    = defn }))-  = markAnnotated (DataDefnWithContext an2 pp_hdr defn) -- See Note [an and an2 in exactDataFamInstDecl]-  where-    pp_hdr mctxt = do-      case top_lvl of-        TopLevel -> markEpAnn an AnnInstance -- TODO: maybe in toplevel-        NotTopLevel -> return ()-      exactHsFamInstLHS an tycon bndrs pats fixity mctxt--{--Note [an and an2 in exactDataFamInstDecl]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--The exactDataFamInstDecl function is called to render a-DataFamInstDecl within its surrounding context. This context is-rendered via the 'pp_hdr' function, which uses the exact print-annotations from that context, named 'an'.  The EPAs used for-rendering the DataDefn are contained in the FamEqn, and are called-'an2'.---}---- -----------------------------------------------------------------------instance ExactPrint (DerivDecl GhcPs) where-  getAnnotationEntry (DerivDecl {deriv_ext = an} ) = fromAnn an-  exact (DerivDecl an typ ms mov) = do-    markEpAnn an AnnDeriving-    mapM_ markAnnotated ms-    markEpAnn an AnnInstance-    mapM_ markAnnotated mov-    markAnnotated typ---- -----------------------------------------------------------------------instance ExactPrint (ForeignDecl GhcPs) where-  getAnnotationEntry (ForeignImport an _ _  _) = fromAnn an-  getAnnotationEntry (ForeignExport an _ _  _) = fromAnn an--  exact (ForeignImport an n ty fimport) = do-    markEpAnn an AnnForeign-    markEpAnn an AnnImport--    markAnnotated fimport--    markAnnotated n-    markEpAnn an AnnDcolon-    markAnnotated ty--  exact (ForeignExport an n ty fexport) = do-    markEpAnn an AnnForeign-    markEpAnn an AnnExport-    markAnnotated fexport-    markAnnotated n-    markEpAnn an AnnDcolon-    markAnnotated ty---- -----------------------------------------------------------------------instance ExactPrint ForeignImport where-  getAnnotationEntry = const NoEntryVal-  exact (CImport cconv safety@(L ll _) _mh _imp (L ls src)) = do-    markAnnotated cconv-    unless (ll == noSrcSpan) $ markAnnotated safety-    unless (ls == noSrcSpan) $ markExternalSourceText ls src ""---- -----------------------------------------------------------------------instance ExactPrint ForeignExport where-  getAnnotationEntry = const NoEntryVal-  exact (CExport spec (L ls src)) = do-    debugM $ "CExport starting"-    markAnnotated spec-    unless (ls == noSrcSpan) $ markExternalSourceText ls src ""---- -----------------------------------------------------------------------instance ExactPrint CExportSpec where-  getAnnotationEntry = const NoEntryVal-  exact (CExportStatic _st _lbl cconv) = do-    debugM $ "CExportStatic starting"-    markAnnotated cconv---- -----------------------------------------------------------------------instance ExactPrint Safety where-  getAnnotationEntry = const NoEntryVal-  exact = withPpr---- -----------------------------------------------------------------------instance ExactPrint CCallConv where-  getAnnotationEntry = const NoEntryVal-  exact = withPpr---- -----------------------------------------------------------------------instance ExactPrint (WarnDecls GhcPs) where-  getAnnotationEntry (Warnings an _ _) = fromAnn an-  exact (Warnings an src warns) = do-    markAnnOpen an src "{-# WARNING" -- Note: might be {-# DEPRECATED-    markAnnotated warns-    markLocatedAALS an id AnnClose (Just "#-}")---- -----------------------------------------------------------------------instance ExactPrint (WarnDecl GhcPs) where-  getAnnotationEntry (Warning an _ _) = fromAnn an--  exact (Warning an lns txt) = do-    markAnnotated lns-    markEpAnn an AnnOpenS -- "["-    case txt of-      WarningTxt    _src ls -> markAnnotated ls-      DeprecatedTxt _src ls -> markAnnotated ls-    markEpAnn an AnnCloseS -- "]"---- -----------------------------------------------------------------------instance ExactPrint StringLiteral where-  getAnnotationEntry = const NoEntryVal--  exact (StringLiteral src fs mcomma) = do-    printSourceText src (show (unpackFS fs))-    mapM_ (\r -> printStringAtKw' r ",") mcomma---- -----------------------------------------------------------------------instance ExactPrint FastString where-  getAnnotationEntry = const NoEntryVal--  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.-  -- exact fs = printStringAdvance (show (unpackFS fs))-  exact fs = printStringAdvance (unpackFS fs)----- -----------------------------------------------------------------------instance ExactPrint (RuleDecls GhcPs) where-  getAnnotationEntry (HsRules an _ _) = fromAnn an-  exact (HsRules an src rules) = do-    case src of-      NoSourceText      -> markLocatedAALS an id AnnOpen  (Just "{-# RULES")-      SourceText srcTxt -> markLocatedAALS an id AnnOpen  (Just srcTxt)-    markAnnotated rules-    markLocatedAALS an id AnnClose (Just "#-}")-    -- markTrailingSemi---- -----------------------------------------------------------------------instance ExactPrint (RuleDecl GhcPs) where-  getAnnotationEntry (HsRule {rd_ext = an}) = fromAnn an-  exact (HsRule an ln act mtybndrs termbndrs lhs rhs) = do-    debugM "HsRule entered"-    markAnnotated ln-    debugM "HsRule after ln"-    markActivation an ra_rest act-    debugM "HsRule after act"-    case mtybndrs of-      Nothing -> return ()-      Just bndrs -> do-        markLocatedMAA an (\a -> fmap fst (ra_tyanns a))  -- AnnForall-        mapM_ markAnnotated bndrs-        markLocatedMAA an (\a -> fmap snd (ra_tyanns a))  -- AnnDot--    markLocatedMAA an (\a -> fmap fst (ra_tmanns a))  -- AnnForall-    mapM_ markAnnotated termbndrs-    markLocatedMAA an (\a -> fmap snd (ra_tmanns a))  -- AnnDot--    markAnnotated lhs-    markEpAnn' an ra_rest AnnEqual-    markAnnotated rhs--markActivation :: EpAnn a -> (a -> [AddEpAnn]) -> Activation -> Annotated ()-markActivation an fn act = do-  case act of-    ActiveBefore src phase -> do-      markEpAnn' an fn AnnOpenS --  '['-      markEpAnn' an fn AnnTilde -- ~-      markLocatedAALS an fn AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))-      markEpAnn' an fn AnnCloseS -- ']'-    ActiveAfter src phase -> do-      markEpAnn' an fn AnnOpenS --  '['-      markLocatedAALS an fn AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))-      markEpAnn' an fn AnnCloseS -- ']'-    NeverActive -> do-      markEpAnn' an fn AnnOpenS --  '['-      markEpAnn' an fn AnnTilde -- ~-      markEpAnn' an fn AnnCloseS -- ']'-    _ -> return ()---- -----------------------------------------------------------------------instance ExactPrint (SpliceDecl GhcPs) where-  getAnnotationEntry = const NoEntryVal--  exact (SpliceDecl _ splice _flag) = do-    markAnnotated splice---- -----------------------------------------------------------------------instance ExactPrint DocDecl where-  getAnnotationEntry = const NoEntryVal--  exact v =-    let str =-          case v of-            (DocCommentNext ds)     -> unpackHDS ds-            (DocCommentPrev ds)     -> unpackHDS ds-            (DocCommentNamed _s ds) -> unpackHDS ds-            (DocGroup _i ds)        -> unpackHDS ds-    in-      printStringAdvance str---- -----------------------------------------------------------------------instance ExactPrint (RoleAnnotDecl GhcPs) where-  getAnnotationEntry (RoleAnnotDecl an _ _) = fromAnn an-  exact (RoleAnnotDecl an ltycon roles) = do-    markEpAnn an AnnType-    markEpAnn an AnnRole-    markAnnotated ltycon-    let markRole (L l (Just r)) = markAnnotated (L l r)-        markRole (L l Nothing) = printStringAtSs l "_"-    mapM_ markRole roles---- -----------------------------------------------------------------------instance ExactPrint Role where-  getAnnotationEntry = const NoEntryVal-  exact = withPpr---- -----------------------------------------------------------------------instance ExactPrint (RuleBndr GhcPs) where-  getAnnotationEntry = const NoEntryVal--  exact (RuleBndr _ ln) = markAnnotated ln-  exact (RuleBndrSig an ln (HsPS _ ty)) = do-    markEpAnn an AnnOpenP -- "("-    markAnnotated ln-    markEpAnn an AnnDcolon-    markAnnotated ty-    markEpAnn an AnnCloseP -- ")"---- -----------------------------------------------------------------------instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where-  getAnnotationEntry (FamEqn { feqn_ext = an}) = fromAnn an-  exact (FamEqn { feqn_ext = an-                , feqn_tycon  = tycon-                , feqn_bndrs  = bndrs-                , feqn_pats   = pats-                , feqn_fixity = fixity-                , feqn_rhs    = rhs }) = do-    exactHsFamInstLHS an tycon bndrs pats fixity Nothing-    markEpAnn an AnnEqual-    markAnnotated rhs---- -----------------------------------------------------------------------exactHsFamInstLHS ::-      EpAnn [AddEpAnn]-   -> LocatedN RdrName-   -> HsOuterTyVarBndrs () GhcPs-   -> HsTyPats GhcPs-   -> LexicalFixity-   -> Maybe (LHsContext GhcPs)-   -> EPP ()-exactHsFamInstLHS an thing bndrs typats fixity mb_ctxt = do-  markEpAnn an AnnForall-  markAnnotated bndrs-  markEpAnn an AnnDot-  mapM_ markAnnotated mb_ctxt-  exact_pats typats-  where-    exact_pats :: HsTyPats GhcPs -> EPP ()-    exact_pats (patl:patr:pats)-      | Infix <- fixity-      = let exact_op_app = do-              markAnnAll (epAnnAnns an) AnnOpenP-              markAnnotated patl-              markAnnotated thing-              markAnnotated patr-              markAnnAll (epAnnAnns an) AnnCloseP-        in case pats of-             [] -> exact_op_app-             _  -> do-               -- markEpAnn an AnnOpenP-               exact_op_app-               -- markEpAnn an AnnCloseP-               mapM_ markAnnotated pats--    exact_pats pats = do-      markAnnAll (epAnnAnns an) AnnOpenP-      markAnnotated thing-      markAnnotated pats-      markAnnAll (epAnnAnns an) AnnCloseP---- ------------------------------------------------------------------------- instance ExactPrint (LHsTypeArg GhcPs) where-instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)-     =>  ExactPrint (HsArg tm ty) where-  getAnnotationEntry = const NoEntryVal--  exact (HsValArg tm)    = markAnnotated tm-  exact (HsTypeArg ss ty) = printStringAtSs ss "@" >> markAnnotated ty-  exact x@(HsArgPar _sp)   = withPpr x -- Does not appear in original source---- -----------------------------------------------------------------------instance ExactPrint (ClsInstDecl GhcPs) where-  getAnnotationEntry cid = fromAnn (fst $ cid_ext cid)--  exact (ClsInstDecl { cid_ext = (an, sortKey)-                     , cid_poly_ty = inst_ty, cid_binds = binds-                     , cid_sigs = sigs, cid_tyfam_insts = ats-                     , cid_overlap_mode = mbOverlap-                     , cid_datafam_insts = adts })-      = do-          top_matter-          markEpAnn an AnnWhere-          markEpAnn an AnnOpenC-          markEpAnnAll an id AnnSemi-          withSortKey sortKey-                               (prepareListAnnotationA ats-                             ++ prepareListAnnotationF (exactDataFamInstDecl an NotTopLevel ) adts-                             ++ prepareListAnnotationA (bagToList binds)-                             ++ prepareListAnnotationA sigs-                               )-          markEpAnn an AnnCloseC -- '}'--      where-        top_matter = do-          markEpAnn an AnnInstance-          mapM_ markAnnotated mbOverlap-          markAnnotated inst_ty-          markEpAnn an AnnWhere -- Optional---- -----------------------------------------------------------------------instance ExactPrint (TyFamInstDecl GhcPs) where-  getAnnotationEntry (TyFamInstDecl an _) = fromAnn an--  exact (TyFamInstDecl { tfid_xtn = an, tfid_eqn = eqn }) = do-    markEpAnn an AnnType-    markEpAnn an AnnInstance-    markAnnotated eqn---- -----------------------------------------------------------------------instance ExactPrint (LocatedP OverlapMode) where-  getAnnotationEntry = entryFromLocatedA--  -- NOTE: NoOverlap is only used in the typechecker-  exact (L (SrcSpanAnn an _) (NoOverlap src)) = do-    markAnnOpenP an src "{-# NO_OVERLAP"-    markAnnCloseP an--  exact (L (SrcSpanAnn an _) (Overlappable src)) = do-    markAnnOpenP an src "{-# OVERLAPPABLE"-    markAnnCloseP an--  exact (L (SrcSpanAnn an _) (Overlapping src)) = do-    markAnnOpenP an src "{-# OVERLAPPING"-    markAnnCloseP an--  exact (L (SrcSpanAnn an _) (Overlaps src)) = do-    markAnnOpenP an src "{-# OVERLAPS"-    markAnnCloseP an--  exact (L (SrcSpanAnn an _) (Incoherent src)) = do-    markAnnOpenP an src "{-# INCOHERENT"-    markAnnCloseP an---- -----------------------------------------------------------------------instance ExactPrint (HsBind GhcPs) where-  getAnnotationEntry FunBind{} = NoEntryVal-  getAnnotationEntry PatBind{pat_ext=an} = fromAnn an-  getAnnotationEntry VarBind{} = NoEntryVal-  getAnnotationEntry AbsBinds{} = NoEntryVal-  getAnnotationEntry PatSynBind{} = NoEntryVal--  exact (FunBind _ _ matches _) = do-    markAnnotated matches-  exact (PatBind _ pat grhss _) = do-    markAnnotated pat-    markAnnotated grhss-  exact (PatSynBind _ bind) = markAnnotated bind--  exact x = error $ "HsBind: exact for " ++ showAst x---- -----------------------------------------------------------------------instance ExactPrint (PatSynBind GhcPs GhcPs) where-  getAnnotationEntry (PSB { psb_ext = an}) = fromAnn an--  exact (PSB{ psb_ext = an-            , psb_id = psyn, psb_args = details-            , psb_def = pat-            , psb_dir = dir }) = do-    markEpAnn an AnnPattern-    case details of-      InfixCon v1 v2 -> do-        markAnnotated v1-        markAnnotated psyn-        markAnnotated v2-      PrefixCon tvs vs -> do-        markAnnotated psyn-        markAnnotated tvs-        markAnnotated vs-      RecCon vs -> do-        markAnnotated psyn-        markEpAnn an AnnOpenC  -- '{'-        markAnnotated vs-        markEpAnn an AnnCloseC -- '}'--    case dir of-      Unidirectional           -> do-        markEpAnn an AnnLarrow-        markAnnotated pat-      ImplicitBidirectional    -> do-        markEpAnn an AnnEqual-        markAnnotated pat-      ExplicitBidirectional mg -> do-        markEpAnn an AnnLarrow-        markAnnotated pat-        markEpAnn an AnnWhere-        markAnnotated mg----- -----------------------------------------------------------------------instance ExactPrint (RecordPatSynField GhcPs) where-  getAnnotationEntry = const NoEntryVal-  exact (RecordPatSynField { recordPatSynField = v }) = markAnnotated v---- -----------------------------------------------------------------------instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where-  getAnnotationEntry (Match ann _ _ _) = fromAnn ann--  exact (Match an mctxt pats grhss) = do-    exactMatch (Match an mctxt pats grhss)---- ---------------------------------------instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where-  getAnnotationEntry (Match ann _ _ _) = fromAnn ann--  exact (Match an mctxt pats grhss) = do-    exactMatch (Match an mctxt pats grhss)---- -----------------------------------------------------------------------exactMatch :: (ExactPrint (GRHSs GhcPs body)) => (Match GhcPs body) -> Annotated ()-exactMatch (Match an mctxt pats grhss) = do--- Based on Expr.pprMatch--  debugM $ "exact Match entered"--  -- herald-  case mctxt of-    FunRhs fun fixity strictness -> do-      debugM $ "exact Match FunRhs:" ++ showPprUnsafe fun-      case strictness of-        SrcStrict -> markEpAnn an AnnBang-        _ -> pure ()-      case fixity of-        Prefix -> do-          annotationsToCommentsA an [AnnOpenP,AnnCloseP]-          markAnnotated fun-          markAnnotated pats-        Infix ->-          case pats of-            (p1:p2:rest)-              | null rest -> do-                  markAnnotated p1-                  markAnnotated fun-                  markAnnotated p2-              | otherwise -> do-                  markEpAnn an AnnOpenP-                  markAnnotated p1-                  markAnnotated fun-                  markAnnotated p2-                  markEpAnn an AnnCloseP-                  mapM_ markAnnotated rest-            _ -> panic "FunRhs"-    LambdaExpr -> do-      markEpAnn an AnnLam-      markAnnotated pats-    GHC.CaseAlt -> do-      markAnnotated pats-    _ -> withPpr mctxt--  markAnnotated grhss---- -----------------------------------------------------------------------instance ExactPrint (GRHSs GhcPs (LocatedA (HsExpr GhcPs))) where-  getAnnotationEntry (GRHSs _ _ _) = NoEntryVal--  exact (GRHSs _ grhss binds) = do-    markAnnotated grhss-    markAnnotated binds---instance ExactPrint (GRHSs GhcPs (LocatedA (HsCmd GhcPs))) where-  getAnnotationEntry (GRHSs _ _ _) = NoEntryVal--  exact (GRHSs _an grhss binds) = do-    markAnnotated grhss-    markAnnotated binds---- ------------------------------------------------------------------------- Temporary until https://gitlab.haskell.org/ghc/ghc/-/issues/20247--- is fixed-fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList-fixValbindsAnn EpAnnNotUsed = EpAnnNotUsed-fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs)-  = (EpAnn (widenAnchor anchor (map toEpaAnn t)) (AnnList ma o c r t) cs)-  where-    toEpaAnn (AddSemiAnn ss)    = AddEpAnn AnnSemi ss-    toEpaAnn (AddCommaAnn ss)   = AddEpAnn AnnComma ss-    toEpaAnn (AddVbarAnn ss)    = AddEpAnn AnnVbar ss-    toEpaAnn (AddRarrowAnn ss)  = AddEpAnn AnnRarrow ss-    toEpaAnn (AddRarrowAnnU ss) = AddEpAnn AnnRarrowU ss-    toEpaAnn (AddLollyAnnU ss)  = AddEpAnn AnnLollyU ss---- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256-fixAnnListAnn :: EpAnn AnnList -> EpAnn AnnList-fixAnnListAnn EpAnnNotUsed = EpAnnNotUsed-fixAnnListAnn (EpAnn anchor (AnnList ma o c r t) cs)-  = (EpAnn (widenAnchor anchor r) (AnnList ma o c r t) cs)---- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256-fixSrcAnnL :: SrcSpanAnnL -> SrcSpanAnnL-fixSrcAnnL (SrcSpanAnn an l) = SrcSpanAnn (fixAnnListAnn an) l---- -----------------------------------------------------------------------instance ExactPrint (HsLocalBinds GhcPs) where-  getAnnotationEntry (HsValBinds an _) = fromAnn (fixValbindsAnn an)-  getAnnotationEntry (HsIPBinds{}) = NoEntryVal-  getAnnotationEntry (EmptyLocalBinds{}) = NoEntryVal--  exact (HsValBinds an' valbinds) = do-    let an = fixValbindsAnn an'-    markLocatedAAL an al_rest AnnWhere-    let manc = case an of-                 EpAnnNotUsed -> Nothing-                 _ -> al_anchor $ anns an--    case manc of-      Just anc -> do-        when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc)-      _ -> return ()--    markAnnList False an $ markAnnotatedWithLayout valbinds--  exact (HsIPBinds an bs)-    = markAnnList True an (markLocatedAAL an al_rest AnnWhere >> markAnnotated bs)-  exact (EmptyLocalBinds _) = return ()----- ----------------------------------------------------------------------instance ExactPrint (HsValBindsLR GhcPs GhcPs) where-  getAnnotationEntry _ = NoEntryVal--  exact (ValBinds sortKey binds sigs) = do-    setLayoutBoth $ withSortKey sortKey-       (prepareListAnnotationA (bagToList binds)-     ++ prepareListAnnotationA sigs-       )-  exact (XValBindsLR _) = panic "XValBindsLR"---- -----------------------------------------------------------------------instance ExactPrint (HsIPBinds GhcPs) where-  getAnnotationEntry = const NoEntryVal--  exact (IPBinds _ binds) = setLayoutBoth $ markAnnotated binds---- -----------------------------------------------------------------------instance ExactPrint (IPBind GhcPs) where-  getAnnotationEntry (IPBind an _ _) = fromAnn an--  exact (IPBind an (Left lr) rhs) = do-    markAnnotated lr-    markEpAnn an AnnEqual-    markAnnotated rhs--  exact (IPBind _ (Right _) _) = error $ "ExactPrint IPBind: Right only after typechecker"---- -----------------------------------------------------------------------instance ExactPrint HsIPName where-  getAnnotationEntry = const NoEntryVal--  exact (HsIPName fs) = printStringAdvance ("?" ++ (unpackFS fs))---- ------------------------------------------------------------------------ Managing lists which have been separated, e.g. Sigs and Binds--prepareListAnnotationF :: (a -> EPP ()) -> [LocatedAn an a] -> [(RealSrcSpan,EPP ())]-prepareListAnnotationF f ls-  = map (\b -> (realSrcSpan $ getLocA b, f (unLoc b))) ls--prepareListAnnotationA :: ExactPrint (LocatedAn an a)-  => [LocatedAn an a] -> [(RealSrcSpan,EPP ())]-prepareListAnnotationA ls = map (\b -> (realSrcSpan $ getLocA b,markAnnotated b)) ls--withSortKey :: AnnSortKey -> [(RealSrcSpan, EPP ())] -> EPP ()-withSortKey annSortKey xs = do-  debugM $ "withSortKey:annSortKey=" ++ showAst annSortKey-  let ordered = case annSortKey of-                  NoAnnSortKey -> sortBy orderByFst xs-                  -- Just keys -> error $ "withSortKey: keys" ++ show keys-                  AnnSortKey keys -> orderByKey xs keys-                                -- `debug` ("withSortKey:" ++-                                --          showPprUnsafe (map fst (sortBy (comparing (flip elemIndex keys . fst)) xs),-                                --                  map fst xs,-                                --                  keys)-                                --          )-  mapM_ snd ordered--orderByFst :: Ord a => (a, b1) -> (a, b2) -> Ordering-orderByFst (a,_) (b,_) = compare a b---- -----------------------------------------------------------------------instance ExactPrint (Sig GhcPs) where-  getAnnotationEntry (TypeSig a _ _)  = fromAnn a-  getAnnotationEntry (PatSynSig a _ _) = fromAnn a-  getAnnotationEntry (ClassOpSig a _ _ _) = fromAnn a-  getAnnotationEntry (IdSig {}) = NoEntryVal-  getAnnotationEntry (FixSig a _) = fromAnn a-  getAnnotationEntry (InlineSig a _ _) = fromAnn a-  getAnnotationEntry (SpecSig a _ _ _) = fromAnn a-  getAnnotationEntry (SpecInstSig a _ _) = fromAnn a-  getAnnotationEntry (MinimalSig a _ _) = fromAnn a-  getAnnotationEntry (SCCFunSig a _ _ _) = fromAnn a-  getAnnotationEntry (CompleteMatchSig a _ _ _) = fromAnn a--  exact (TypeSig an vars ty)  = exactVarSig an vars ty--  exact (PatSynSig an lns typ) = do-    markLocatedAAL an asRest AnnPattern-    markAnnotated lns-    markLocatedAA an asDcolon-    markAnnotated typ--  exact (ClassOpSig an is_deflt vars ty)-    | is_deflt  = markLocatedAAL an asRest AnnDefault >> exactVarSig an vars ty-    | otherwise = exactVarSig an vars ty--  exact (FixSig an (FixitySig _ names (Fixity src v fdir))) = do-    let fixstr = case fdir of-         InfixL -> "infixl"-         InfixR -> "infixr"-         InfixN -> "infix"-    markLocatedAALS an id AnnInfix (Just fixstr)-    markLocatedAALS an id AnnVal (Just (sourceTextToString src (show v)))-    markAnnotated names---  exact (InlineSig an ln inl) = do-    markAnnOpen an (inl_src inl) "{-# INLINE"-    markActivation an id (inl_act inl)-    markAnnotated ln-    debugM $ "InlineSig:an=" ++ showAst an-    p <- getPosP-    debugM $ "InlineSig: p=" ++ show p-    markLocatedAALS an id AnnClose (Just "#-}")-    debugM $ "InlineSig:done"--  exact (SpecSig an ln typs inl) = do-    markAnnOpen an (inl_src inl) "{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE-    markActivation an id (inl_act inl)-    markAnnotated ln-    markEpAnn an AnnDcolon-    markAnnotated typs-    markLocatedAALS an id AnnClose (Just "#-}")--  exact (SpecInstSig an src typ) = do-    markAnnOpen an src "{-# SPECIALISE"-    markEpAnn an AnnInstance-    markAnnotated typ-    markLocatedAALS an id AnnClose (Just "#-}")---  exact (MinimalSig an src formula) = do-    markAnnOpen an src "{-# MINIMAL"-    markAnnotated formula-    markLocatedAALS an id AnnClose (Just "#-}")--  exact (SCCFunSig an src ln ml) = do-    markAnnOpen an src "{-# SCC"-    markAnnotated ln-    markAnnotated ml-    markLocatedAALS an id AnnClose (Just "#-}")--  exact (CompleteMatchSig an src cs mty) = do-    markAnnOpen an src "{-# COMPLETE"-    markAnnotated cs-    case mty of-      Nothing -> return ()-      Just ty -> do-        markEpAnn an AnnDcolon-        markAnnotated ty-    markLocatedAALS an id AnnClose (Just "#-}")--  exact x = error $ "exact Sig for:" ++ showAst x---- -----------------------------------------------------------------------exactVarSig :: (ExactPrint a) => EpAnn AnnSig -> [LocatedN RdrName] -> a -> EPP ()-exactVarSig an vars ty = do-  mapM_ markAnnotated vars-  markLocatedAA an asDcolon-  markAnnotated ty---- -----------------------------------------------------------------------instance ExactPrint (StandaloneKindSig GhcPs) where-  getAnnotationEntry (StandaloneKindSig an _ _) = fromAnn an--  exact (StandaloneKindSig an vars sig) = do-    markEpAnn an AnnType-    markAnnotated vars-    markEpAnn an AnnDcolon-    markAnnotated sig---- -----------------------------------------------------------------------instance ExactPrint (DefaultDecl GhcPs) where-  getAnnotationEntry (DefaultDecl an _) = fromAnn an--  exact (DefaultDecl an tys) = do-    markEpAnn an AnnDefault-    markEpAnn an AnnOpenP-    markAnnotated tys-    markEpAnn an AnnCloseP---- -----------------------------------------------------------------------instance ExactPrint (AnnDecl GhcPs) where-  getAnnotationEntry (HsAnnotation an _ _ _) = fromAnn an--  exact (HsAnnotation an src prov e) = do-    markAnnOpenP an src "{-# ANN"-    case prov of-      (ValueAnnProvenance n) -> markAnnotated n-      (TypeAnnProvenance n) -> do-        markLocatedAAL an apr_rest AnnType-        markAnnotated n-      ModuleAnnProvenance -> markLocatedAAL an apr_rest AnnModule--    markAnnotated e-    markAnnCloseP an---- -----------------------------------------------------------------------instance ExactPrint (BF.BooleanFormula (LocatedN RdrName)) where-  getAnnotationEntry = const NoEntryVal--  exact (BF.Var x)  = do-    markAnnotated x-  exact (BF.Or ls)  = markAnnotated ls-  exact (BF.And ls) = do-    markAnnotated ls-  exact (BF.Parens x)  = do-    markAnnotated x---- -----------------------------------------------------------------------instance (ExactPrint body) => ExactPrint (HsWildCardBndrs GhcPs body) where-  getAnnotationEntry = const NoEntryVal-  exact (HsWC _ ty) = markAnnotated ty---- -----------------------------------------------------------------------instance ExactPrint (GRHS GhcPs (LocatedA (HsExpr GhcPs))) where-  getAnnotationEntry (GRHS an _ _) = fromAnn an--  exact (GRHS an guards expr) = do-    debugM $ "GRHS comments:" ++ showGhc (comments an)-    markAnnKwM an ga_vbar AnnVbar-    markAnnotated guards-    debugM $ "GRHS before matchSeparator"-    markLocatedAA an ga_sep -- Mark the matchSeparator for these GRHSs-    debugM $ "GRHS after matchSeparator"-    markAnnotated expr--instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where-  getAnnotationEntry (GRHS ann _ _) = fromAnn ann--  exact (GRHS an guards expr) = do-    markAnnKwM an ga_vbar AnnVbar-    markAnnotated guards-    markLocatedAA an ga_sep -- Mark the matchSeparator for these GRHSs-    markAnnotated expr---- -----------------------------------------------------------------------instance ExactPrint (HsExpr GhcPs) where-  getAnnotationEntry (HsVar{})                    = NoEntryVal-  getAnnotationEntry (HsUnboundVar an _)          = fromAnn an-  getAnnotationEntry (HsConLikeOut{})             = NoEntryVal-  getAnnotationEntry (HsRecFld{})                 = NoEntryVal-  getAnnotationEntry (HsOverLabel an _)           = fromAnn an-  getAnnotationEntry (HsIPVar an _)               = fromAnn an-  getAnnotationEntry (HsOverLit an _)             = fromAnn an-  getAnnotationEntry (HsLit an _)                 = fromAnn an-  getAnnotationEntry (HsLam _ _)                  = NoEntryVal-  getAnnotationEntry (HsLamCase an _)             = fromAnn an-  getAnnotationEntry (HsApp an _ _)               = fromAnn an-  getAnnotationEntry (HsAppType _ _ _)            = NoEntryVal-  getAnnotationEntry (OpApp an _ _ _)             = fromAnn an-  getAnnotationEntry (NegApp an _ _)              = fromAnn an-  getAnnotationEntry (HsPar an _)                 = fromAnn an-  getAnnotationEntry (SectionL an _ _)            = fromAnn an-  getAnnotationEntry (SectionR an _ _)            = fromAnn an-  getAnnotationEntry (ExplicitTuple an _ _)       = fromAnn an-  getAnnotationEntry (ExplicitSum an _ _ _)       = fromAnn an-  getAnnotationEntry (HsCase an _ _)              = fromAnn an-  getAnnotationEntry (HsIf an _ _ _)              = fromAnn an-  getAnnotationEntry (HsMultiIf an _)             = fromAnn an-  getAnnotationEntry (HsLet an _ _)               = fromAnn an-  getAnnotationEntry (HsDo an _ _)                = fromAnn an-  getAnnotationEntry (ExplicitList an _)          = fromAnn an-  getAnnotationEntry (RecordCon an _ _)           = fromAnn an-  getAnnotationEntry (RecordUpd an _ _)           = fromAnn an-  getAnnotationEntry (HsGetField an _ _)          = fromAnn an-  getAnnotationEntry (HsProjection an _)          = fromAnn an-  getAnnotationEntry (ExprWithTySig an _ _)       = fromAnn an-  getAnnotationEntry (ArithSeq an _ _)            = fromAnn an-  getAnnotationEntry (HsBracket an _)             = fromAnn an-  getAnnotationEntry (HsRnBracketOut{})           = NoEntryVal-  getAnnotationEntry (HsTcBracketOut{})           = NoEntryVal-  getAnnotationEntry (HsSpliceE an _)             = fromAnn an-  getAnnotationEntry (HsProc an _ _)              = fromAnn an-  getAnnotationEntry (HsStatic an _)              = fromAnn an-  getAnnotationEntry (HsTick {})                  = NoEntryVal-  getAnnotationEntry (HsBinTick {})               = NoEntryVal-  getAnnotationEntry (HsPragE{})                  = NoEntryVal---  exact (HsVar _ n) = markAnnotated n-  exact x@(HsUnboundVar an _v) = do-    case an of-      EpAnnNotUsed -> withPpr x-      EpAnn _ (EpAnnUnboundVar (ob,cb) l) _ -> do-        printStringAtAA ob "`"-        printStringAtAA l  "_"-        printStringAtAA cb "`"-  -- exact x@(HsConLikeOut{})             = withPpr x-  -- exact x@(HsRecFld{})                 = withPpr x-  exact x@(HsOverLabel _ _) = withPpr x--  exact (HsIPVar _ (HsIPName n))-    = printStringAdvance ("?" ++ unpackFS n)--  exact x@(HsOverLit _an ol) = do-    let str = case ol_val ol of-                HsIntegral   (IL src _ _) -> src-                HsFractional (FL { fl_text = src }) -> src-                HsIsString src _          -> src-    -- markExternalSourceText l str ""-    case str of-      SourceText s -> printStringAdvance s-      NoSourceText -> withPpr x--  exact (HsLit _an lit) = withPpr lit-  exact (HsLam _ (MG _ (L _ [match]) _)) = do-    markAnnotated match-  exact (HsLam _ _) = error $ "HsLam with other than one match"--  exact (HsLamCase an mg) = do-    markEpAnn an AnnLam-    markEpAnn an AnnCase-    markAnnotated mg--  exact (HsApp _an e1 e2) = do-    p <- getPosP-    debugM $ "HsApp entered. p=" ++ show p-    markAnnotated e1-    markAnnotated e2-  exact (HsAppType ss fun arg) = do-    markAnnotated fun-    printStringAtSs ss "@"-    markAnnotated arg-  exact (OpApp _an e1 e2 e3) = do-    markAnnotated e1-    markAnnotated e2-    markAnnotated e3--  exact (NegApp an e _) = do-    markEpAnn an AnnMinus-    markAnnotated e--  exact (HsPar an e) = do-    markOpeningParen an-    markAnnotated e-    debugM $ "HsPar closing paren"-    markClosingParen an-    debugM $ "HsPar done"--  exact (SectionL _an expr op) = do-    markAnnotated expr-    markAnnotated op--  exact (SectionR _an op expr) = do-    markAnnotated op-    markAnnotated expr--  exact (ExplicitTuple an args b) = do-    if b == Boxed then markEpAnn an AnnOpenP-                  else markEpAnn an AnnOpenPH--    mapM_ markAnnotated args--    if b == Boxed then markEpAnn an AnnCloseP-                  else markEpAnn an AnnClosePH-    debugM $ "ExplicitTuple done"--  exact (ExplicitSum an _alt _arity expr) = do-    markAnnKw an aesOpen AnnOpenPH-    markAnnKwAll an aesBarsBefore AnnVbar-    markAnnotated expr-    markAnnKwAll an aesBarsAfter AnnVbar-    markAnnKw an aesClose AnnClosePH--  exact (HsCase an e alts) = do-    markAnnKw an hsCaseAnnCase AnnCase-    markAnnotated e-    markAnnKw an hsCaseAnnOf AnnOf-    markEpAnn' an hsCaseAnnsRest AnnOpenC-    markEpAnnAll an hsCaseAnnsRest AnnSemi-    setLayoutBoth $ markAnnotated alts-    markEpAnn' an hsCaseAnnsRest AnnCloseC--  exact (HsIf an e1 e2 e3) = do-    markAnnKw an aiIf AnnIf-    markAnnotated e1-    markAnnKwM an aiThenSemi AnnSemi-    markAnnKw an aiThen AnnThen-    markAnnotated e2-    markAnnKwM an aiElseSemi AnnSemi-    markAnnKw an aiElse AnnElse-    markAnnotated e3--  exact (HsMultiIf an mg) = do-    markEpAnn an AnnIf-    markEpAnn an AnnOpenC -- optional-    markAnnotated mg-    markEpAnn an AnnCloseC -- optional--  exact (HsLet an binds e) = do-    setLayoutBoth $ do -- Make sure the 'in' gets indented too-      markAnnKw an alLet AnnLet-      debugM $ "HSlet:binds coming"-      setLayoutBoth $ markAnnotated binds-      debugM $ "HSlet:binds done"-      markAnnKw an alIn AnnIn-      debugM $ "HSlet:expr coming"-      markAnnotated e--  exact (HsDo an do_or_list_comp stmts) = do-    debugM $ "HsDo"-    markAnnList True an $ exactDo an do_or_list_comp stmts--  exact (ExplicitList an es) = do-    debugM $ "ExplicitList start"-    markLocatedMAA an al_open-    markAnnotated es-    markLocatedMAA an al_close-    debugM $ "ExplicitList end"-  exact (RecordCon an con_id binds) = do-    markAnnotated con_id-    markEpAnn an AnnOpenC-    markAnnotated binds-    markEpAnn an AnnCloseC-  exact (RecordUpd an expr fields) = do-    markAnnotated expr-    markEpAnn an AnnOpenC-    markAnnotated fields-    markEpAnn an AnnCloseC-  exact (HsGetField _an expr field) = do-    markAnnotated expr-    markAnnotated field-  exact (HsProjection an flds) = do-    markAnnKw an apOpen AnnOpenP-    markAnnotated flds-    markAnnKw an apClose AnnCloseP-  exact (ExprWithTySig an expr sig) = do-    markAnnotated expr-    markEpAnn an AnnDcolon-    markAnnotated sig-  exact (ArithSeq an _ seqInfo) = do-    markEpAnn an AnnOpenS -- '['-    case seqInfo of-        From e -> do-          markAnnotated e-          markEpAnn an AnnDotdot-        FromTo e1 e2 -> do-          markAnnotated e1-          markEpAnn an AnnDotdot-          markAnnotated e2-        FromThen e1 e2 -> do-          markAnnotated e1-          markEpAnn an AnnComma-          markAnnotated e2-          markEpAnn an AnnDotdot-        FromThenTo e1 e2 e3 -> do-          markAnnotated e1-          markEpAnn an AnnComma-          markAnnotated e2-          markEpAnn an AnnDotdot-          markAnnotated e3-    markEpAnn an AnnCloseS -- ']'---  exact (HsBracket an (ExpBr _ e)) = do-    markEpAnn an AnnOpenEQ -- "[|"-    markEpAnn an AnnOpenE  -- "[e|" -- optional-    markAnnotated e-    markEpAnn an AnnCloseQ -- "|]"-  exact (HsBracket an (PatBr _ e)) = do-    markLocatedAALS an id AnnOpen (Just "[p|")-    markAnnotated e-    markEpAnn an AnnCloseQ -- "|]"-  exact (HsBracket an (DecBrL _ e)) = do--    markLocatedAALS an id AnnOpen (Just "[d|")-    -- See https://gitlab.haskell.org/ghc/ghc/-/issues/20257, we need-    -- to mark braces here for the time being-    markEpAnn an AnnOpenC -- "{"-    markAnnotated e-    markEpAnn an AnnCloseC -- "}"-    markEpAnn an AnnCloseQ -- "|]"-  -- -- exact (HsBracket an (DecBrG _ _)) =-  -- --   traceM "warning: DecBrG introduced after renamer"-  exact (HsBracket an (TypBr _ e)) = do-    markLocatedAALS an id AnnOpen (Just "[t|")-    markAnnotated e-    markEpAnn an AnnCloseQ -- "|]"-  exact (HsBracket an (VarBr _ b e)) = do-    if b-      then do-        markEpAnn an AnnSimpleQuote-        markAnnotated e-      else do-        markEpAnn an AnnThTyQuote-        markAnnotated e-  exact (HsBracket an (TExpBr _ e)) = do-    markLocatedAALS an id AnnOpen (Just "[||")-    markLocatedAALS an id AnnOpenE (Just "[e||")-    markAnnotated e-    markLocatedAALS an id AnnClose (Just "||]")---  -- exact x@(HsRnBracketOut{})           = withPpr x-  -- exact x@(HsTcBracketOut{})           = withPpr x-  exact (HsSpliceE _ sp) = markAnnotated sp--  exact (HsProc an p c) = do-    debugM $ "HsProc start"-    markEpAnn an AnnProc-    markAnnotated p-    markEpAnn an AnnRarrow-    debugM $ "HsProc after AnnRarrow"-    markAnnotated c--  exact (HsStatic an e) = do-    markEpAnn an AnnStatic-    markAnnotated e--  -- exact x@(HsTick {})                  = withPpr x-  -- exact x@(HsBinTick {})               = withPpr x-  exact (HsPragE _ prag e) = do-    markAnnotated prag-    markAnnotated e-  exact x = error $ "exact HsExpr for:" ++ showAst x---- -----------------------------------------------------------------------exactDo :: (ExactPrint body)-        => EpAnn AnnList -> (HsStmtContext any) -> body -> EPP ()-exactDo an (DoExpr m)    stmts = exactMdo an m AnnDo             >> markAnnotatedWithLayout stmts-exactDo an GhciStmtCtxt  stmts = markLocatedAAL an al_rest AnnDo >> markAnnotatedWithLayout stmts-exactDo an ArrowExpr     stmts = markLocatedAAL an al_rest AnnDo >> markAnnotatedWithLayout stmts-exactDo an (MDoExpr m)   stmts = exactMdo an m AnnMdo            >> markAnnotatedWithLayout stmts-exactDo _  ListComp      stmts = markAnnotatedWithLayout stmts-exactDo _  MonadComp     stmts = markAnnotatedWithLayout stmts-exactDo _  _             _     = panic "pprDo" -- PatGuard, ParStmtCxt--exactMdo :: EpAnn AnnList -> Maybe ModuleName -> AnnKeywordId -> EPP ()-exactMdo an Nothing            kw = markLocatedAAL  an al_rest kw-exactMdo an (Just module_name) kw = markLocatedAALS an al_rest kw (Just n)-    where-      n = (moduleNameString module_name) ++ "." ++ (keywordToString (G kw))----- ----------------------------------------------------------------------instance ExactPrint (HsPragE GhcPs) where-  getAnnotationEntry HsPragSCC{}  = NoEntryVal--  exact (HsPragSCC an st sl) = do-    markAnnOpenP an st "{-# SCC"-    let txt = sourceTextToString (sl_st sl) (unpackFS $ sl_fs sl)-    markLocatedAALS an apr_rest AnnVal    (Just txt) -- optional-    markLocatedAALS an apr_rest AnnValStr (Just txt) -- optional-    markAnnCloseP an----- -----------------------------------------------------------------------instance ExactPrint (HsSplice GhcPs) where-  getAnnotationEntry (HsTypedSplice an _ _ _)   = fromAnn an-  getAnnotationEntry (HsUntypedSplice an _ _ _) = fromAnn an-  getAnnotationEntry (HsQuasiQuote _ _ _ _ _)   = NoEntryVal-  getAnnotationEntry (HsSpliced _ _ _)          = NoEntryVal--  exact (HsTypedSplice an DollarSplice _n e) = do-    markEpAnn an AnnDollarDollar-    markAnnotated e--  exact (HsUntypedSplice an decoration _n b) = do-    when (decoration == DollarSplice) $ markEpAnn an AnnDollar-    markAnnotated b--  exact (HsQuasiQuote _ _ q ss fs) = do-    -- The quasiquote string does not honour layout offsets. Store-    -- the colOffset for now.-    -- TODO: use local?-    oldOffset <- 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-    p <- getPosP-    debugM $ "HsQuasiQuote:after:(p,ss)=" ++ show (p,ss2range ss)--  exact x = error $ "exact HsSplice for:" ++ showAst x---- ------------------------------------------------------------------------- TODO:AZ: combine these instances-instance ExactPrint (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where-  getAnnotationEntry = const NoEntryVal-  exact (MG _ matches _) = do-    -- TODO:AZ use SortKey, in MG ann.-    markAnnotated matches--instance ExactPrint (MatchGroup GhcPs (LocatedA (HsCmd GhcPs))) where-  getAnnotationEntry = const NoEntryVal-  exact (MG _ matches _) = do-    -- TODO:AZ use SortKey, in MG ann.-    markAnnotated matches---- -----------------------------------------------------------------------instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where-  getAnnotationEntry = const NoEntryVal-  exact (HsRecFields fields mdot) = do-    markAnnotated fields-    case mdot of-      Nothing -> return ()-      Just (L ss _) ->-        printStringAtSs ss ".."-      -- Note: mdot contains the SrcSpan where the ".." appears, if present---- -----------------------------------------------------------------------instance (ExactPrint body)-    => ExactPrint (HsRecField' (FieldOcc GhcPs) body) where-  getAnnotationEntry x = fromAnn (hsRecFieldAnn x)-  exact (HsRecField an f arg isPun) = do-    debugM $ "HsRecField"-    markAnnotated f-    if isPun then return ()-             else do-      markEpAnn an AnnEqual-      markAnnotated arg---- -----------------------------------------------------------------------instance (ExactPrint body)-    => ExactPrint (HsRecField' (FieldLabelStrings GhcPs) body) where-  getAnnotationEntry x = fromAnn (hsRecFieldAnn x)-  exact (HsRecField an f arg isPun) = do-    debugM $ "HsRecField FieldLabelStrings"-    markAnnotated f-    if isPun then return ()-             else do-      markEpAnn an AnnEqual-      markAnnotated arg---- -----------------------------------------------------------------------instance (ExactPrint (LocatedA body))-    => ExactPrint (HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body)) where-  getAnnotationEntry x = fromAnn (hsRecFieldAnn x)-  exact (HsRecField an f arg isPun) = do-    debugM $ "HsRecUpdField"-    markAnnotated f-    if isPun then return ()-             else markEpAnn an AnnEqual-    unless ((locA $ getLoc arg) == noSrcSpan ) $ markAnnotated arg---- ----------------------------------------------------------------------instance-    (ExactPrint (HsRecField' (a GhcPs) body),-     ExactPrint (HsRecField' (b GhcPs) body))-    => ExactPrint-         (Either [LocatedA (HsRecField' (a GhcPs) body)]-                 [LocatedA (HsRecField' (b GhcPs) body)]) where-  getAnnotationEntry = const NoEntryVal-  exact (Left rbinds) = markAnnotated rbinds-  exact (Right pbinds) = markAnnotated pbinds---- -----------------------------------------------------------------------instance ExactPrint (FieldLabelStrings GhcPs) where-  getAnnotationEntry = const NoEntryVal-  exact (FieldLabelStrings fs) = markAnnotated fs---- -----------------------------------------------------------------------instance ExactPrint (HsFieldLabel GhcPs) where-  getAnnotationEntry (HsFieldLabel an _) = fromAnn an--  exact (HsFieldLabel an fs) = do-    markAnnKwM an afDot  AnnDot-    markAnnotated fs---- -----------------------------------------------------------------------instance ExactPrint (HsTupArg GhcPs) where-  getAnnotationEntry (Present an _) = fromAnn an-  getAnnotationEntry (Missing an)   = fromAnn an--  exact (Present _ e) = markAnnotated e--  exact (Missing EpAnnNotUsed) = return ()-  exact (Missing _) = printStringAdvance ","---- -----------------------------------------------------------------------instance ExactPrint (HsCmdTop GhcPs) where-  getAnnotationEntry = const NoEntryVal-  exact (HsCmdTop _ cmd) = markAnnotated cmd---- -----------------------------------------------------------------------instance ExactPrint (HsCmd GhcPs) where-  getAnnotationEntry (HsCmdArrApp an _ _ _ _)   = fromAnn an-  getAnnotationEntry (HsCmdArrForm an _ _ _ _ ) = fromAnn an-  getAnnotationEntry (HsCmdApp an _ _ )         = fromAnn an-  getAnnotationEntry (HsCmdLam {})              = NoEntryVal-  getAnnotationEntry (HsCmdPar an _)            = fromAnn an-  getAnnotationEntry (HsCmdCase an _ _)         = fromAnn an-  getAnnotationEntry (HsCmdLamCase an _)        = fromAnn an-  getAnnotationEntry (HsCmdIf an _ _ _ _)       = fromAnn an-  getAnnotationEntry (HsCmdLet an _ _)          = fromAnn an-  getAnnotationEntry (HsCmdDo an _)             = fromAnn an----  exact (HsCmdArrApp an arr arg _o isRightToLeft) = do-    if isRightToLeft-      then do-        markAnnotated arr-        markKw (anns an)-        markAnnotated arg-      else do-        markAnnotated arg-        markKw (anns an)-        markAnnotated arr--  exact (HsCmdArrForm an e fixity _mf cs) = do-    markLocatedMAA an al_open-    case (fixity, cs) of-      (Infix, (arg1:argrest)) -> do-        markAnnotated arg1-        markAnnotated e-        markAnnotated argrest-      (Prefix, _) -> do-        markAnnotated e-        markAnnotated cs-      (Infix, []) -> error "Not possible"-    markLocatedMAA an al_close--  exact (HsCmdApp _an e1 e2) = do-    markAnnotated e1-    markAnnotated e2--  exact (HsCmdLam _ match) = markAnnotated match--  exact (HsCmdPar an e) = do-    markOpeningParen an-    markAnnotated e-    markClosingParen an--  exact (HsCmdCase an e alts) = do-    markAnnKw an hsCaseAnnCase AnnCase-    markAnnotated e-    markAnnKw an hsCaseAnnOf AnnOf-    markEpAnn' an hsCaseAnnsRest AnnOpenC-    markEpAnnAll an hsCaseAnnsRest AnnSemi-    markAnnotated alts-    markEpAnn' an hsCaseAnnsRest AnnCloseC--  exact (HsCmdLamCase an matches) = do-    markEpAnn an AnnLam-    markEpAnn an AnnCase-    markAnnotated matches--  exact (HsCmdIf an _ e1 e2 e3) = do-    markAnnKw an aiIf AnnIf-    markAnnotated e1-    markAnnKwM an aiThenSemi AnnSemi-    markAnnKw an aiThen AnnThen-    markAnnotated e2-    markAnnKwM an aiElseSemi AnnSemi-    markAnnKw an aiElse AnnElse-    markAnnotated e3--  exact (HsCmdLet an binds e) = do-    markAnnKw an alLet AnnLet-    markAnnotated binds-    markAnnKw an alIn AnnIn-    markAnnotated e--  exact (HsCmdDo an es) = do-    debugM $ "HsCmdDo"-    markEpAnn' an al_rest AnnDo-    markAnnotated es--  -- exact x = error $ "exact HsCmd for:" ++ showAst x---- -----------------------------------------------------------------------instance (-  ExactPrint (LocatedA (body GhcPs)),-                 Anno (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ~ SrcSpanAnnA,-           Anno [GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))] ~ SrcSpanAnnL,-           (ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))])))-   => ExactPrint (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) where-  getAnnotationEntry (LastStmt _ _ _ _)             = NoEntryVal-  getAnnotationEntry (BindStmt an _ _)              = fromAnn an-  getAnnotationEntry (ApplicativeStmt _ _ _)        = NoEntryVal-  getAnnotationEntry (BodyStmt _ _ _ _)             = NoEntryVal-  getAnnotationEntry (LetStmt an _)                 = fromAnn an-  getAnnotationEntry (ParStmt _ _ _ _)              = NoEntryVal-  getAnnotationEntry (TransStmt an _ _ _ _ _ _ _ _) = fromAnn an-  getAnnotationEntry (RecStmt an _ _ _ _ _ _)       = fromAnn an--  -------------------------------------------------------------------  exact (LastStmt _ body _ _) = do-    debugM $ "LastStmt"-    markAnnotated body--  exact (BindStmt an pat body) = do-    debugM $ "BindStmt"-    markAnnotated pat-    markEpAnn an AnnLarrow-    markAnnotated body--  exact (ApplicativeStmt _ _body _) = do-    debugM $ "ApplicativeStmt"-    -- TODO: ApplicativeStmt-    -- markAnnotated body-    error $ "need to complete ApplicativeStmt"--  exact (BodyStmt _ body _ _) = do-    debugM $ "BodyStmt"-    markAnnotated body--  exact (LetStmt an binds) = do-    debugM $ "LetStmt"-    markEpAnn an AnnLet-    markAnnotated binds--  exact (ParStmt _ pbs _ _) = do-    debugM $ "ParStmt"-    markAnnotated pbs---  exact (TransStmt an form stmts _b using by _ _ _) = do-    debugM $ "TransStmt"-    markAnnotated stmts-    exactTransStmt an by using form---  exact (RecStmt an stmts _ _ _ _ _) = do-    debugM $ "RecStmt"-    markLocatedAAL an al_rest AnnRec-    markAnnList True an (markAnnotated stmts)--  -- exact x = error $ "exact CmdLStmt for:" ++ showAst x-  -- exact x = error $ "exact CmdLStmt for:"----- -----------------------------------------------------------------------instance ExactPrint (ParStmtBlock GhcPs GhcPs) where-  getAnnotationEntry = const NoEntryVal-  exact (ParStmtBlock _ stmts _ _) = markAnnotated stmts--exactTransStmt :: EpAnn [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm -> EPP ()-exactTransStmt an by using ThenForm = do-  debugM $ "exactTransStmt:ThenForm"-  markEpAnn an AnnThen-  markAnnotated using-  case by of-    Nothing -> return ()-    Just b -> do-      markEpAnn an AnnBy-      markAnnotated b-exactTransStmt an by using GroupForm = do-  debugM $ "exactTransStmt:GroupForm"-  markEpAnn an AnnThen-  markEpAnn an AnnGroup-  case by of-    Just b -> do-      markEpAnn an AnnBy-      markAnnotated b-    Nothing -> return ()-  markEpAnn an AnnUsing-  markAnnotated using---- -----------------------------------------------------------------------instance ExactPrint (TyClDecl GhcPs) where-  getAnnotationEntry (FamDecl   { })                      = NoEntryVal-  getAnnotationEntry (SynDecl   { tcdSExt = an })         = fromAnn an-  getAnnotationEntry (DataDecl  { tcdDExt = an })         = fromAnn an-  getAnnotationEntry (ClassDecl { tcdCExt = (an, _, _) }) = fromAnn an--  exact (FamDecl _ decl) = do-    markAnnotated decl--  exact (SynDecl { tcdSExt = an-                 , tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity-                 , tcdRhs = 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-    annotationsToComments (epAnnAnns an) [AnnOpenP,AnnCloseP]-    markEpAnn an AnnType--    exactVanillaDeclHead ltycon tyvars fixity Nothing-    markEpAnn an AnnEqual-    markAnnotated rhs--  exact (DataDecl { tcdDExt = an, tcdLName = ltycon, tcdTyVars = tyvars-                  , tcdFixity = fixity, tcdDataDefn = defn }) =-    exactDataDefn an (exactVanillaDeclHead ltycon tyvars fixity) defn--  -- -------------------------------------  exact (ClassDecl {tcdCExt = (an, sortKey, _),-                    tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,-                    tcdFixity = fixity,-                    tcdFDs  = fds,-                    tcdSigs = sigs, tcdMeths = methods,-                    tcdATs = ats, tcdATDefs = at_defs,-                    tcdDocs = _docs})-      -- TODO: add a test that demonstrates tcdDocs-      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part-      = do-          top_matter-          markEpAnn an AnnOpenC-          markEpAnn an AnnCloseC--      | otherwise       -- Laid out-      = do-          top_matter-          markEpAnn an AnnOpenC-          markEpAnnAll an id AnnSemi-          withSortKey sortKey-                               (prepareListAnnotationA sigs-                             ++ prepareListAnnotationA (bagToList methods)-                             ++ prepareListAnnotationA ats-                             ++ prepareListAnnotationA at_defs-                             -- ++ prepareListAnnotation docs-                               )-          markEpAnn an AnnCloseC-      where-        top_matter = do-          annotationsToComments (epAnnAnns an)  [AnnOpenP, AnnCloseP]-          markEpAnn an AnnClass-          exactVanillaDeclHead lclas tyvars fixity context-          unless (null fds) $ do-            markEpAnn an AnnVbar-            markAnnotated fds-          markEpAnn an AnnWhere---- -----------------------------------------------------------------------instance ExactPrint (FunDep GhcPs) where-  getAnnotationEntry (FunDep an _ _) = fromAnn an--  exact (FunDep an ls rs') = do-    markAnnotated ls-    markEpAnn an AnnRarrow-    markAnnotated rs'---- -----------------------------------------------------------------------instance ExactPrint (FamilyDecl GhcPs) where-  getAnnotationEntry (FamilyDecl { fdExt = an }) = fromAnn an--  exact (FamilyDecl { fdExt = an-                    , fdInfo = info-                    , fdTopLevel = top_level-                    , fdLName = ltycon-                    , fdTyVars = tyvars-                    , fdFixity = fixity-                    , fdResultSig = L _ result-                    , fdInjectivityAnn = mb_inj }) = do-    -- = vcat [ pprFlavour info <+> pp_top_level <+>-    --          pp_vanilla_decl_head ltycon tyvars fixity Nothing <+>-    --          pp_kind <+> pp_inj <+> pp_where-    --        , nest 2 $ pp_eqns ]-    exactFlavour an info-    exact_top_level-    annotationsToCommentsA an [AnnOpenP,AnnCloseP]-    exactVanillaDeclHead ltycon tyvars fixity Nothing-    exact_kind-    case mb_inj of-      Nothing -> return ()-      Just inj -> do-        markEpAnn an AnnVbar-        markAnnotated inj-    case info of-      ClosedTypeFamily mb_eqns -> do-        markEpAnn an AnnWhere-        markEpAnn an AnnOpenC-        case mb_eqns of-          Nothing -> markEpAnn an AnnDotdot-          Just eqns -> markAnnotated eqns-        markEpAnn an AnnCloseC-      _ -> return ()-    where-      exact_top_level = case top_level of-                          TopLevel    -> markEpAnn an AnnFamily-                          NotTopLevel -> do-                            -- It seems that in some kind of legacy-                            -- mode the 'family' keyword is still-                            -- accepted.-                            markEpAnn an AnnFamily-                            return ()--      exact_kind = case result of-                     NoSig    _         -> return ()-                     KindSig  _ kind    -> markEpAnn an AnnDcolon >> markAnnotated kind-                     TyVarSig _ tv_bndr -> markEpAnn an AnnEqual >> markAnnotated tv_bndr---exactFlavour :: EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> EPP ()-exactFlavour an DataFamily            = markEpAnn an AnnData-exactFlavour an OpenTypeFamily        = markEpAnn an AnnType-exactFlavour an (ClosedTypeFamily {}) = markEpAnn an AnnType---- -----------------------------------------------------------------------data DataDefnWithContext-  = DataDefnWithContext-  { ddwc_an :: EpAnn [AddEpAnn]-  , ddwc_hdr:: (Maybe (LHsContext GhcPs) -> EPP ()) -- Printing the header-  , ddwc_defn:: HsDataDefn GhcPs-  }--instance ExactPrint DataDefnWithContext where-  getAnnotationEntry DataDefnWithContext{ddwc_an = an} = fromAnn an--  exact (DataDefnWithContext an exactHdr defn)-    = exactDataDefn an exactHdr defn--exactDataDefn :: EpAnn [AddEpAnn]-              -> (Maybe (LHsContext GhcPs) -> EPP ()) -- Printing the header-              -> HsDataDefn GhcPs-              -> EPP ()-exactDataDefn an exactHdr-                 (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context-                             , dd_cType = mb_ct-                             , dd_kindSig = mb_sig-                             , dd_cons = condecls, dd_derivs = derivings }) = do-  annotationsToComments (epAnnAnns an) [AnnOpenP, AnnCloseP]-  if new_or_data == DataType-    then markEpAnn an AnnData-    else markEpAnn an AnnNewtype-  markEpAnn an AnnInstance -- optional-  mapM_ markAnnotated mb_ct-  exactHdr context-  case mb_sig of-    Nothing -> return ()-    Just kind -> do-      markEpAnn an AnnDcolon-      markAnnotated kind-  when (isGadt condecls) $ markEpAnn an AnnWhere-  markEpAnn an AnnOpenC-  exact_condecls an condecls-  markEpAnn an AnnCloseC-  mapM_ markAnnotated derivings-  return ()---exactVanillaDeclHead :: LocatedN RdrName-                     -> LHsQTyVars GhcPs-                     -> LexicalFixity-                     -> Maybe (LHsContext GhcPs)-                     -> EPP ()-exactVanillaDeclHead thing (HsQTvs { hsq_explicit = tyvars }) fixity context = do-  let-    exact_tyvars :: [LHsTyVarBndr () GhcPs] -> EPP ()-    exact_tyvars (varl:varsr)-      | fixity == Infix && length varsr > 1 = do-          markAnnotated varl-          markAnnotated thing-          markAnnotated (head varsr)-          markAnnotated (tail varsr)-          return ()-      | fixity == Infix = do-          markAnnotated varl-          markAnnotated thing-          markAnnotated varsr-          return ()-      | otherwise = do-          markAnnotated thing-          mapM_ markAnnotated (varl:varsr)-          return ()-    exact_tyvars [] = do-      markAnnotated thing-  mapM_ markAnnotated context-  exact_tyvars tyvars---- -----------------------------------------------------------------------instance ExactPrint (InjectivityAnn GhcPs) where-  getAnnotationEntry (InjectivityAnn an _ _) = fromAnn an-  exact (InjectivityAnn an lhs rhs) = do-    markEpAnn an AnnVbar-    markAnnotated lhs-    markEpAnn an AnnRarrow-    mapM_ markAnnotated rhs---- -----------------------------------------------------------------------class Typeable flag => ExactPrintTVFlag flag where-  exactTVDelimiters :: EpAnn [AddEpAnn] -> flag -> Annotated () -> Annotated ()--instance ExactPrintTVFlag () where-  exactTVDelimiters an _ thing_inside = do-    markEpAnnAll an id AnnOpenP-    thing_inside-    markEpAnnAll an id AnnCloseP--instance ExactPrintTVFlag Specificity where-  exactTVDelimiters an s thing_inside = do-    markEpAnnAll an id open-    thing_inside-    markEpAnnAll an id close-    where-      (open, close) = case s of-        SpecifiedSpec -> (AnnOpenP, AnnCloseP)-        InferredSpec  -> (AnnOpenC, AnnCloseC)--instance ExactPrintTVFlag flag => ExactPrint (HsTyVarBndr flag GhcPs) where-  getAnnotationEntry (UserTyVar an _ _)     = fromAnn an-  getAnnotationEntry (KindedTyVar an _ _ _) = fromAnn an--  exact (UserTyVar an flag n) =-    exactTVDelimiters an flag $ markAnnotated n-  exact (KindedTyVar an flag n k) = exactTVDelimiters an flag $ do-    markAnnotated n-    markEpAnn an AnnDcolon-    markAnnotated k---- -----------------------------------------------------------------------instance ExactPrint (HsType GhcPs) where-  getAnnotationEntry (HsForAllTy _ _ _)        = NoEntryVal-  getAnnotationEntry (HsQualTy _ _ _)          = NoEntryVal-  getAnnotationEntry (HsTyVar an _ _)          = fromAnn an-  getAnnotationEntry (HsAppTy _ _ _)           = NoEntryVal-  getAnnotationEntry (HsAppKindTy _ _ _)       = NoEntryVal-  getAnnotationEntry (HsFunTy an _ _ _)        = fromAnn an-  getAnnotationEntry (HsListTy an _)           = fromAnn an-  getAnnotationEntry (HsTupleTy an _ _)        = fromAnn an-  getAnnotationEntry (HsSumTy an _)            = fromAnn an-  getAnnotationEntry (HsOpTy _ _ _ _)          = NoEntryVal-  getAnnotationEntry (HsParTy an _)            = fromAnn an-  getAnnotationEntry (HsIParamTy an _ _)       = fromAnn an-  getAnnotationEntry (HsStarTy _ _)            = NoEntryVal-  getAnnotationEntry (HsKindSig an _ _)        = fromAnn an-  getAnnotationEntry (HsSpliceTy _ _)          = NoEntryVal-  getAnnotationEntry (HsDocTy an _ _)          = fromAnn an-  getAnnotationEntry (HsBangTy an _ _)         = fromAnn an-  getAnnotationEntry (HsRecTy an _)            = fromAnn an-  getAnnotationEntry (HsExplicitListTy an _ _) = fromAnn an-  getAnnotationEntry (HsExplicitTupleTy an _)  = fromAnn an-  getAnnotationEntry (HsTyLit _ _)             = NoEntryVal-  getAnnotationEntry (HsWildCardTy _)          = NoEntryVal-  getAnnotationEntry (XHsType _)               = NoEntryVal---  exact (HsForAllTy { hst_xforall = _an-                    , hst_tele = tele, hst_body = ty }) = do-    markAnnotated tele-    markAnnotated ty--  exact (HsQualTy _ ctxt ty) = do-    markAnnotated ctxt-    markAnnotated ty-  exact (HsTyVar an promoted name) = do-    when (promoted == IsPromoted) $ markEpAnn an AnnSimpleQuote-    markAnnotated name--  exact (HsAppTy _ t1 t2) = markAnnotated t1 >> markAnnotated t2-  exact (HsAppKindTy ss ty ki) = do-    markAnnotated ty-    printStringAtSs ss "@"-    markAnnotated ki-  exact (HsFunTy an mult ty1 ty2) = do-    markAnnotated ty1-    markArrow an mult-    markAnnotated ty2-  exact (HsListTy an tys) = do-    markOpeningParen an-    markAnnotated tys-    markClosingParen an-  exact (HsTupleTy an _con tys) = do-    markOpeningParen an-    markAnnotated tys-    markClosingParen an-  exact (HsSumTy an tys) = do-    markOpeningParen an-    markAnnotated tys-    markClosingParen an-  exact (HsOpTy _an t1 lo t2) = do-    markAnnotated t1-    markAnnotated lo-    markAnnotated t2-  exact (HsParTy an ty) = do-    markOpeningParen an-    markAnnotated ty-    markClosingParen an-  exact (HsIParamTy an n t) = do-      markAnnotated n-      markEpAnn an AnnDcolon-      markAnnotated t-  exact (HsStarTy _an isUnicode)-    = if isUnicode-        then printStringAdvance "\x2605" -- Unicode star-        else printStringAdvance "*"-  exact (HsKindSig an ty k) = do-    markAnnotated ty-    markEpAnn an AnnDcolon-    markAnnotated k-  exact (HsSpliceTy _ splice) = do-    markAnnotated splice-  -- exact x@(HsDocTy an _ _)          = withPpr x-  exact (HsBangTy an (HsSrcBang mt _up str) ty) = do-    case mt of-      NoSourceText -> return ()-      SourceText src -> do-        debugM $ "HsBangTy: src=" ++ showAst src-        markLocatedAALS an id AnnOpen  (Just src)-        markLocatedAALS an id AnnClose (Just "#-}")-        debugM $ "HsBangTy: done unpackedness"-    case str of-      SrcLazy     -> markEpAnn an AnnTilde-      SrcStrict   -> markEpAnn an AnnBang-      NoSrcStrict -> return ()-    markAnnotated ty-  -- exact x@(HsRecTy an _)            = withPpr x-  exact (HsExplicitListTy an prom tys) = do-    when (isPromoted prom) $ markEpAnn an AnnSimpleQuote-    markEpAnn an AnnOpenS-    markAnnotated tys-    markEpAnn an AnnCloseS-  exact (HsExplicitTupleTy an tys) = do-    markEpAnn an AnnSimpleQuote-    markEpAnn an AnnOpenP-    markAnnotated tys-    markEpAnn an AnnCloseP-  exact (HsTyLit _ lit) = do-    case lit of-      (HsNumTy src v) -> printSourceText src (show v)-      (HsStrTy src v) -> printSourceText src (show v)-      (HsCharTy src v) -> printSourceText src (show v)-  exact (HsWildCardTy _) = printStringAdvance "_"-  exact x = error $ "missing match for HsType:" ++ showAst x---- -----------------------------------------------------------------------instance ExactPrint (HsForAllTelescope GhcPs) where-  getAnnotationEntry (HsForAllVis an _)   = fromAnn an-  getAnnotationEntry (HsForAllInvis an _) = fromAnn an--  exact (HsForAllVis an bndrs)   = do-    markLocatedAA an fst -- AnnForall-    markAnnotated bndrs-    markLocatedAA an snd -- AnnRarrow--  exact (HsForAllInvis an bndrs) = do-    markLocatedAA an fst -- AnnForall-    markAnnotated bndrs-    markLocatedAA an snd -- AnnDot---- -----------------------------------------------------------------------instance ExactPrint (HsDerivingClause GhcPs) where-  getAnnotationEntry d@(HsDerivingClause{}) = fromAnn (deriv_clause_ext d)--  exact (HsDerivingClause { deriv_clause_ext      = an-                          , deriv_clause_strategy = dcs-                          , deriv_clause_tys      = dct }) = do-    markEpAnn an AnnDeriving-    exact_strat_before-    markAnnotated dct-    exact_strat_after-      where-        -- -- This complexity is to distinguish between-        -- --    deriving Show-        -- --    deriving (Show)-        -- pp_dct [HsIB { hsib_body = ty }]-        --          = ppr (parenthesizeHsType appPrec ty)-        -- pp_dct _ = parens (interpp'SP dct)--        -- @via@ is unique in that in comes /after/ the class being derived,-        -- so we must special-case it.-        (exact_strat_before, exact_strat_after) =-          case dcs of-            Just v@(L _ ViaStrategy{}) -> (pure (), markAnnotated v)-            _                          -> (mapM_ markAnnotated dcs, pure ())---- -----------------------------------------------------------------------instance ExactPrint (DerivStrategy GhcPs) where-  getAnnotationEntry (StockStrategy an)    = fromAnn an-  getAnnotationEntry (AnyclassStrategy an) = fromAnn an-  getAnnotationEntry (NewtypeStrategy an)  = fromAnn an-  getAnnotationEntry (ViaStrategy (XViaStrategyPs an  _)) = fromAnn an--  exact (StockStrategy an)    = markEpAnn an AnnStock-  exact (AnyclassStrategy an) = markEpAnn an AnnAnyclass-  exact (NewtypeStrategy an)  = markEpAnn an AnnNewtype-  exact (ViaStrategy (XViaStrategyPs an ty))-    = markEpAnn an AnnVia >> markAnnotated ty---- -----------------------------------------------------------------------instance (ExactPrint a) => ExactPrint (LocatedC a) where-  getAnnotationEntry (L sann _) = fromAnn sann--  exact (L (SrcSpanAnn EpAnnNotUsed _) a) = markAnnotated a-  exact (L (SrcSpanAnn (EpAnn _ (AnnContext ma opens closes) _) _) a) = do-    mapM_ (markKwA AnnOpenP) (sort opens)-    markAnnotated a-    mapM_ (markKwA AnnCloseP) (sort closes)-    case ma of-      Just (UnicodeSyntax, r) -> markKwA AnnDarrowU r-      Just (NormalSyntax,  r) -> markKwA AnnDarrow  r-      Nothing -> pure ()---- -----------------------------------------------------------------------instance ExactPrint (DerivClauseTys GhcPs) where-  getAnnotationEntry = const NoEntryVal--  exact (DctSingle _ ty) = markAnnotated ty-  exact (DctMulti _ tys) = do-    markAnnotated tys---- -----------------------------------------------------------------------instance ExactPrint (HsSigType GhcPs) where-  getAnnotationEntry = const NoEntryVal--  exact (HsSig _ bndrs ty) = do-    markAnnotated bndrs-    markAnnotated ty---- -----------------------------------------------------------------------instance ExactPrint (LocatedN RdrName) where-  getAnnotationEntry (L sann _) = fromAnn sann--  exact (L (SrcSpanAnn EpAnnNotUsed l) n) = do-    p <- getPosP-    debugM $ "LocatedN RdrName:NOANN: (p,l,str)=" ++ show (p,ss2range l, showPprUnsafe n)-    let str = case (showPprUnsafe n) of-              -- TODO: unicode support?-                "forall" -> if spanLength (realSrcSpan l) == 1 then "∀" else "forall"-                s -> s-    printStringAtSs l str-  exact (L (SrcSpanAnn (EpAnn _anchor ann _cs) _ll) n) = do-    case ann of-      NameAnn a o l c t -> do-        markName a o (Just (l,n)) c-        markTrailing t-      NameAnnCommas a o cs c t -> do-        let (kwo,kwc) = adornments a-        markKw (AddEpAnn kwo o)-        forM_ cs (\loc -> markKw (AddEpAnn AnnComma loc))-        markKw (AddEpAnn kwc c)-        markTrailing t-      NameAnnOnly a o c t -> do-        markName a o Nothing c-        markTrailing t-      NameAnnRArrow nl t -> do-        markKw (AddEpAnn AnnRarrow nl)-        markTrailing t-      NameAnnQuote q name t -> do-        debugM $ "NameAnnQuote"-        markKw (AddEpAnn AnnSimpleQuote q)-        markAnnotated (L name n)-        markTrailing t-      NameAnnTrailing t -> do-        printStringAdvance (showPprUnsafe n)-        markTrailing t--markName :: NameAdornment-         -> EpaLocation -> Maybe (EpaLocation,RdrName) -> EpaLocation -> EPP ()-markName adorn open mname close = do-  let (kwo,kwc) = adornments adorn-  markKw (AddEpAnn kwo open)-  case mname of-    Nothing -> return ()-    Just (name, a) -> printStringAtAA name (showPprUnsafe a)-  markKw (AddEpAnn kwc close)--adornments :: NameAdornment -> (AnnKeywordId, AnnKeywordId)-adornments NameParens     = (AnnOpenP, AnnCloseP)-adornments NameParensHash = (AnnOpenPH, AnnClosePH)-adornments NameBackquotes = (AnnBackquote, AnnBackquote)-adornments NameSquare     = (AnnOpenS, AnnCloseS)--markTrailing :: [TrailingAnn] -> EPP ()-markTrailing ts = do-  p <- getPosP-  debugM $ "markTrailing:" ++ showPprUnsafe (p,ts)-  mapM_ markKwT (sort ts)---- ------------------------------------------------------------------------- based on pp_condecls in Decls.hs-exact_condecls :: EpAnn [AddEpAnn] -> [LConDecl GhcPs] -> EPP ()-exact_condecls an cs-  | gadt_syntax                  -- In GADT syntax-  = do-      mapM_ markAnnotated cs-  | otherwise                    -- In H98 syntax-  = do-      markEpAnn an AnnEqual-      mapM_ markAnnotated cs-  where-    gadt_syntax = case cs of-      []                      -> False-      (L _ ConDeclH98{}  : _) -> False-      (L _ ConDeclGADT{} : _) -> True---- -----------------------------------------------------------------------instance ExactPrint (ConDecl GhcPs) where-  getAnnotationEntry x@(ConDeclGADT{}) = fromAnn (con_g_ext x)-  getAnnotationEntry x@(ConDeclH98{})  = fromAnn (con_ext x)---- based on pprConDecl-  exact (ConDeclH98 { con_ext = an-                    , con_name = con-                    , con_forall = has_forall-                    , con_ex_tvs = ex_tvs-                    , con_mb_cxt = mcxt-                    , con_args = args-                    , con_doc = doc }) = do-    mapM_ markAnnotated doc-    when has_forall $ markEpAnn an AnnForall-    mapM_ markAnnotated ex_tvs-    when has_forall $ markEpAnn an AnnDot-    mapM_ markAnnotated mcxt-    when (isJust mcxt) $ markEpAnn an AnnDarrow--    exact_details args--    where-    --   -- In ppr_details: let's not print the multiplicities (they are always 1, by-    --   -- definition) as they do not appear in an actual declaration.-      exact_details (InfixCon t1 t2) = do-        markAnnotated t1-        markAnnotated con-        markAnnotated t2-      exact_details (PrefixCon tyargs tys) = do-        markAnnotated con-        markAnnotated tyargs-        markAnnotated tys-      exact_details (RecCon fields) = do-        markAnnotated con-        markAnnotated fields--  -- -------------------------------------  exact (ConDeclGADT { con_g_ext = an-                     , con_names = cons-                     , con_bndrs = bndrs-                     , con_mb_cxt = mcxt, con_g_args = args-                     , con_res_ty = res_ty, con_doc = doc }) = do-    mapM_ markAnnotated doc-    mapM_ markAnnotated cons-    markEpAnn an AnnDcolon-    annotationsToComments (epAnnAnns an)  [AnnOpenP, AnnCloseP]-    markAnnotated bndrs-    mapM_ markAnnotated mcxt-    when (isJust mcxt) $ markEpAnn an AnnDarrow-    case args of-        (PrefixConGADT args') -> mapM_ markScaled args'-        (RecConGADT fields)   -> markAnnotated fields-    markAnnotated res_ty---- -----------------------------------------------------------------------instance ExactPrint Void where-  getAnnotationEntry = const NoEntryVal-  exact _ = return ()---- -----------------------------------------------------------------------instance ExactPrintTVFlag flag => ExactPrint (HsOuterTyVarBndrs flag GhcPs) where-  getAnnotationEntry (HsOuterImplicit _) = NoEntryVal-  getAnnotationEntry (HsOuterExplicit an _) = fromAnn an--  exact (HsOuterImplicit _) = pure ()-  exact (HsOuterExplicit an bndrs) = do-    markLocatedAA an fst -- "forall"-    markAnnotated bndrs-    markLocatedAA an snd -- "."---- -----------------------------------------------------------------------instance ExactPrint (ConDeclField GhcPs) where-  getAnnotationEntry f@(ConDeclField{}) = fromAnn (cd_fld_ext f)--  exact (ConDeclField an names ftype mdoc) = do-    markAnnotated names-    markEpAnn an AnnDcolon-    markAnnotated ftype-    mapM_ markAnnotated mdoc---- -----------------------------------------------------------------------instance ExactPrint (FieldOcc GhcPs) where-  getAnnotationEntry = const NoEntryVal-  exact (FieldOcc _ n) = markAnnotated n---- -----------------------------------------------------------------------instance ExactPrint (AmbiguousFieldOcc GhcPs) where-  getAnnotationEntry = const NoEntryVal-  exact (Unambiguous _ n) = markAnnotated n-  exact (Ambiguous   _ n) = markAnnotated n---- -----------------------------------------------------------------------markScaled :: (HsScaled GhcPs (LBangType GhcPs)) -> Annotated ()-markScaled (HsScaled arr (L l c)) =-  markAnnotated ((L l (HsScaled arr (L (noAnnSrcSpan $ locA l) c)))-                 :: LocatedA (HsScaled GhcPs (LBangType GhcPs)))--instance (ExactPrint a) => ExactPrint (HsScaled GhcPs a) where-  getAnnotationEntry = const NoEntryVal-  exact (HsScaled arr t) = do-    markAnnotated t-    markArrow EpAnnNotUsed arr---- -----------------------------------------------------------------------instance ExactPrint (LocatedP CType) where-  getAnnotationEntry = entryFromLocatedA--  exact (L (SrcSpanAnn EpAnnNotUsed _) ct) = withPpr ct-  exact (L (SrcSpanAnn an _ll)-         (CType stp mh (stct,ct))) = do-    markAnnOpenP an stp "{-# CTYPE"-    case mh of-      Nothing -> return ()-      Just (Header srcH _h) ->-         markLocatedAALS an apr_rest AnnHeader (Just (toSourceTextWithSuffix srcH "" ""))-    markLocatedAALS an apr_rest AnnVal (Just (toSourceTextWithSuffix stct (unpackFS ct) ""))-    markAnnCloseP an---- -----------------------------------------------------------------------instance ExactPrint (SourceText, RuleName) where-  -- We end up at the right place from the Located wrapper-  getAnnotationEntry = const NoEntryVal--  exact (st, rn)-    = printStringAdvance (toSourceTextWithSuffix st (unpackFS rn) "")----- =====================================================================--- LocatedL instances start -------- Each is dealt with specifically, as they have--- different wrapping annotations in the al_rest zone.------ In future, the annotation could perhaps be improved, with an--- 'al_pre' and 'al_post' set of annotations to be simply sorted and--- applied.--- -----------------------------------------------------------------------instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where-  getAnnotationEntry = entryFromLocatedA--  exact (L (SrcSpanAnn ann _) ies) = do-    debugM $ "LocatedL [LIE"-    markLocatedAAL ann al_rest AnnHiding-    p <- getPosP-    debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p-    markAnnList True ann (markAnnotated ies)--instance (ExactPrint (Match GhcPs (LocatedA body)))-   => ExactPrint (LocatedL [LocatedA (Match GhcPs (LocatedA body))]) where-  getAnnotationEntry = entryFromLocatedA-  exact (L la a) = do-    debugM $ "LocatedL [LMatch"-    -- TODO: markAnnList?-    markEpAnnAll (ann la) al_rest AnnWhere-    markLocatedMAA (ann la) al_open-    markEpAnnAll (ann la) al_rest AnnSemi-    markAnnotated a-    markLocatedMAA (ann la) al_close---- instance ExactPrint (LocatedL [ExprLStmt GhcPs]) where-instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]) where-  getAnnotationEntry = entryFromLocatedAFixed-  exact (L (SrcSpanAnn an' _) stmts) = do-    let an = fixAnnListAnn an'-    debugM $ "LocatedL [ExprLStmt"-    markAnnList True an $ do-      -- markLocatedMAA an al_open-      case snocView stmts of-        Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do-          debugM $ "LocatedL [ExprLStmt: snocView"-          markAnnotated ls-          markAnnotated initStmts-        _ -> markAnnotated stmts-        -- x -> error $ "pprDo:ListComp" ++ showAst x-      -- markLocatedMAA an al_close---- instance ExactPrint (LocatedL [CmdLStmt GhcPs]) where-instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]) where-  getAnnotationEntry = entryFromLocatedAFixed-  exact (L (SrcSpanAnn ann' _) es) = do-    let ann = fixAnnListAnn ann'-    debugM $ "LocatedL [CmdLStmt"-    markLocatedMAA ann al_open-    mapM_ markAnnotated es-    markLocatedMAA ann al_close--instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where-  getAnnotationEntry = entryFromLocatedA-  exact (L (SrcSpanAnn an _) fs) = do-    debugM $ "LocatedL [LConDeclField"-    markAnnList True an (mapM_ markAnnotated fs) -- AZ:TODO get rid of mapM_--instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where-  getAnnotationEntry = entryFromLocatedA-  exact (L (SrcSpanAnn an _) bf) = do-    debugM $ "LocatedL [LBooleanFormula"-    markAnnList True an (markAnnotated bf)---- ------------------------------------------------------------------------ LocatedL instances end ----- =====================================================================--instance ExactPrint (IE GhcPs) where-  getAnnotationEntry (IEVar _ _)            = NoEntryVal-  getAnnotationEntry (IEThingAbs an _)      = fromAnn an-  getAnnotationEntry (IEThingAll an _)      = fromAnn an-  getAnnotationEntry (IEThingWith an _ _ _) = fromAnn an-  getAnnotationEntry (IEModuleContents an _)= fromAnn an-  getAnnotationEntry (IEGroup _ _ _)        = NoEntryVal-  getAnnotationEntry (IEDoc _ _)            = NoEntryVal-  getAnnotationEntry (IEDocNamed _ _)       = NoEntryVal--  exact (IEVar _ ln) = markAnnotated ln-  exact (IEThingAbs _ thing) = markAnnotated thing-  exact (IEThingAll an thing) = do-    markAnnotated thing-    markEpAnn an AnnOpenP-    markEpAnn an AnnDotdot-    markEpAnn an AnnCloseP--  exact (IEThingWith an thing wc withs) = do-    markAnnotated thing-    markEpAnn an AnnOpenP-    case wc of-      NoIEWildcard -> markAnnotated withs-      IEWildcard pos -> do-        let (bs, as) = splitAt pos withs-        markAnnotated bs-        markEpAnn an AnnDotdot-        markEpAnn an AnnComma-        markAnnotated as-    markEpAnn an AnnCloseP--  exact (IEModuleContents an (L lm mn)) = do-    markEpAnn an AnnModule-    printStringAtSs lm (moduleNameString mn)--  -- exact (IEGroup _ _ _)          = NoEntryVal-  -- exact (IEDoc _ _)              = NoEntryVal-  -- exact (IEDocNamed _ _)         = NoEntryVal-  exact x = error $ "missing match for IE:" ++ showAst x---- -----------------------------------------------------------------------instance ExactPrint (IEWrappedName RdrName) where-  getAnnotationEntry = const NoEntryVal--  exact (IEName n) = markAnnotated n-  exact (IEPattern r n) = do-    printStringAtAA r "pattern"-    markAnnotated n-  exact (IEType r n) = do-    printStringAtAA r "type"-    markAnnotated n---- -----------------------------------------------------------------------instance ExactPrint (Pat GhcPs) where-  getAnnotationEntry (WildPat _)              = NoEntryVal-  getAnnotationEntry (VarPat _ _)             = NoEntryVal-  getAnnotationEntry (LazyPat an _)           = fromAnn an-  getAnnotationEntry (AsPat an _ _)           = fromAnn an-  getAnnotationEntry (ParPat an _)            = fromAnn an-  getAnnotationEntry (BangPat an _)           = fromAnn an-  getAnnotationEntry (ListPat an _)           = fromAnn an-  getAnnotationEntry (TuplePat an _ _)        = fromAnn an-  getAnnotationEntry (SumPat an _ _ _)        = fromAnn an-  getAnnotationEntry (ConPat an _ _)          = fromAnn an-  getAnnotationEntry (ViewPat an _ _)         = fromAnn an-  getAnnotationEntry (SplicePat _ _)          = NoEntryVal-  getAnnotationEntry (LitPat _ _)             = NoEntryVal-  getAnnotationEntry (NPat an _ _ _)          = fromAnn an-  getAnnotationEntry (NPlusKPat an _ _ _ _ _) = fromAnn an-  getAnnotationEntry (SigPat an _ _)          = fromAnn an--  exact (WildPat _) = do-    anchor <- getAnchorU-    debugM $ "WildPat:anchor=" ++ show anchor-    printStringAtRs anchor "_"-  exact (VarPat _ n) = do-        -- The parser inserts a placeholder value for a record pun rhs. This must be-        -- filtered.-        let pun_RDR = "pun-right-hand-side"-        when (showPprUnsafe n /= pun_RDR) $ markAnnotated n-  exact (LazyPat an pat) = do-    markEpAnn an AnnTilde-    markAnnotated pat-  exact (AsPat an n pat) = do-    markAnnotated n-    markEpAnn an AnnAt-    markAnnotated pat-  exact (ParPat an pat) = do-    markAnnKw an ap_open AnnOpenP-    markAnnotated pat-    markAnnKw an ap_close AnnCloseP--  exact (BangPat an pat) = do-    markEpAnn an AnnBang-    markAnnotated pat--  exact (ListPat an pats) = markAnnList True an (markAnnotated pats)--  exact (TuplePat an pats boxity) = do-    case boxity of-      Boxed   -> markEpAnn an AnnOpenP-      Unboxed -> markEpAnn an AnnOpenPH-    markAnnotated pats-    case boxity of-      Boxed   -> markEpAnn an AnnCloseP-      Unboxed -> markEpAnn an AnnClosePH--  exact (SumPat an pat _alt _arity) = do-    markLocatedAAL an sumPatParens AnnOpenPH-    markAnnKwAll an sumPatVbarsBefore AnnVbar-    markAnnotated pat-    markAnnKwAll an sumPatVbarsAfter AnnVbar-    markLocatedAAL an sumPatParens AnnClosePH--  -- | ConPat an con args)-  exact (ConPat an con details) = exactUserCon an con details-  exact (ViewPat an expr pat) = do-    markAnnotated expr-    markEpAnn an AnnRarrow-    markAnnotated pat-  exact (SplicePat _ splice) = markAnnotated splice-  exact (LitPat _ lit) = printStringAdvance (hsLit2String lit)-  exact (NPat an ol mn _) = do-    when (isJust mn) $ markEpAnn an AnnMinus-    markAnnotated ol--  -- | NPlusKPat an n lit1 lit2 _ _)-  exact (NPlusKPat an n k lit2 _ _) = do-    markAnnotated n-    -- We need a fix for-    -- https://gitlab.haskell.org/ghc/ghc/-/issues/20243 to complete-    -- this-    markAnnotated k--  exact (SigPat an pat sig) = do-    markAnnotated pat-    markEpAnn an AnnDcolon-    markAnnotated sig-  -- exact x = error $ "missing match for Pat:" ++ showAst x---- -----------------------------------------------------------------------instance ExactPrint (HsPatSigType GhcPs) where-  getAnnotationEntry = const NoEntryVal--  exact (HsPS an ty) = do-    markAnnKw an id AnnAt-    markAnnotated ty---- -----------------------------------------------------------------------instance ExactPrint (HsOverLit GhcPs) where-  getAnnotationEntry = const NoEntryVal--  exact ol =-    let str = case ol_val ol of-                HsIntegral   (IL src _ _) -> src-                HsFractional (FL{ fl_text = src }) -> src-                HsIsString src _ -> src-    in-      case str of-        SourceText s -> printStringAdvance s-        NoSourceText -> return ()---- -----------------------------------------------------------------------hsLit2String :: HsLit GhcPs -> String-hsLit2String lit =-  case lit of-    HsChar       src v   -> toSourceTextWithSuffix src v ""-    -- It should be included here-    -- https://github.com/ghc/ghc/blob/master/compiler/parser/Lexer.x#L1471-    HsCharPrim   src p   -> toSourceTextWithSuffix src p "#"-    HsString     src v   -> toSourceTextWithSuffix src v ""-    HsStringPrim src v   -> toSourceTextWithSuffix src v ""-    HsInt        _ (IL src _ v)   -> toSourceTextWithSuffix src v ""-    HsIntPrim    src v   -> toSourceTextWithSuffix src v ""-    HsWordPrim   src v   -> toSourceTextWithSuffix src v ""-    HsInt64Prim  src v   -> toSourceTextWithSuffix src v ""-    HsWord64Prim src v   -> toSourceTextWithSuffix src v ""-    HsInteger    src v _ -> toSourceTextWithSuffix src v ""-    HsRat        _ fl@(FL{fl_text = src }) _ -> toSourceTextWithSuffix src fl ""-    HsFloatPrim  _ fl@(FL{fl_text = src })   -> toSourceTextWithSuffix src fl "#"-    HsDoublePrim _ fl@(FL{fl_text = src })   -> toSourceTextWithSuffix src fl "##"-    -- (XLit x) -> error $ "got XLit for:" ++ showPprUnsafe x--toSourceTextWithSuffix :: (Show a) => SourceText -> a -> String -> String-toSourceTextWithSuffix (NoSourceText)    alt suffix = show alt ++ suffix-toSourceTextWithSuffix (SourceText txt) _alt suffix = txt ++ suffix--sourceTextToString :: SourceText -> String -> String-sourceTextToString NoSourceText alt   = alt-sourceTextToString (SourceText txt) _ = txt---- -----------------------------------------------------------------------exactUserCon :: (ExactPrint con) => EpAnn [AddEpAnn] -> con -> HsConPatDetails GhcPs -> EPP ()-exactUserCon _  c (InfixCon p1 p2) = markAnnotated p1 >> markAnnotated c >> markAnnotated p2-exactUserCon an c details          = do-  markAnnotated c-  markEpAnn an AnnOpenC-  exactConArgs details-  markEpAnn an AnnCloseC---exactConArgs ::HsConPatDetails GhcPs -> EPP ()-exactConArgs (PrefixCon tyargs pats) = markAnnotated tyargs >> markAnnotated pats-exactConArgs (InfixCon p1 p2) = markAnnotated p1 >> markAnnotated p2-exactConArgs (RecCon rpats)   = markAnnotated rpats---- -----------------------------------------------------------------------entryFromLocatedA :: LocatedAn ann a -> Entry-entryFromLocatedA (L la _) = fromAnn la---- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256-entryFromLocatedAFixed :: LocatedL a -> Entry-entryFromLocatedAFixed (L la _)-  = fromAnn (fixSrcAnnL 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 cl s = do-  p <- getPosP-  colOffset <- getLayoutOffsetP-  if isGoodDeltaWithOffset cl colOffset-    then do-      printStringAt (undelta p cl colOffset) s-        `debug` ("printStringAtLsDelta:(pos,s):" ++ show (undelta p cl colOffset,s))-    else return () `debug` ("printStringAtLsDelta:bad delta for (mc,s):" ++ show (cl,s))---- -----------------------------------------------------------------------isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool-isGoodDeltaWithOffset dp colOffset = isGoodDelta (deltaPos l c)-  where (l,c) = undelta (0,0) dp colOffset--printQueuedComment :: (Monad m, Monoid w) => RealSrcSpan -> Comment -> DeltaPos -> EP w m ()-printQueuedComment loc Comment{commentContents} dp = do-  p <- getPosP-  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-    setPriorEndASTD False loc-  p' <- getPosP-  debugM $ "printQueuedComment: (p,p',dp,colOffset,undelta)=" ++ show (p,p',dp,colOffset,undelta p dp colOffset)----------------------------------------------------------------------------setLayoutBoth :: (Monad m, Monoid w) => EP w m () -> EP w m ()-setLayoutBoth k = do-  oldLHS <- gets dLHS-  oldAnchorOffset <- getLayoutOffsetP-  debugM $ "setLayoutBoth: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)-  modify (\a -> a { dMarkLayout = True-                  , pMarkLayout = True } )-  let reset = do-        debugM $ "setLayoutBoth:reset: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)-        modify (\a -> a { dMarkLayout = False-                        , dLHS = oldLHS-                        , pMarkLayout = False-                        , pLHS = oldAnchorOffset} )-  k <* reset---- Use 'local', designed for this-setLayoutTopLevelP :: (Monad m, Monoid w) => EP w m () -> EP w m ()-setLayoutTopLevelP k = do-  debugM $ "setLayoutTopLevelP entered"-  oldAnchorOffset <- getLayoutOffsetP-  modify (\a -> a { pMarkLayout = False-                  , pLHS = 0} )-  k-  debugM $ "setLayoutTopLevelP:resetting"-  setLayoutOffsetP oldAnchorOffset----------------------------------------------------------------------------getPosP :: (Monad m, Monoid w) => EP w m Pos-getPosP = gets epPos--setPosP :: (Monad m, Monoid w) => Pos -> EP w m ()-setPosP l = do-  -- debugM $ "setPosP:" ++ show l-  modify (\s -> s {epPos = l})--getExtraDP :: (Monad m, Monoid w) => EP w m (Maybe Anchor)-getExtraDP = gets uExtraDP--setExtraDP :: (Monad m, Monoid w) => Maybe Anchor -> EP w m ()-setExtraDP md = do-  debugM $ "setExtraDP:" ++ show md-  modify (\s -> s {uExtraDP = md})--getPriorEndD :: (Monad m, Monoid w) => EP w m Pos-getPriorEndD = gets dPriorEndPosition--getAnchorU :: (Monad m, Monoid w) => EP w m RealSrcSpan-getAnchorU = gets uAnchorSpan--setPriorEndD :: (Monad m, Monoid w) => Pos -> EP w m ()-setPriorEndD pe = do-  -- setLayoutStartIfNeededD (snd pe)-  setPriorEndNoLayoutD pe--setPriorEndNoLayoutD :: (Monad m, Monoid w) => Pos -> EP w m ()-setPriorEndNoLayoutD pe = do-  debugM $ "setPriorEndNoLayout:pe=" ++ show pe-  modify (\s -> s { dPriorEndPosition = pe })--setPriorEndASTD :: (Monad m, Monoid w) => Bool -> RealSrcSpan -> EP w m ()-setPriorEndASTD layout pe = setPriorEndASTPD layout (rs2range pe)--setPriorEndASTPD :: (Monad m, Monoid w) => Bool -> (Pos,Pos) -> EP w m ()-setPriorEndASTPD layout pe@(fm,to) = do-  debugM $ "setPriorEndASTD:pe=" ++ show pe-  when layout $ setLayoutStartD (snd fm)-  modify (\s -> s { dPriorEndPosition = to } )--setLayoutStartD :: (Monad m, Monoid w) => Int -> EP w m ()-setLayoutStartD p = do-  EPState{dMarkLayout} <- get-  when dMarkLayout $ do-    debugM $ "setLayoutStartD: setting dLHS=" ++ show p-    modify (\s -> s { dMarkLayout = False-                    , dLHS = LayoutStartCol p})--setAnchorU :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()-setAnchorU rss = do-  debugM $ "setAnchorU:" ++ show (rs2range rss)-  modify (\s -> s { uAnchorSpan = rss })--getUnallocatedComments :: (Monad m, Monoid w) => EP w m [Comment]-getUnallocatedComments = gets epComments--putUnallocatedComments :: (Monad m, Monoid w) => [Comment] -> EP w m ()-putUnallocatedComments cs = modify (\s -> s { epComments = cs } )--getLayoutOffsetP :: (Monad m, Monoid w) => EP w m LayoutStartCol-getLayoutOffsetP = gets pLHS--setLayoutOffsetP :: (Monad m, Monoid w) => LayoutStartCol -> EP w m ()-setLayoutOffsetP c = do-  debugM $ "setLayoutOffsetP:" ++ show c-  modify (\s -> s { pLHS = c })----- -----------------------------------------------------------------------advance :: (Monad m, Monoid w) => DeltaPos -> EP w m ()-advance dp = do-  p <- getPosP-  colOffset <- getLayoutOffsetP-  debugM $ "advance:(p,dp,colOffset,ws)=" ++ show (p,dp,colOffset,undelta p dp colOffset)-  printWhitespace (undelta p dp colOffset)---- -----------------------------------------------------------------------adjustDeltaForOffsetM :: DeltaPos -> EPP DeltaPos-adjustDeltaForOffsetM dp = do-  colOffset <- gets dLHS-  return (adjustDeltaForOffset 0 colOffset dp)---- ------------------------------------------------------------------------ Printing functions--printString :: (Monad m, Monoid w) => Bool -> String -> EP w m ()-printString layout str = do-  EPState{epPos = (_,c), pMarkLayout} <- get-  PrintOptions{epTokenPrint, epWhitespacePrint} <- ask-  when (pMarkLayout && layout) $ do-    debugM $ "printString: setting pLHS to " ++ show c-    modify (\s -> s { pLHS = LayoutStartCol c, pMarkLayout = False } )--  -- Advance position, taking care of any newlines in the string-  let strDP = dpFromString str-      cr = getDeltaLine strDP-  p <- getPosP-  colOffset <- getLayoutOffsetP-  -- debugM $ "printString:(p,colOffset,strDP,cr)="  ++ show (p,colOffset,strDP,cr)-  if cr == 0-    then setPosP (undelta p strDP colOffset)-    else setPosP (undelta p 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) >>= \s -> tell EPWriter { output = s}-    else lift (epTokenPrint      str) >>= \s -> tell EPWriter { output = s}------------------------------------------------------------printStringAdvance :: String -> EPP ()-printStringAdvance str = do-  ss <- getAnchorU-  printStringAtKw' ss str------------------------------------------------------------newLine :: (Monad m, Monoid w) => EP w m ()-newLine = do-    (l,_) <- getPosP-    printString False "\n"-    setPosP (l+1,1)+  , exactPrintWithOptions+  , makeDeltaAst++  -- * Configuration+  , EPOptions(epRigidity, epAstPrint, epTokenPrint, epWhitespacePrint, epUpdateAnchors)+  , stringOptions+  , epOptions+  , deltaOptions+  ) where++import GHC+import GHC.Base (NonEmpty(..))+import GHC.Core.Coercion.Axiom (Role(..))+import GHC.Data.Bag+import qualified GHC.Data.BooleanFormula as BF+import GHC.Data.FastString+import GHC.Types.Basic hiding (EP)+import GHC.Types.Fixity+import GHC.Types.ForeignCall+import GHC.Types.SourceText+import GHC.Types.Var+import GHC.Utils.Outputable hiding ( (<>) )+import GHC.Unit.Module.Warnings+import GHC.Utils.Misc+import GHC.Utils.Panic++import Control.Monad.Identity+import qualified Control.Monad.Reader as Reader+import Control.Monad.RWS+import Data.Data ( Data )+import Data.Dynamic+import Data.Foldable+import Data.Functor.Const+import qualified Data.Set.Ordered as OSet+import qualified Data.Set as Set+import Data.Typeable+import Data.List ( partition, sortBy)+import Data.Maybe ( isJust, mapMaybe )++import Data.Void++import Language.Haskell.GHC.ExactPrint.Lookup+import Language.Haskell.GHC.ExactPrint.Utils+import Language.Haskell.GHC.ExactPrint.Types++-- import Debug.Trace++-- ---------------------------------------------------------------------++exactPrint :: ExactPrint ast => ast -> String+exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast))++-- | The additional option to specify the rigidity and printing+-- configuration.+exactPrintWithOptions :: (ExactPrint ast, Monoid b, Monad m)+                      => EPOptions m b+                      -> ast+                      -> m (ast, b)+exactPrintWithOptions r ast =+    runEP r (markAnnotated ast)++makeDeltaAst :: ExactPrint ast => ast -> ast+makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated 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 epReader action = do+  (ast, w) <- evalRWST action epReader defaultEPState+  return (ast, output w)++-- ---------------------------------------------------------------------++defaultEPState :: EPState+defaultEPState = EPState+             { epPos      = (1,1)+             , dLHS       = 0+             , pMarkLayout = False+             , pLHS = 0+             , dMarkLayout = False+             , dPriorEndPosition = (1,1)+             , uAnchorSpan = badRealSrcSpan+             , uExtraDP = Nothing+             , epComments = []+             , epCommentsApplied = []+             }+++-- ---------------------------------------------------------------------+-- 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+            {+              epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a+            , epTokenPrint :: String -> m a+            , epWhitespacePrint :: String -> m a+            , epRigidity :: Rigidity+            , epUpdateAnchors :: Bool+            }++-- | Helper to create a 'EPOptions'+epOptions ::+      (forall ast . Data ast => GHC.Located ast -> a -> m a)+      -> (String -> m a)+      -> (String -> m a)+      -> Rigidity+      -> Bool+      -> EPOptions m a+epOptions astPrint tokenPrint wsPrint rigidity delta = EPOptions+             {+               epAstPrint = astPrint+             , epWhitespacePrint = wsPrint+             , epTokenPrint = tokenPrint+             , epRigidity = rigidity+             , epUpdateAnchors = delta+             }++-- | Options which can be used to print as a normal String.+stringOptions :: EPOptions Identity String+stringOptions = epOptions (\_ b -> return b) return return NormalLayout False++-- | Options which can be used to simply update the AST to be in delta+-- form, without generating output+deltaOptions :: EPOptions Identity ()+deltaOptions = epOptions (\_ _ -> return ()) (\_ -> return ()) (\_ -> return ()) NormalLayout True++data EPWriter a = EPWriter+              { output :: !a }++instance Monoid w => Semigroup (EPWriter w) where+  (EPWriter a) <> (EPWriter b) = EPWriter (a <> b)++instance Monoid w => Monoid (EPWriter w) where+  mempty = EPWriter mempty++data EPState = EPState+             { uAnchorSpan :: !RealSrcSpan -- ^ in pre-changed AST+                                          -- reference frame, from+                                          -- Annotation+             , uExtraDP :: !(Maybe Anchor) -- ^ Used to anchor a+                                             -- list++             -- Print phase+             , epPos        :: !Pos -- ^ Current output position+             , pMarkLayout  :: !Bool+             , pLHS   :: !LayoutStartCol++             -- Delta phase+             , dPriorEndPosition :: !Pos -- ^ End of Position reached+                                         -- when processing the+                                         -- preceding element+             , dMarkLayout :: !Bool+             , dLHS        :: !LayoutStartCol++             -- Shared+             , epComments :: ![Comment]+             , epCommentsApplied :: ![[Comment]]+             }++-- ---------------------------------------------------------------------++-- AZ:TODO: this can just be a function :: (EpAnn a) -> Entry+class HasEntry ast where+  fromAnn :: ast -> Entry++-- ---------------------------------------------------------------------++-- type Annotated = FreeT AnnotationF Identity+-- type Annotated a = EP w m a++-- ---------------------------------------------------------------------++-- | 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 a = enterAnn (getAnnotationEntry 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 (Eq, Show)++-- | For GenLocated SrcSpan, we construct an entry location but cannot update it.+data CanUpdateAnchor = CanUpdateAnchor+                     | CanUpdateAnchorOnly+                     | NoCanUpdateAnchor+                   deriving (Eq, Show)++data Entry = Entry Anchor EpAnnComments FlushComments CanUpdateAnchor+           | NoEntryVal++-- | For flagging whether to capture comments in an EpaDelta or not+data CaptureComments = CaptureComments+                     | NoCaptureComments++mkEntry :: Anchor -> EpAnnComments -> Entry+mkEntry anc cs = Entry anc cs NoFlushComments CanUpdateAnchor++instance HasEntry (SrcSpanAnn' (EpAnn an)) where+  fromAnn (SrcSpanAnn EpAnnNotUsed ss) = mkEntry (spanAsAnchor ss) emptyComments+  fromAnn (SrcSpanAnn an _) = fromAnn an++instance HasEntry (EpAnn a) where+  fromAnn (EpAnn anchor _ cs) = mkEntry anchor cs+  fromAnn EpAnnNotUsed = NoEntryVal++-- ---------------------------------------------------------------------++fromAnn' :: (HasEntry a) => a -> Entry+fromAnn' an = case fromAnn an of+  NoEntryVal -> NoEntryVal+  Entry a c _ u -> Entry a c FlushComments u++-- ---------------------------------------------------------------------++astId :: (Typeable a) => a -> String+astId a = show (typeOf a)++cua :: (Monad m, Monoid w) => CanUpdateAnchor -> EP w m [a] -> EP w m [a]+cua CanUpdateAnchor f = f+cua CanUpdateAnchorOnly _ = return []+cua NoCanUpdateAnchor _ = return []++-- | "Enter" an annotation, by using the associated 'anchor' field as+-- the new reference point for calculating all DeltaPos positions.+--+-- This is combination of the ghc=exactprint Delta.withAST and+-- Print.exactPC functions and effectively does the delta processing+-- immediately followed by the print processing.  JIT ghc-exactprint.+enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a+enterAnn NoEntryVal a = do+  p <- getPosP+  debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a)+  r <- exact a+  debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a)+  return r+enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do+  p <- getPosP+  debugM $ "enterAnn:starting:(p,a) =" ++ show (p, astId a)+  -- debugM $ "enterAnn:(cs) =" ++ showGhc (cs)+  let curAnchor = anchor anchor' -- As a base for the current AST element+  debugM $ "enterAnn:(curAnchor):=" ++ show (rs2range curAnchor)+  case canUpdateAnchor of+    CanUpdateAnchor -> pushAppliedComments+    _ -> return ()+  addCommentsA (priorComments cs)+  debugM $ "enterAnn:Added comments"+  printComments curAnchor+  priorCs <- cua canUpdateAnchor takeAppliedComments -- no pop+  -- -------------------------+  case anchor_op anchor' of+    MovedAnchor dp -> do+      debugM $ "enterAnn: MovedAnchor:" ++ show dp+      -- Set the original anchor as prior end, so the rest of this AST+      -- fragment has a reference+      setPriorEndNoLayoutD (ss2pos curAnchor)+    _ -> do+      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 = ss2pos curAnchor+  priorEndAfterComments <- getPriorEndD+  let edp' = adjustDeltaForOffset+               -- Use the propagated offset if one is set+               -- Note that we need to use the new offset if it has+               -- changed.+               off (ss2delta priorEndAfterComments curAnchor)+  debugM $ "enterAnn: (edp',off,priorEndAfterComments,curAnchor):" ++ show (edp',off,priorEndAfterComments,rs2range curAnchor)+  let edp'' = case anchor_op anchor' of+        MovedAnchor dp -> dp+        _ -> edp'+  -- ---------------------------------------------+  -- let edp = edp''+  med <- getExtraDP+  setExtraDP Nothing+  let edp = case med of+        Nothing -> edp''+        Just (Anchor _ (MovedAnchor dp)) -> dp+                   -- Replace original with desired one. Allows all+                   -- list entry values to be DP (1,0)+        Just (Anchor r _) -> dp+          where+            dp = adjustDeltaForOffset+                   off (ss2delta priorEndAfterComments r)+  when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ show (med,edp)+  -- ---------------------------------------------+  -- Preparation complete, perform the action+  when (priorEndAfterComments < spanStart) (do+    debugM $ "enterAnn.dPriorEndPosition:spanStart=" ++ show spanStart+    modify (\s -> s { dPriorEndPosition    = spanStart } ))++  debugM $ "enterAnn: (anchor_op, curAnchor):" ++ show (anchor_op anchor', rs2range curAnchor)+  debugM $ "enterAnn: (dLHS,spanStart,pec,edp)=" ++ show (off,spanStart,priorEndAfterComments,edp)+  p <- getPosP+  d <- getPriorEndD+  debugM $ "enterAnn: (posp, posd)=" ++ show (p,d)++  -- end of delta phase processing+  -- -------------------------------------------------------------------+  -- start of print phase processing++  let mflush = when (flush == FlushComments) $ do+        debugM $ "flushing comments in enterAnn"+        flushComments (getFollowingComments cs)++  -- let+  --   st = annNone+  -- withOffset st (advance edp >> exact a >> mflush)+-- local :: (r -> r) -> RWST r w s m a -> RWST r w s m a+  advance edp+  a' <- exact a+  mflush++  -- end of sub-Anchor processing, start of tail end processing+  postCs <- cua canUpdateAnchor takeAppliedCommentsPop+  when (flush == NoFlushComments) $ do+    when ((getFollowingComments cs) /= []) $ do+      debugM $ "starting trailing comments:" ++ showAst (getFollowingComments cs)+      mapM_ printOneComment (map tokComment $ getFollowingComments cs)+      debugM $ "ending trailing comments"++  let newAchor = anchor' { anchor_op = MovedAnchor edp }+  let r = case canUpdateAnchor of+            CanUpdateAnchor -> setAnnotationAnchor a' newAchor (mkEpaComments (priorCs++ postCs) [])+            CanUpdateAnchorOnly -> setAnnotationAnchor a' newAchor emptyComments+            NoCanUpdateAnchor -> a'+  -- let r = (setAnnotationAnchor a' newAchor (mkEpaComments [] postCs))+  pure () -- monadic action to flush debugM+  -- debugM $ "calling setAnnotationAnchor:(curAnchor, newAchor,priorCs,postCs)=" ++ showAst (show (rs2range curAnchor), newAchor, priorCs, postCs)+  -- debugM $ "calling setAnnotationAnchor:(newAchor,postCs)=" ++ showAst (newAchor, postCs)+  debugM $ "enterAnn:done:(p,a) =" ++ show (p, astId a')+  return r++-- ---------------------------------------------------------------------++-- withComments :: (Monad m, Monoid w) => Annotation -> (EP w m a -> EP w m a)+-- withComments a =+--   local (\s -> s { epAnn = a, epContext = pushAcs (epContext s) })+++-- ---------------------------------------------------------------------++addCommentsA :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()+addCommentsA csNew = addComments (map tokComment 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) => [Comment] -> EP w m ()+addComments csNew = do+  -- debugM $ "addComments:" ++ show csNew+  cs <- getUnallocatedComments+  -- Make sure we merge duplicates while sorting, needed until+  -- https://gitlab.haskell.org/ghc/ghc/-/issues/20239 is resolved+  let ocs = OSet.fromList cs+  let ncs = OSet.fromList csNew+  putUnallocatedComments (OSet.toAscList (ocs OSet.<>| ncs))+++-- ---------------------------------------------------------------------++-- | 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 trailing = do+  addCommentsA trailing+  cs <- getUnallocatedComments+  debugM $ "flushing comments starting"+  mapM_ printOneComment (sortComments cs)+  debugM $ "flushing comments done"++-- ---------------------------------------------------------------------++-- |In order to interleave annotations into the stream, we turn them into+-- comments. They are removed from the annotation to avoid duplication.+annotationsToComments :: (Monad m, Monoid w)+  => EpAnn a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m (EpAnn a)+annotationsToComments EpAnnNotUsed _ _kws = return EpAnnNotUsed+annotationsToComments (EpAnn anc a cs) l kws = do+  let (newComments, newAnns) = go ([],[]) (view l a)+  addComments newComments+  return (EpAnn anc (set l (reverse newAnns) a) cs)+  where+    keywords = Set.fromList kws++    go :: ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])+    go acc [] = acc+    go (cs',ans) ((AddEpAnn k ss) : ls)+      | Set.member k keywords = go ((mkKWComment k ss):cs', ans) ls+      | otherwise             = go (cs', (AddEpAnn k ss):ans)    ls+++-- -- |In order to interleave annotations into the stream, we turn them into+-- -- comments.+-- annotationsToComments' :: (Monad m, Monoid w) => [AddEpAnn] -> [AnnKeywordId] -> EP w m ()+-- annotationsToComments' ans kws = do+--   let+--     getSpans _ [] = []+--     getSpans k1 (AddEpAnn k2 ss:as)+--       | k1 == k2 = ss : getSpans k1 as+--       | otherwise = getSpans k1 as+--     doOne :: (Monad m, Monoid w) => AnnKeywordId -> EP w m [Comment]+--     doOne kw = do+--       let sps =getSpans kw ans+--       return $ map (mkKWComment kw ) sps+--     -- TODO:AZ make sure these are sorted/merged properly when the invariant for+--     -- allocateComments is re-established.+--   newComments <- mapM doOne kws+--   addComments (concat newComments)++-- annotationsToCommentsA :: (Monad m, Monoid w) => EpAnn [AddEpAnn] -> [AnnKeywordId] -> EP w m ()+-- annotationsToCommentsA EpAnnNotUsed _ = return ()+-- annotationsToCommentsA an kws = annotationsToComments' (anns an) kws++-- ---------------------------------------------------------------------++-- Temporary function to simply reproduce the "normal" pretty printer output+withPpr :: (Monad m, Monoid w, Outputable a) => a -> EP w m a+withPpr a = do+  ss <- getAnchorU+  debugM $ "withPpr: ss=" ++ show ss+  printStringAtRs' ss (showPprUnsafe a)+  return a++-- ---------------------------------------------------------------------++-- | An AST fragment with an annotation must be able to return the+-- requirements for nesting another one, captured in an 'Entry', and+-- to be able to use the rest of the exactprint machinery to print the+-- element.  In the analogy to Outputable, 'exact' plays the role of+-- 'ppr'.+class (Typeable a) => ExactPrint a where+  getAnnotationEntry :: a -> Entry+  setAnnotationAnchor :: a -> Anchor -> 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 (NoSourceText) txt   =  printStringAdvance txt >> return ()+printSourceText (SourceText   txt) _ =  printStringAdvance txt >> return ()++-- ---------------------------------------------------------------------++printStringAtSs :: (Monad m, Monoid w) => SrcSpan -> String -> EP w m ()+printStringAtSs ss str = printStringAtRs (realSrcSpan ss) str >> return ()++printStringAtRs :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m EpaLocation+printStringAtRs pa str = printStringAtRsC CaptureComments pa str++printStringAtRsC :: (Monad m, Monoid w)+  => CaptureComments -> RealSrcSpan -> String -> EP w m EpaLocation+printStringAtRsC capture pa str = do+  printComments pa+  pe <- getPriorEndD+  debugM $ "printStringAtRs:pe=" ++ show pe+  let p = ss2delta pe pa+  p' <- adjustDeltaForOffsetM p+  printStringAtLsDelta p' str+  setPriorEndASTD True pa+  cs' <- case capture of+    CaptureComments -> takeAppliedComments+    NoCaptureComments -> return []+  debugM $ "printStringAtRs:cs'=" ++ show cs'+  -- return (EpaDelta p' (map comment2LEpaComment (noKWComments cs')))+  return (EpaDelta p' (map comment2LEpaComment cs'))++printStringAtRs' :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m ()+printStringAtRs' pa str = printStringAtRsC NoCaptureComments pa str >> return ()++-- ---------------------------------------------------------------------++-- AZ:TODO get rid of this+printStringAtMLoc :: (Monad m, Monoid w) => Maybe EpaLocation -> String -> EP w m ()+printStringAtMLoc (Just aa) s = printStringAtAA aa s >> return ()+printStringAtMLoc Nothing s = printStringAtLsDelta (SameLine 1) s >> return ()++printStringAtMLoc' :: (Monad m, Monoid w)+  => Maybe EpaLocation -> String -> EP w m (Maybe EpaLocation)+printStringAtMLoc' (Just aa) s = Just <$> printStringAtAA aa s+printStringAtMLoc' Nothing s = do+  printStringAtLsDelta (SameLine 1) s+  return (Just (EpaDelta (SameLine 1) []))++printStringAtMLocL :: (Monad m, Monoid w)+  => EpAnn a -> Lens a (Maybe EpaLocation) -> String -> EP w m (EpAnn a)+printStringAtMLocL EpAnnNotUsed _ _ = return EpAnnNotUsed+printStringAtMLocL (EpAnn anc an cs) l s = do+  r <- go (view l an) s+  return (EpAnn anc (set l r an) cs)+  where+    go (Just aa) str = Just <$> printStringAtAA aa str+    go Nothing str = do+      printStringAtLsDelta (SameLine 1) str+      return (Just (EpaDelta (SameLine 1) []))++printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation+printStringAtAA el str = printStringAtAAC CaptureComments el str++printStringAtAAL :: (Monad m, Monoid w)+  => EpAnn a -> Lens a EpaLocation -> String -> EP w m (EpAnn a)+printStringAtAAL EpAnnNotUsed _ _ = return EpAnnNotUsed+printStringAtAAL (EpAnn anc an cs) l str = do+  r <- printStringAtAAC CaptureComments (view l an) str+  return (EpAnn anc (set l r an) cs)++printStringAtAAC :: (Monad m, Monoid w)+  => CaptureComments -> EpaLocation -> String -> EP w m EpaLocation+printStringAtAAC capture (EpaSpan r) s = printStringAtRsC capture r s+printStringAtAAC capture (EpaDelta d cs) s = do+  mapM_ (printOneComment . tokComment) cs+  pe1 <- getPriorEndD+  p1 <- getPosP+  printStringAtLsDelta d s+  p2 <- getPosP+  pe2 <- getPriorEndD+  debugM $ "printStringAtAA:(pe1,pe2,p1,p2)=" ++ show (pe1,pe2,p1,p2)+  -- setPriorEndASTPD True (p1,p2)+  setPriorEndASTPD True (pe1,pe2)+  cs' <- case capture of+    CaptureComments -> takeAppliedComments+    NoCaptureComments -> return []+  debugM $ "printStringAtAA:(pe1,pe2,p1,p2,cs')=" ++ show (pe1,pe2,p1,p2,cs')+  -- return (EpaDelta d (map comment2LEpaComment (noKWComments cs')))+  return (EpaDelta d (map comment2LEpaComment cs'))+++-- ---------------------------------------------------------------------++markExternalSourceText :: (Monad m, Monoid w) => SrcSpan -> SourceText -> String -> EP w m ()+markExternalSourceText l NoSourceText txt   = printStringAtRs (realSrcSpan l) txt >> return ()+markExternalSourceText l (SourceText txt) _ = printStringAtRs (realSrcSpan l) txt >> return ()++-- ---------------------------------------------------------------------++-- -- TODO: remove in favour of markLensMAA+-- markLocatedMAA :: (Monad m, Monoid w) => EpAnn a -> (a -> Maybe AddEpAnn) -> EP w m ()+-- markLocatedMAA EpAnnNotUsed  _  = return ()+-- markLocatedMAA (EpAnn _ a _) f =+--   case f a of+--     Nothing -> return ()+--     Just aa -> markAddEpAnn aa >> return ()++markLensMAA :: (Monad m, Monoid w) => EpAnn a -> Lens a (Maybe AddEpAnn) -> EP w m (EpAnn a)+markLensMAA EpAnnNotUsed  _  = return EpAnnNotUsed+markLensMAA (EpAnn anc a cs) l =+  case view l a of+    Nothing -> return (EpAnn anc a cs)+    Just aa -> do+      aa' <- markAddEpAnn aa+      return (EpAnn anc (set l (Just aa') a) cs)++markLensAA :: (Monad m, Monoid w) => EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)+markLensAA EpAnnNotUsed  _  = return EpAnnNotUsed+markLensAA (EpAnn anc a cs) l = do+  a' <- markKw (view l a)+  return (EpAnn anc (set l a' a) cs)+++-- TODO: removein favour of markEpAnnL+markLocatedAAL :: (Monad m, Monoid w) => EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> EP w m Int+markLocatedAAL EpAnnNotUsed  _ _ = return 1+markLocatedAAL (EpAnn _ a _) f kw = go (f a)+  where+    go [] = return 1+    go (aa@(AddEpAnn kw' _):as)+      | kw' == kw = mark [aa] kw+      | otherwise = go as+++markEpAnnLMS :: (Monad m, Monoid w)+  => EpAnn a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m (EpAnn a)+markEpAnnLMS an l kw Nothing = markEpAnnL an l kw+markEpAnnLMS EpAnnNotUsed  _ _ _ = return EpAnnNotUsed+markEpAnnLMS (EpAnn anc a cs) l kw (Just str) = do+  anns <- mapM go (view l a)+  return (EpAnn anc (set l anns a) cs)+  where+    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+    go (AddEpAnn kw' r)+      | kw' == kw = do+          r' <- printStringAtAA r str+          return (AddEpAnn kw' r')+      | otherwise = return (AddEpAnn kw' r)++markEpAnnLMS' :: (Monad m, Monoid w)+                => EpAnn a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m (EpAnn a)+markEpAnnLMS' an l _kw Nothing = markLensKwA an l+markEpAnnLMS' EpAnnNotUsed  _ _ _ = return EpAnnNotUsed+markEpAnnLMS' (EpAnn anc a cs) l kw (Just str) = do+  anns <- go (view l a)+  return (EpAnn anc (set l anns a) cs)+  where+    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+    go (AddEpAnn kw' r)+      | kw' == kw = do+          r' <- printStringAtAA r str+          return (AddEpAnn kw' r')+      | otherwise = return (AddEpAnn kw' r)++-- ---------------------------------------------------------------------++markArrow :: (Monad m, Monoid w)+  => EpAnn TrailingAnn -> HsArrow GhcPs -> EP w m (EpAnn TrailingAnn, HsArrow GhcPs)+markArrow an arr = do+  arr' <-+    case arr of+      HsUnrestrictedArrow _u ->+        return arr+      HsLinearArrow u ma -> do+        ma' <- mapM markAddEpAnn ma+        return (HsLinearArrow u ma')+      HsExplicitMult u ma t  -> do+        ma' <- mapM markAddEpAnn ma+        t' <- markAnnotated t+        return (HsExplicitMult u ma' t')++  an' <- case an of+           EpAnnNotUsed -> pure EpAnnNotUsed+           EpAnn anc a cs -> do+             a' <- markKwT a+             return (EpAnn anc a' cs)+  return (an', arr')++-- ---------------------------------------------------------------------++markAnnCloseP :: (Monad m, Monoid w) => EpAnn AnnPragma -> EP w m (EpAnn AnnPragma)+markAnnCloseP an = markEpAnnLMS' an lapr_close AnnClose (Just "#-}")++markAnnOpenP :: (Monad m, Monoid w) => EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)+markAnnOpenP an NoSourceText txt   = markEpAnnLMS' an lapr_open AnnOpen (Just txt)+markAnnOpenP an (SourceText txt) _ = markEpAnnLMS' an lapr_open AnnOpen (Just txt)++markAnnOpen :: (Monad m, Monoid w) => EpAnn [AddEpAnn] -> SourceText -> String -> EP w m (EpAnn [AddEpAnn])+markAnnOpen an NoSourceText txt   = markEpAnnLMS an lidl AnnOpen (Just txt)+markAnnOpen an (SourceText txt) _ = markEpAnnLMS an lidl AnnOpen (Just txt)++markAnnOpen' :: (Monad m, Monoid w)+  => Maybe EpaLocation -> SourceText -> String -> EP w m (Maybe EpaLocation)+markAnnOpen' ms NoSourceText txt   = printStringAtMLoc' ms txt+markAnnOpen' ms (SourceText txt) _ = printStringAtMLoc' ms txt++markAnnOpen'' :: (Monad m, Monoid w)+  => EpaLocation -> SourceText -> String -> EP w m EpaLocation+markAnnOpen'' el NoSourceText txt   = printStringAtAA el txt+markAnnOpen'' el (SourceText txt) _ = printStringAtAA el txt++-- ---------------------------------------------------------------------+{-+data AnnParen+  = AnnParen {+      ap_adornment :: ParenType,+      ap_open      :: EpaLocation,+      ap_close     :: EpaLocation+      } deriving (Data)+-}+markOpeningParen, markClosingParen :: (Monad m, Monoid w) => EpAnn AnnParen -> EP w m (EpAnn AnnParen)+markOpeningParen an = markParen an lfst+markClosingParen an = markParen an lsnd++markParen :: (Monad m, Monoid w) => EpAnn AnnParen -> (forall a. Lens (a,a) a) -> EP w m (EpAnn AnnParen)+markParen EpAnnNotUsed _ = return (EpAnnNotUsed)+markParen (EpAnn anc (AnnParen pt o c) cs) l = do+  loc' <- markKwA (view l $ kw pt) (view l (o, c))+  let (o',c') = set l loc' (o,c)+  return (EpAnn anc (AnnParen pt o' c') cs)+  where+    kw AnnParens       = (AnnOpenP,  AnnCloseP)+    kw AnnParensHash   = (AnnOpenPH, AnnClosePH)+    kw AnnParensSquare = (AnnOpenS, AnnCloseS)+-- markParen' :: (Monad m, Monoid w) => EpAnn AnnParen -> (forall a. (a,a) -> a) -> EP w m (EpAnn AnnParen)+-- markParen' EpAnnNotUsed _ = return (EpAnnNotUsed)+-- markParen' (EpAnn anc (AnnParen pt o c) cs) f = do+--   markKwA (f $ kw pt) (f (o, c))+--   return (EpAnn anc (AnnParen pt o c) cs)+--   where+--     kw AnnParens       = (AnnOpenP,  AnnCloseP)+--     kw AnnParensHash   = (AnnOpenPH, AnnClosePH)+--     kw AnnParensSquare = (AnnOpenS, AnnCloseS)++-- ---------------------------------------------------------------------+-- Bare bones Optics+-- Base on From https://hackage.haskell.org/package/lens-tutorial-1.0.3/docs/Control-Lens-Tutorial.html++type Lens    a b = forall f . Functor f => (b -> f        b) -> (a -> f        a)+type Getting a b =                         (b -> Const  b b) -> (a -> Const b  a)+type ASetter a b =                         (b -> Identity b) -> (a -> Identity a)++view :: MonadReader s m => Getting s a -> m a+-- view l = Reader.asks (getConst #. l Const)+view l = Reader.asks (getConst . l Const)+{-# INLINE view #-}++over :: ASetter a b -> (b -> b) -> (a -> a)+-- over l f = runIdentity #. l (Identity #. f)+over l f = runIdentity . l (Identity . f)+{-# INLINE over #-}++set  :: Lens a b -> b -> a -> a+set lens b = over lens (\_ -> 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++lalLet :: Lens AnnsLet EpaLocation+lalLet k annsLet = fmap (\newLoc -> annsLet { alLet = newLoc })+                        (k (alLet annsLet))++lalIn :: Lens AnnsLet EpaLocation+lalIn k annsLet = fmap (\newLoc -> annsLet { alIn = newLoc })+                       (k (alIn annsLet))+-- data AnnsModule+--   = AnnsModule {+--     am_main :: [AddEpAnn],+--     am_decls :: AnnList+--     } deriving (Data, Eq)++lam_main :: Lens AnnsModule [AddEpAnn]+lam_main k annsModule = fmap (\newAnns -> annsModule { am_main = newAnns })+                             (k (am_main annsModule))++-- lam_decls :: Lens AnnsModule AnnList+-- lam_decls k annsModule = fmap (\newAnns -> annsModule { am_decls = newAnns })+--                               (k (am_decls annsModule))+++-- data EpAnnImportDecl = EpAnnImportDecl+--   { importDeclAnnImport    :: EpaLocation+--   , importDeclAnnPragma    :: Maybe (EpaLocation, EpaLocation)+--   , importDeclAnnSafe      :: Maybe EpaLocation+--   , importDeclAnnQualified :: Maybe EpaLocation+--   , importDeclAnnPackage   :: Maybe EpaLocation+--   , importDeclAnnAs        :: Maybe EpaLocation+--   } deriving (Data)++limportDeclAnnImport :: Lens EpAnnImportDecl EpaLocation+limportDeclAnnImport k annImp = fmap (\new -> annImp { importDeclAnnImport = new })+                                     (k (importDeclAnnImport annImp))++-- limportDeclAnnPragma :: Lens EpAnnImportDecl (Maybe (EpaLocation, EpaLocation))+-- limportDeclAnnPragma k annImp = fmap (\new -> annImp { importDeclAnnPragma = new })+--                                      (k (importDeclAnnPragma annImp))++limportDeclAnnSafe :: Lens EpAnnImportDecl (Maybe EpaLocation)+limportDeclAnnSafe k annImp = fmap (\new -> annImp { importDeclAnnSafe = new })+                                     (k (importDeclAnnSafe annImp))++limportDeclAnnQualified :: Lens EpAnnImportDecl (Maybe EpaLocation)+limportDeclAnnQualified k annImp = fmap (\new -> annImp { importDeclAnnQualified = new })+                                     (k (importDeclAnnQualified annImp))++limportDeclAnnPackage :: Lens EpAnnImportDecl (Maybe EpaLocation)+limportDeclAnnPackage k annImp = fmap (\new -> annImp { importDeclAnnPackage = new })+                                     (k (importDeclAnnPackage annImp))++-- limportDeclAnnAs :: Lens EpAnnImportDecl (Maybe EpaLocation)+-- limportDeclAnnAs k annImp = fmap (\new -> annImp { importDeclAnnAs = new })+--                                      (k (importDeclAnnAs annImp))++-- -------------------------------------++-- data AnnList+--   = AnnList {+--       al_anchor    :: Maybe Anchor, -- ^ start point of a list having layout+--       al_open      :: Maybe AddEpAnn,+--       al_close     :: Maybe AddEpAnn,+--       al_rest      :: [AddEpAnn], -- ^ context, such as 'where' keyword+--       al_trailing  :: [TrailingAnn] -- ^ items appearing after the+--                                     -- list, such as '=>' for a+--                                     -- context+--       } deriving (Data,Eq)++lal_open :: Lens AnnList (Maybe AddEpAnn)+lal_open k parent = fmap (\new -> parent { al_open = new })+                           (k (al_open parent))++lal_close :: Lens AnnList (Maybe AddEpAnn)+lal_close k parent = fmap (\new -> parent { al_close = new })+                           (k (al_close parent))++lal_rest :: Lens AnnList [AddEpAnn]+lal_rest k parent = fmap (\new -> parent { al_rest = new })+                           (k (al_rest parent))++lal_trailing :: Lens AnnList [TrailingAnn]+lal_trailing k parent = fmap (\new -> parent { al_trailing = new })+                           (k (al_trailing parent))++-- -------------------------------------++lapr_rest :: Lens AnnPragma [AddEpAnn]+lapr_rest k parent = fmap (\newAnns -> parent { apr_rest = newAnns })+                          (k (apr_rest parent))++lapr_open :: Lens AnnPragma AddEpAnn+lapr_open k parent = fmap (\new -> parent { apr_open = new })+                          (k (apr_open parent))++lapr_close :: Lens AnnPragma AddEpAnn+lapr_close k parent = fmap (\new -> parent { apr_close = new })+                          (k (apr_close parent))++lidl :: Lens [AddEpAnn] [AddEpAnn]+lidl k parent = fmap (\new -> new)+                     (k parent)++lid :: Lens a a+lid k parent = fmap (\new -> new)+                    (k parent)++lfst :: Lens (a,a) a+lfst k parent = fmap (\new -> (new, snd parent))+                     (k (fst parent))++lsnd :: Lens (a,a) a+lsnd k parent = fmap (\new -> (fst parent, new))+                     (k (snd parent))++-- -------------------------------------+-- data AnnExplicitSum+--   = AnnExplicitSum {+--       aesOpen       :: EpaLocation,+--       aesBarsBefore :: [EpaLocation],+--       aesBarsAfter  :: [EpaLocation],+--       aesClose      :: EpaLocation+--       } deriving Data++laesOpen :: Lens AnnExplicitSum EpaLocation+laesOpen k parent = fmap (\new -> parent { aesOpen = new })+                         (k (aesOpen parent))++laesBarsBefore :: Lens AnnExplicitSum [EpaLocation]+laesBarsBefore k parent = fmap (\new -> parent { aesBarsBefore = new })+                               (k (aesBarsBefore parent))++laesBarsAfter :: Lens AnnExplicitSum [EpaLocation]+laesBarsAfter k parent = fmap (\new -> parent { aesBarsAfter = new })+                               (k (aesBarsAfter parent))++laesClose :: Lens AnnExplicitSum EpaLocation+laesClose k parent = fmap (\new -> parent { aesClose = new })+                               (k (aesClose parent))++-- -------------------------------------+-- data AnnFieldLabel+--   = AnnFieldLabel {+--       afDot :: Maybe EpaLocation+--       } deriving Data++lafDot :: Lens AnnFieldLabel (Maybe EpaLocation)+lafDot k parent = fmap (\new -> parent { afDot = new })+                         (k (afDot parent))++-- -------------------------------------+-- data AnnProjection+--   = AnnProjection {+--       apOpen  :: EpaLocation, -- ^ '('+--       apClose :: EpaLocation  -- ^ ')'+--       } deriving Data++lapOpen :: Lens AnnProjection EpaLocation+lapOpen k parent = fmap (\new -> parent { apOpen = new })+                         (k (apOpen parent))++lapClose :: Lens AnnProjection EpaLocation+lapClose k parent = fmap (\new -> parent { apClose = new })+                         (k (apClose parent))++-- -------------------------------------+-- data AnnsIf+--   = AnnsIf {+--       aiIf       :: EpaLocation,+--       aiThen     :: EpaLocation,+--       aiElse     :: EpaLocation,+--       aiThenSemi :: Maybe EpaLocation,+--       aiElseSemi :: Maybe EpaLocation+--       } deriving Data++laiIf :: Lens AnnsIf EpaLocation+laiIf k parent = fmap (\new -> parent { aiIf = new })+                      (k (aiIf parent))++laiThen :: Lens AnnsIf EpaLocation+laiThen k parent = fmap (\new -> parent { aiThen = new })+                        (k (aiThen parent))++laiElse :: Lens AnnsIf EpaLocation+laiElse k parent = fmap (\new -> parent { aiElse = new })+                        (k (aiElse parent))++laiThenSemi :: Lens AnnsIf (Maybe EpaLocation)+laiThenSemi k parent = fmap (\new -> parent { aiThenSemi = new })+                            (k (aiThenSemi parent))++laiElseSemi :: Lens AnnsIf (Maybe EpaLocation)+laiElseSemi k parent = fmap (\new -> parent { aiElseSemi = new })+                            (k (aiElseSemi parent))++-- -------------------------------------++-- data AnnParen+--   = AnnParen {+--       ap_adornment :: ParenType,+--       ap_open      :: EpaLocation,+--       ap_close     :: EpaLocation+--       } deriving (Data)++lap_open :: Lens AnnParen EpaLocation+lap_open k parent = fmap (\new -> parent { ap_open = new })+                         (k (ap_open parent))++lap_close :: Lens AnnParen EpaLocation+lap_close k parent = fmap (\new -> parent { ap_close = new })+                          (k (ap_close parent))++-- -------------------------------------+-- data EpAnnHsCase = EpAnnHsCase+--       { hsCaseAnnCase :: EpaLocation+--       , hsCaseAnnOf   :: EpaLocation+--       , hsCaseAnnsRest :: [AddEpAnn]+--       } deriving Data++lhsCaseAnnCase :: Lens EpAnnHsCase EpaLocation+lhsCaseAnnCase k parent = fmap (\new -> parent { hsCaseAnnCase = new })+                               (k (hsCaseAnnCase parent))++lhsCaseAnnOf :: Lens EpAnnHsCase EpaLocation+lhsCaseAnnOf k parent = fmap (\new -> parent { hsCaseAnnOf = new })+                               (k (hsCaseAnnOf parent))++lhsCaseAnnsRest :: Lens EpAnnHsCase [AddEpAnn]+lhsCaseAnnsRest k parent = fmap (\new -> parent { hsCaseAnnsRest = new })+                                (k (hsCaseAnnsRest parent))++-- ---------------------------------------------------------------------++-- data HsRuleAnn+--   = HsRuleAnn+--        { ra_tyanns :: Maybe (AddEpAnn, AddEpAnn)+--                  -- ^ The locations of 'forall' and '.' for forall'd type vars+--                  -- Using AddEpAnn to capture possible unicode variants+--        , ra_tmanns :: Maybe (AddEpAnn, AddEpAnn)+--                  -- ^ The locations of 'forall' and '.' for forall'd term vars+--                  -- Using AddEpAnn to capture possible unicode variants+--        , ra_rest :: [AddEpAnn]+--        } deriving (Data, Eq)++lra_tyanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))+lra_tyanns k parent = fmap (\new -> parent { ra_tyanns = new })+                               (k (ra_tyanns parent))++ff :: Maybe (a,b) -> (Maybe a,Maybe b)+ff Nothing = (Nothing, Nothing)+ff (Just (a,b)) = (Just a, Just b)+++gg :: (Maybe a,Maybe b) -> Maybe (a,b)+gg (Nothing, Nothing) = Nothing+gg (Just a, Just b) = Just (a,b)+gg _ = error "gg:expecting two Nothing or two Just"++lff :: Lens (Maybe (a,b)) (Maybe a,Maybe b)+lff k parent = fmap (\new -> gg new)+                    (k (ff parent))++-- (.) :: Lens' a b -> Lens' b c -> Lens' a c+lra_tyanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)+lra_tyanns_fst = lra_tyanns . lff . lfst++lra_tyanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)+lra_tyanns_snd = lra_tyanns . lff . lsnd++lra_tmanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))+lra_tmanns k parent = fmap (\new -> parent { ra_tmanns = new })+                               (k (ra_tmanns parent))++lra_tmanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)+lra_tmanns_fst = lra_tmanns . lff . lfst++lra_tmanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)+lra_tmanns_snd = lra_tmanns . lff . lsnd++lra_rest :: Lens HsRuleAnn [AddEpAnn]+lra_rest k parent = fmap (\new -> parent { ra_rest = new })+                                (k (ra_rest parent))+++-- ---------------------------------------------------------------------+-- data GrhsAnn+--   = GrhsAnn {+--       ga_vbar :: Maybe EpaLocation, -- TODO:AZ do we need this?+--       ga_sep  :: AddEpAnn -- ^ Match separator location+--       } deriving (Data)++lga_vbar :: Lens GrhsAnn (Maybe EpaLocation)+lga_vbar k parent = fmap (\new -> parent { ga_vbar = new })+                                (k (ga_vbar parent))++lga_sep :: Lens GrhsAnn AddEpAnn+lga_sep k parent = fmap (\new -> parent { ga_sep = new })+                                (k (ga_sep parent))++-- ---------------------------------------------------------------------+-- data AnnSig+--   = AnnSig {+--       asDcolon :: AddEpAnn, -- Not an EpaAnchor to capture unicode option+--       asRest   :: [AddEpAnn]+--       } deriving Data++lasDcolon :: Lens AnnSig AddEpAnn+lasDcolon k parent = fmap (\new -> parent { asDcolon = new })+                                (k (asDcolon parent))++lasRest :: Lens AnnSig [AddEpAnn]+lasRest k parent = fmap (\new -> parent { asRest = new })+                                (k (asRest parent))++-- ---------------------------------------------------------------------+-- data EpAnnSumPat = EpAnnSumPat+--       { sumPatParens      :: [AddEpAnn]+--       , sumPatVbarsBefore :: [EpaLocation]+--       , sumPatVbarsAfter  :: [EpaLocation]+--       } deriving Data++lsumPatParens :: Lens EpAnnSumPat [AddEpAnn]+lsumPatParens k parent = fmap (\new -> parent { sumPatParens = new })+                              (k (sumPatParens parent))++lsumPatVbarsBefore :: Lens EpAnnSumPat [EpaLocation]+lsumPatVbarsBefore k parent = fmap (\new -> parent { sumPatVbarsBefore = new })+                              (k (sumPatVbarsBefore parent))++lsumPatVbarsAfter :: Lens EpAnnSumPat [EpaLocation]+lsumPatVbarsAfter k parent = fmap (\new -> parent { sumPatVbarsAfter = new })+                              (k (sumPatVbarsAfter parent))++-- End of lenses+-- ---------------------------------------------------------------------++markLensKwA :: (Monad m, Monoid w)+  => EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)+markLensKwA EpAnnNotUsed  _    = return EpAnnNotUsed+markLensKwA (EpAnn anc a cs) l = do+  loc <- markKw (view l a)+  return (EpAnn anc (set l loc a) cs)++markLensKw :: (Monad m, Monoid w)+  => EpAnn a -> Lens a EpaLocation -> AnnKeywordId -> EP w m (EpAnn a)+markLensKw EpAnnNotUsed  _ _  = return EpAnnNotUsed+markLensKw (EpAnn anc a cs) l kw = do+  loc <- markKwA kw (view l a)+  return (EpAnn anc (set l loc a) cs)++markAnnKwL :: (Monad m, Monoid w)+  => EpAnn a -> Lens a EpaLocation -> AnnKeywordId -> EP w m (EpAnn a)+markAnnKwL = markLensKw++markAnnKwAllL :: (Monad m, Monoid w)+  => EpAnn a -> Lens a [EpaLocation] -> AnnKeywordId -> EP w m (EpAnn a)+markAnnKwAllL EpAnnNotUsed  _ _  = return EpAnnNotUsed+-- markAnnKwAllL (EpAnn _ a _) f kw = mapM_ (markKwA kw) (sort (f a))+markAnnKwAllL (EpAnn anc a cs) l kw = do+  -- anns <- mapM (markKwA kw) (sort (view l a))+  anns <- mapM (markKwA kw) (view l a)+  return (EpAnn anc (set l anns a) cs)++markLensKwM :: (Monad m, Monoid w)+  => EpAnn a -> Lens a (Maybe EpaLocation) -> AnnKeywordId -> EP w m (EpAnn a)+markLensKwM EpAnnNotUsed  _ _ = return EpAnnNotUsed+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++-- ---------------------------------------------------------------------++markALocatedA :: (Monad m, Monoid w) => EpAnn AnnListItem -> EP w m (EpAnn AnnListItem)+markALocatedA EpAnnNotUsed  = return EpAnnNotUsed+markALocatedA (EpAnn anc a cs) = do+  t <- markTrailing (lann_trailing a)+  return (EpAnn anc (a { lann_trailing = t }) cs)++-- Deprecate in favour of markEpAnnL+markEpAnn :: (Monad m, Monoid w)+  => EpAnn [AddEpAnn] -> AnnKeywordId -> EP w m Int -- Return something to trigger not used warning+markEpAnn EpAnnNotUsed _ = return 1+markEpAnn (EpAnn _ a _) kw = mark a kw >> return 1++-- -- Deprecate in favour of markEpAnnL+-- markEpAnn' :: (Monad m, Monoid w)+--   => EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EP w m ()+-- markEpAnn' EpAnnNotUsed _ _ = return ()+-- markEpAnn' (EpAnn _anc a _cs) f kw = mark' (f a) kw >> return ()++markEpAnnL :: (Monad m, Monoid w)+  => EpAnn ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)+markEpAnnL EpAnnNotUsed _ _ = return EpAnnNotUsed+markEpAnnL (EpAnn anc a cs) l kw = do+  anns <- mark' (view l a) kw+  return (EpAnn anc (set l anns a) cs)++markEpAnnAllL :: (Monad m, Monoid w)+  => EpAnn ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)+markEpAnnAllL EpAnnNotUsed _ _ = return EpAnnNotUsed+markEpAnnAllL (EpAnn anc a cs) l kw = do+  anns <- mapM doit (view l a)+  return (EpAnn anc (set l anns a) cs)+  where+    doit an@(AddEpAnn ka _)+      = if ka == kw+          then markKw an+          else return an++markAddEpAnn :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+markAddEpAnn a@(AddEpAnn kw _) = do+  r <- mark' [a] kw+  case r of+    [a'] -> return a'+    _ -> error "Should not happen: markAddEpAnn"++mark :: (Monad m, Monoid w) => [AddEpAnn] -> AnnKeywordId -> EP w m Int+mark anns kw = do+  case find (\(AddEpAnn k _) -> k == kw) anns of+    Just aa -> markKw aa >> return 1+    Nothing -> case find (\(AddEpAnn k _) -> k == (unicodeAnn kw)) anns of+      Just aau -> markKw aau >> return 1+      Nothing -> return 1++mark' :: (Monad m, Monoid w) => [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]+mark' anns kw = do+  case find' kw anns of+    (lead, Just aa, end) -> do+      aa' <- markKw aa+      return (lead ++ [aa'] ++ end)+    (_lead, Nothing, _end) -> case find' (unicodeAnn kw) anns of+      (leadu, Just aau, endu) -> do+        aau' <- markKw aau+        return (leadu ++ [aau'] ++ endu)+      (_,Nothing,_) -> return anns++-- | Find for update, returning lead section of the list, item if+-- found, and tail of the list+find' :: AnnKeywordId -> [AddEpAnn] -> ([AddEpAnn], Maybe AddEpAnn, [AddEpAnn])+find' kw anns = (lead, middle, end)+  where+    (lead, rest) = break (\(AddEpAnn k _) -> k == kw) anns+    (middle,end) = case rest of+      [] -> (Nothing, [])+      (x:xs) -> (Just x, xs)++markKw :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+markKw an = markKwC CaptureComments an++markKwC :: (Monad m, Monoid w) => CaptureComments -> AddEpAnn -> EP w m AddEpAnn+markKwC capture (AddEpAnn kw ss) = do+  ss' <- markKwAC capture kw ss+  return (AddEpAnn kw ss')++-- | This should be the main driver of the process, managing printing keywords.+-- It returns the 'EpaDelta' variant of the passed in 'EpaLocation'+markKwA :: (Monad m, Monoid w) => AnnKeywordId -> EpaLocation -> EP w m EpaLocation+markKwA kw aa = markKwAC CaptureComments kw aa++markKwAC :: (Monad m, Monoid w)+  => CaptureComments -> AnnKeywordId -> EpaLocation -> EP w m EpaLocation+markKwAC capture kw aa = printStringAtAAC capture aa (keywordToString kw)++-- | Print a keyword encoded in a 'TrailingAnn'+markKwT :: (Monad m, Monoid w) => TrailingAnn -> EP w m TrailingAnn+markKwT (AddSemiAnn ss)    = AddSemiAnn    <$> markKwA AnnSemi ss+markKwT (AddCommaAnn ss)   = AddCommaAnn   <$> markKwA AnnComma ss+markKwT (AddVbarAnn ss)    = AddVbarAnn    <$> markKwA AnnVbar ss+markKwT (AddRarrowAnn ss)  = AddRarrowAnn  <$> markKwA AnnRarrow ss+markKwT (AddRarrowAnnU ss) = AddRarrowAnnU <$> markKwA AnnRarrowU ss+markKwT (AddLollyAnnU ss)  = AddLollyAnnU  <$> markKwA AnnLollyU ss++-- ---------------------------------------------------------------------++markAnnList :: (Monad m, Monoid w)+  => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)+markAnnList reallyTrail ann action = do+  markAnnListA reallyTrail ann $ \a -> do+    r <- action+    return (a,r)++markAnnListA :: (Monad m, Monoid w)+  => Bool -> EpAnn AnnList+  -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))+  -> EP w m (EpAnn AnnList, a)+markAnnListA _ EpAnnNotUsed action = do+  action EpAnnNotUsed+markAnnListA reallyTrail an action = do+  debugM $ "markAnnListA: an=" ++ showAst an+  an0 <- markLensMAA an lal_open+  an1 <- if (not reallyTrail)+           then markTrailingL an0 lal_trailing+           else return an0+  an2 <- markEpAnnAllL an1 lal_rest AnnSemi+  (an3, r) <- action an2+  an4 <- markLensMAA an3 lal_close+  an5 <- if reallyTrail+           then markTrailingL an4 lal_trailing+           else return an4+  debugM $ "markAnnListA: an5=" ++ showAst an+  return (an5, r)+++markAnnList' :: (Monad m, Monoid w)+  => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)+markAnnList' reallyTrail an action = do+  p <- getPosP+  debugM $ "markAnnList : " ++ showPprUnsafe (p, an)+  an0 <- markLensMAA an lal_open+  an1 <- if (not reallyTrail)+           then markTrailingL an0 lal_trailing+           else return an0+  an2 <- markEpAnnAllL an1 lal_rest AnnSemi+  r <- action+  an3 <- markLensMAA an2 lal_close+  an4 <- if reallyTrail+           then markTrailingL an3 lal_trailing+           else return an3+  return (an4, r)++-- ---------------------------------------------------------------------++printComments :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()+printComments ss = do+  cs <- commentAllocation ss+  debugM $ "printComments: (ss): " ++ showPprUnsafe (rs2range ss)+  -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentAnchor cs)+  mapM_ printOneComment cs++-- ---------------------------------------------------------------------++printOneComment :: (Monad m, Monoid w) => Comment -> EP w m ()+printOneComment c@(Comment _str loc _r _mo) = do+  debugM $ "printOneComment:c=" ++ showGhc c+  dp <-case anchor_op loc of+    MovedAnchor dp -> return dp+    _ -> do+        pe <- getPriorEndD+        let dp = ss2delta pe (anchor loc)+        debugM $ "printOneComment:(dp,pe,anchor loc)=" ++ showGhc (dp,pe,ss2pos $ anchor loc)+        adjustDeltaForOffsetM dp+  mep <- getExtraDP+  dp' <- case mep of+    Just (Anchor _ (MovedAnchor edp)) -> do+      debugM $ "printOneComment:edp=" ++ show edp+      adjustDeltaForOffsetM edp+    _ -> return dp+  -- Start of debug printing+  -- LayoutStartCol dOff <- getLayoutOffsetD+  -- debugM $ "printOneComment:(dp,dp',dOff)=" ++ showGhc (dp,dp',dOff)+  -- End of debug printing+  -- setPriorEndD (ss2posEnd (anchor loc))+  updateAndApplyComment c dp'+  printQueuedComment (anchor loc) c dp'++updateAndApplyComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()+updateAndApplyComment co@(Comment str anc pp mo) dp = do+  -- debugM $ "updateAndApplyComment: (dp,anc',co)=" ++ showAst (dp,anc',co)+  applyComment (Comment str anc' pp mo)+  where+    -- anc' = anc { anchor_op = MovedAnchor dp }+    anc' = anc { anchor_op = op}++    (r,c) = ss2posEnd pp+    la = anchor anc+    dp'' = if r == 0+           then (ss2delta (r,c+1) la)+           else (ss2delta (r,c)   la)+    dp' = if pp == anchor anc+             then dp+             else dp''+    op' = case dp' of+            SameLine n -> if n >= 0+                            then MovedAnchor dp'+                            else MovedAnchor dp+            _ -> MovedAnchor dp'+    op = if str == "" && op' == MovedAnchor (SameLine 0) -- EOF comment+           then MovedAnchor dp+           -- else op'+           else MovedAnchor dp++-- ---------------------------------------------------------------------++commentAllocation :: (Monad m, Monoid w) => RealSrcSpan -> EP w m [Comment]+commentAllocation ss = do+  cs <- 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 _str loc _r _mo) -> (ss2pos $ anchor loc) <= (ss2pos ss)) 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 a = setLayoutBoth $ markAnnotated a++-- ---------------------------------------------------------------------++markTopLevelList :: (Monad m, Monoid w) => ExactPrint ast => [ast] -> EP w m [ast]+markTopLevelList ls = mapM (\a -> setLayoutTopLevelP $ markAnnotated a) 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 (L l _) = Entry (spanAsAnchor l) emptyComments NoFlushComments NoCanUpdateAnchor+  getAnnotationEntry (L l _) = case l of+    UnhelpfulSpan _ -> NoEntryVal+    _ -> Entry (hackSrcSpanToAnchor l) emptyComments NoFlushComments CanUpdateAnchorOnly+  -- getAnnotationEntry (L l _) = NoEntryVal++  -- setAnnotationAnchor _la _anc _cs = error "should not be called:setAnnotationAnchor (Located a)"+  setAnnotationAnchor (L _ a) anc _cs = L (hackAnchorToSrcSpan anc) a++  exact (L l a) = L l <$> markAnnotated a++instance (ExactPrint a) => ExactPrint (LocatedA a) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor la anc cs = setAnchorAn la anc cs+  exact (L la a) = do+    debugM $ "LocatedA a:la loc=" ++ show (ss2range $ locA la)+    a' <- markAnnotated a+    ann' <- markALocatedA (ann la)+    return (L (la { ann = ann'}) a')++instance (ExactPrint a) => ExactPrint [a] where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor ls _ _ = ls+  exact ls = mapM markAnnotated ls++instance (ExactPrint a) => ExactPrint (Maybe a) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor ma _ _ = ma+  exact ma = mapM markAnnotated ma++-- ---------------------------------------------------------------------++-- | 'Located (HsModule GhcPs)' corresponds to 'ParsedSource'+instance ExactPrint HsModule where+  getAnnotationEntry hsmod = fromAnn' (hsmodAnn hsmod)+  -- A bit pointless actually changing anything here+  setAnnotationAnchor hsmod anc cs = setAnchorHsModule hsmod anc cs+                   `debug` ("setAnnotationAnchor hsmod called" ++ showAst (anc,cs))++  exact hsmod@(HsModule EpAnnNotUsed _ _ _ _ _ _ _) = withPpr hsmod >> return hsmod+  exact (HsModule an lo mmn mexports imports decls mdeprec mbDoc) = do++    debugM "HsModule Entered"++    mbDoc' <- markAnnotated mbDoc++    (an0, mmn' , mdeprec', mexports') <-+      case mmn of+        Nothing -> return (an, mmn, mdeprec, mexports)+        Just m -> do+          an0 <- markEpAnnL an lam_main AnnModule+          m' <- markAnnotated m++          mdeprec' <- setLayoutTopLevelP $ markAnnotated mdeprec++          mexports' <- setLayoutTopLevelP $ markAnnotated mexports++          debugM $ "HsModule.AnnWhere coming"+          an1 <- setLayoutTopLevelP $ markEpAnnL an0 lam_main AnnWhere+          debugM $ "HsModule.AnnWhere done, an1=" ++ showAst (anns an1)++          return (an1, Just m', mdeprec', mexports')++    -- debugM $ "After HsModule.AnnWhere done, an0=" ++ showAst (anns an0)+    let ann_decls = EpAnn (entry an) (am_decls $ anns an0) emptyComments+    (ann_decls', (decls', imports')) <- markAnnList' False ann_decls $ do+      imports' <- markTopLevelList imports+      decls' <- markTopLevelList decls+      return (decls', imports')+    let am_decls' = case ann_decls' of+          EpAnnNotUsed -> (am_decls $ anns an0)+          EpAnn _ r _ -> r++    let anf = an0 { anns = (anns an0) { am_decls = am_decls' }}+    debugM $ "HsModule, anf=" ++ showAst anf++    return (HsModule anf lo mmn' mexports' imports' decls' mdeprec' mbDoc')++-- ---------------------------------------------------------------------++instance ExactPrint ModuleName where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor n _anc cs = n+     `debug` ("ModuleName.setAnnotationAnchor:cs=" ++ showAst cs)+  exact n = do+    debugM $ "ModuleName: " ++ showPprUnsafe n+    withPpr n++-- ---------------------------------------------------------------------++instance ExactPrint (LocatedP WarningTxt) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn++  exact (L (SrcSpanAnn an l) (WarningTxt (L la src) ws)) = do+    an0 <- markAnnOpenP an src "{-# WARNING"+    an1 <- markEpAnnL an0 lapr_rest AnnOpenS+    ws' <- markAnnotated ws+    an2 <- markEpAnnL an1 lapr_rest AnnCloseS+    an3 <- markAnnCloseP an2+    return (L (SrcSpanAnn an3 l) (WarningTxt (L la src) ws'))++  exact (L (SrcSpanAnn an l) (DeprecatedTxt (L ls src) ws)) = do+    an0 <- markAnnOpenP an src "{-# DEPRECATED"+    an1 <- markEpAnnL an0 lapr_rest AnnOpenS+    ws' <- markAnnotated ws+    an2 <- markEpAnnL an1 lapr_rest AnnCloseS+    an3 <- markAnnCloseP an2+    return (L (SrcSpanAnn an3 l) (DeprecatedTxt (L ls src) ws'))++-- ---------------------------------------------------------------------++instance ExactPrint (ImportDecl GhcPs) where+  getAnnotationEntry idecl = fromAnn (ideclExt idecl)+  setAnnotationAnchor idecl anc cs = idecl { ideclExt = setAnchorEpa (ideclExt idecl) anc cs }++  exact x@(ImportDecl EpAnnNotUsed _ _ _ _ _ _ _ _ _) = withPpr x+  exact (ImportDecl ann msrc m mpkg src safeflag qualFlag impl mAs hiding) = do++    ann0 <- markLensKw ann limportDeclAnnImport AnnImport+    let (EpAnn _anc an _cs) = ann0++    -- "{-# SOURCE" and "#-}"+    importDeclAnnPragma' <-+      case msrc of+        SourceText _txt -> do+          debugM $ "ImportDecl sourcetext"+          case importDeclAnnPragma an of+            Just (mo, mc) -> do+              mo' <- markAnnOpen'' mo msrc "{-# SOURCE"+              mc' <- printStringAtAA mc "#-}"+              return $ Just (mo', mc')+            Nothing ->  do+              _ <- markAnnOpen' Nothing msrc "{-# SOURCE"+              printStringAtMLoc Nothing "#-}"+              return Nothing+        NoSourceText -> return (importDeclAnnPragma an)+    ann1 <- if safeflag+      then (markLensKwM ann0 limportDeclAnnSafe AnnSafe)+      else return ann0+    ann2 <-+      case qualFlag of+        QualifiedPre  -- 'qualified' appears in prepositive position.+          -> printStringAtMLocL ann1 limportDeclAnnQualified "qualified"+        _ -> return ann1+    ann3 <-+      case mpkg of+       Just (StringLiteral src' v _) ->+         printStringAtMLocL ann2 limportDeclAnnPackage (sourceTextToString src' (show v))+       _ -> return ann2++    m' <- markAnnotated m++    ann4 <-+      case qualFlag of+        QualifiedPost  -- 'qualified' appears in postpositive position.+          -> printStringAtMLocL ann3 limportDeclAnnQualified "qualified"+        _ -> return ann3++    (importDeclAnnAs', mAs') <-+      case mAs of+        Nothing -> return (importDeclAnnAs an, Nothing)+        Just m0 -> do+          a <- printStringAtMLoc' (importDeclAnnAs an) "as"+          m'' <- markAnnotated m0+          return (a, Just m'')++    hiding' <-+      case hiding of+        Nothing -> return hiding+        Just (isHiding,lie) -> do+          lie' <- markAnnotated lie+          return (Just (isHiding, lie'))++    let (EpAnn anc' an' cs') = ann4+    let an2 = an' { importDeclAnnAs = importDeclAnnAs'+                  , importDeclAnnPragma = importDeclAnnPragma'+                  }++    return (ImportDecl (EpAnn anc' an2 cs') msrc m' mpkg src safeflag qualFlag impl mAs' hiding')+++-- ---------------------------------------------------------------------++instance ExactPrint HsDocString where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact = withPpr -- TODO:AZ use annotations++-- ---------------------------------------------------------------------++instance ExactPrint (HsDecl GhcPs) where+  getAnnotationEntry (TyClD      _ _) = NoEntryVal+  getAnnotationEntry (InstD      _ _) = NoEntryVal+  getAnnotationEntry (DerivD     _ _) = NoEntryVal+  getAnnotationEntry (ValD       _ _) = NoEntryVal+  getAnnotationEntry (SigD       _ _) = NoEntryVal+  getAnnotationEntry (KindSigD   _ _) = NoEntryVal+  getAnnotationEntry (DefD       _ _) = NoEntryVal+  getAnnotationEntry (ForD       _ _) = NoEntryVal+  getAnnotationEntry (WarningD   _ _) = NoEntryVal+  getAnnotationEntry (AnnD       _ _) = NoEntryVal+  getAnnotationEntry (RuleD      _ _) = NoEntryVal+  getAnnotationEntry (SpliceD    _ _) = NoEntryVal+  getAnnotationEntry (DocD       _ _) = NoEntryVal+  getAnnotationEntry (RoleAnnotD _ _) = NoEntryVal++  -- We do not recurse, the generic traversal using this feature+  -- should do that for us.+  setAnnotationAnchor d _ _ = d++  exact (TyClD       x d) = TyClD       x <$> markAnnotated d+  exact (InstD       x d) = InstD       x <$> markAnnotated d+  exact (DerivD      x d) = DerivD      x <$> markAnnotated d+  exact (ValD        x d) = ValD        x <$> markAnnotated d+  exact (SigD        x d) = SigD        x <$> markAnnotated d+  exact (KindSigD    x d) = KindSigD    x <$> markAnnotated d+  exact (DefD        x d) = DefD        x <$> markAnnotated d+  exact (ForD        x d) = ForD        x <$> markAnnotated d+  exact (WarningD    x d) = WarningD    x <$> markAnnotated d+  exact (AnnD        x d) = AnnD        x <$> markAnnotated d+  exact (RuleD       x d) = RuleD       x <$> markAnnotated d+  exact (SpliceD     x d) = SpliceD     x <$> markAnnotated d+  exact (DocD        x d) = DocD        x <$> markAnnotated d+  exact (RoleAnnotD  x d) = RoleAnnotD  x <$> markAnnotated d++-- ---------------------------------------------------------------------++instance ExactPrint (InstDecl GhcPs) where+  getAnnotationEntry (ClsInstD     _  _) = NoEntryVal+  getAnnotationEntry (DataFamInstD an _) = fromAnn an+  getAnnotationEntry (TyFamInstD   _  _) = NoEntryVal++  setAnnotationAnchor (DataFamInstD an d) anc cs = DataFamInstD (setAnchorEpa an anc cs) d+  setAnnotationAnchor d _ _ = d+++  exact (ClsInstD     a  cid) = do+    cid' <- markAnnotated cid+    return (ClsInstD     a  cid')+  exact (DataFamInstD an decl) = do+    d' <- markAnnotated (DataFamInstDeclWithContext an TopLevel decl)+    return (DataFamInstD an (dc_d d'))+  exact (TyFamInstD a eqn) = do+    eqn' <- markAnnotated eqn+    return (TyFamInstD a eqn')++-- ---------------------------------------------------------------------++data DataFamInstDeclWithContext+  = DataFamInstDeclWithContext+    { _dc_a :: EpAnn [AddEpAnn]+    , _dc_f :: TopLevelFlag+    , dc_d :: DataFamInstDecl GhcPs+    }++instance ExactPrint DataFamInstDeclWithContext where+  getAnnotationEntry (DataFamInstDeclWithContext _ _ (DataFamInstDecl (FamEqn { feqn_ext = an})))+    = fromAnn an+  setAnnotationAnchor (DataFamInstDeclWithContext a c (DataFamInstDecl fe)) anc cs+    = (DataFamInstDeclWithContext a c (DataFamInstDecl (fe { feqn_ext = (setAnchorEpa (feqn_ext fe) anc cs)})))+  exact (DataFamInstDeclWithContext an c d) = do+    debugM $ "starting DataFamInstDeclWithContext:an=" ++ showAst an+    (an', d') <- exactDataFamInstDecl an c d+    return (DataFamInstDeclWithContext an' c d')++-- ---------------------------------------------------------------------++exactDataFamInstDecl :: (Monad m, Monoid w)+                     => EpAnn [AddEpAnn] -> TopLevelFlag -> DataFamInstDecl GhcPs+                     -> EP w m (EpAnn [AddEpAnn], DataFamInstDecl GhcPs)+exactDataFamInstDecl an top_lvl+  (DataFamInstDecl (FamEqn { feqn_ext    = an2+                           , feqn_tycon  = tycon+                           , feqn_bndrs  = bndrs+                           , feqn_pats   = pats+                           , feqn_fixity = fixity+                           , feqn_rhs    = defn })) = do+    (an', an2', tycon', bndrs', _,  _mc, defn') <- exactDataDefn an2 pp_hdr defn+    return+      (an',+       DataFamInstDecl ( FamEqn { feqn_ext    = an2'+                                , feqn_tycon  = tycon'+                                , feqn_bndrs  = bndrs'+                                , feqn_pats   = pats+                                , feqn_fixity = fixity+                                , feqn_rhs    = defn' }))+                    `debug` ("exactDataFamInstDecl: defn' derivs:" ++ showAst (dd_derivs defn'))+  where+    pp_hdr :: (Monad m, Monoid w)+           => Maybe (LHsContext GhcPs)+           -> EP w m ( EpAnn [AddEpAnn]+                     , LocatedN RdrName+                     , HsOuterTyVarBndrs () GhcPs+                     , HsTyPats GhcPs+                     , Maybe (LHsContext GhcPs))+    pp_hdr mctxt = do+      an0 <- case top_lvl of+               TopLevel -> markEpAnnL an lidl AnnInstance -- TODO: maybe in toplevel+               NotTopLevel -> return an+      exactHsFamInstLHS an0 tycon bndrs pats fixity mctxt++{-+Note [an and an2 in exactDataFamInstDecl]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The exactDataFamInstDecl function is called to render a+DataFamInstDecl within its surrounding context. This context is+rendered via the 'pp_hdr' function, which uses the exact print+annotations from that context, named 'an'.  The EPAs used for+rendering the DataDefn are contained in the FamEqn, and are called+'an2'.++-}++-- ---------------------------------------------------------------------++instance ExactPrint (DerivDecl GhcPs) where+  getAnnotationEntry (DerivDecl {deriv_ext = an} ) = fromAnn an+  setAnnotationAnchor dd anc cs = dd { deriv_ext = setAnchorEpa (deriv_ext dd) anc cs }+  exact (DerivDecl an typ ms mov) = do+    an0 <- markEpAnnL an lidl AnnDeriving+    ms' <- mapM markAnnotated ms+    an1 <- markEpAnnL an0 lidl AnnInstance+    mov' <- mapM markAnnotated mov+    typ' <- markAnnotated typ+    return (DerivDecl an1 typ' ms' mov')++-- ---------------------------------------------------------------------++instance ExactPrint (ForeignDecl GhcPs) where+  getAnnotationEntry (ForeignImport an _ _  _) = fromAnn an+  getAnnotationEntry (ForeignExport an _ _  _) = fromAnn an++  setAnnotationAnchor (ForeignImport an a b c) anc cs = ForeignImport (setAnchorEpa an anc cs) a b c+  setAnnotationAnchor (ForeignExport an a b c) anc cs = ForeignExport (setAnchorEpa an anc cs) a b c++  exact (ForeignImport an n ty fimport) = do+    an0 <- markEpAnnL an lidl AnnForeign+    an1 <- markEpAnnL an0 lidl AnnImport++    fimport' <- markAnnotated fimport++    n' <- markAnnotated n+    an2 <- markEpAnnL an1 lidl AnnDcolon+    ty' <- markAnnotated ty+    return (ForeignImport an2 n' ty' fimport')++  exact (ForeignExport an n ty fexport) = do+    an0 <- markEpAnnL an lidl AnnForeign+    an1 <- markEpAnnL an0 lidl AnnExport+    fexport' <- markAnnotated fexport+    n' <- markAnnotated n+    an2 <- markEpAnnL an1 lidl AnnDcolon+    ty' <- markAnnotated ty+    return (ForeignExport an2 n' ty' fexport')++-- ---------------------------------------------------------------------++instance ExactPrint ForeignImport where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (CImport cconv safety@(L ll _) mh imp (L ls src)) = do+    cconv' <- markAnnotated cconv+    unless (ll == noSrcSpan) $ markAnnotated safety >> return ()+    unless (ls == noSrcSpan) $ markExternalSourceText ls src "" >> return ()+    return (CImport cconv' safety mh imp (L ls src))++-- ---------------------------------------------------------------------++instance ExactPrint ForeignExport where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (CExport spec (L ls src)) = do+    debugM $ "CExport starting"+    spec' <- markAnnotated spec+    unless (ls == noSrcSpan) $ markExternalSourceText ls src ""+    return (CExport spec' (L ls src))++-- ---------------------------------------------------------------------++instance ExactPrint CExportSpec where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (CExportStatic st lbl cconv) = do+    debugM $ "CExportStatic starting"+    cconv' <- markAnnotated cconv+    return (CExportStatic st lbl cconv')++-- ---------------------------------------------------------------------++instance ExactPrint Safety where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact = withPpr++-- ---------------------------------------------------------------------++instance ExactPrint CCallConv where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact = withPpr++-- ---------------------------------------------------------------------++instance ExactPrint (WarnDecls GhcPs) where+  getAnnotationEntry (Warnings an _ _) = fromAnn an+  setAnnotationAnchor (Warnings an a b) anc cs = Warnings (setAnchorEpa an anc cs) a b++  exact (Warnings an src warns) = do+    an0 <- markAnnOpen an src "{-# WARNING" -- Note: might be {-# DEPRECATED+    warns' <- markAnnotated warns+    an1 <- markEpAnnLMS an0 lidl AnnClose (Just "#-}")+    return (Warnings an1 src warns')++-- ---------------------------------------------------------------------++instance ExactPrint (WarnDecl GhcPs) where+  getAnnotationEntry (Warning an _ _) = fromAnn an+  setAnnotationAnchor (Warning an a b) anc cs = Warning (setAnchorEpa an anc cs) a b++  exact (Warning an lns txt) = do+    lns' <- markAnnotated lns+    an0 <- markEpAnnL an lidl AnnOpenS -- "["+    txt' <-+      case txt of+        WarningTxt    src ls -> do+          ls' <- markAnnotated ls+          return (WarningTxt    src ls')+        DeprecatedTxt src ls -> do+          ls' <- markAnnotated ls+          return (DeprecatedTxt src ls')+    an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"+    return (Warning an1 lns' txt')++-- ---------------------------------------------------------------------++instance ExactPrint StringLiteral where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact l@(StringLiteral src fs mcomma) = do+    printSourceText src (show (unpackFS fs))+    mapM_ (\r -> printStringAtRs r ",") mcomma+    return l++-- ---------------------------------------------------------------------++instance ExactPrint FastString where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.+  -- exact fs = printStringAdvance (show (unpackFS fs))+  exact fs = printStringAdvance (unpackFS fs) >> return fs+++-- ---------------------------------------------------------------------++instance ExactPrint (RuleDecls GhcPs) where+  getAnnotationEntry (HsRules an _ _) = fromAnn an+  setAnnotationAnchor (HsRules an a b) anc cs = HsRules (setAnchorEpa an anc cs) a b+  exact (HsRules an src rules) = do+    an0 <-+      case src of+        NoSourceText      -> markEpAnnLMS an lidl AnnOpen  (Just "{-# RULES")+        SourceText srcTxt -> markEpAnnLMS an lidl AnnOpen  (Just srcTxt)+    rules' <- markAnnotated rules+    an1 <- markEpAnnLMS an0 lidl AnnClose (Just "#-}")+    return (HsRules an1 src rules')++-- ---------------------------------------------------------------------++instance ExactPrint (RuleDecl GhcPs) where+  getAnnotationEntry (HsRule {rd_ext = an}) = fromAnn an+  setAnnotationAnchor r anc cs = r { rd_ext = setAnchorEpa (rd_ext r) anc cs}+  exact (HsRule an ln act mtybndrs termbndrs lhs rhs) = do+    debugM "HsRule entered"+    ln' <- markAnnotated ln+    debugM "HsRule after ln"+    an0 <- markActivation an lra_rest act+    debugM "HsRule after act"+    (an1, mtybndrs') <-+      case mtybndrs of+        Nothing -> return (an0, Nothing)+        Just bndrs -> do+          -- an1 <-  markLensMAA an0 (\a -> fmap fst (ra_tyanns a))  -- AnnForall+          an1 <-  markLensMAA an0 lra_tyanns_fst  -- AnnForall+          bndrs' <- mapM markAnnotated bndrs+          -- an2 <- markLensMAA an1 (\a -> fmap snd (ra_tyanns a))  -- AnnDot+          an2 <- markLensMAA an1 lra_tyanns_snd  -- AnnDot+          return (an2, Just bndrs')++    -- an2 <- markLensMAA an1 (\a -> fmap fst (ra_tmanns a))  -- AnnForall+    an2 <- markLensMAA an1 lra_tmanns_fst  -- AnnForall+    termbndrs' <- mapM markAnnotated termbndrs+    -- an3 <- markLensMAA an2 (\a -> fmap snd (ra_tmanns a))  -- AnnDot+    an3 <- markLensMAA an2 lra_tmanns_snd  -- AnnDot++    lhs' <- markAnnotated lhs+    an4 <- markEpAnnL an3 lra_rest AnnEqual+    rhs' <- markAnnotated rhs+    return (HsRule an4 ln' act mtybndrs' termbndrs' lhs' rhs')++markActivation :: (Monad m, Monoid w)+  => EpAnn a -> Lens a [AddEpAnn] -> Activation -> EP w m (EpAnn a)+markActivation an l act = do+  case act of+    ActiveBefore src phase -> do+      an0 <- markEpAnnL an l AnnOpenS --  '['+      an1 <- markEpAnnL an0 l AnnTilde -- ~+      an2 <- markEpAnnLMS an1 l AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))+      an3 <- markEpAnnL an2 l AnnCloseS -- ']'+      return an3+    ActiveAfter src phase -> do+      an0 <- markEpAnnL an l AnnOpenS --  '['+      an1 <- markEpAnnLMS an0 l AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))+      an2 <- markEpAnnL an1 l AnnCloseS -- ']'+      return an2+    NeverActive -> do+      an0 <- markEpAnnL an l AnnOpenS --  '['+      an1 <- markEpAnnL an0 l AnnTilde -- ~+      an2 <- markEpAnnL an1 l AnnCloseS -- ']'+      return an2+    _ -> return an++-- ---------------------------------------------------------------------++instance ExactPrint (SpliceDecl GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (SpliceDecl x splice flag) = do+    splice' <- markAnnotated splice+    return (SpliceDecl x splice' flag)++-- ---------------------------------------------------------------------++instance ExactPrint DocDecl where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact v =+    let str =+          case v of+            (DocCommentNext ds)     -> unpackHDS ds+            (DocCommentPrev ds)     -> unpackHDS ds+            (DocCommentNamed _s ds) -> unpackHDS ds+            (DocGroup _i ds)        -> unpackHDS ds+    in+      printStringAdvance str >> return v++-- ---------------------------------------------------------------------++instance ExactPrint (RoleAnnotDecl GhcPs) where+  getAnnotationEntry (RoleAnnotDecl an _ _) = fromAnn an+  setAnnotationAnchor (RoleAnnotDecl an a b) anc cs = RoleAnnotDecl (setAnchorEpa an anc cs) a b+  exact (RoleAnnotDecl an ltycon roles) = do+    an0 <- markEpAnnL an lidl AnnType+    an1 <- markEpAnnL an0 lidl AnnRole+    ltycon' <- markAnnotated ltycon+    let markRole (L l (Just r)) = do+          (L _ r') <- markAnnotated (L l r)+          return (L l (Just r'))+        markRole (L l Nothing) = do+          printStringAtSs l "_"+          return (L l Nothing)+    roles' <- mapM markRole roles+    return (RoleAnnotDecl an1 ltycon' roles')++-- ---------------------------------------------------------------------++instance ExactPrint Role where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact = withPpr++-- ---------------------------------------------------------------------++instance ExactPrint (RuleBndr GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (RuleBndr x ln) = do+    ln' <- markAnnotated ln+    return (RuleBndr x ln')+  exact (RuleBndrSig an ln (HsPS x ty)) = do+    an0 <- markEpAnnL an lidl AnnOpenP -- "("+    ln' <- markAnnotated ln+    an1 <- markEpAnnL an0 lidl AnnDcolon+    ty' <- markAnnotated ty+    an2 <- markEpAnnL an1 lidl AnnCloseP -- ")"+    return (RuleBndrSig an2 ln' (HsPS x ty'))++-- ---------------------------------------------------------------------++instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where+  getAnnotationEntry (FamEqn { feqn_ext = an}) = fromAnn an+  setAnnotationAnchor fe anc cs = fe {feqn_ext = setAnchorEpa (feqn_ext fe) anc cs}+  exact (FamEqn { feqn_ext = an+                , feqn_tycon  = tycon+                , feqn_bndrs  = bndrs+                , feqn_pats   = pats+                , feqn_fixity = fixity+                , feqn_rhs    = rhs }) = do+    (an0, tycon', bndrs', pats', _) <- exactHsFamInstLHS an tycon bndrs pats fixity Nothing+    an1 <- markEpAnnL an0 lidl AnnEqual+    rhs' <- markAnnotated rhs+    return (FamEqn { feqn_ext = an1+                   , feqn_tycon  = tycon'+                   , feqn_bndrs  = bndrs'+                   , feqn_pats   = pats'+                   , feqn_fixity = fixity+                   , feqn_rhs    = rhs' })++-- ---------------------------------------------------------------------++exactHsFamInstLHS ::+      (Monad m, Monoid w)+   => EpAnn [AddEpAnn]+   -> LocatedN RdrName+   -> HsOuterTyVarBndrs () GhcPs+   -> HsTyPats GhcPs+   -> LexicalFixity+   -> Maybe (LHsContext GhcPs)+   -> EP w m ( EpAnn [AddEpAnn]+             , LocatedN RdrName+             , HsOuterTyVarBndrs () GhcPs+             , HsTyPats GhcPs, Maybe (LHsContext GhcPs))+exactHsFamInstLHS an thing bndrs typats fixity mb_ctxt = do+  an0 <- markEpAnnL an lidl AnnForall+  bndrs' <- markAnnotated bndrs+  an1 <- markEpAnnL an0 lidl AnnDot+  mb_ctxt' <- mapM markAnnotated mb_ctxt+  (an2, thing', typats') <- exact_pats an1 typats+  return (an2, thing', bndrs', typats', mb_ctxt')+  where+    exact_pats :: (Monad m, Monoid w)+      => EpAnn [AddEpAnn] -> HsTyPats GhcPs -> EP w m (EpAnn [AddEpAnn], LocatedN RdrName, HsTyPats GhcPs)+    exact_pats an' (patl:patr:pats)+      | Infix <- fixity+      = let exact_op_app = do+              an0 <- markEpAnnAllL an' lidl AnnOpenP+              patl' <- markAnnotated patl+              thing' <- markAnnotated thing+              patr' <- markAnnotated patr+              an1 <- markEpAnnAllL an0 lidl AnnCloseP+              return (an1, thing', [patl',patr'])+        in case pats of+             [] -> exact_op_app+             _  -> do+               (an0, thing', p) <- exact_op_app+               pats' <- mapM markAnnotated pats+               return (an0, thing', p++pats')++    exact_pats an' pats = do+      an0 <- markEpAnnAllL an' lidl AnnOpenP+      thing' <- markAnnotated thing+      pats' <- markAnnotated pats+      an1 <- markEpAnnAllL an0 lidl AnnCloseP+      return (an1, thing', pats')++-- ---------------------------------------------------------------------++-- instance ExactPrint (LHsTypeArg GhcPs) where+instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)+     =>  ExactPrint (HsArg tm ty) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact a@(HsValArg tm)    = markAnnotated tm >> return a+  exact a@(HsTypeArg ss ty) = printStringAtSs ss "@" >> markAnnotated ty >> return a+  exact x@(HsArgPar _sp)   = withPpr x -- Does not appear in original source++-- ---------------------------------------------------------------------++instance ExactPrint (ClsInstDecl GhcPs) where+  getAnnotationEntry cid = fromAnn (fst $ cid_ext cid)+  setAnnotationAnchor cid anc cs+    = cid { cid_ext = (setAnchorEpa (fst $ cid_ext cid) anc cs, (snd $ cid_ext cid)) }++  exact (ClsInstDecl { cid_ext = (an, sortKey)+                     , cid_poly_ty = inst_ty, cid_binds = binds+                     , cid_sigs = sigs, cid_tyfam_insts = ats+                     , cid_overlap_mode = mbOverlap+                     , cid_datafam_insts = adts })+      = do+          (an0, mbOverlap', inst_ty') <- top_matter+          -- an0 <- markEpAnnL an' lidl AnnWhere+          an1 <- markEpAnnL an0 lidl AnnOpenC+          an2 <- markEpAnnAllL an1 lid AnnSemi+          ds <- withSortKey sortKey+                               (prepareListAnnotationA ats+                             ++ prepareListAnnotationF an adts+                             ++ prepareListAnnotationA (bagToList binds)+                             ++ prepareListAnnotationA sigs+                               )+          an3 <- markEpAnnL an2 lidl AnnCloseC -- '}'+          let+            ats'   = undynamic ds+            adts'  = undynamic ds+            binds' = listToBag $ undynamic ds+            sigs'  = undynamic ds+          return (ClsInstDecl { cid_ext = (an3, sortKey)+                              , cid_poly_ty = inst_ty', cid_binds = binds'+                              , cid_sigs = sigs', cid_tyfam_insts = ats'+                              , cid_overlap_mode = mbOverlap'+                              , cid_datafam_insts = adts' })++      where+        top_matter = do+          an0 <- markEpAnnL an lidl AnnInstance+          mo <- mapM markAnnotated mbOverlap+          it <- markAnnotated inst_ty+          an1 <- markEpAnnL an0 lidl AnnWhere -- Optional+          return (an1, mo,it)++-- ---------------------------------------------------------------------++instance ExactPrint (TyFamInstDecl GhcPs) where+  getAnnotationEntry (TyFamInstDecl an _) = fromAnn an+  setAnnotationAnchor (TyFamInstDecl an a) anc cs = TyFamInstDecl (setAnchorEpa an anc cs) a++  exact d@(TyFamInstDecl { tfid_xtn = an, tfid_eqn = eqn }) = do+    an0 <- markEpAnnL an lidl AnnType+    an1 <- markEpAnnL an0 lidl AnnInstance+    eqn' <- markAnnotated eqn+    return (d { tfid_xtn = an1, tfid_eqn = eqn' })++-- ---------------------------------------------------------------------++instance ExactPrint (LocatedP OverlapMode) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn++  -- NOTE: NoOverlap is only used in the typechecker+  exact (L (SrcSpanAnn an l) (NoOverlap src)) = do+    an0 <- markAnnOpenP an src "{-# NO_OVERLAP"+    an1 <- markAnnCloseP an0+    return (L (SrcSpanAnn an1 l) (NoOverlap src))++  exact (L (SrcSpanAnn an l) (Overlappable src)) = do+    an0 <- markAnnOpenP an src "{-# OVERLAPPABLE"+    an1 <- markAnnCloseP an0+    return (L (SrcSpanAnn an1 l) (Overlappable src))++  exact (L (SrcSpanAnn an l) (Overlapping src)) = do+    an0 <- markAnnOpenP an src "{-# OVERLAPPING"+    an1 <- markAnnCloseP an0+    return (L (SrcSpanAnn an1 l) (Overlapping src))++  exact (L (SrcSpanAnn an l) (Overlaps src)) = do+    an0 <- markAnnOpenP an src "{-# OVERLAPS"+    an1 <- markAnnCloseP an0+    return (L (SrcSpanAnn an1 l) (Overlaps src))++  exact (L (SrcSpanAnn an l) (Incoherent src)) = do+    an0 <- markAnnOpenP an src "{-# INCOHERENT"+    an1 <- markAnnCloseP an0+    return (L (SrcSpanAnn an1 l) (Incoherent src))++-- ---------------------------------------------------------------------++instance ExactPrint (HsBind GhcPs) where+  getAnnotationEntry FunBind{} = NoEntryVal+  getAnnotationEntry PatBind{pat_ext=an} = fromAnn an+  getAnnotationEntry VarBind{} = NoEntryVal+  getAnnotationEntry AbsBinds{} = NoEntryVal+  getAnnotationEntry PatSynBind{} = NoEntryVal++  setAnnotationAnchor pb@PatBind{} anc cs = pb { pat_ext = setAnchorEpa (pat_ext pb) anc cs}+  setAnnotationAnchor a _ _ = a++  exact (FunBind x fid matches t) = do+    matches' <- markAnnotated matches+    let+      fun_id' = case unLoc (mg_alts matches') of+        [] -> fid+        (L _ m:_) -> case m_ctxt m of+          FunRhs f _ _ -> f+          _ -> fid+    return (FunBind x fun_id' matches' t)+  exact (PatBind x pat grhss t) = do+    pat' <- markAnnotated pat+    grhss' <- markAnnotated grhss+    return (PatBind x pat' grhss' t)+  exact (PatSynBind x bind) = do+    bind' <- markAnnotated bind+    return (PatSynBind x bind')++  exact x = error $ "HsBind: exact for " ++ showAst x++-- ---------------------------------------------------------------------++instance ExactPrint (PatSynBind GhcPs GhcPs) where+  getAnnotationEntry (PSB { psb_ext = an}) = fromAnn an+  setAnnotationAnchor p anc cs = p { psb_ext = setAnchorEpa (psb_ext p) anc cs}++  exact (PSB{ psb_ext = an+            , psb_id = psyn, psb_args = details+            , psb_def = pat+            , psb_dir = dir }) = do+    an0 <- markEpAnnL an lidl AnnPattern+    (an1, psyn', details') <-+      case details of+        InfixCon v1 v2 -> do+          v1' <- markAnnotated v1+          psyn' <- markAnnotated psyn+          v2' <- markAnnotated v2+          return (an0, psyn',InfixCon v1' v2')+        PrefixCon tvs vs -> do+          psyn' <- markAnnotated psyn+          tvs' <- markAnnotated tvs+          vs' <- markAnnotated vs+          return (an0, psyn', PrefixCon tvs' vs')+        RecCon vs -> do+          psyn' <- markAnnotated psyn+          an1 <- markEpAnnL an0 lidl AnnOpenC  -- '{'+          vs' <- markAnnotated vs+          an2 <- markEpAnnL an1 lidl AnnCloseC -- '}'+          return (an2, psyn', RecCon vs')++    (an2, pat', dir') <-+      case dir of+        Unidirectional           -> do+          an2 <- markEpAnnL an1 lidl AnnLarrow+          pat' <- markAnnotated pat+          return (an2, pat', dir)+        ImplicitBidirectional    -> do+          an2 <- markEpAnnL an1 lidl AnnEqual+          pat' <- markAnnotated pat+          return (an2, pat', dir)+        ExplicitBidirectional mg -> do+          an2 <- markEpAnnL an1 lidl AnnLarrow+          pat' <- markAnnotated pat+          an3 <- markEpAnnL an2 lidl  AnnWhere+          mg' <- markAnnotated mg+          return (an3, pat', ExplicitBidirectional mg')++    return (PSB{ psb_ext = an2+               , psb_id = psyn', psb_args = details'+               , psb_def = pat'+               , psb_dir = dir' })+++-- ---------------------------------------------------------------------++instance ExactPrint (RecordPatSynField GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact r@(RecordPatSynField { recordPatSynField = v }) = markAnnotated v+        >> return r++-- ---------------------------------------------------------------------++instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where+  getAnnotationEntry (Match ann _ _ _) = fromAnn ann+  setAnnotationAnchor (Match an a b c) anc cs = Match (setAnchorEpa an anc cs) a b c++  exact (Match an mctxt pats grhss) =+    exactMatch (Match an mctxt pats grhss)++-- -------------------------------------++instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where+  getAnnotationEntry (Match ann _ _ _) = fromAnn ann+  setAnnotationAnchor (Match an a b c) anc cs = Match (setAnchorEpa an anc cs) a b c++  exact (Match an mctxt pats grhss) =+    exactMatch (Match an mctxt pats grhss)++-- ---------------------------------------------------------------------++exactMatch :: (Monad m, Monoid w) => (ExactPrint (GRHSs GhcPs body)) => (Match GhcPs body) -> EP w m (Match GhcPs body)+exactMatch (Match an mctxt pats grhss) = do++  debugM $ "exact Match entered"++  (an0, mctxt', pats') <-+    case mctxt of+      FunRhs fun fixity strictness -> do+        debugM $ "exact Match FunRhs:" ++ showPprUnsafe fun+        an0' <-+          case strictness of+            SrcStrict -> markEpAnnL an lidl AnnBang+            _ -> pure an+        case fixity of+          Prefix -> do+            an' <- annotationsToComments an0' lidl [AnnOpenP,AnnCloseP]+            fun' <- markAnnotated fun+            pats' <- markAnnotated pats+            return (an', FunRhs fun' fixity strictness, pats')+          Infix ->+            case pats of+              (p1:p2:rest)+                | null rest -> do+                    p1'  <- markAnnotated p1+                    fun' <- markAnnotated fun+                    p2'  <- markAnnotated p2+                    return (an0', FunRhs fun' fixity strictness, [p1',p2'])+                | otherwise -> do+                    an0  <- markEpAnnL an0' lidl AnnOpenP+                    p1'  <- markAnnotated p1+                    fun' <- markAnnotated fun+                    p2'  <- markAnnotated p2+                    an1  <- markEpAnnL an0 lidl AnnCloseP+                    rest' <- mapM markAnnotated rest+                    return (an1, FunRhs fun' fixity strictness, p1':p2':rest')+              _ -> panic "FunRhs"+      LambdaExpr -> do+        an0' <- markEpAnnL an lidl AnnLam+        pats' <- markAnnotated pats+        return (an0', LambdaExpr, pats')+      CaseAlt -> do+        pats' <- markAnnotated pats+        return (an, CaseAlt, pats')+      _ -> do+        mctxt' <- withPpr mctxt+        return (an, mctxt', pats)++  grhss' <- markAnnotated grhss++  return (Match an0 mctxt' pats' grhss')++-- ---------------------------------------------------------------------++instance ExactPrint (GRHSs GhcPs (LocatedA (HsExpr GhcPs))) where+  getAnnotationEntry (GRHSs _ _ _) = NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (GRHSs cs grhss binds) = do+    addCommentsA $ priorComments cs+    addCommentsA $ getFollowingComments cs+    grhss' <- markAnnotated 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 _ _ _) = NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (GRHSs cs grhss binds) = do+    addCommentsA $ priorComments cs+    addCommentsA $ getFollowingComments cs+    grhss' <- markAnnotated grhss+    binds' <- markAnnotated binds+    -- The comments will be added back as they are printed+    return (GRHSs emptyComments grhss' binds')++-- ---------------------------------------------------------------------++-- Temporary until https://gitlab.haskell.org/ghc/ghc/-/issues/20247+-- is fixed+fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList+fixValbindsAnn EpAnnNotUsed = EpAnnNotUsed+fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs)+  = (EpAnn (widenAnchor anchor (map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs)+++-- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256+fixAnnListAnn :: EpAnn AnnList -> EpAnn AnnList+fixAnnListAnn EpAnnNotUsed = EpAnnNotUsed+fixAnnListAnn (EpAnn anchor (AnnList ma o c r t) cs)+  = (EpAnn (widenAnchor anchor r) (AnnList ma o c r t) cs)++-- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256+fixSrcAnnL :: SrcSpanAnnL -> SrcSpanAnnL+fixSrcAnnL (SrcSpanAnn an l) = SrcSpanAnn (fixAnnListAnn an) l++-- ---------------------------------------------------------------------++instance ExactPrint (HsLocalBinds GhcPs) where+  getAnnotationEntry (HsValBinds an _) = fromAnn (fixValbindsAnn an)+  getAnnotationEntry (HsIPBinds{}) = NoEntryVal+  getAnnotationEntry (EmptyLocalBinds{}) = NoEntryVal++  setAnnotationAnchor (HsValBinds an a) anc cs = HsValBinds (setAnchorEpaL an anc cs) a+  setAnnotationAnchor a _ _ = a++  exact (HsValBinds an' valbinds) = do+    let an = fixValbindsAnn an'+    debugM $ "exact HsValBinds: an=" ++ showAst an+    an0 <- markEpAnnL an lal_rest AnnWhere++    let manc = case an of+                 EpAnnNotUsed -> Nothing+                 _ -> al_anchor $ anns an++    case manc of+      Just anc -> do+        when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc)+      _ -> return ()++    (an1, valbinds') <- markAnnList False an0 $ markAnnotatedWithLayout valbinds+    debugM $ "exact HsValBinds: an1=" ++ showAst an1+    return (HsValBinds an1 valbinds')++  exact (HsIPBinds an bs) = do+    (as, ipb) <- markAnnList True an (markLocatedAAL an al_rest AnnWhere+                           >> markAnnotated bs+                           >>= \bs' -> return (HsIPBinds an bs'::HsLocalBinds GhcPs))+    case ipb of+      HsIPBinds _ bs' -> return (HsIPBinds as bs'::HsLocalBinds GhcPs)+      _ -> error "should not happen HsIPBinds"+  exact b@(EmptyLocalBinds _) = return b+++-- ---------------------------------------------------------------------+instance ExactPrint (HsValBindsLR GhcPs GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (ValBinds sortKey binds sigs) = do+    ds <- setLayoutBoth $ withSortKey sortKey+       (prepareListAnnotationA (bagToList binds)+     ++ prepareListAnnotationA sigs+       )+    let+      binds' = listToBag $ undynamic ds+      sigs'  = undynamic ds+    return (ValBinds sortKey binds' sigs')+  exact (XValBindsLR _) = panic "XValBindsLR"++undynamic :: Typeable a => [Dynamic] -> [a]+undynamic ds = mapMaybe fromDynamic ds++-- ---------------------------------------------------------------------++instance ExactPrint (HsIPBinds GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact b@(IPBinds _ binds) = setLayoutBoth $ markAnnotated binds >> return b++-- ---------------------------------------------------------------------++instance ExactPrint (IPBind GhcPs) where+  getAnnotationEntry (IPBind an _ _) = fromAnn an+  setAnnotationAnchor (IPBind an a b) anc cs = IPBind (setAnchorEpa an anc cs) a b++  exact (IPBind an (Left lr) rhs) = do+    lr' <- markAnnotated lr+    an0 <- markEpAnnL an lidl AnnEqual+    rhs' <- markAnnotated rhs+    return (IPBind an0 (Left lr') rhs')++  exact (IPBind _ (Right _) _) = error $ "ExactPrint IPBind: Right only after typechecker"++-- ---------------------------------------------------------------------++instance ExactPrint HsIPName where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact i@(HsIPName fs) = printStringAdvance ("?" ++ (unpackFS fs)) >> return i++-- ---------------------------------------------------------------------+-- Managing lists which have been separated, e.g. Sigs and Binds++prepareListAnnotationF :: (Monad m, Monoid w) =>+  EpAnn [AddEpAnn] -> [LDataFamInstDecl GhcPs] -> [(RealSrcSpan,EP w m Dynamic)]+prepareListAnnotationF an ls = map (\b -> (realSrcSpan $ getLocA b, go b)) ls+  where+    go (L l a) = do+      -- d' <- markAnnotated (DataFamInstDeclWithContext an TopLevel a)+      d' <- markAnnotated (DataFamInstDeclWithContext an NotTopLevel a)+      return (toDyn (L l (dc_d d')))++prepareListAnnotationA :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))+  => [LocatedAn an a] -> [(RealSrcSpan,EP w m Dynamic)]+prepareListAnnotationA ls = map (\b -> (realSrcSpan $ getLocA b,go b)) ls+  where+    go b = do+      b' <- markAnnotated b+      return (toDyn b')++withSortKey :: (Monad m, Monoid w) => AnnSortKey -> [(RealSrcSpan, EP w m Dynamic)] -> EP w m [Dynamic]+withSortKey annSortKey xs = do+  debugM $ "withSortKey:annSortKey=" ++ showAst annSortKey+  let ordered = case annSortKey of+                  NoAnnSortKey -> sortBy orderByFst xs+                  -- Just keys -> error $ "withSortKey: keys" ++ show keys+                  AnnSortKey keys -> orderByKey xs keys+                                -- `debug` ("withSortKey:" +++                                --          showPprUnsafe (map fst (sortBy (comparing (flip elemIndex keys . fst)) xs),+                                --                  map fst xs,+                                --                  keys)+                                --          )+  mapM snd ordered++orderByFst :: Ord a => (a, b1) -> (a, b2) -> Ordering+orderByFst (a,_) (b,_) = compare a b++-- ---------------------------------------------------------------------++instance ExactPrint (Sig GhcPs) where+  getAnnotationEntry (TypeSig a _ _)  = fromAnn a+  getAnnotationEntry (PatSynSig a _ _) = fromAnn a+  getAnnotationEntry (ClassOpSig a _ _ _) = fromAnn a+  getAnnotationEntry (IdSig {}) = NoEntryVal+  getAnnotationEntry (FixSig a _) = fromAnn a+  getAnnotationEntry (InlineSig a _ _) = fromAnn a+  getAnnotationEntry (SpecSig a _ _ _) = fromAnn a+  getAnnotationEntry (SpecInstSig a _ _) = fromAnn a+  getAnnotationEntry (MinimalSig a _ _) = fromAnn a+  getAnnotationEntry (SCCFunSig a _ _ _) = fromAnn a+  getAnnotationEntry (CompleteMatchSig a _ _ _) = fromAnn a++  setAnnotationAnchor (TypeSig a x y)  anc           cs = (TypeSig (setAnchorEpa a anc cs) x y)+  setAnnotationAnchor (PatSynSig a x y) anc          cs = (PatSynSig (setAnchorEpa a anc cs) x y)+  setAnnotationAnchor (ClassOpSig a x y z) anc       cs = (ClassOpSig (setAnchorEpa a anc cs) x y z)+  setAnnotationAnchor i@(IdSig {}) _ _s = i+  setAnnotationAnchor (FixSig a x) anc               cs = (FixSig (setAnchorEpa a anc cs) x)+  setAnnotationAnchor (InlineSig a x y) anc          cs = (InlineSig (setAnchorEpa a anc cs) x y)+  setAnnotationAnchor (SpecSig a x y z) anc          cs = (SpecSig (setAnchorEpa a anc cs) x y z)+  setAnnotationAnchor (SpecInstSig a x y) anc        cs = (SpecInstSig (setAnchorEpa a anc cs) x y)+  setAnnotationAnchor (MinimalSig a x y) anc         cs = (MinimalSig (setAnchorEpa a anc cs) x y)+  setAnnotationAnchor (SCCFunSig a x y z) anc        cs = (SCCFunSig (setAnchorEpa a anc cs) x y z)+  setAnnotationAnchor (CompleteMatchSig a x y z) anc cs = (CompleteMatchSig (setAnchorEpa a anc cs) x y z)++  exact (TypeSig an vars ty)  = do+    (an', vars', ty') <- exactVarSig an vars ty+    return (TypeSig an' vars' ty')++  exact (PatSynSig an lns typ) = do+    an0 <- markEpAnnL an lasRest AnnPattern+    lns' <- markAnnotated lns+    an1 <- markLensAA an0 lasDcolon+    typ' <- markAnnotated typ+    return (PatSynSig an1 lns' typ')++  exact (ClassOpSig an is_deflt vars ty)+    | is_deflt  = do+        an0 <- markEpAnnL an lasRest AnnDefault+        (an1, vars',ty') <- exactVarSig an0 vars ty+        return (ClassOpSig an1 is_deflt vars' ty')+    | otherwise = do+        (an0, vars',ty') <- exactVarSig an vars ty+        return (ClassOpSig an0 is_deflt vars' ty')++  exact (FixSig an (FixitySig x names (Fixity src v fdir))) = do+    let fixstr = case fdir of+         InfixL -> "infixl"+         InfixR -> "infixr"+         InfixN -> "infix"+    an0 <- markEpAnnLMS an  lidl AnnInfix (Just fixstr)+    an1 <- markEpAnnLMS an0 lidl AnnVal (Just (sourceTextToString src (show v)))+    names' <- markAnnotated names+    return (FixSig an1 (FixitySig x names' (Fixity src v fdir)))++  exact (InlineSig an ln inl) = do+    an0 <- markAnnOpen an (inl_src inl) "{-# INLINE"+    an1 <- markActivation an0 id (inl_act inl)+    ln' <- markAnnotated ln+    debugM $ "InlineSig:an=" ++ showAst an+    p <- getPosP+    debugM $ "InlineSig: p=" ++ show p+    an2 <- markEpAnnLMS an1 lidl AnnClose (Just "#-}")+    debugM $ "InlineSig:done"+    return (InlineSig an2 ln' inl)++  exact (SpecSig an ln typs inl) = do+    an0 <- markAnnOpen an (inl_src inl) "{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE+    an1 <- markActivation an0 lidl (inl_act inl)+    ln' <- markAnnotated ln+    an2 <- markEpAnnL an1 lidl AnnDcolon+    typs' <- markAnnotated typs+    an3 <- markEpAnnLMS an2 lidl AnnClose (Just "#-}")+    return (SpecSig an3 ln' typs' inl)++  exact (SpecInstSig an src typ) = do+    an0 <- markAnnOpen an src "{-# SPECIALISE"+    an1 <- markEpAnnL an0 lidl AnnInstance+    typ' <- markAnnotated typ+    an2 <- markEpAnnLMS an1 lidl AnnClose (Just "#-}")+    return (SpecInstSig an2 src typ')++  exact (MinimalSig an src formula) = do+    an0 <- markAnnOpen an src "{-# MINIMAL"+    formula' <- markAnnotated formula+    an1 <- markEpAnnLMS an0 lidl AnnClose (Just "#-}")+    return (MinimalSig an1 src formula')++  exact (SCCFunSig an src ln ml) = do+    an0 <- markAnnOpen an src "{-# SCC"+    ln' <- markAnnotated ln+    ml' <- markAnnotated ml+    an1 <- markEpAnnLMS an0 lidl AnnClose (Just "#-}")+    return (SCCFunSig an1 src ln' ml')++  exact (CompleteMatchSig an src cs mty) = do+    an0 <- markAnnOpen an src "{-# COMPLETE"+    cs' <- markAnnotated cs+    (an1, mty') <-+      case mty of+        Nothing -> return (an0, mty)+        Just ty -> do+          an1 <- markEpAnnL an0 lidl AnnDcolon+          ty' <- markAnnotated ty+          return (an1, Just ty')+    an2 <- markEpAnnLMS an1 lidl AnnClose (Just "#-}")+    return (CompleteMatchSig an2 src cs' mty')++  exact x = error $ "exact Sig for:" ++ showAst x++-- ---------------------------------------------------------------------++exactVarSig :: (Monad m, Monoid w, ExactPrint a)+  => EpAnn AnnSig -> [LocatedN RdrName] -> a -> EP w m (EpAnn AnnSig, [LocatedN RdrName], a)+exactVarSig an vars ty = do+  vars' <- mapM markAnnotated vars+  an0 <- markLensAA an lasDcolon+  ty' <- markAnnotated ty+  return (an0, vars', ty')++-- ---------------------------------------------------------------------++instance ExactPrint (StandaloneKindSig GhcPs) where+  getAnnotationEntry (StandaloneKindSig an _ _) = fromAnn an+  setAnnotationAnchor (StandaloneKindSig an a b) anc cs = StandaloneKindSig (setAnchorEpa an anc cs) a b++  exact (StandaloneKindSig an vars sig) = do+    an0 <- markEpAnnL an lidl AnnType+    vars' <- markAnnotated vars+    an1 <- markEpAnnL an0 lidl AnnDcolon+    sig' <- markAnnotated sig+    return (StandaloneKindSig an1 vars' sig')++-- ---------------------------------------------------------------------++instance ExactPrint (DefaultDecl GhcPs) where+  getAnnotationEntry (DefaultDecl an _) = fromAnn an+  setAnnotationAnchor (DefaultDecl an a) anc cs = DefaultDecl (setAnchorEpa an anc cs) a++  exact (DefaultDecl an tys) = do+    an0 <- markEpAnnL an lidl AnnDefault+    an1 <- markEpAnnL an0 lidl AnnOpenP+    tys' <- markAnnotated tys+    an2 <- markEpAnnL an1 lidl AnnCloseP+    return (DefaultDecl an2 tys')++-- ---------------------------------------------------------------------++instance ExactPrint (AnnDecl GhcPs) where+  getAnnotationEntry (HsAnnotation an _ _ _) = fromAnn an+  setAnnotationAnchor (HsAnnotation an a b c) anc cs = HsAnnotation (setAnchorEpa an anc cs) a b c++  exact (HsAnnotation an src prov e) = do+    an0 <- markAnnOpenP an src "{-# ANN"+    (an1, prov') <-+      case prov of+        (ValueAnnProvenance n) -> do+          n' <- markAnnotated n+          return (an0, ValueAnnProvenance n')+        (TypeAnnProvenance n) -> do+          an1 <- markEpAnnL an0 lapr_rest AnnType+          n' <- markAnnotated n+          return (an1, TypeAnnProvenance n')+        ModuleAnnProvenance -> do+          an1 <- markEpAnnL an lapr_rest AnnModule+          return (an1, prov)++    e' <- markAnnotated e+    an2 <- markAnnCloseP an1+    return (HsAnnotation an2 src prov' e')++-- ---------------------------------------------------------------------++instance ExactPrint (BF.BooleanFormula (LocatedN RdrName)) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (BF.Var x)  = do+    x' <- markAnnotated x+    return (BF.Var x')+  exact (BF.Or ls)  = do+    ls' <- markAnnotated ls+    return (BF.Or ls')+  exact (BF.And ls) = do+    ls' <- markAnnotated ls+    return (BF.And ls')+  exact (BF.Parens x)  = do+    x' <- markAnnotated x+    return (BF.Parens x')++-- ---------------------------------------------------------------------++instance (ExactPrint body) => ExactPrint (HsWildCardBndrs GhcPs body) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (HsWC x ty) = do+    ty' <- markAnnotated ty+    return (HsWC x ty')++-- ---------------------------------------------------------------------++instance ExactPrint (GRHS GhcPs (LocatedA (HsExpr GhcPs))) where+  getAnnotationEntry (GRHS an _ _) = fromAnn an+  setAnnotationAnchor (GRHS an a b) anc cs = GRHS (setAnchorEpa an anc cs) a b++  exact (GRHS an guards expr) = do+    debugM $ "GRHS comments:" ++ showGhc (comments an)+    an0 <- markLensKwM an lga_vbar AnnVbar+    guards' <- markAnnotated guards+    debugM $ "GRHS before matchSeparator"+    an1 <- markLensAA an0 lga_sep -- Mark the matchSeparator for these GRHSs+    debugM $ "GRHS after matchSeparator"+    expr' <- markAnnotated expr+    return (GRHS an1 guards' expr')++instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where+  getAnnotationEntry (GRHS ann _ _) = fromAnn ann+  setAnnotationAnchor (GRHS an a b) anc cs = GRHS (setAnchorEpa an anc cs) a b++  exact (GRHS an guards expr) = do+    an0 <- markLensKwM an lga_vbar AnnVbar+    guards' <- markAnnotated guards+    an1 <- markLensAA an0 lga_sep -- Mark the matchSeparator for these GRHSs+    expr' <- markAnnotated expr+    return (GRHS an1 guards' expr')++-- ---------------------------------------------------------------------++instance ExactPrint (HsExpr GhcPs) where+  getAnnotationEntry (HsVar{})                    = NoEntryVal+  getAnnotationEntry (HsUnboundVar an _)          = fromAnn an+  getAnnotationEntry (HsConLikeOut{})             = NoEntryVal+  getAnnotationEntry (HsRecFld{})                 = NoEntryVal+  getAnnotationEntry (HsOverLabel an _)           = fromAnn an+  getAnnotationEntry (HsIPVar an _)               = fromAnn an+  getAnnotationEntry (HsOverLit an _)             = fromAnn an+  getAnnotationEntry (HsLit an _)                 = fromAnn an+  getAnnotationEntry (HsLam _ _)                  = NoEntryVal+  getAnnotationEntry (HsLamCase an _)             = fromAnn an+  getAnnotationEntry (HsApp an _ _)               = fromAnn an+  getAnnotationEntry (HsAppType _ _ _)            = NoEntryVal+  getAnnotationEntry (OpApp an _ _ _)             = fromAnn an+  getAnnotationEntry (NegApp an _ _)              = fromAnn an+  getAnnotationEntry (HsPar an _)                 = fromAnn an+  getAnnotationEntry (SectionL an _ _)            = fromAnn an+  getAnnotationEntry (SectionR an _ _)            = fromAnn an+  getAnnotationEntry (ExplicitTuple an _ _)       = fromAnn an+  getAnnotationEntry (ExplicitSum an _ _ _)       = fromAnn an+  getAnnotationEntry (HsCase an _ _)              = fromAnn an+  getAnnotationEntry (HsIf an _ _ _)              = fromAnn an+  getAnnotationEntry (HsMultiIf an _)             = fromAnn an+  getAnnotationEntry (HsLet an _ _)               = fromAnn an+  getAnnotationEntry (HsDo an _ _)                = fromAnn an+  getAnnotationEntry (ExplicitList an _)          = fromAnn an+  getAnnotationEntry (RecordCon an _ _)           = fromAnn an+  getAnnotationEntry (RecordUpd an _ _)           = fromAnn an+  getAnnotationEntry (HsGetField an _ _)          = fromAnn an+  getAnnotationEntry (HsProjection an _)          = fromAnn an+  getAnnotationEntry (ExprWithTySig an _ _)       = fromAnn an+  getAnnotationEntry (ArithSeq an _ _)            = fromAnn an+  getAnnotationEntry (HsBracket an _)             = fromAnn an+  getAnnotationEntry (HsRnBracketOut{})           = NoEntryVal+  getAnnotationEntry (HsTcBracketOut{})           = NoEntryVal+  getAnnotationEntry (HsSpliceE an _)             = fromAnn an+  getAnnotationEntry (HsProc an _ _)              = fromAnn an+  getAnnotationEntry (HsStatic an _)              = fromAnn an+  getAnnotationEntry (HsTick {})                  = NoEntryVal+  getAnnotationEntry (HsBinTick {})               = NoEntryVal+  getAnnotationEntry (HsPragE{})                  = NoEntryVal++  setAnnotationAnchor a@(HsVar{})              _ _s = a+  setAnnotationAnchor (HsUnboundVar an a)    anc cs = (HsUnboundVar (setAnchorEpa an anc cs) a)+  setAnnotationAnchor a@(HsConLikeOut{})       _ _s = a+  setAnnotationAnchor a@(HsRecFld{})           _ _s = a+  setAnnotationAnchor (HsOverLabel an a)     anc cs = (HsOverLabel (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsIPVar an a)         anc cs = (HsIPVar (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsOverLit an a)       anc cs = (HsOverLit (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsLit an a)           anc cs = (HsLit (setAnchorEpa an anc cs) a)+  setAnnotationAnchor a@(HsLam _ _)            _ _s = a+  setAnnotationAnchor (HsLamCase an a)       anc cs = (HsLamCase (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsApp an a b)         anc cs = (HsApp (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor a@(HsAppType _ _ _)      _ _s = a+  setAnnotationAnchor (OpApp an a b c)       anc cs = (OpApp (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor (NegApp an a b)        anc cs = (NegApp (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsPar an a)           anc cs = (HsPar (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (SectionL an a b)      anc cs = (SectionL (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (SectionR an a b)      anc cs = (SectionR (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (ExplicitTuple an a b) anc cs = (ExplicitTuple (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (ExplicitSum an a b c) anc cs = (ExplicitSum (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor (HsCase an a b)        anc cs = (HsCase (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsIf an a b c)        anc cs = (HsIf (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor (HsMultiIf an a)       anc cs = (HsMultiIf (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsLet an a b)         anc cs = (HsLet (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsDo an a b)          anc cs = (HsDo (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (ExplicitList an a)    anc cs = (ExplicitList (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (RecordCon an a b)     anc cs = (RecordCon (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (RecordUpd an a b)     anc cs = (RecordUpd (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsGetField an a b)    anc cs = (HsGetField (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsProjection an a)    anc cs = (HsProjection (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (ExprWithTySig an a b) anc cs = (ExprWithTySig (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (ArithSeq an a b)      anc cs = (ArithSeq (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsBracket an a)       anc cs = (HsBracket (setAnchorEpa an anc cs) a)+  setAnnotationAnchor a@(HsRnBracketOut{})     _ _s = a+  setAnnotationAnchor a@(HsTcBracketOut{})     _ _s = a+  setAnnotationAnchor (HsSpliceE an a)       anc cs = (HsSpliceE (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsProc an a b)        anc cs = (HsProc (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsStatic an a)        anc cs = (HsStatic (setAnchorEpa an anc cs) a)+  setAnnotationAnchor a@(HsTick {})            _ _s = a+  setAnnotationAnchor a@(HsBinTick {})         _ _s = a+  setAnnotationAnchor a@(HsPragE{})            _ _s = a++  exact (HsVar x n) = do+    n' <- markAnnotated n+    return (HsVar x n')+  exact x@(HsUnboundVar an _) = do+    case an of+      EpAnnNotUsed -> withPpr x+      EpAnn _ (EpAnnUnboundVar (ob,cb) l) _ -> do+        printStringAtAA ob "`" >> return ()+        printStringAtAA l  "_" >> return ()+        printStringAtAA cb "`" >> return ()+        return x+  -- exact x@(HsConLikeOut{})             = withPpr x+  -- exact x@(HsRecFld{})                 = withPpr x+  exact x@(HsOverLabel _ _) = withPpr x++  exact x@(HsIPVar _ (HsIPName n))+    = printStringAdvance ("?" ++ unpackFS n) >> return x++  exact x@(HsOverLit _an ol) = do+    let str = case ol_val ol of+                HsIntegral   (IL src _ _) -> src+                HsFractional (FL { fl_text = src }) -> src+                HsIsString src _          -> src+    -- markExternalSourceText l str ""+    case str of+      SourceText s -> printStringAdvance s >> return ()+      NoSourceText -> withPpr x >> return ()+    return x++  exact (HsLit an lit) = do+    lit' <- withPpr lit+    return (HsLit an lit')+  exact (HsLam x mg) = do+    mg' <- markAnnotated mg+    return (HsLam x mg')++  exact (HsLamCase an mg) = do+    an0 <- markEpAnnL an lidl AnnLam+    an1 <- markEpAnnL an0 lidl AnnCase+    mg' <- markAnnotated mg+    return (HsLamCase an1 mg')++  exact (HsApp an e1 e2) = do+    p <- getPosP+    debugM $ "HsApp entered. p=" ++ show p+    e1' <- markAnnotated e1+    e2' <- markAnnotated e2+    return (HsApp an e1' e2')+  exact (HsAppType ss fun arg) = do+    fun' <- markAnnotated fun+    printStringAtSs ss "@"+    arg' <- markAnnotated arg+    return (HsAppType ss fun' arg')+  exact (OpApp an e1 e2 e3) = do+    e1' <- markAnnotated e1+    e2' <- markAnnotated e2+    e3' <- markAnnotated e3+    return (OpApp an e1' e2' e3')++  exact (NegApp an e s) = do+    an0 <- markEpAnnL an lidl AnnMinus+    e' <- markAnnotated e+    return (NegApp an0 e' s)++  exact (HsPar an e) = do+    an0 <- markOpeningParen an+    e' <- markAnnotated e+    debugM $ "HsPar closing paren"+    an1 <- markClosingParen an0+    debugM $ "HsPar done"+    return (HsPar an1 e')++  exact (SectionL an expr op) = do+    expr' <- markAnnotated expr+    op' <- markAnnotated op+    return (SectionL an expr' op')++  exact (SectionR an op expr) = do+    op' <- markAnnotated op+    expr' <- markAnnotated expr+    return (SectionR an op' expr')++  exact (ExplicitTuple an args b) = do+    an0 <- if b == Boxed then markEpAnnL an lidl AnnOpenP+                         else markEpAnnL an lidl AnnOpenPH++    args' <- mapM markAnnotated args++    an1 <- if b == Boxed then markEpAnnL an0 lidl AnnCloseP+                         else markEpAnnL an0 lidl AnnClosePH+    debugM $ "ExplicitTuple done"+    return (ExplicitTuple an1 args' b)++  exact (ExplicitSum an alt arity expr) = do+    an0 <- markLensKw an laesOpen AnnOpenPH+    an1 <- markAnnKwAllL an0 laesBarsBefore AnnVbar+    expr' <- markAnnotated expr+    an2 <- markAnnKwAllL an1 laesBarsAfter AnnVbar+    an3 <- markLensKw an2 laesClose AnnClosePH+    return (ExplicitSum an3 alt arity expr')++  exact (HsCase an e alts) = do+    an0 <- markAnnKwL an lhsCaseAnnCase AnnCase+    e' <- markAnnotated e+    an1 <- markAnnKwL an0 lhsCaseAnnOf AnnOf+    an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC+    an3 <- markEpAnnAllL an2 lhsCaseAnnsRest AnnSemi+    alts' <- setLayoutBoth $ markAnnotated alts+    an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC+    return (HsCase an4 e' alts')++  exact (HsIf an e1 e2 e3) = do+    an0 <- markAnnKwL an laiIf AnnIf+    e1' <- markAnnotated e1+    an1 <- markLensKwM an0 laiThenSemi AnnSemi+    an2 <- markAnnKwL an1 laiThen AnnThen+    e2' <- markAnnotated e2+    an3 <- markLensKwM an2 laiElseSemi AnnSemi+    an4 <- markAnnKwL an3 laiElse AnnElse+    e3' <- markAnnotated e3+    return (HsIf an4 e1' e2' e3')++  exact (HsMultiIf an mg) = do+    an0 <- markEpAnnL an lidl AnnIf+    an1 <- markEpAnnL an0 lidl AnnOpenC -- optional+    mg' <- markAnnotated mg+    an2 <- markEpAnnL an1 lidl AnnCloseC -- optional+    return (HsMultiIf an2 mg')++  exact (HsLet an binds e) = do+    setLayoutBoth $ do -- Make sure the 'in' gets indented too+      an0 <- markLensKw an lalLet AnnLet+      debugM $ "HSlet:binds coming"+      binds' <- setLayoutBoth $ markAnnotated binds+      debugM $ "HSlet:binds done"+      an1 <- markLensKw an0 lalIn AnnIn+      debugM $ "HSlet:expr coming"+      e' <- markAnnotated e+      return (HsLet an1 binds' e')++  exact (HsDo an do_or_list_comp stmts) = do+    debugM $ "HsDo"+    (an',stmts') <- markAnnListA True an $ \a -> exactDo a do_or_list_comp stmts+    return (HsDo an' do_or_list_comp stmts')++  exact (ExplicitList an es) = do+    debugM $ "ExplicitList start"+    an0 <- markLensMAA an lal_open+    es' <- markAnnotated es+    an1 <- markLensMAA an0 lal_close+    debugM $ "ExplicitList end"+    return (ExplicitList an1 es')+  exact (RecordCon an con_id binds) = do+    con_id' <- markAnnotated con_id+    an0 <- markEpAnnL an lidl AnnOpenC+    binds' <- markAnnotated binds+    an1 <- markEpAnnL an0 lidl AnnCloseC+    return (RecordCon an1 con_id' binds')+  exact (RecordUpd an expr fields) = do+    expr' <- markAnnotated expr+    an0 <- markEpAnnL an lidl AnnOpenC+    fields' <- markAnnotated fields+    an1 <- markEpAnnL an0 lidl AnnCloseC+    return (RecordUpd an1 expr' fields')+  exact (HsGetField an expr field) = do+    expr' <- markAnnotated expr+    field' <- markAnnotated field+    return (HsGetField an expr' field')+  exact (HsProjection an flds) = do+    an0 <- markAnnKwL an lapOpen AnnOpenP+    flds' <- markAnnotated flds+    an1 <- markAnnKwL an0 lapClose AnnCloseP+    return (HsProjection an1 flds')+  exact (ExprWithTySig an expr sig) = do+    expr' <- markAnnotated expr+    an0 <- markEpAnnL an lidl AnnDcolon+    sig' <- markAnnotated sig+    return (ExprWithTySig an0 expr' sig')+  exact (ArithSeq an s seqInfo) = do+    an0 <- markEpAnnL an lidl AnnOpenS -- '['+    (an1, seqInfo') <-+      case seqInfo of+        From e -> do+          e' <- markAnnotated e+          an' <- markEpAnnL an0 lidl AnnDotdot+          return (an', From e')+        FromTo e1 e2 -> do+          e1' <- markAnnotated e1+          an' <- markEpAnnL an0 lidl AnnDotdot+          e2' <- markAnnotated e2+          return (an', FromTo e1' e2')+        FromThen e1 e2 -> do+          e1' <- markAnnotated e1+          an' <- markEpAnnL an0 lidl AnnComma+          e2' <- markAnnotated e2+          an'' <- markEpAnnL an' lidl AnnDotdot+          return (an'', FromThen e1' e2')+        FromThenTo e1 e2 e3 -> do+          e1' <- markAnnotated e1+          an' <- markEpAnnL an0 lidl AnnComma+          e2' <- markAnnotated e2+          an'' <- markEpAnnL an' lidl AnnDotdot+          e3' <- markAnnotated e3+          return (an'', FromThenTo e1' e2' e3')+    an2 <- markEpAnnL an1 lidl AnnCloseS -- ']'+    return (ArithSeq an2 s seqInfo')++  exact (HsBracket an (ExpBr a e)) = do+    an0 <- markEpAnnL an lidl AnnOpenEQ -- "[|"+    an1 <- markEpAnnL an0 lidl AnnOpenE  -- "[e|" -- optional+    e' <- markAnnotated e+    an2 <- markEpAnnL an1 lidl AnnCloseQ -- "|]"+    return (HsBracket an2 (ExpBr a e'))+  exact (HsBracket an (PatBr a e)) = do+    an0 <- markEpAnnLMS an lidl AnnOpen (Just "[p|")+    e' <- markAnnotated e+    an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"+    return (HsBracket an1 (PatBr a e'))+  exact (HsBracket an (DecBrL a e)) = do+    an0 <- markEpAnnLMS an lidl AnnOpen (Just "[d|")+    -- See https://gitlab.haskell.org/ghc/ghc/-/issues/20257, we need+    -- to mark braces here for the time being+    an1 <- markEpAnnL an0 lidl AnnOpenC -- "{"+    e' <- markAnnotated e+    an2 <- markEpAnnL an1 lidl AnnCloseC -- "}"+    an3 <- markEpAnnL an2 lidl AnnCloseQ -- "|]"+    return (HsBracket an3 (DecBrL a e'))+  -- -- exact (HsBracket an (DecBrG _ _)) =+  -- --   traceM "warning: DecBrG introduced after renamer"+  exact (HsBracket an (TypBr a e)) = do+    an0 <- markEpAnnLMS an lidl AnnOpen (Just "[t|")+    e' <- markAnnotated e+    an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"+    return (HsBracket an1 (TypBr a e'))+  exact (HsBracket an (VarBr a b e)) = do+    (an0, e') <-+      if b+      then do+        an' <- markEpAnnL an lidl AnnSimpleQuote+        e' <- markAnnotated e+        return (an', e')+      else do+        an' <- markEpAnnL an lidl AnnThTyQuote+        e' <- markAnnotated e+        return (an', e')+    return (HsBracket an0 (VarBr a b e'))+  exact (HsBracket an (TExpBr a e)) = do+    an0 <- markEpAnnLMS an lidl AnnOpen (Just "[||")+    an1 <- markEpAnnLMS an0 lidl AnnOpenE (Just "[e||")+    e' <- markAnnotated e+    an2 <- markEpAnnLMS an1 lidl AnnClose (Just "||]")+    return (HsBracket an2 (TExpBr a e'))+++  -- exact x@(HsRnBracketOut{})           = withPpr x+  -- exact x@(HsTcBracketOut{})           = withPpr x+  exact (HsSpliceE a sp) = do+    sp' <- markAnnotated sp+    return (HsSpliceE a sp')++  exact (HsProc an p c) = do+    debugM $ "HsProc start"+    an0 <- markEpAnnL an lidl AnnProc+    p' <- markAnnotated p+    an1 <- markEpAnnL an0 lidl AnnRarrow+    debugM $ "HsProc after AnnRarrow"+    c' <- markAnnotated c+    return (HsProc an1 p' c')++  exact (HsStatic an e) = do+    an0 <- markEpAnnL an lidl AnnStatic+    e' <- markAnnotated e+    return (HsStatic an0 e')++  -- exact x@(HsTick {})                  = withPpr x+  -- exact x@(HsBinTick {})               = withPpr x+  exact (HsPragE a prag e) = do+    prag' <- markAnnotated prag+    e' <- markAnnotated e+    return (HsPragE a prag' e')+  exact x = error $ "exact HsExpr for:" ++ showAst x++-- ---------------------------------------------------------------------++exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))+        => EpAnn AnnList -> HsStmtContext any -> LocatedAn an a+        -> EP w m (EpAnn AnnList, LocatedAn an a)+exactDo an (DoExpr m)    stmts = exactMdo an m AnnDo          >>= \an0 -> markMaybeDodgyStmts an0 stmts+exactDo an GhciStmtCtxt  stmts = markEpAnnL an lal_rest AnnDo >>= \an0 -> markMaybeDodgyStmts an0 stmts+exactDo an ArrowExpr     stmts = markEpAnnL an lal_rest AnnDo >>= \an0 -> markMaybeDodgyStmts an0 stmts+exactDo an (MDoExpr m)   stmts = exactMdo an m AnnMdo         >>= \an0 -> markMaybeDodgyStmts an0 stmts+exactDo an ListComp      stmts = markMaybeDodgyStmts an stmts+exactDo an MonadComp     stmts = markMaybeDodgyStmts an stmts+exactDo _  _             _     = panic "pprDo" -- PatGuard, ParStmtCxt++exactMdo :: (Monad m, Monoid w)+  => EpAnn AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m (EpAnn AnnList) +exactMdo an Nothing            kw = markEpAnnL   an lal_rest kw+exactMdo an (Just module_name) kw = markEpAnnLMS an lal_rest kw (Just n)+    where+      n = (moduleNameString module_name) ++ "." ++ (keywordToString kw)++markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))+  => EpAnn AnnList -> LocatedAn an a -> EP w m (EpAnn AnnList, LocatedAn an a)+markMaybeDodgyStmts an stmts =+  if isGoodSrcSpan (getLocA stmts)+    then do+      r <- markAnnotatedWithLayout stmts+      return (an, r)+    else return (an, stmts)++-- ---------------------------------------------------------------------+instance ExactPrint (HsPragE GhcPs) where+  getAnnotationEntry HsPragSCC{}  = NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (HsPragSCC an st sl) = do+    an0 <- markAnnOpenP an st "{-# SCC"+    let txt = sourceTextToString (sl_st sl) (unpackFS $ sl_fs sl)+    an1 <- markEpAnnLMS an0 lapr_rest AnnVal    (Just txt) -- optional+    an2 <- markEpAnnLMS an1 lapr_rest AnnValStr (Just txt) -- optional+    an3 <- markAnnCloseP an2+    return (HsPragSCC an3 st sl)+++-- ---------------------------------------------------------------------++instance ExactPrint (HsSplice GhcPs) where+  getAnnotationEntry (HsTypedSplice an _ _ _)   = fromAnn an+  getAnnotationEntry (HsUntypedSplice an _ _ _) = fromAnn an+  getAnnotationEntry (HsQuasiQuote _ _ _ _ _)   = NoEntryVal+  getAnnotationEntry (HsSpliced _ _ _)          = NoEntryVal++  setAnnotationAnchor (HsTypedSplice an a b c)   anc cs = (HsTypedSplice (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor (HsUntypedSplice an a b c) anc cs = (HsUntypedSplice (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor a@(HsQuasiQuote _ _ _ _ _) _ _ = a+  setAnnotationAnchor a@(HsSpliced _ _ _)        _ _ = a++  exact (HsTypedSplice an DollarSplice n e) = do+    an0 <- markEpAnnL an lidl AnnDollarDollar+    e' <- markAnnotated e+    return (HsTypedSplice an0 DollarSplice n e')++  exact (HsUntypedSplice an decoration n b) = do+    an0 <- if (decoration == DollarSplice)+             then markEpAnnL an lidl AnnDollar+             else return an+    b' <- markAnnotated b+    return (HsUntypedSplice an0 decoration n b')++  exact (HsQuasiQuote a b q ss fs) = do+    -- The quasiquote string does not honour layout offsets. Store+    -- the colOffset for now.+    -- TODO: use local?+    oldOffset <- 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+    p <- getPosP+    debugM $ "HsQuasiQuote:after:(p,ss)=" ++ show (p,ss2range ss)+    return (HsQuasiQuote a b q ss fs)++  exact x = error $ "exact HsSplice for:" ++ showAst x++-- ---------------------------------------------------------------------++-- TODO:AZ: combine these instances+instance ExactPrint (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (MG x matches o) = do+    -- TODO:AZ use SortKey, in MG ann.+    -- matches' <- markAnnotated matches+    matches' <- if isGoodSrcSpan (getLocA matches)+      then markAnnotated matches+      else return matches+    return (MG x matches' o)++instance ExactPrint (MatchGroup GhcPs (LocatedA (HsCmd GhcPs))) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (MG x matches o) = do+    -- TODO:AZ use SortKey, in MG ann.+    matches' <- if isGoodSrcSpan (getLocA matches)+      then markAnnotated matches+      else return matches+    return (MG x matches' o)++-- ---------------------------------------------------------------------++instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (HsRecFields fields mdot) = do+    fields' <- markAnnotated fields+    case mdot of+      Nothing -> return ()+      Just (L ss _) ->+        printStringAtSs ss ".." >> return ()+      -- Note: mdot contains the SrcSpan where the ".." appears, if present+    return (HsRecFields fields' mdot)++-- ---------------------------------------------------------------------++instance (ExactPrint body)+    => ExactPrint (HsRecField' (FieldOcc GhcPs) body) where+  getAnnotationEntry x = fromAnn (hsRecFieldAnn x)+  setAnnotationAnchor x anc cs = x { hsRecFieldAnn = setAnchorEpa (hsRecFieldAnn x) anc cs}+  exact (HsRecField an f arg isPun) = do+    debugM $ "HsRecField"+    f' <- markAnnotated f+    (an0, arg') <- if isPun+      then return (an, arg)+      else do+        an0 <- markEpAnnL an lidl AnnEqual+        arg' <- markAnnotated arg+        return (an0, arg')+    return (HsRecField an0 f' arg' isPun)++-- ---------------------------------------------------------------------++instance (ExactPrint body)+    => ExactPrint (HsRecField' (FieldLabelStrings GhcPs) body) where+  getAnnotationEntry x = fromAnn (hsRecFieldAnn x)+  setAnnotationAnchor x anc cs = x { hsRecFieldAnn = setAnchorEpa (hsRecFieldAnn x) anc cs}+  exact (HsRecField an f arg isPun) = do+    debugM $ "HsRecField FieldLabelStrings"+    f' <- markAnnotated f+    (an0, arg') <- if isPun+      then return (an, arg)+      else do+        an0 <- markEpAnnL an lidl AnnEqual+        arg' <- markAnnotated arg+        return (an0, arg')+    return (HsRecField an0 f' arg' isPun)++-- ---------------------------------------------------------------------++instance (ExactPrint (LocatedA body))+    => ExactPrint (HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body)) where+  getAnnotationEntry x = fromAnn (hsRecFieldAnn x)+  setAnnotationAnchor x anc cs = x { hsRecFieldAnn = setAnchorEpa (hsRecFieldAnn x) anc cs}+  exact (HsRecField an f arg isPun) = do+    debugM $ "HsRecUpdField"+    f' <- markAnnotated f+    an0 <- if isPun then return an+                    else markEpAnnL an lidl AnnEqual+    arg' <- if ((locA $ getLoc arg) == noSrcSpan )+      then return arg+      else markAnnotated arg+    return (HsRecField an0 f' arg' isPun)++-- ---------------------------------------------------------------------++instance+    (ExactPrint (HsRecField' (a GhcPs) body),+     ExactPrint (HsRecField' (b GhcPs) body))+    => ExactPrint+         (Either [LocatedA (HsRecField' (a GhcPs) body)]+                 [LocatedA (HsRecField' (b GhcPs) body)]) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (Left rbinds) = do+    rbinds' <- markAnnotated rbinds+    return (Left rbinds')+  exact (Right pbinds) = do+    pbinds' <- markAnnotated pbinds+    return (Right pbinds')++-- ---------------------------------------------------------------------++instance ExactPrint (FieldLabelStrings GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (FieldLabelStrings fs) = FieldLabelStrings <$> markAnnotated fs++-- ---------------------------------------------------------------------++instance ExactPrint (NonEmpty (Located (HsFieldLabel GhcPs))) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (h :| t) = do+    h' <- markAnnotated h+    t' <- markAnnotated t+    return (h' :| t')++-- ---------------------------------------------------------------------++instance ExactPrint (HsFieldLabel GhcPs) where+  getAnnotationEntry (HsFieldLabel an _) = fromAnn an+  setAnnotationAnchor (HsFieldLabel an a) anc cs = HsFieldLabel (setAnchorEpa an anc cs) a++  exact (HsFieldLabel an fs) = do+    an0 <- markLensKwM an lafDot  AnnDot+    fs' <- markAnnotated fs+    return (HsFieldLabel an0 fs')++-- ---------------------------------------------------------------------++instance ExactPrint (HsTupArg GhcPs) where+  getAnnotationEntry (Present an _) = fromAnn an+  getAnnotationEntry (Missing an)   = fromAnn an++  setAnnotationAnchor (Present an a) anc cs = Present (setAnchorEpa an anc cs) a+  setAnnotationAnchor (Missing an)   anc cs = Missing (setAnchorEpa an anc cs)++  exact (Present a e) = Present a <$> markAnnotated e++  exact a@(Missing EpAnnNotUsed) = return a+  exact a@(Missing _) = printStringAdvance "," >> return a++-- ---------------------------------------------------------------------++instance ExactPrint (HsCmdTop GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (HsCmdTop a cmd) = HsCmdTop a <$> markAnnotated cmd++-- ---------------------------------------------------------------------++instance ExactPrint (HsCmd GhcPs) where+  getAnnotationEntry (HsCmdArrApp an _ _ _ _)   = fromAnn an+  getAnnotationEntry (HsCmdArrForm an _ _ _ _ ) = fromAnn an+  getAnnotationEntry (HsCmdApp an _ _ )         = fromAnn an+  getAnnotationEntry (HsCmdLam {})              = NoEntryVal+  getAnnotationEntry (HsCmdPar an _)            = fromAnn an+  getAnnotationEntry (HsCmdCase an _ _)         = fromAnn an+  getAnnotationEntry (HsCmdLamCase an _)        = fromAnn an+  getAnnotationEntry (HsCmdIf an _ _ _ _)       = fromAnn an+  getAnnotationEntry (HsCmdLet an _ _)          = fromAnn an+  getAnnotationEntry (HsCmdDo an _)             = fromAnn an++  setAnnotationAnchor (HsCmdArrApp an a b c d)   anc cs = (HsCmdArrApp (setAnchorEpa an anc cs) a b c d)+  setAnnotationAnchor (HsCmdArrForm an a b c d ) anc cs = (HsCmdArrForm (setAnchorEpa an anc cs) a b c d )+  setAnnotationAnchor (HsCmdApp an a b )         anc cs = (HsCmdApp (setAnchorEpa an anc cs) a b )+  setAnnotationAnchor a@(HsCmdLam {})              _ _s = a+  setAnnotationAnchor (HsCmdPar an a)            anc cs = (HsCmdPar (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsCmdCase an a b)         anc cs = (HsCmdCase (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsCmdLamCase an a)        anc cs = (HsCmdLamCase (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsCmdIf an a b c d)       anc cs = (HsCmdIf (setAnchorEpa an anc cs) a b c d)+  setAnnotationAnchor (HsCmdLet an a b)          anc cs = (HsCmdLet (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsCmdDo an a)             anc cs = (HsCmdDo (setAnchorEpa an anc cs) a)++  exact (HsCmdArrApp an arr arg o isRightToLeft) = do+    if isRightToLeft+      then do+        arr' <- markAnnotated arr+        an0 <- markKw (anns an)+        arg' <- markAnnotated arg+        let an1 = an{anns = an0}+        return (HsCmdArrApp an1 arr' arg' o isRightToLeft)+      else do+        arg' <- markAnnotated arg+        an0 <- markKw (anns an)+        arr' <- markAnnotated arr+        let an1 = an{anns = an0}+        return (HsCmdArrApp an1 arr' arg' o isRightToLeft)++  exact (HsCmdArrForm an e fixity mf cs) = do+    -- markLocatedMAA an al_open+    an0 <- markLensMAA an lal_open+    (e',cs') <- case (fixity, cs) of+      (Infix, (arg1:argrest)) -> do+        arg1' <- markAnnotated arg1+        e' <- markAnnotated e+        argrest' <- markAnnotated argrest+        return (e', arg1':argrest')+      (Prefix, _) -> do+        e' <- markAnnotated e+        cs' <- markAnnotated cs+        return (e', cs')+      (Infix, []) -> error "Not possible"+    an1 <- markLensMAA an0 lal_close+    return (HsCmdArrForm an1 e' fixity mf cs')++  exact (HsCmdApp an e1 e2) = do+    e1' <- markAnnotated e1+    e2' <- markAnnotated e2+    return (HsCmdApp an e1' e2')++  exact (HsCmdLam a match) = do+    match' <- markAnnotated match+    return (HsCmdLam a match')++  exact (HsCmdPar an e) = do+    an0 <- markOpeningParen an+    e' <- markAnnotated e+    an1 <- markClosingParen an0+    return (HsCmdPar an1 e')++  exact (HsCmdCase an e alts) = do+    an0 <- markLensKw an lhsCaseAnnCase AnnCase+    e' <- markAnnotated e+    an1 <- markLensKw an0 lhsCaseAnnOf AnnOf+    an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC+    an3 <- markEpAnnAllL an2 lhsCaseAnnsRest AnnSemi+    alts' <- markAnnotated alts+    an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC+    return (HsCmdCase an4 e' alts')++  exact (HsCmdLamCase an matches) = do+    an0 <- markEpAnnL an lidl AnnLam+    an1 <- markEpAnnL an0 lidl AnnCase+    matches' <- markAnnotated matches+    return (HsCmdLamCase an1 matches')++  exact (HsCmdIf an a e1 e2 e3) = do+    an0 <- markLensKw an laiIf AnnIf+    e1' <- markAnnotated e1+    an1 <- markLensKwM an0 laiThenSemi AnnSemi+    an2 <- markLensKw an1 laiThen AnnThen+    e2' <- markAnnotated e2+    an3 <- markLensKwM an2 laiElseSemi AnnSemi+    an4 <- markLensKw an3 laiElse AnnElse+    e3' <- markAnnotated e3+    return (HsCmdIf an4 a e1' e2' e3')++  exact (HsCmdLet an binds e) = do+    an0 <- markLensKw an lalLet AnnLet+    binds' <- markAnnotated binds+    an1 <- markLensKw an0 lalIn AnnIn+    e' <- markAnnotated e+    return (HsCmdLet an1 binds' e')++  exact (HsCmdDo an es) = do+    debugM $ "HsCmdDo"+    an0 <- markEpAnnL an lal_rest AnnDo+    es' <- markAnnotated es+    return (HsCmdDo an0 es')++  -- exact x = error $ "exact HsCmd for:" ++ showAst x++-- ---------------------------------------------------------------------++instance (+  ExactPrint (LocatedA (body GhcPs)),+                 Anno (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ~ SrcSpanAnnA,+           Anno [GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))] ~ SrcSpanAnnL,+           (ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))])))+   => ExactPrint (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) where+  getAnnotationEntry (LastStmt _ _ _ _)             = NoEntryVal+  getAnnotationEntry (BindStmt an _ _)              = fromAnn an+  getAnnotationEntry (ApplicativeStmt _ _ _)        = NoEntryVal+  getAnnotationEntry (BodyStmt _ _ _ _)             = NoEntryVal+  getAnnotationEntry (LetStmt an _)                 = fromAnn an+  getAnnotationEntry (ParStmt _ _ _ _)              = NoEntryVal+  getAnnotationEntry (TransStmt an _ _ _ _ _ _ _ _) = fromAnn an+  getAnnotationEntry (RecStmt an _ _ _ _ _ _)       = fromAnn an++  -----------------------------------------------------------------++  setAnnotationAnchor a@(LastStmt _ _ _ _)             _ _s = a+  setAnnotationAnchor (BindStmt an a b)              anc cs = (BindStmt (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor a@(ApplicativeStmt _ _ _)        _ _s = a+  setAnnotationAnchor a@(BodyStmt _ _ _ _)             _ _s = a+  setAnnotationAnchor (LetStmt an a)                 anc cs = (LetStmt (setAnchorEpa an anc cs) a)+  setAnnotationAnchor a@(ParStmt _ _ _ _)              _ _s = a+  setAnnotationAnchor (TransStmt an a b c d e f g h) anc cs = (TransStmt (setAnchorEpa an anc cs) a b c d e f g h)+  setAnnotationAnchor (RecStmt an a b c d e f)       anc cs = (RecStmt (setAnchorEpa an anc cs) a b c d e f)++  -----------------------------------------------------------------++  exact (LastStmt a body b c) = do+    debugM $ "LastStmt"+    body' <- markAnnotated body+    return (LastStmt a body' b c)++  exact (BindStmt an pat body) = do+    debugM $ "BindStmt"+    pat' <- markAnnotated pat+    an0 <- markEpAnnL an lidl AnnLarrow+    body' <- markAnnotated body+    return (BindStmt an0 pat' body')++  exact (ApplicativeStmt _ _body _) = do+    debugM $ "ApplicativeStmt"+    -- TODO: ApplicativeStmt+    -- markAnnotated body+    error $ "need to complete ApplicativeStmt"++  exact (BodyStmt a body b c) = do+    debugM $ "BodyStmt"+    body' <- markAnnotated body+    return (BodyStmt a body' b c)++  exact (LetStmt an binds) = do+    debugM $ "LetStmt"+    an0 <- markEpAnnL an lidl AnnLet+    binds' <- markAnnotated binds+    return (LetStmt an0 binds')++  exact (ParStmt a pbs b c) = do+    debugM $ "ParStmt"+    pbs' <- markAnnotated pbs+    return (ParStmt a pbs' b c)++  exact (TransStmt an form stmts b using by c d e) = do+    debugM $ "TransStmt"+    stmts' <- markAnnotated stmts+    (an', by', using') <- exactTransStmt an by using form+    return (TransStmt an' form stmts' b using' by' c d e)+++  exact (RecStmt an stmts a b c d e) = do+    debugM $ "RecStmt"+    -- markLocatedAAL an al_rest AnnRec+    an0 <- markEpAnnL an lal_rest AnnRec+    (an1, stmts') <- markAnnList True an0 (markAnnotated stmts)+    return (RecStmt an1 stmts' a b c d e)++  -- exact x = error $ "exact CmdLStmt for:" ++ showAst x+  -- exact x = error $ "exact CmdLStmt for:"+++-- ---------------------------------------------------------------------++instance ExactPrint (ParStmtBlock GhcPs GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (ParStmtBlock a stmts b c) = do+    stmts' <- markAnnotated stmts+    return (ParStmtBlock a stmts' b c)++exactTransStmt :: (Monad m, Monoid w)+  => EpAnn [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm+  -> EP w m (EpAnn [AddEpAnn], Maybe (LHsExpr GhcPs), (LHsExpr GhcPs))+exactTransStmt an by using ThenForm = do+  debugM $ "exactTransStmt:ThenForm"+  an0 <- markEpAnnL an lidl AnnThen+  using' <- markAnnotated using+  case by of+    Nothing -> return (an0, by, using')+    Just b -> do+      an1 <- markEpAnnL an0 lidl AnnBy+      b' <- markAnnotated b+      return (an1, Just b', using')+exactTransStmt an by using GroupForm = do+  debugM $ "exactTransStmt:GroupForm"+  an0 <- markEpAnnL an lidl AnnThen+  an1 <- markEpAnnL an0 lidl AnnGroup+  (an2, by') <- case by of+    Nothing -> return (an1, by)+    Just b -> do+      an2 <- markEpAnnL an1 lidl AnnBy+      b' <- markAnnotated b+      return (an2, Just b')+  an3 <- markEpAnnL an2 lidl AnnUsing+  using' <- markAnnotated using+  return (an3, by', using')++-- ---------------------------------------------------------------------++instance ExactPrint (TyClDecl GhcPs) where+  getAnnotationEntry (FamDecl   { })                      = NoEntryVal+  getAnnotationEntry (SynDecl   { tcdSExt = an })         = fromAnn an+  getAnnotationEntry (DataDecl  { tcdDExt = an })         = fromAnn an+  getAnnotationEntry (ClassDecl { tcdCExt = (an, _, _) }) = fromAnn an++  setAnnotationAnchor a@FamDecl{}     _ _s = a+  setAnnotationAnchor x@SynDecl{}   anc cs = x { tcdSExt = setAnchorEpa (tcdSExt x) anc cs }+  setAnnotationAnchor x@DataDecl{}  anc cs = x { tcdDExt = setAnchorEpa (tcdDExt x) anc cs }+  setAnnotationAnchor x@ClassDecl{} anc cs = x { tcdCExt = (setAnchorEpa an anc cs, a, b) }+    where+      (an,a,b) = tcdCExt x++  exact (FamDecl a decl) = do+    decl' <- markAnnotated decl+    return (FamDecl a decl')++  exact (SynDecl { tcdSExt = an+                 , tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity+                 , tcdRhs = 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+    an0 <- annotationsToComments an lidl [AnnOpenP,AnnCloseP]+    an1 <- markEpAnnL an0 lidl AnnType++    (_anx, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing+    an2 <- markEpAnnL an1 lidl AnnEqual+    rhs' <- markAnnotated rhs+    return (SynDecl { tcdSExt = an2+                    , tcdLName = ltycon', tcdTyVars = tyvars', tcdFixity = fixity+                    , tcdRhs = rhs' })++  -- TODO: add a workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/20452+  exact (DataDecl { tcdDExt = an, tcdLName = ltycon, tcdTyVars = tyvars+                  , tcdFixity = fixity, tcdDataDefn = defn }) = do+    (_, an', ltycon', tyvars', _, _mctxt', defn') <-+      exactDataDefn an (exactVanillaDeclHead ltycon tyvars fixity) defn+    return (DataDecl { tcdDExt = an', tcdLName = ltycon', tcdTyVars = tyvars'+                     , tcdFixity = fixity, tcdDataDefn = defn' })++  -- -----------------------------------++  exact (ClassDecl {tcdCExt = (an, sortKey, lo),+                    tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,+                    tcdFixity = fixity,+                    tcdFDs  = fds,+                    tcdSigs = sigs, tcdMeths = methods,+                    tcdATs = ats, tcdATDefs = at_defs,+                    tcdDocs = _docs})+      -- TODO: add a test that demonstrates tcdDocs+      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part+      = do+          (an0, fds', lclas', tyvars',context') <- top_matter+          an1 <- markEpAnnL an0 lidl AnnOpenC+          an2 <- markEpAnnL an1 lidl AnnCloseC+          return (ClassDecl {tcdCExt = (an2, sortKey, lo),+                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',+                             tcdFixity = fixity,+                             tcdFDs  = fds',+                             tcdSigs = sigs, tcdMeths = methods,+                             tcdATs = ats, tcdATDefs = at_defs,+                             tcdDocs = _docs})++      | otherwise       -- Laid out+      = do+          (an0, fds', lclas', tyvars',context') <- top_matter+          an1 <- markEpAnnL    an0 lidl AnnOpenC+          an2 <- markEpAnnAllL an1 lidl AnnSemi+          ds <- withSortKey sortKey+                               (prepareListAnnotationA sigs+                             ++ prepareListAnnotationA (bagToList methods)+                             ++ prepareListAnnotationA ats+                             ++ prepareListAnnotationA at_defs+                             -- ++ prepareListAnnotation docs+                               )+          an3 <- markEpAnnL an2 lidl AnnCloseC+          let+            sigs'    = undynamic ds+            methods' = listToBag $ undynamic ds+            ats'     = undynamic ds+            at_defs' = undynamic ds+          return (ClassDecl {tcdCExt = (an3, sortKey, lo),+                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',+                             tcdFixity = fixity,+                             tcdFDs  = fds',+                             tcdSigs = sigs', tcdMeths = methods',+                             tcdATs = ats', tcdATDefs = at_defs',+                             tcdDocs = _docs})+      where+        top_matter = do+          an' <- annotationsToComments an lidl  [AnnOpenP, AnnCloseP]+          an0 <- markEpAnnL an' lidl AnnClass+          (_, lclas', tyvars',_,context') <-  exactVanillaDeclHead lclas tyvars fixity context+          (an1, fds') <- if (null fds)+            then return (an0, fds)+            else do+              an1 <- markEpAnnL an0 lidl AnnVbar+              fds' <- markAnnotated fds+              return (an1, fds')+          an2 <- markEpAnnL an1 lidl AnnWhere+          return (an2, fds', lclas', tyvars',context')+++-- ---------------------------------------------------------------------++instance ExactPrint (FunDep GhcPs) where+  getAnnotationEntry (FunDep an _ _) = fromAnn an+  setAnnotationAnchor (FunDep an a b) anc cs = FunDep (setAnchorEpa an anc cs) a b++  exact (FunDep an ls rs') = do+    ls' <- markAnnotated ls+    an0 <- markEpAnnL an lidl AnnRarrow+    rs'' <- markAnnotated rs'+    return (FunDep an0 ls' rs'')++-- ---------------------------------------------------------------------++instance ExactPrint (FamilyDecl GhcPs) where+  getAnnotationEntry (FamilyDecl { fdExt = an }) = fromAnn an+  setAnnotationAnchor x anc cs = x { fdExt = setAnchorEpa (fdExt x) anc cs}++  exact (FamilyDecl { fdExt = an+                    , fdInfo = info+                    , fdTopLevel = top_level+                    , fdLName = ltycon+                    , fdTyVars = tyvars+                    , fdFixity = fixity+                    , fdResultSig = L lr result+                    , fdInjectivityAnn = mb_inj }) = do+    an0 <- exactFlavour an info+    an1 <- exact_top_level an0+    an2 <- annotationsToComments an1 lidl [AnnOpenP,AnnCloseP]+    (_, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing+    (an3, result') <- exact_kind an2+    (an4, mb_inj') <-+      case mb_inj of+        Nothing -> return (an3, mb_inj)+        Just inj -> do+          an4 <- markEpAnnL an3 lidl AnnVbar+          inj' <- markAnnotated inj+          return (an4, Just inj')+    (an5, info') <-+             case info of+               ClosedTypeFamily mb_eqns -> do+                 an5 <- markEpAnnL an4 lidl AnnWhere+                 an6 <- markEpAnnL an5 lidl AnnOpenC+                 (an7, mb_eqns') <-+                   case mb_eqns of+                     Nothing -> do+                       an7 <- markEpAnnL an6 lidl AnnDotdot+                       return (an7, mb_eqns)+                     Just eqns -> do+                       eqns' <- markAnnotated eqns+                       return (an6, Just eqns')+                 an8 <- markEpAnnL an7 lidl AnnCloseC+                 return (an8, ClosedTypeFamily mb_eqns')+               _ -> return (an4, info)+    return (FamilyDecl { fdExt = an5+                       , fdInfo = info'+                       , fdTopLevel = top_level+                       , fdLName = ltycon'+                       , fdTyVars = tyvars'+                       , fdFixity = fixity+                       , fdResultSig = L lr result'+                       , fdInjectivityAnn = mb_inj' })+    where+      exact_top_level an' =+        case top_level of+          TopLevel    -> markEpAnnL an' lidl AnnFamily+          NotTopLevel -> do+            -- It seems that in some kind of legacy+            -- mode the 'family' keyword is still+            -- accepted.+            markEpAnnL an' lidl AnnFamily++      exact_kind an' =+        case result of+          NoSig    _         -> return (an', result)+          KindSig  x kind    -> do+            an0 <- markEpAnnL an' lidl AnnDcolon+            kind' <- markAnnotated kind+            return (an0, KindSig  x kind')+          TyVarSig x tv_bndr -> do+            an0 <- markEpAnnL an' lidl AnnEqual+            tv_bndr' <- markAnnotated tv_bndr+            return (an0, TyVarSig x tv_bndr')+++exactFlavour :: (Monad m, Monoid w) => EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> EP w m (EpAnn [AddEpAnn])+exactFlavour an DataFamily            = markEpAnnL an lidl AnnData+exactFlavour an OpenTypeFamily        = markEpAnnL an lidl AnnType+exactFlavour an (ClosedTypeFamily {}) = markEpAnnL an lidl AnnType++-- ---------------------------------------------------------------------++exactDataDefn+  :: (Monad m, Monoid w)+  => EpAnn [AddEpAnn]+  -> (Maybe (LHsContext GhcPs) -> EP w m (EpAnn [AddEpAnn]+                                         , LocatedN RdrName+                                         , a+                                         , b+                                         , Maybe (LHsContext GhcPs))) -- Printing the header+  -> HsDataDefn GhcPs+  -> EP w m ( EpAnn [AddEpAnn] -- ^ from exactHdr+            , EpAnn [AddEpAnn] -- ^ updated one passed in+            , LocatedN RdrName, a, b, Maybe (LHsContext GhcPs), HsDataDefn GhcPs)+exactDataDefn an exactHdr+                 (HsDataDefn { dd_ext = x, dd_ND = new_or_data, dd_ctxt = context+                             , dd_cType = mb_ct+                             , dd_kindSig = mb_sig+                             , dd_cons = condecls, dd_derivs = derivings }) = do+  an' <- annotationsToComments an lidl [AnnOpenP, AnnCloseP]+  an0 <- if new_or_data == DataType+    then markEpAnnL an' lidl AnnData+    else markEpAnnL an' lidl AnnNewtype+  an1 <- markEpAnnL an0 lidl AnnInstance -- optional+  mb_ct' <- mapM markAnnotated mb_ct+  (anx, ln', tvs', b, mctxt') <- exactHdr context+  (an2, mb_sig') <- case mb_sig of+    Nothing -> return (an1, Nothing)+    Just kind -> do+      an2 <- markEpAnnL an1 lidl AnnDcolon+      kind' <- markAnnotated kind+      return (an2, Just kind')+  an3 <- if (isGadt condecls)+    then markEpAnnL an2 lidl AnnWhere+    else return an2+  an4 <- markEpAnnL an3 lidl AnnOpenC+  (an5, condecls') <- exact_condecls an4 condecls+  an6 <- markEpAnnL an5 lidl AnnCloseC+  derivings' <- mapM markAnnotated derivings+  return (anx, an6, ln', tvs', b, mctxt',+                 (HsDataDefn { dd_ext = x, dd_ND = new_or_data, dd_ctxt = context+                             , dd_cType = mb_ct'+                             , dd_kindSig = mb_sig'+                             , dd_cons = condecls', dd_derivs = derivings' }))+++exactVanillaDeclHead :: (Monad m, Monoid w)+                     => LocatedN RdrName+                     -> LHsQTyVars GhcPs+                     -> LexicalFixity+                     -> Maybe (LHsContext GhcPs)+                     -> EP w m ( EpAnn [AddEpAnn]+                               , LocatedN RdrName+                               , LHsQTyVars GhcPs+                               , (), Maybe (LHsContext GhcPs))+exactVanillaDeclHead thing tvs@(HsQTvs { hsq_explicit = tyvars }) fixity context = do+  let+    exact_tyvars (varl:varsr)+      | fixity == Infix && length varsr > 1 = do+          varl' <- markAnnotated varl+          thing' <- markAnnotated thing+          hvarsr <- markAnnotated (head varsr)+          tvarsr <- markAnnotated (tail varsr)+          return (thing', varl':hvarsr:tvarsr)+      | fixity == Infix = do+          varl' <- markAnnotated varl+          thing' <- markAnnotated thing+          varsr' <- markAnnotated varsr+          return (thing', varl':varsr')+      | otherwise = do+          thing' <- markAnnotated thing+          vs <- mapM markAnnotated (varl:varsr)+          return (thing', vs)+    exact_tyvars [] = do+      thing' <- markAnnotated thing+      return (thing', [])+  context' <- mapM markAnnotated context+  (thing', tyvars') <- exact_tyvars tyvars+  return (EpAnnNotUsed, thing', tvs { hsq_explicit = tyvars' }, (), context')++-- ---------------------------------------------------------------------++instance ExactPrint (InjectivityAnn GhcPs) where+  getAnnotationEntry (InjectivityAnn an _ _) = fromAnn an+  setAnnotationAnchor (InjectivityAnn an a b) anc cs = InjectivityAnn (setAnchorEpa an anc cs) a b+  exact (InjectivityAnn an lhs rhs) = do+    an0 <- markEpAnnL an lidl AnnVbar+    lhs' <- markAnnotated lhs+    an1 <- markEpAnnL an0 lidl AnnRarrow+    rhs' <- mapM markAnnotated rhs+    return (InjectivityAnn an1 lhs' rhs')++-- ---------------------------------------------------------------------++class Typeable flag => ExactPrintTVFlag flag where+  exactTVDelimiters :: (Monad m, Monoid w)+    => EpAnn [AddEpAnn] -> flag -> EP w m (HsTyVarBndr flag GhcPs)+    -> EP w m (EpAnn [AddEpAnn], (HsTyVarBndr flag GhcPs))++instance ExactPrintTVFlag () where+  exactTVDelimiters an _ thing_inside = do+    an0 <- markEpAnnAllL an lid AnnOpenP+    r <- thing_inside+    an1 <- markEpAnnAllL an0 lid AnnCloseP+    return (an1, r)++instance ExactPrintTVFlag Specificity where+  exactTVDelimiters an s thing_inside = do+    an0 <- markEpAnnAllL an lid open+    r <- thing_inside+    an1 <- markEpAnnAllL an0 lid close+    return (an1, r)+    where+      (open, close) = case s of+        SpecifiedSpec -> (AnnOpenP, AnnCloseP)+        InferredSpec  -> (AnnOpenC, AnnCloseC)++instance ExactPrintTVFlag flag => ExactPrint (HsTyVarBndr flag GhcPs) where+  getAnnotationEntry (UserTyVar an _ _)     = fromAnn an+  getAnnotationEntry (KindedTyVar an _ _ _) = fromAnn an++  setAnnotationAnchor (UserTyVar an a b)     anc cs = UserTyVar (setAnchorEpa an anc cs) a b+  setAnnotationAnchor (KindedTyVar an a b c) anc cs = KindedTyVar (setAnchorEpa an anc cs) a b c++  exact (UserTyVar an flag n) = do+    r <- exactTVDelimiters an flag $ do+           n' <- markAnnotated n+           return (UserTyVar an flag n')+    case r of+      (an', UserTyVar _ flag'' n'') -> return (UserTyVar an' flag'' n'')+      _ -> error "KindedTyVar should never happen here"+  exact (KindedTyVar an flag n k) = do+    r <- exactTVDelimiters an flag $ do+          n' <- markAnnotated n+          an0 <- markEpAnnL an lidl AnnDcolon+          k' <- markAnnotated k+          return (KindedTyVar an0 flag n' k')+    case r of+      (an',KindedTyVar _ flag'' n'' k'') -> return (KindedTyVar an' flag'' n'' k'')+      _ -> error "UserTyVar should never happen here"++-- ---------------------------------------------------------------------++instance ExactPrint (HsType GhcPs) where+  getAnnotationEntry (HsForAllTy _ _ _)        = NoEntryVal+  getAnnotationEntry (HsQualTy _ _ _)          = NoEntryVal+  getAnnotationEntry (HsTyVar an _ _)          = fromAnn an+  getAnnotationEntry (HsAppTy _ _ _)           = NoEntryVal+  getAnnotationEntry (HsAppKindTy _ _ _)       = NoEntryVal+  getAnnotationEntry (HsFunTy an _ _ _)        = fromAnn an+  getAnnotationEntry (HsListTy an _)           = fromAnn an+  getAnnotationEntry (HsTupleTy an _ _)        = fromAnn an+  getAnnotationEntry (HsSumTy an _)            = fromAnn an+  getAnnotationEntry (HsOpTy _ _ _ _)          = NoEntryVal+  getAnnotationEntry (HsParTy an _)            = fromAnn an+  getAnnotationEntry (HsIParamTy an _ _)       = fromAnn an+  getAnnotationEntry (HsStarTy _ _)            = NoEntryVal+  getAnnotationEntry (HsKindSig an _ _)        = fromAnn an+  getAnnotationEntry (HsSpliceTy _ _)          = NoEntryVal+  getAnnotationEntry (HsDocTy an _ _)          = fromAnn an+  getAnnotationEntry (HsBangTy an _ _)         = fromAnn an+  getAnnotationEntry (HsRecTy an _)            = fromAnn an+  getAnnotationEntry (HsExplicitListTy an _ _) = fromAnn an+  getAnnotationEntry (HsExplicitTupleTy an _)  = fromAnn an+  getAnnotationEntry (HsTyLit _ _)             = NoEntryVal+  getAnnotationEntry (HsWildCardTy _)          = NoEntryVal+  getAnnotationEntry (XHsType _)               = NoEntryVal++  setAnnotationAnchor a@(HsForAllTy _ _ _)        _ _s = a+  setAnnotationAnchor a@(HsQualTy _ _ _)          _ _s = a+  setAnnotationAnchor (HsTyVar an a b)          anc cs = (HsTyVar (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor a@(HsAppTy _ _ _)           _ _s = a+  setAnnotationAnchor a@(HsAppKindTy _ _ _)       _ _s = a+  setAnnotationAnchor (HsFunTy an a b c)        anc cs = (HsFunTy (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor (HsListTy an a)           anc cs = (HsListTy (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsTupleTy an a b)        anc cs = (HsTupleTy (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsSumTy an a)            anc cs = (HsSumTy (setAnchorEpa an anc cs) a)+  setAnnotationAnchor a@(HsOpTy _ _ _ _)          _ _s = a+  setAnnotationAnchor (HsParTy an a)            anc cs = (HsParTy (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsIParamTy an a b)       anc cs = (HsIParamTy (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor a@(HsStarTy _ _)            _ _s = a+  setAnnotationAnchor (HsKindSig an a b)        anc cs = (HsKindSig (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor a@(HsSpliceTy _ _)          _ _s = a+  setAnnotationAnchor (HsDocTy an a b)          anc cs = (HsDocTy (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsBangTy an a b)         anc cs = (HsBangTy (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsRecTy an a)            anc cs = (HsRecTy (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsExplicitListTy an a b) anc cs = (HsExplicitListTy (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (HsExplicitTupleTy an a)  anc cs = (HsExplicitTupleTy (setAnchorEpa an anc cs) a)+  setAnnotationAnchor a@(HsTyLit _ _)             _ _s = a+  setAnnotationAnchor a@(HsWildCardTy _)          _ _s = a+  setAnnotationAnchor a@(XHsType _)               _ _s = a++  exact (HsForAllTy { hst_xforall = an+                    , hst_tele = tele, hst_body = ty }) = do+    tele' <- markAnnotated tele+    ty' <- markAnnotated ty+    return (HsForAllTy { hst_xforall = an+                       , hst_tele = tele', hst_body = ty' })++  exact (HsQualTy an ctxt ty) = do+    ctxt' <- markAnnotated ctxt+    ty' <- markAnnotated ty+    return (HsQualTy an ctxt' ty')+  exact (HsTyVar an promoted name) = do+    an0 <- if (promoted == IsPromoted)+             then markEpAnnL an lidl AnnSimpleQuote+             else return an+    name' <- markAnnotated name+    return (HsTyVar an0 promoted name')+  exact (HsAppTy an t1 t2) = do+    t1' <- markAnnotated t1+    t2' <- markAnnotated t2+    return (HsAppTy an t1' t2')+  exact (HsAppKindTy ss ty ki) = do+    ty' <- markAnnotated ty+    printStringAtSs ss "@"+    ki' <- markAnnotated ki+    return (HsAppKindTy ss ty' ki')+  exact (HsFunTy an mult ty1 ty2) = do+    ty1' <- markAnnotated ty1+    (an', mult') <- markArrow an mult+    ty2' <- markAnnotated ty2+    return (HsFunTy an' mult' ty1' ty2')+  exact (HsListTy an tys) = do+    an0 <- markOpeningParen an+    tys' <- markAnnotated tys+    an1 <- markClosingParen an0+    return (HsListTy an1 tys')+  exact (HsTupleTy an con tys) = do+    an0 <- markOpeningParen an+    tys' <- markAnnotated tys+    an1 <- markClosingParen an0+    return (HsTupleTy an1 con tys')+  exact (HsSumTy an tys) = do+    an0 <- markOpeningParen an+    tys' <- markAnnotated tys+    an1 <- markClosingParen an0+    return (HsSumTy an1 tys')+  exact (HsOpTy an t1 lo t2) = do+    t1' <- markAnnotated t1+    lo' <- markAnnotated lo+    t2' <- markAnnotated t2+    return (HsOpTy an t1' lo' t2')+  exact (HsParTy an ty) = do+    an0 <- markOpeningParen an+    ty' <- markAnnotated ty+    an1 <- markClosingParen an0+    return (HsParTy an1 ty')+  exact (HsIParamTy an n t) = do+    n' <- markAnnotated n+    an0 <- markEpAnnL an lidl AnnDcolon+    t' <- markAnnotated t+    return (HsIParamTy an0 n' t')+  exact (HsStarTy an isUnicode) = do+    if isUnicode+        then printStringAdvance "\x2605" -- Unicode star+        else printStringAdvance "*"+    return (HsStarTy an isUnicode)+  exact (HsKindSig an ty k) = do+    ty' <- markAnnotated ty+    an0 <- markEpAnnL an lidl AnnDcolon+    k' <- markAnnotated k+    return (HsKindSig an0 ty' k')+  exact (HsSpliceTy a splice) = do+    splice' <- markAnnotated splice+    return (HsSpliceTy a splice')+  -- exact x@(HsDocTy an _ _)          = withPpr x+  exact (HsBangTy an (HsSrcBang mt up str) ty) = do+    an0 <-+      case mt of+        NoSourceText -> return an+        SourceText src -> do+          debugM $ "HsBangTy: src=" ++ showAst src+          an0 <- markEpAnnLMS an lid AnnOpen  (Just src)+          an1 <- markEpAnnLMS an0 lid AnnClose (Just "#-}")+          debugM $ "HsBangTy: done unpackedness"+          return an1+    an1 <-+      case str of+        SrcLazy     -> markEpAnnL an0 lidl AnnTilde+        SrcStrict   -> markEpAnnL an0 lidl AnnBang+        NoSrcStrict -> return an0+    ty' <- markAnnotated ty+    return (HsBangTy an1 (HsSrcBang mt up str) ty')+  -- exact x@(HsRecTy an _)            = withPpr x+  exact (HsExplicitListTy an prom tys) = do+    an0 <- if (isPromoted prom)+             then markEpAnnL an lidl AnnSimpleQuote+             else return an+    an1 <- markEpAnnL an0 lidl AnnOpenS+    tys' <- markAnnotated tys+    an2 <- markEpAnnL an1 lidl AnnCloseS+    return (HsExplicitListTy an2 prom tys')+  exact (HsExplicitTupleTy an tys) = do+    an0 <- markEpAnnL an lidl AnnSimpleQuote+    an1 <- markEpAnnL an0 lidl AnnOpenP+    tys' <- markAnnotated tys+    an2 <- markEpAnnL an1 lidl AnnCloseP+    return (HsExplicitTupleTy an2 tys')+  exact (HsTyLit a lit) = do+    case lit of+      (HsNumTy src v) -> printSourceText src (show v)+      (HsStrTy src v) -> printSourceText src (show v)+      (HsCharTy src v) -> printSourceText src (show v)+    return (HsTyLit a lit)+  exact t@(HsWildCardTy _) = printStringAdvance "_" >> return t+  exact x = error $ "missing match for HsType:" ++ showAst x++-- ---------------------------------------------------------------------++instance ExactPrint (HsForAllTelescope GhcPs) where+  getAnnotationEntry (HsForAllVis an _)   = fromAnn an+  getAnnotationEntry (HsForAllInvis an _) = fromAnn an++  setAnnotationAnchor (HsForAllVis an a) anc cs = HsForAllVis (setAnchorEpa an anc cs) a+  setAnnotationAnchor (HsForAllInvis an a) anc cs = HsForAllInvis (setAnchorEpa an anc cs) a++  exact (HsForAllVis an bndrs)   = do+    an0 <- markLensAA an lfst -- AnnForall+    bndrs' <- markAnnotated bndrs+    an1 <- markLensAA an0 lsnd -- AnnRarrow+    return (HsForAllVis an1 bndrs')++  exact (HsForAllInvis an bndrs) = do+    an0 <- markLensAA an lfst -- AnnForall+    bndrs' <- markAnnotated bndrs+    an1 <- markLensAA an0 lsnd -- AnnDot+    return (HsForAllInvis an1 bndrs')++-- ---------------------------------------------------------------------++instance ExactPrint (HsDerivingClause GhcPs) where+  getAnnotationEntry d@(HsDerivingClause{}) = fromAnn (deriv_clause_ext d)+  setAnnotationAnchor x anc cs = (x { deriv_clause_ext = setAnchorEpa (deriv_clause_ext x) anc cs})+                                   `debug` ("setAnnotationAnchor HsDerivingClause: (anc,cs):" ++ showAst (anc,cs))++  exact (HsDerivingClause { deriv_clause_ext      = an+                          , deriv_clause_strategy = dcs+                          , deriv_clause_tys      = dct }) = do+    an0 <- markEpAnnL an lidl AnnDeriving+    exact_strat_before+    dct' <- markAnnotated dct+    exact_strat_after+    return (HsDerivingClause { deriv_clause_ext      = an0+                             , deriv_clause_strategy = dcs+                             , deriv_clause_tys      = dct' })+      where+        -- -- This complexity is to distinguish between+        -- --    deriving Show+        -- --    deriving (Show)+        -- pp_dct [HsIB { hsib_body = ty }]+        --          = ppr (parenthesizeHsType appPrec ty)+        -- pp_dct _ = parens (interpp'SP dct)++        -- @via@ is unique in that in comes /after/ the class being derived,+        -- so we must special-case it.+        (exact_strat_before, exact_strat_after) =+          case dcs of+            Just v@(L _ ViaStrategy{}) -> (pure (), markAnnotated v >> pure ())+            _                          -> (mapM_ markAnnotated dcs, pure ())++-- ---------------------------------------------------------------------++instance ExactPrint (DerivStrategy GhcPs) where+  getAnnotationEntry (StockStrategy an)    = fromAnn an+  getAnnotationEntry (AnyclassStrategy an) = fromAnn an+  getAnnotationEntry (NewtypeStrategy an)  = fromAnn an+  getAnnotationEntry (ViaStrategy (XViaStrategyPs an  _)) = fromAnn an++  setAnnotationAnchor (StockStrategy an)    anc cs = (StockStrategy (setAnchorEpa an anc cs))+  setAnnotationAnchor (AnyclassStrategy an) anc cs = (AnyclassStrategy (setAnchorEpa an anc cs))+  setAnnotationAnchor (NewtypeStrategy an)  anc cs = (NewtypeStrategy (setAnchorEpa an anc cs))+  setAnnotationAnchor (ViaStrategy (XViaStrategyPs an  a)) anc cs = (ViaStrategy (XViaStrategyPs (setAnchorEpa an anc cs)  a))++  exact s@(StockStrategy an)    = markEpAnn an AnnStock >> return s+  exact s@(AnyclassStrategy an) = markEpAnn an AnnAnyclass >> return s+  exact s@(NewtypeStrategy an)  = markEpAnn an AnnNewtype >> return s+  exact s@(ViaStrategy (XViaStrategyPs an ty))+    = markEpAnn an AnnVia >> markAnnotated ty >> return s++-- ---------------------------------------------------------------------++instance (ExactPrint a) => ExactPrint (LocatedC a) where+  getAnnotationEntry (L sann _) = fromAnn sann+  setAnnotationAnchor = setAnchorAn++  exact (L (SrcSpanAnn EpAnnNotUsed l) a) = do+    a' <- markAnnotated a+    return (L (SrcSpanAnn EpAnnNotUsed l) a')+  exact (L (SrcSpanAnn (EpAnn anc (AnnContext ma opens closes) cs) l) a) = do+    -- mapM_ (markKwA AnnOpenP) (sort opens)+    mapM_ (markKwA AnnOpenP) opens+    a' <- markAnnotated a+    -- mapM_ (markKwA AnnCloseP) (sort closes)+    mapM_ (markKwA AnnCloseP) closes+    case ma of+      Just (UnicodeSyntax, r) -> markKwA AnnDarrowU r >> pure ()+      Just (NormalSyntax,  r) -> markKwA AnnDarrow  r >> pure ()+      Nothing -> pure ()+    return (L (SrcSpanAnn (EpAnn anc (AnnContext ma opens closes) cs) l) a')++-- ---------------------------------------------------------------------++instance ExactPrint (DerivClauseTys GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (DctSingle x ty) = do+    ty' <- markAnnotated ty+    return (DctSingle x ty')+  exact (DctMulti x tys) = do+    tys' <- markAnnotated tys+    return (DctMulti x tys')++-- ---------------------------------------------------------------------++instance ExactPrint (HsSigType GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (HsSig a bndrs ty) = do+    bndrs' <- markAnnotated bndrs+    ty' <- markAnnotated ty+    return (HsSig a bndrs' ty')++-- ---------------------------------------------------------------------++instance ExactPrint (LocatedN RdrName) where+  getAnnotationEntry (L sann _) = fromAnn sann+  setAnnotationAnchor = setAnchorAn++  exact x@(L (SrcSpanAnn EpAnnNotUsed l) n) = do+    printUnicode (spanAsAnchor l) n+    return x+  exact (L (SrcSpanAnn (EpAnn anc ann cs) ll) n) = do+    ann' <-+      case ann of+        NameAnn a o l c t -> do+          mn <- markName a o (Just (l,n)) c+          -- let (o', (Just (l',_)), c') =+          --       case mn of+          --        (o', (Just (l',n')), c') -> (o', (Just (l',n')), c')+          --        _ -> error "ExactPrint (LocatedN RdrName)"+          -- t' <- markTrailing t+          -- return (NameAnn a o' l' c' t')+          case mn of+            (o', (Just (l',_n)), c') -> do -- (o', (Just (l',n')), c')+              t' <- markTrailing t+              return (NameAnn a o' l' c' t')+            _ -> error "ExactPrint (LocatedN RdrName)"+        NameAnnCommas a o commas c t -> do+          let (kwo,kwc) = adornments a+          (AddEpAnn _ o') <- markKwC NoCaptureComments (AddEpAnn kwo o)+          commas' <- forM commas (\loc -> locFromAdd <$> markKwC NoCaptureComments (AddEpAnn AnnComma loc))+          (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)+          t' <- markTrailing t+          return (NameAnnCommas a o' commas' c' t')+        NameAnnOnly a o c t -> do+          (o',_,c') <- markName a o Nothing c+          t' <- markTrailing t+          return (NameAnnOnly a o' c' t')+        NameAnnRArrow nl t -> do+          (AddEpAnn _ nl') <- markKwC NoCaptureComments (AddEpAnn AnnRarrow nl)+          t' <- markTrailing t+          return (NameAnnRArrow nl' t')+        NameAnnQuote q name t -> do+          debugM $ "NameAnnQuote"+          (AddEpAnn _ q') <- markKwC NoCaptureComments (AddEpAnn AnnSimpleQuote q)+          (L name' _) <- markAnnotated (L name n)+          t' <- markTrailing t+          return (NameAnnQuote q' name' t')+        NameAnnTrailing t -> do+          anc' <- printUnicode anc n+          t' <- markTrailing t+          return (NameAnnTrailing t')+    return (L (SrcSpanAnn (EpAnn anc ann' cs) ll) n)++locFromAdd :: AddEpAnn -> EpaLocation+locFromAdd (AddEpAnn _ loc) = loc++printUnicode :: (Monad m, Monoid w) => Anchor -> RdrName -> EP w m Anchor+printUnicode anc n = do+  let str = case (showPprUnsafe n) of+            -- TODO: unicode support?+              "forall" -> if spanLength (anchor anc) == 1 then "∀" else "forall"+              s -> s+  loc <- printStringAtAAC NoCaptureComments (EpaDelta (SameLine 0) []) str+  case loc of+    EpaSpan _ -> return anc+    EpaDelta dp [] -> return anc { anchor_op = MovedAnchor dp }+    EpaDelta _ _cs -> error "printUnicode should not capture comments"+++markName :: (Monad m, Monoid w)+  => NameAdornment -> EpaLocation -> Maybe (EpaLocation,RdrName) -> EpaLocation+  -> EP w m (EpaLocation, Maybe (EpaLocation,RdrName), EpaLocation)+markName adorn open mname close = do+  let (kwo,kwc) = adornments adorn+  (AddEpAnn _ open') <- markKwC CaptureComments (AddEpAnn kwo open)+  mname' <-+    case mname of+      Nothing -> return Nothing+      Just (name, a) -> do+        name' <- printStringAtAAC CaptureComments name (showPprUnsafe a)+        return (Just (name',a))+  (AddEpAnn _ close') <- markKwC CaptureComments (AddEpAnn kwc close)+  return (open', mname', close')++adornments :: NameAdornment -> (AnnKeywordId, AnnKeywordId)+adornments NameParens     = (AnnOpenP, AnnCloseP)+adornments NameParensHash = (AnnOpenPH, AnnClosePH)+adornments NameBackquotes = (AnnBackquote, AnnBackquote)+adornments NameSquare     = (AnnOpenS, AnnCloseS)+++markTrailingL :: (Monad m, Monoid w) => EpAnn a -> Lens a [TrailingAnn] -> EP w m (EpAnn a)+markTrailingL EpAnnNotUsed _ = return EpAnnNotUsed+markTrailingL (EpAnn anc an cs) l = do+  ts <- mapM markKwT (view l an)+  return (EpAnn anc (set l ts an) cs)++markTrailing :: (Monad m, Monoid w) => [TrailingAnn] -> EP w m [TrailingAnn]+markTrailing ts = do+  p <- getPosP+  debugM $ "markTrailing:" ++ showPprUnsafe (p,ts)+  mapM markKwT ts++-- ---------------------------------------------------------------------++-- based on pp_condecls in Decls.hs+exact_condecls :: (Monad m, Monoid w)+  => EpAnn [AddEpAnn] -> [LConDecl GhcPs] -> EP w m (EpAnn [AddEpAnn],[LConDecl GhcPs])+exact_condecls an cs+  | gadt_syntax                  -- In GADT syntax+  = do+      cs' <- mapM markAnnotated cs+      return (an, cs')+  | otherwise                    -- In H98 syntax+  = do+      an0 <- markEpAnnL an lidl AnnEqual+      cs' <- mapM markAnnotated cs+      return (an0, cs')+  where+    gadt_syntax = case cs of+      []                      -> False+      (L _ ConDeclH98{}  : _) -> False+      (L _ ConDeclGADT{} : _) -> True++-- ---------------------------------------------------------------------++instance ExactPrint (ConDecl GhcPs) where+  getAnnotationEntry x@(ConDeclGADT{}) = fromAnn (con_g_ext x)+  getAnnotationEntry x@(ConDeclH98{})  = fromAnn (con_ext x)++  setAnnotationAnchor x@ConDeclGADT{} anc cs = x { con_g_ext = setAnchorEpa (con_g_ext x) anc cs}+  setAnnotationAnchor x@ConDeclH98{}  anc cs = x { con_ext   = setAnchorEpa (con_ext x) anc cs}++-- based on pprConDecl+  exact (ConDeclH98 { con_ext = an+                    , con_name = con+                    , con_forall = has_forall+                    , con_ex_tvs = ex_tvs+                    , con_mb_cxt = mcxt+                    , con_args = args+                    , con_doc = doc }) = do+    doc' <- mapM markAnnotated doc+    an0 <- if has_forall+      then markEpAnnL an lidl AnnForall+      else return an+    ex_tvs' <- mapM markAnnotated ex_tvs+    an1 <- if has_forall+      then markEpAnnL an0 lidl AnnDot+      else return an0+    mcxt' <- mapM markAnnotated mcxt+    an2 <- if (isJust mcxt)+      then markEpAnnL an1 lidl AnnDarrow+      else return an1++    (con', args') <- exact_details args+    return (ConDeclH98 { con_ext = an2+                       , con_name = con'+                       , con_forall = has_forall+                       , con_ex_tvs = ex_tvs'+                       , con_mb_cxt = mcxt'+                       , con_args = args'+                       , con_doc = doc' })++    where+    --   -- In ppr_details: let's not print the multiplicities (they are always 1, by+    --   -- definition) as they do not appear in an actual declaration.+      exact_details (InfixCon t1 t2) = do+        t1' <- markAnnotated t1+        con' <- markAnnotated con+        t2' <- markAnnotated t2+        return (con', InfixCon t1' t2')+      exact_details (PrefixCon tyargs tys) = do+        con' <- markAnnotated con+        tyargs' <- markAnnotated tyargs+        tys' <- markAnnotated tys+        return (con', PrefixCon tyargs' tys')+      exact_details (RecCon fields) = do+        con' <- markAnnotated con+        fields' <- markAnnotated fields+        return (con', RecCon fields')++  -- -----------------------------------++  exact (ConDeclGADT { con_g_ext = an+                     , con_names = cons+                     , con_bndrs = bndrs+                     , con_mb_cxt = mcxt, con_g_args = args+                     , con_res_ty = res_ty, con_doc = doc }) = do+    doc' <- mapM markAnnotated doc+    cons' <- mapM markAnnotated cons+    an0 <- markEpAnnL an lidl AnnDcolon+    an1 <- annotationsToComments an0 lidl  [AnnOpenP, AnnCloseP]++    -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558+    bndrs' <- case bndrs of+      L _ (HsOuterImplicit _) -> return bndrs+      _ -> markAnnotated bndrs++    mcxt' <- mapM markAnnotated mcxt+    an2 <- if (isJust mcxt)+      then markEpAnnL an1 lidl AnnDarrow+      else return an1+    args' <-+      case args of+          (PrefixConGADT args0) -> do+            args0' <- mapM markScaled args0+            return (PrefixConGADT args0')+          (RecConGADT fields) -> do+            fields' <- markAnnotated fields+            return (RecConGADT fields')+    res_ty' <- markAnnotated res_ty+    return (ConDeclGADT { con_g_ext = an2+                        , con_names = cons'+                        , con_bndrs = bndrs'+                        , con_mb_cxt = mcxt', con_g_args = args'+                        , con_res_ty = res_ty', con_doc = doc' })++-- ---------------------------------------------------------------------++instance ExactPrint Void where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact x = return x++-- ---------------------------------------------------------------------++instance ExactPrintTVFlag flag => ExactPrint (HsOuterTyVarBndrs flag GhcPs) where+  getAnnotationEntry (HsOuterImplicit _) = NoEntryVal+  getAnnotationEntry (HsOuterExplicit an _) = fromAnn an++  setAnnotationAnchor (HsOuterImplicit a) _ _ = HsOuterImplicit a+  setAnnotationAnchor (HsOuterExplicit an a) anc cs = HsOuterExplicit (setAnchorEpa an anc cs) a++  exact b@(HsOuterImplicit _) = pure b+  exact (HsOuterExplicit an bndrs) = do+    an0 <- markLensAA an lfst -- "forall"+    bndrs' <- markAnnotated bndrs+    an1 <- markLensAA an0 lsnd -- "."+    return (HsOuterExplicit an1 bndrs')++-- ---------------------------------------------------------------------++instance ExactPrint (ConDeclField GhcPs) where+  getAnnotationEntry f@(ConDeclField{}) = fromAnn (cd_fld_ext f)++  setAnnotationAnchor x anc cs = x { cd_fld_ext = setAnchorEpa (cd_fld_ext x) anc cs}++  exact (ConDeclField an names ftype mdoc) = do+    names' <- markAnnotated names+    an0 <- markEpAnnL an lidl AnnDcolon+    ftype' <- markAnnotated ftype+    mdoc' <- mapM markAnnotated mdoc+    return (ConDeclField an0 names' ftype' mdoc')++-- ---------------------------------------------------------------------++instance ExactPrint (FieldOcc GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact f@(FieldOcc _ n) = markAnnotated n >> return f++-- ---------------------------------------------------------------------++instance ExactPrint (AmbiguousFieldOcc GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact f@(Unambiguous _ n) = markAnnotated n >> return f+  exact f@(Ambiguous   _ n) = markAnnotated n >> return f++-- ---------------------------------------------------------------------++markScaled :: (Monad m, Monoid w)+  => HsScaled GhcPs (LBangType GhcPs) -> EP w m (HsScaled GhcPs (LBangType GhcPs))+markScaled (HsScaled arr (L l c)) = do+  (L l1 (HsScaled arr' (L l2 c'))) <- markAnnotated (L l (HsScaled arr (L (noAnnSrcSpan $ locA l) c))+                 :: LocatedA (HsScaled GhcPs (LBangType GhcPs)))+  let l' = l1 <> l2+  return (HsScaled arr' (L l' c'))++instance (ExactPrint a) => ExactPrint (HsScaled GhcPs a) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (HsScaled arr t) = do+    t' <- markAnnotated t+    (_, arr') <- markArrow EpAnnNotUsed arr+    return (HsScaled arr' t')++-- ---------------------------------------------------------------------++instance ExactPrint (LocatedP CType) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn++  exact x@(L (SrcSpanAnn EpAnnNotUsed _) ct) = withPpr ct >> return x+  exact (L (SrcSpanAnn an ll)+         (CType stp mh (stct,ct))) = do+    an0 <- markAnnOpenP an stp "{-# CTYPE"+    an1 <- case mh of+             Nothing -> return an0+             Just (Header srcH _h) ->+               markEpAnnLMS an0 lapr_rest AnnHeader (Just (toSourceTextWithSuffix srcH "" ""))+    an2 <- markEpAnnLMS an1 lapr_rest AnnVal (Just (toSourceTextWithSuffix stct (unpackFS ct) ""))+    an3 <- markAnnCloseP an2+    return (L (SrcSpanAnn an3 ll)+         (CType stp mh (stct,ct)))++-- ---------------------------------------------------------------------++instance ExactPrint (SourceText, RuleName) where+  -- We end up at the right place from the Located wrapper+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (st, rn)+    = printStringAdvance (toSourceTextWithSuffix st (unpackFS rn) "")+      >> return (st, rn)+++-- =====================================================================+-- LocatedL instances start --+--+-- Each is dealt with specifically, as they have+-- different wrapping annotations in the al_rest zone.+--+-- In future, the annotation could perhaps be improved, with an+-- 'al_pre' and 'al_post' set of annotations to be simply sorted and+-- applied.+-- ---------------------------------------------------------------------++instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn++  exact (L (SrcSpanAnn an l) ies) = do+    debugM $ "LocatedL [LIE"+    an0 <- markEpAnnL an lal_rest AnnHiding+    p <- getPosP+    debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p+    (an1, ies') <- markAnnList True an0 (markAnnotated ies)+    return (L (SrcSpanAnn an1 l) ies')++instance (ExactPrint (Match GhcPs (LocatedA body)))+   => ExactPrint (LocatedL [LocatedA (Match GhcPs (LocatedA body))]) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn+  exact (L la a) = do+    let an = ann la+    debugM $ "LocatedL [LMatch"+    -- TODO: markAnnList?+    an0 <- markEpAnnAllL an lal_rest AnnWhere+    an1 <- markLensMAA an0 lal_open+    an2 <- markEpAnnAllL an1 lal_rest AnnSemi+    a' <- markAnnotated a+    an3 <- markLensMAA an2 lal_close+    return (L (la { ann = an3}) a')++-- instance ExactPrint (LocatedL [ExprLStmt GhcPs]) where+instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]) where+  getAnnotationEntry = entryFromLocatedAFixed+  setAnnotationAnchor = setAnchorAn+  exact (L (SrcSpanAnn an' l) stmts) = do+    let an = fixAnnListAnn an'+    debugM $ "LocatedL [ExprLStmt"+    (an'', stmts') <- markAnnList True an $ do+      -- markLocatedMAA an al_open+      case snocView stmts of+        Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do+          debugM $ "LocatedL [ExprLStmt: snocView"+          ls' <- markAnnotated ls+          initStmts' <- markAnnotated initStmts+          return (initStmts' ++ [ls'])+        _ -> do+          markAnnotated stmts+        -- x -> error $ "pprDo:ListComp" ++ showAst x+      -- markLocatedMAA an al_close+    return (L (SrcSpanAnn an'' l) stmts')++-- instance ExactPrint (LocatedL [CmdLStmt GhcPs]) where+instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]) where+  getAnnotationEntry = entryFromLocatedAFixed+  setAnnotationAnchor = setAnchorAn+  exact (L (SrcSpanAnn ann' l) es) = do+    let ann = fixAnnListAnn ann'+    debugM $ "LocatedL [CmdLStmt"+    an0 <- markLensMAA ann lal_open+    es' <- mapM markAnnotated es+    an1 <- markLensMAA an0 lal_close+    return (L (SrcSpanAnn an1 l) es')++instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn+  exact (L (SrcSpanAnn an l) fs) = do+    debugM $ "LocatedL [LConDeclField"+    (an', fs') <- markAnnList True an (markAnnotated fs)+    return (L (SrcSpanAnn an' l) fs')++instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn+  exact (L (SrcSpanAnn an l) bf) = do+    debugM $ "LocatedL [LBooleanFormula"+    (an', bf') <- markAnnList True an (markAnnotated bf)+    return (L (SrcSpanAnn an' l) bf')++-- ---------------------------------------------------------------------+-- LocatedL instances end --+-- =====================================================================++instance ExactPrint (IE GhcPs) where+  getAnnotationEntry (IEVar _ _)            = NoEntryVal+  getAnnotationEntry (IEThingAbs an _)      = fromAnn an+  getAnnotationEntry (IEThingAll an _)      = fromAnn an+  getAnnotationEntry (IEThingWith an _ _ _) = fromAnn an+  getAnnotationEntry (IEModuleContents an _)= fromAnn an+  getAnnotationEntry (IEGroup _ _ _)        = NoEntryVal+  getAnnotationEntry (IEDoc _ _)            = NoEntryVal+  getAnnotationEntry (IEDocNamed _ _)       = NoEntryVal++  setAnnotationAnchor a@(IEVar _ _)             _ _s = a+  setAnnotationAnchor (IEThingAbs an a)       anc cs = (IEThingAbs (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (IEThingAll an a)       anc cs = (IEThingAll (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (IEThingWith an a b c)  anc cs = (IEThingWith (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor (IEModuleContents an a) anc cs = (IEModuleContents (setAnchorEpa an anc cs) a)+  setAnnotationAnchor a@(IEGroup _ _ _)         _ _s = a+  setAnnotationAnchor a@(IEDoc _ _)             _ _s = a+  setAnnotationAnchor a@(IEDocNamed _ _)        _ _s = a++  exact (IEVar x ln) = do+    ln' <- markAnnotated ln+    return (IEVar x ln')+  exact (IEThingAbs x thing) = do+    thing' <- markAnnotated thing+    return (IEThingAbs x thing')+  exact (IEThingAll an thing) = do+    thing' <- markAnnotated thing+    an0 <- markEpAnnL an  lidl AnnOpenP+    an1 <- markEpAnnL an0 lidl AnnDotdot+    an2 <- markEpAnnL an1 lidl AnnCloseP+    return (IEThingAll an2 thing')++  exact (IEThingWith an thing wc withs) = do+    thing' <- markAnnotated thing+    an0 <- markEpAnnL an lidl AnnOpenP+    (an1, wc', withs') <-+      case wc of+        NoIEWildcard -> do+          withs'' <- markAnnotated withs+          return (an0, wc, withs'')+        IEWildcard pos -> do+          let (bs, as) = splitAt pos withs+          bs' <- markAnnotated bs+          an1 <- markEpAnnL an0 lidl AnnDotdot+          an2 <- markEpAnnL an1 lidl AnnComma+          as' <- markAnnotated as+          return (an2, wc, bs'++as')+    an2 <- markEpAnnL an1 lidl AnnCloseP+    return (IEThingWith an2 thing' wc' withs')++  exact (IEModuleContents an m) = do+    an0 <- markEpAnnL an lidl AnnModule+    m' <- markAnnotated m+    return (IEModuleContents an0 m')++  -- exact (IEGroup _ _ _)          = NoEntryVal+  -- exact (IEDoc _ _)              = NoEntryVal+  -- exact (IEDocNamed _ _)         = NoEntryVal+  exact x = error $ "missing match for IE:" ++ showAst x++-- ---------------------------------------------------------------------++instance ExactPrint (IEWrappedName RdrName) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (IEName n) = do+    n' <- markAnnotated n+    return (IEName n')+  exact (IEPattern r n) = do+    r' <- printStringAtAA r "pattern"+    n' <- markAnnotated n+    return (IEPattern r' n')+  exact (IEType r n) = do+    r' <- printStringAtAA r "type"+    n' <- markAnnotated n+    return (IEType r' n')++-- ---------------------------------------------------------------------++instance ExactPrint (Pat GhcPs) where+  getAnnotationEntry (WildPat _)              = NoEntryVal+  getAnnotationEntry (VarPat _ _)             = NoEntryVal+  getAnnotationEntry (LazyPat an _)           = fromAnn an+  getAnnotationEntry (AsPat an _ _)           = fromAnn an+  getAnnotationEntry (ParPat an _)            = fromAnn an+  getAnnotationEntry (BangPat an _)           = fromAnn an+  getAnnotationEntry (ListPat an _)           = fromAnn an+  getAnnotationEntry (TuplePat an _ _)        = fromAnn an+  getAnnotationEntry (SumPat an _ _ _)        = fromAnn an+  getAnnotationEntry (ConPat an _ _)          = fromAnn an+  getAnnotationEntry (ViewPat an _ _)         = fromAnn an+  getAnnotationEntry (SplicePat _ _)          = NoEntryVal+  getAnnotationEntry (LitPat _ _)             = NoEntryVal+  getAnnotationEntry (NPat an _ _ _)          = fromAnn an+  getAnnotationEntry (NPlusKPat an _ _ _ _ _) = fromAnn an+  getAnnotationEntry (SigPat an _ _)          = fromAnn an++  setAnnotationAnchor a@(WildPat _)              _ _s = a+  setAnnotationAnchor a@(VarPat _ _)             _ _s = a+  setAnnotationAnchor (LazyPat an a)            anc cs = (LazyPat (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (AsPat an a b)            anc cs = (AsPat (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (ParPat an a)             anc cs = (ParPat (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (BangPat an a)            anc cs = (BangPat (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (ListPat an a)            anc cs = (ListPat (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (TuplePat an a b)         anc cs = (TuplePat (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (SumPat an a b c)         anc cs = (SumPat (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor (ConPat an a b)           anc cs = (ConPat (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor (ViewPat an a b)          anc cs = (ViewPat (setAnchorEpa an anc cs) a b)+  setAnnotationAnchor a@(SplicePat _ _)         _ _s = a+  setAnnotationAnchor a@(LitPat _ _)            _ _s = a+  setAnnotationAnchor (NPat an a b c)          anc cs = (NPat (setAnchorEpa an anc cs) a b c)+  setAnnotationAnchor (NPlusKPat an a b c d e) anc cs = (NPlusKPat (setAnchorEpa an anc cs) a b c d e)+  setAnnotationAnchor (SigPat an a b)          anc cs = (SigPat (setAnchorEpa an anc cs) a b)++  exact (WildPat w) = do+    anchor <- getAnchorU+    debugM $ "WildPat:anchor=" ++ show anchor+    _ <- printStringAtRs anchor "_"+    return (WildPat w)+  exact (VarPat x n) = do+    -- The parser inserts a placeholder value for a record pun rhs. This must be+    -- filtered.+    let pun_RDR = "pun-right-hand-side"+    n' <- if (showPprUnsafe n /= pun_RDR)+      then markAnnotated n+      else return n+    return (VarPat x n')+  exact (LazyPat an pat) = do+    an0 <- markEpAnnL an lidl AnnTilde+    pat' <- markAnnotated pat+    return (LazyPat an0 pat')+  exact (AsPat an n pat) = do+    n' <- markAnnotated n+    an0 <- markEpAnnL an lidl AnnAt+    pat' <- markAnnotated pat+    return (AsPat an0 n' pat')+  exact (ParPat an pat) = do+    an0 <- markAnnKwL an lap_open AnnOpenP+    pat' <- markAnnotated pat+    an1 <- markAnnKwL an0 lap_close AnnCloseP+    return (ParPat an1 pat')+  exact (BangPat an pat) = do+    an0 <- markEpAnnL an lidl AnnBang+    pat' <- markAnnotated pat+    return (BangPat an0 pat')++  exact (ListPat an pats) = do+    (an', pats') <- markAnnList True an (markAnnotated pats)+    return (ListPat an' pats')++  exact (TuplePat an pats boxity) = do+    an0 <- case boxity of+             Boxed   -> markEpAnnL an lidl AnnOpenP+             Unboxed -> markEpAnnL an lidl AnnOpenPH+    pats' <- markAnnotated pats+    an1 <- case boxity of+             Boxed   -> markEpAnnL an0 lidl AnnCloseP+             Unboxed -> markEpAnnL an0 lidl AnnClosePH+    return (TuplePat an1 pats' boxity)++  exact (SumPat an pat alt arity) = do+    an0 <- markEpAnnL an lsumPatParens AnnOpenPH+    an1 <- markAnnKwAllL an0 lsumPatVbarsBefore AnnVbar+    pat' <- markAnnotated pat+    an2 <- markAnnKwAllL an1 lsumPatVbarsAfter AnnVbar+    an3 <- markEpAnnL an2 lsumPatParens AnnClosePH+    return (SumPat an3 pat' alt arity)++  -- | ConPat an con args)+  exact (ConPat an con details) = do+    (an', con', details') <- exactUserCon an con details+    return (ConPat an' con' details')+  exact (ViewPat an expr pat) = do+    expr' <- markAnnotated expr+    an0 <- markEpAnnL an lidl AnnRarrow+    pat' <- markAnnotated pat+    return (ViewPat an0 expr' pat')+  exact (SplicePat x splice) = do+    splice' <- markAnnotated splice+    return (SplicePat x splice')+  exact p@(LitPat _ lit) = printStringAdvance (hsLit2String lit) >> return p+  exact (NPat an ol mn z) = do+    an0 <- if (isJust mn)+      then markEpAnnL an lidl AnnMinus+      else return an+    ol' <- markAnnotated ol+    return (NPat an0 ol' mn z)++  -- | NPlusKPat an n lit1 lit2 _ _)+  exact (NPlusKPat an n k lit2 a b) = do+    n' <- markAnnotated n+    an' <- printStringAtAAL an lid "+"+    k' <- markAnnotated k+    return (NPlusKPat an' n' k' lit2 a b)++  exact (SigPat an pat sig) = do+    pat' <- markAnnotated pat+    an0 <- markEpAnnL an lidl AnnDcolon+    sig' <- markAnnotated sig+    return (SigPat an0 pat' sig')++-- ---------------------------------------------------------------------++instance ExactPrint (HsPatSigType GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact (HsPS an ty) = do+    an0 <- markAnnKwL an lid AnnAt+    ty' <- markAnnotated ty+    return (HsPS an0 ty')++-- ---------------------------------------------------------------------++instance ExactPrint (HsOverLit GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ = a++  exact ol =+    let str = case ol_val ol of+                HsIntegral   (IL src _ _) -> src+                HsFractional (FL{ fl_text = src }) -> src+                HsIsString src _ -> src+    in+      case str of+        SourceText s -> printStringAdvance s >> return ol+        NoSourceText -> return ol++-- ---------------------------------------------------------------------++hsLit2String :: HsLit GhcPs -> String+hsLit2String lit =+  case lit of+    HsChar       src v   -> toSourceTextWithSuffix src v ""+    -- It should be included here+    -- https://github.com/ghc/ghc/blob/master/compiler/parser/Lexer.x#L1471+    HsCharPrim   src p   -> toSourceTextWithSuffix src p "#"+    HsString     src v   -> toSourceTextWithSuffix src v ""+    HsStringPrim src v   -> toSourceTextWithSuffix src v ""+    HsInt        _ (IL src _ v)   -> toSourceTextWithSuffix src v ""+    HsIntPrim    src v   -> toSourceTextWithSuffix src v ""+    HsWordPrim   src v   -> toSourceTextWithSuffix src v ""+    HsInt64Prim  src v   -> toSourceTextWithSuffix src v ""+    HsWord64Prim src v   -> toSourceTextWithSuffix src v ""+    HsInteger    src v _ -> toSourceTextWithSuffix src v ""+    HsRat        _ fl@(FL{fl_text = src }) _ -> toSourceTextWithSuffix src fl ""+    HsFloatPrim  _ fl@(FL{fl_text = src })   -> toSourceTextWithSuffix src fl "#"+    HsDoublePrim _ fl@(FL{fl_text = src })   -> toSourceTextWithSuffix src fl "##"+    -- (XLit x) -> error $ "got XLit for:" ++ showPprUnsafe x++toSourceTextWithSuffix :: (Show a) => SourceText -> a -> String -> String+toSourceTextWithSuffix (NoSourceText)    alt suffix = show alt ++ suffix+toSourceTextWithSuffix (SourceText txt) _alt suffix = txt ++ suffix++sourceTextToString :: SourceText -> String -> String+sourceTextToString NoSourceText alt   = alt+sourceTextToString (SourceText txt) _ = txt++-- ---------------------------------------------------------------------++exactUserCon :: (Monad m, Monoid w, ExactPrint con)+  => EpAnn [AddEpAnn] -> con -> HsConPatDetails GhcPs+  -> EP w m (EpAnn [AddEpAnn], con, HsConPatDetails GhcPs)+exactUserCon an c (InfixCon p1 p2) = do+  p1' <- markAnnotated p1+  c' <- markAnnotated c+  p2' <- markAnnotated p2+  return (an, c', InfixCon p1' p2')+exactUserCon an c details = do+  c' <- markAnnotated c+  an0 <- markEpAnnL an lidl AnnOpenC+  details' <- exactConArgs details+  an1 <- markEpAnnL an0 lidl AnnCloseC+  return (an1, c', details')++exactConArgs :: (Monad m, Monoid w)+  => HsConPatDetails GhcPs -> EP w m (HsConPatDetails GhcPs)+exactConArgs (PrefixCon tyargs pats) = do+  tyargs' <- markAnnotated tyargs+  pats' <- markAnnotated pats+  return (PrefixCon tyargs' pats')+exactConArgs (InfixCon p1 p2) = do+  p1' <- markAnnotated p1+  p2' <- markAnnotated p2+  return (InfixCon p1' p2')+exactConArgs (RecCon rpats) = do+  rpats' <- markAnnotated rpats+  return (RecCon rpats')++-- ---------------------------------------------------------------------++entryFromLocatedA :: LocatedAn ann a -> Entry+entryFromLocatedA (L la _) = fromAnn la++-- See https://gitlab.haskell.org/ghc/ghc/-/issues/20256+entryFromLocatedAFixed :: LocatedL a -> Entry+entryFromLocatedAFixed (L la _)+  = fromAnn (fixSrcAnnL 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 cl s = do+  p <- getPosP+  colOffset <- getLayoutOffsetP+  if isGoodDeltaWithOffset cl colOffset+    then do+      printStringAt (undelta p cl colOffset) s+        -- `debug` ("printStringAtLsDelta:(pos,s):" ++ show (undelta p cl colOffset,s))+      p' <- getPosP+      d <- getPriorEndD+      debugM $ "printStringAtLsDelta:(pos,p',d,s):" ++ show (undelta p cl colOffset,p',d,s)+    else return () `debug` ("printStringAtLsDelta:bad delta for (mc,s):" ++ show (cl,s))++-- ---------------------------------------------------------------------++isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool+isGoodDeltaWithOffset dp colOffset = isGoodDelta (deltaPos l c)+  where (l,c) = undelta (0,0) dp colOffset++-- | Print a comment, using the current layout offset to convert the+-- @DeltaPos@ to an absolute position.+printQueuedComment :: (Monad m, Monoid w) => RealSrcSpan -> Comment -> DeltaPos -> EP w m ()+printQueuedComment loc Comment{commentContents} dp = do+  p <- 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+    -- setPriorEndASTD False loc+  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 k = do+  oldLHS <- getLayoutOffsetD+  oldAnchorOffset <- getLayoutOffsetP+  debugM $ "setLayoutBoth: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)+  modify (\a -> a { dMarkLayout = True+                  , pMarkLayout = True } )+  let reset = do+        debugM $ "setLayoutBoth:reset: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)+        modify (\a -> 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 k = do+  debugM $ "setLayoutTopLevelP entered"+  oldAnchorOffset <- getLayoutOffsetP+  modify (\a -> a { pMarkLayout = False+                  , pLHS = 0} )+  r <- k+  debugM $ "setLayoutTopLevelP:resetting"+  setLayoutOffsetP oldAnchorOffset+  return r++------------------------------------------------------------------------++getPosP :: (Monad m, Monoid w) => EP w m Pos+getPosP = gets epPos++setPosP :: (Monad m, Monoid w) => Pos -> EP w m ()+setPosP l = do+  -- debugM $ "setPosP:" ++ show l+  modify (\s -> s {epPos = l})++getExtraDP :: (Monad m, Monoid w) => EP w m (Maybe Anchor)+getExtraDP = gets uExtraDP++setExtraDP :: (Monad m, Monoid w) => Maybe Anchor -> EP w m ()+setExtraDP md = do+  debugM $ "setExtraDP:" ++ show md+  modify (\s -> s {uExtraDP = md})++getPriorEndD :: (Monad m, Monoid w) => EP w m Pos+getPriorEndD = gets dPriorEndPosition++getAnchorU :: (Monad m, Monoid w) => EP w m RealSrcSpan+getAnchorU = gets uAnchorSpan++setPriorEndD :: (Monad m, Monoid w) => Pos -> EP w m ()+setPriorEndD pe = do+  setPriorEndNoLayoutD pe++setPriorEndNoLayoutD :: (Monad m, Monoid w) => Pos -> EP w m ()+setPriorEndNoLayoutD pe = do+  debugM $ "setPriorEndNoLayoutD:pe=" ++ show pe+  modify (\s -> s { dPriorEndPosition = pe })++setPriorEndASTD :: (Monad m, Monoid w) => Bool -> RealSrcSpan -> EP w m ()+setPriorEndASTD layout pe = setPriorEndASTPD layout (rs2range pe)++setPriorEndASTPD :: (Monad m, Monoid w) => Bool -> (Pos,Pos) -> EP w m ()+setPriorEndASTPD layout pe@(fm,to) = do+  debugM $ "setPriorEndASTD:pe=" ++ show pe+  when layout $ setLayoutStartD (snd fm)+  modify (\s -> s { dPriorEndPosition = to } )++setLayoutStartD :: (Monad m, Monoid w) => Int -> EP w m ()+setLayoutStartD p = do+  EPState{dMarkLayout} <- get+  when dMarkLayout $ do+    debugM $ "setLayoutStartD: setting dLHS=" ++ show p+    modify (\s -> s { dMarkLayout = False+                    , dLHS = LayoutStartCol p})++getLayoutOffsetD :: (Monad m, Monoid w) => EP w m LayoutStartCol+getLayoutOffsetD = gets dLHS++setAnchorU :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()+setAnchorU rss = do+  debugM $ "setAnchorU:" ++ show (rs2range rss)+  modify (\s -> s { uAnchorSpan = rss })++getUnallocatedComments :: (Monad m, Monoid w) => EP w m [Comment]+getUnallocatedComments = gets epComments++putUnallocatedComments :: (Monad m, Monoid w) => [Comment] -> EP w m ()+putUnallocatedComments cs = modify (\s -> s { epComments = cs } )++-- | Push a fresh stack frame for the applied comments gatherer+pushAppliedComments  :: (Monad m, Monoid w) => EP w m ()+pushAppliedComments = modify (\s -> 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 = do+  ccs <- gets epCommentsApplied+  case ccs of+    [] -> do+      modify (\s -> s { epCommentsApplied = [] })+      return []+    h:t -> do+      modify (\s -> s { epCommentsApplied = []:t })+      return (reverse 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 = do+  ccs <- gets epCommentsApplied+  case ccs of+    [] -> do+      modify (\s -> s { epCommentsApplied = [] })+      return []+    h:t -> do+      modify (\s -> s { epCommentsApplied = t })+      return (reverse 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 c = do+  ccs <- gets epCommentsApplied+  case ccs of+    []    -> modify (\s -> s { epCommentsApplied = [[c]] } )+    (h:t) -> modify (\s -> s { epCommentsApplied = (c:h):t } )++getLayoutOffsetP :: (Monad m, Monoid w) => EP w m LayoutStartCol+getLayoutOffsetP = gets pLHS++setLayoutOffsetP :: (Monad m, Monoid w) => LayoutStartCol -> EP w m ()+setLayoutOffsetP c = do+  debugM $ "setLayoutOffsetP:" ++ show c+  modify (\s -> s { pLHS = c })+++-- ---------------------------------------------------------------------++advance :: (Monad m, Monoid w) => DeltaPos -> EP w m ()+advance dp = do+  p <- 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 ???+      p <- getPosP+      d <- getPriorEndD+      r <- getAnchorU+      setPriorEndD (fst $ rs2range r)+      debugM $ "advance:after: (posp, posd, posd')=" ++ show (p,d,fst $ rs2range r)+    else+      return ()++-- ---------------------------------------------------------------------++adjustDeltaForOffsetM :: (Monad m, Monoid w) => DeltaPos -> EP w m DeltaPos+adjustDeltaForOffsetM dp = do+  colOffset <- getLayoutOffsetD+  return (adjustDeltaForOffset colOffset dp)++-- ---------------------------------------------------------------------+-- Printing functions++printString :: (Monad m, Monoid w) => Bool -> String -> EP w m ()+printString layout str = do+  EPState{epPos = (_,c), pMarkLayout} <- get+  EPOptions{epTokenPrint, epWhitespacePrint} <- ask+  when (pMarkLayout && layout) $ do+    debugM $ "printString: setting pLHS to " ++ show c+    modify (\s -> s { pLHS = LayoutStartCol c, pMarkLayout = False } )++  -- Advance position, taking care of any newlines in the string+  let strDP = dpFromString str+      cr = getDeltaLine 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) >>= \s -> tell EPWriter { output = s}+    else lift (epTokenPrint      str) >>= \s -> tell EPWriter { output = s}++--------------------------------------------------------++printStringAdvance :: (Monad m, Monoid w) => String -> EP w m ()+printStringAdvance str = do+  ss <- getAnchorU+  _ <- printStringAtRs ss str+  return ()++--------------------------------------------------------++newLine :: (Monad m, Monoid w) => EP w m ()+newLine = do+    (l,_) <- getPosP+    (ld,_) <- getPriorEndD+    printString False "\n"+    setPosP (l+1,1)+    setPriorEndNoLayoutD (ld+1,1)  padUntil :: (Monad m, Monoid w) => Pos -> EP w m () padUntil (l,c) = do