ghc-exactprint 1.5.0 → 1.6.0

raw patch · 21 files changed

+654/−1161 lines, 21 filesdep +Cabal-syntaxdep ~basedep ~ghcdep ~ghc-pathsPVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal-syntax

Dependency ranges changed: base, ghc, ghc-paths

API changes (from Hackage documentation)

Files

• ChangeLog +2/−0
• ghc-exactprint.cabal +16/−15
• src/Language/Haskell/GHC/ExactPrint/Dump.hs +0/−4
• src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs +240/−258
• src/Language/Haskell/GHC/ExactPrint/Lookup.hs +105/−105
• src/Language/Haskell/GHC/ExactPrint/Orphans.hs +1/−7
• src/Language/Haskell/GHC/ExactPrint/Parsers.hs +27/−14
• src/Language/Haskell/GHC/ExactPrint/Preprocess.hs +23/−7
• src/Language/Haskell/GHC/ExactPrint/Transform.hs +68/−240
• src/Language/Haskell/GHC/ExactPrint/Utils.hs +28/−40
• tests/Test.hs +44/−5
• tests/Test/Common.hs +6/−9
• tests/Test/NoAnnotations.hs +1/−1
• tests/Test/Transform.hs +17/−454
• tests/examples/failing/record-dot-operator-parens.hs +7/−0
• tests/examples/failing/record-dot-operator-parens.hs.bad +7/−0
• tests/examples/ghc92/CommentPlacement4.hs +9/−0
• tests/examples/ghc92/CommentPlacement5.hs +9/−0
• tests/examples/ghc92/CommentPlacement6.hs +27/−0
• tests/examples/ghc92/Observer1.hs +2/−2
• tests/examples/ghc94/record-dot-four-out.hs +15/−0

@@ -1,3 +1,5 @@+2022-09-30 v1.6.0+	* Support GHC 9.4.1 and GHC 9.4.2 2022-02-01 v1.5.0 	* Add private version of showAstData, to be able to render 	AnchorOperation's hacked into SrcSpan's.

@@ -1,12 +1,12 @@ name:                ghc-exactprint-version:             1.5.0+version:             1.6.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                      be compiled by GHC, currently excluding lhs files.                      .-                     Note: requires GHC 9.2 or later. For GHC versions from-                           7.10.2 to 9.0.* see this library with versions < 1.1+                     Note: requires GHC 9.4.*. For earlier GHC+                     versions see lower version numbers.                      .  license:             BSD3@@ -15,7 +15,8 @@ maintainer:          alan.zimm@gmail.com category:            Development build-type:          Simple-tested-with:         GHC == 9.2.1+tested-with:         GHC == 9.4.1+                   , GHC == 9.4.2 extra-source-files:  ChangeLog                      tests/examples/failing/*.hs                      tests/examples/ghc710-only/*.hs@@ -28,6 +29,7 @@                      tests/examples/ghc88/*.hs                      tests/examples/ghc90/*.hs                      tests/examples/ghc92/*.hs+                     tests/examples/ghc94/*.hs                      tests/examples/pre-ghc810/*.hs                      tests/examples/pre-ghc86/*.hs                      tests/examples/pre-ghc90/*.hs@@ -71,15 +73,14 @@   -- other-extensions:   GHC-Options:         -Wall -Wredundant-constraints   -- GHC-Options:         -Weverything-  build-depends:       base >=4.16 && <4.18+  build-depends:       base >=4.17 && <4.18                      , bytestring >= 0.10.6                      , containers >= 0.5                      , ordered-containers                      , data-default                      , directory >= 1.2                      , filepath  >= 1.4-                     , ghc       >= 7.10.2-                     , ghc-paths >= 0.1+                     , ghc       >= 9.4.1                      , mtl       >= 2.2.1                      , syb       >= 0.5                      , free      >= 4.12@@ -88,7 +89,7 @@     default-language:    Haskell2010-  if impl (ghc < 9.2)+  if impl (ghc < 9.4)       buildable: False  Test-Suite test@@ -106,8 +107,6 @@                      , Test.Transform   GHC-Options:         -threaded -Wall -Wredundant-constraints   Default-language:    Haskell2010-  if impl (ghc < 9.2)-      buildable: False   Build-depends:       HUnit >= 1.2                      , base < 4.18                      , bytestring@@ -117,7 +116,7 @@                      , Diff                      , directory >= 1.2                      , filepath  >= 1.4-                     , ghc  >= 7.10.2+                     , ghc       >= 9.4.1                      , ghc-paths  >= 0.1                      , mtl        >= 2.2.1                      , syb        >= 0.5@@ -126,10 +125,13 @@                      -- for the lib only                      , fail >= 4.9 && <4.10                      , ghc-boot+                     , Cabal-syntax   if flag (dev)       build-depends: free   else       build-depends: ghc-exactprint+  if impl (ghc < 9.4)+      buildable: False  executable roundtrip   main-is: Roundtrip.hs@@ -138,7 +140,7 @@                  Test.CommonUtils                  -- Test.Consistency   default-language:    Haskell2010-  if impl (ghc >= 9.2) && flag (roundtrip)+  if impl (ghc >= 9.4) && flag (roundtrip)     build-depends:                  HUnit                , base@@ -148,7 +150,7 @@                , filepath                , ghc                , ghc-exactprint-               , ghc-paths+               -- , ghc-paths                , syb                , temporary                , time@@ -185,8 +187,7 @@                  , directory                  , filemanip                  , filepath-                 , ghc       >= 9.2-                 , ghc-paths >= 0.1+                 , ghc       >= 9.4.1                  , HUnit                  , text   >= 1.2.2                  , turtle >= 1.3.0

@@ -59,7 +59,6 @@               `extQ` annotationAddEpAnn               `extQ` annotationGrhsAnn               `extQ` annotationEpAnnHsCase-              `extQ` annotationEpAnnHsLet               `extQ` annotationAnnList               `extQ` annotationEpAnnImportDecl               `extQ` annotationAnnParen@@ -239,9 +238,6 @@              annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc             annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase")--            annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc-            annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet")              annotationAnnList :: EpAnn AnnList -> SDoc             annotationAnnList = annotation' (text "EpAnn AnnList")

@@ -5,9 +5,12 @@ {-# LANGUAGE MultiWayIf           #-} {-# LANGUAGE NamedFieldPuns       #-} {-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE StandaloneDeriving   #-} {-# LANGUAGE TupleSections        #-}+{-# LANGUAGE TypeApplications     #-} {-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns         #-} {-# LANGUAGE UndecidableInstances  #-} -- For the (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ExactPrint instance@@ -30,21 +33,25 @@   ) where  import GHC-import GHC.Base (NonEmpty(..) )+-- import GHC.Base (NonEmpty(..) ) import GHC.Core.Coercion.Axiom (Role(..)) import GHC.Data.Bag import qualified GHC.Data.BooleanFormula as BF import GHC.Data.FastString+import GHC.TypeLits import GHC.Types.Basic hiding (EP) import GHC.Types.Fixity import GHC.Types.ForeignCall import GHC.Types.SourceText+import GHC.Types.PkgQual import GHC.Types.Var import GHC.Utils.Outputable hiding ( (<>) ) import GHC.Unit.Module.Warnings import GHC.Utils.Misc import GHC.Utils.Panic +-- import GHC.Types.PkgQual+ import Control.Monad.Identity import qualified Control.Monad.Reader as Reader import Control.Monad.RWS@@ -52,10 +59,11 @@ import Data.Dynamic import Data.Foldable import Data.Functor.Const-import qualified Data.Set.Ordered as OSet+import Data.List+-- import qualified Data.Set.Ordered as OSet import qualified Data.Set as Set import Data.Typeable-import Data.List ( partition, sortBy)+-- import Data.List ( partition, sortBy) import Data.Maybe ( isJust, mapMaybe )  import Data.Void@@ -411,12 +419,8 @@ 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)) +  putUnallocatedComments (sort (cs ++ csNew))  -- --------------------------------------------------------------------- @@ -623,30 +627,43 @@  -- --------------------------------------------------------------------- -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')+markToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)+  => LHsToken tok GhcPs -> EP w m (LHsToken tok GhcPs)+markToken (L NoTokenLoc t) = return (L NoTokenLoc t)+markToken (L (TokenLoc aa) t) = do+  aa' <- printStringAtAA aa (symbolVal (Proxy @tok))+  return (L (TokenLoc aa') t) -  an' <- case an of-           EpAnnNotUsed -> pure EpAnnNotUsed-           EpAnn anc a cs -> do-             a' <- markKwT a-             return (EpAnn anc a' cs)-  return (an', arr')+markUniToken :: forall m w tok utok. (Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok)+  => LHsUniToken tok utok GhcPs -> EP w m (LHsUniToken tok utok GhcPs)+markUniToken (L l HsNormalTok)  = do+  (L l' _) <- markToken (L l (HsTok @tok))+  return (L l' HsNormalTok)+markUniToken (L l HsUnicodeTok) = do+  (L l' _) <- markToken (L l (HsTok @utok))+  return (L l' HsUnicodeTok)  -- --------------------------------------------------------------------- +markArrow :: (Monad m, Monoid w) => HsArrow GhcPs -> EP w m (HsArrow GhcPs)+markArrow (HsUnrestrictedArrow arr) = do+  arr' <- markUniToken arr+  return (HsUnrestrictedArrow arr')+markArrow (HsLinearArrow (HsPct1 pct1 arr)) = do+  pct1' <- markToken pct1+  arr' <- markUniToken arr+  return (HsLinearArrow (HsPct1 pct1' arr'))+markArrow (HsLinearArrow (HsLolly arr)) = do+  arr' <- markToken arr+  return (HsLinearArrow (HsLolly arr'))+markArrow (HsExplicitMult pct t arr) = do+  pct' <- markToken pct+  t' <- markAnnotated t+  arr' <- markUniToken arr+  return (HsExplicitMult pct' t' arr')++-- ---------------------------------------------------------------------+ markAnnCloseP :: (Monad m, Monoid w) => EpAnn AnnPragma -> EP w m (EpAnn AnnPragma) markAnnCloseP an = markEpAnnLMS' an lapr_close AnnClose (Just "#-}") @@ -727,13 +744,6 @@ -- --------------------------------------------------------------------- -- 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],@@ -930,13 +940,13 @@ --       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_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))+-- lap_close :: Lens AnnParen EpaLocation+-- lap_close k parent = fmap (\new -> parent { ap_close = new })+--                           (k (ap_close parent))  -- ------------------------------------- -- data EpAnnHsCase = EpAnnHsCase@@ -1190,9 +1200,6 @@ 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  -- --------------------------------------------------------------------- @@ -1342,7 +1349,6 @@ -- Start of ExactPrint instances -- --------------------------------------------------------------------- - -- | Bare Located elements are simply stripped off without further -- processing. instance (ExactPrint a) => ExactPrint (Located a) where@@ -1364,6 +1370,13 @@     ann' <- markALocatedA (ann la)     return (L (la { ann = ann'}) a') +instance (ExactPrint a) => ExactPrint (LocatedAn NoEpAnns a) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor la anc cs = setAnchorAn la anc cs+  exact (L la a) = do+    a' <- markAnnotated a+    return (L la a')+ instance (ExactPrint a) => ExactPrint [a] where   getAnnotationEntry = const NoEntryVal   setAnnotationAnchor ls _ _ = ls@@ -1379,15 +1392,12 @@ -- | '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') <-@@ -1401,9 +1411,7 @@            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') @@ -1433,7 +1441,7 @@  -- --------------------------------------------------------------------- -instance ExactPrint (LocatedP WarningTxt) where+instance ExactPrint (LocatedP (WarningTxt GhcPs)) where   getAnnotationEntry = entryFromLocatedA   setAnnotationAnchor = setAnchorAn @@ -1490,10 +1498,9 @@         _ -> return ann1     ann3 <-       case mpkg of-       Just (StringLiteral src' v _) ->+       RawPkgQual (StringLiteral src' v _) ->          printStringAtMLocL ann2 limportDeclAnnPackage (sourceTextToString src' (show v))        _ -> return ann2-     m' <- markAnnotated m      ann4 <-@@ -1530,8 +1537,17 @@ instance ExactPrint HsDocString where   getAnnotationEntry _ = NoEntryVal   setAnnotationAnchor a _ _ = a-  exact = withPpr -- TODO:AZ use annotations+  exact ds = do+    (printStringAdvance . exactPrintHsDocString) ds+    return ds +instance ExactPrint a => ExactPrint (WithHsDocIdentifiers a GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ = a+  exact (WithHsDocIdentifiers ds ids) = do+    ds' <- exact ds+    return (WithHsDocIdentifiers ds' ids)+ -- ---------------------------------------------------------------------  instance ExactPrint (HsDecl GhcPs) where@@ -1572,20 +1588,19 @@ -- ---------------------------------------------------------------------  instance ExactPrint (InstDecl GhcPs) where-  getAnnotationEntry (ClsInstD     _  _) = NoEntryVal-  getAnnotationEntry (DataFamInstD an _) = fromAnn an-  getAnnotationEntry (TyFamInstD   _  _) = NoEntryVal+  getAnnotationEntry (ClsInstD     _ _) = NoEntryVal+  getAnnotationEntry (DataFamInstD _ _) = NoEntryVal+  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 (DataFamInstD x decl) = do+    d' <- markAnnotated (DataFamInstDeclWithContext noAnn TopLevel decl)+    return (DataFamInstD x (dc_d d'))   exact (TyFamInstD a eqn) = do     eqn' <- markAnnotated eqn     return (TyFamInstD a eqn')@@ -1594,7 +1609,7 @@  data DataFamInstDeclWithContext   = DataFamInstDeclWithContext-    { _dc_a :: EpAnn [AddEpAnn]+    { _dc_a :: EpAnn [AddEpAnn] -- TODO: remove this field     , _dc_f :: TopLevelFlag     , dc_d :: DataFamInstDecl GhcPs     }@@ -1622,6 +1637,7 @@                            , feqn_fixity = fixity                            , feqn_rhs    = defn })) = do     (an', an2', tycon', bndrs', _,  _mc, defn') <- exactDataDefn an2 pp_hdr defn+                                                 -- See Note [an and an2 in exactDataFamInstDecl]     return       (an',        DataFamInstDecl ( FamEqn { feqn_ext    = an2'@@ -1648,7 +1664,6 @@ {- 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@@ -1877,19 +1892,15 @@  -- --------------------------------------------------------------------- -instance ExactPrint DocDecl where+instance ExactPrint (DocDecl GhcPs) 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+  exact v = case v of+    (DocCommentNext ds)    -> DocCommentNext <$> exact ds+    (DocCommentPrev ds)    -> DocCommentPrev <$> exact ds+    (DocCommentNamed s ds) -> DocCommentNamed s <$> exact ds+    (DocGroup i ds)        -> DocGroup i <$> exact ds  -- --------------------------------------------------------------------- @@ -1904,7 +1915,7 @@           (L _ r') <- markAnnotated (L l r)           return (L l (Just r'))         markRole (L l Nothing) = do-          printStringAtSs l "_"+          printStringAtSs (locA l) "_"           return (L l Nothing)     roles' <- mapM markRole roles     return (RoleAnnotDecl an1 ltycon' roles')@@ -2104,7 +2115,6 @@   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}@@ -2253,6 +2263,9 @@       CaseAlt -> do         pats' <- markAnnotated pats         return (an, CaseAlt, pats')+      LamCaseAlt v -> do+        pats' <- markAnnotated pats+        return (an, LamCaseAlt v, pats')       _ -> do         mctxt' <- withPpr mctxt         return (an, mctxt', pats)@@ -2379,13 +2392,12 @@   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+  exact (IPBind an lr rhs) = do     lr' <- markAnnotated lr     an0 <- markEpAnnL an lidl AnnEqual     rhs' <- markAnnotated rhs-    return (IPBind an0 (Left lr') rhs')+    return (IPBind an0 lr' rhs') -  exact (IPBind _ (Right _) _) = error $ "ExactPrint IPBind: Right only after typechecker"  -- --------------------------------------------------------------------- @@ -2666,19 +2678,18 @@ instance ExactPrint (HsExpr GhcPs) where   getAnnotationEntry (HsVar{})                    = NoEntryVal   getAnnotationEntry (HsUnboundVar an _)          = fromAnn an-  getAnnotationEntry (HsConLikeOut{})             = NoEntryVal-  getAnnotationEntry (HsRecFld{})                 = NoEntryVal+  getAnnotationEntry (HsRecSel{})                 = 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 (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 (HsPar an _ _ _)             = fromAnn an   getAnnotationEntry (SectionL an _ _)            = fromAnn an   getAnnotationEntry (SectionR an _ _)            = fromAnn an   getAnnotationEntry (ExplicitTuple an _ _)       = fromAnn an@@ -2686,7 +2697,7 @@   getAnnotationEntry (HsCase an _ _)              = fromAnn an   getAnnotationEntry (HsIf an _ _ _)              = fromAnn an   getAnnotationEntry (HsMultiIf an _)             = fromAnn an-  getAnnotationEntry (HsLet an _ _)               = fromAnn an+  getAnnotationEntry (HsLet an _ _ _ _)           = fromAnn an   getAnnotationEntry (HsDo an _ _)                = fromAnn an   getAnnotationEntry (ExplicitList an _)          = fromAnn an   getAnnotationEntry (RecordCon an _ _)           = fromAnn an@@ -2695,31 +2706,27 @@   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 (HsTypedBracket an _)        = fromAnn an+  getAnnotationEntry (HsUntypedBracket an _)      = fromAnn an   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 a@(HsRecSel{})           _ _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 (HsLamCase an a b)     anc cs = (HsLamCase (setAnchorEpa an anc cs) a b)   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 (HsPar an a b c)       anc cs = (HsPar (setAnchorEpa an anc cs) a b c)   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)@@ -2727,7 +2734,7 @@   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 (HsLet an a b c d)     anc cs = (HsLet (setAnchorEpa an anc cs) a b c d)   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)@@ -2736,14 +2743,11 @@   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 (HsTypedBracket an a)   anc cs = (HsTypedBracket (setAnchorEpa an anc cs) a)+  setAnnotationAnchor (HsUntypedBracket an a) anc cs = (HsUntypedBracket (setAnchorEpa an anc cs) 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@@ -2757,8 +2761,7 @@         printStringAtAA l  "_" >> return ()         printStringAtAA cb "`" >> return ()         return x-  -- exact x@(HsConLikeOut{})             = withPpr x-  -- exact x@(HsRecFld{})                 = withPpr x+  -- exact x@(HsRecSel{})                 = withPpr x   exact x@(HsOverLabel _ _) = withPpr x    exact x@(HsIPVar _ (HsIPName n))@@ -2781,11 +2784,12 @@     mg' <- markAnnotated mg     return (HsLam x mg') -  exact (HsLamCase an mg) = do+  exact (HsLamCase an lc_variant mg) = do     an0 <- markEpAnnL an lidl AnnLam-    an1 <- markEpAnnL an0 lidl AnnCase+    an1 <- markEpAnnL an0 lidl (case lc_variant of LamCase -> AnnCase+                                                   LamCases -> AnnCases)     mg' <- markAnnotated mg-    return (HsLamCase an1 mg')+    return (HsLamCase an1 lc_variant mg')    exact (HsApp an e1 e2) = do     p <- getPosP@@ -2809,13 +2813,13 @@     e' <- markAnnotated e     return (NegApp an0 e' s) -  exact (HsPar an e) = do-    an0 <- markOpeningParen an+  exact (HsPar an lpar e rpar) = do+    lpar' <- markToken lpar     e' <- markAnnotated e     debugM $ "HsPar closing paren"-    an1 <- markClosingParen an0+    rpar' <- markToken rpar     debugM $ "HsPar done"-    return (HsPar an1 e')+    return (HsPar an lpar' e' rpar')    exact (SectionL an expr op) = do     expr' <- markAnnotated expr@@ -2874,16 +2878,16 @@     an2 <- markEpAnnL an1 lidl AnnCloseC -- optional     return (HsMultiIf an2 mg') -  exact (HsLet an binds e) = do+  exact (HsLet an tkLet binds tkIn e) = do     setLayoutBoth $ do -- Make sure the 'in' gets indented too-      an0 <- markLensKw an lalLet AnnLet+      tkLet' <- markToken tkLet       debugM $ "HSlet:binds coming"       binds' <- setLayoutBoth $ markAnnotated binds       debugM $ "HSlet:binds done"-      an1 <- markLensKw an0 lalIn AnnIn+      tkIn' <- markToken tkIn       debugM $ "HSlet:expr coming"       e' <- markAnnotated e-      return (HsLet an1 binds' e')+      return (HsLet an tkLet' binds' tkIn' e')    exact (HsDo an do_or_list_comp stmts) = do     debugM $ "HsDo"@@ -2915,7 +2919,7 @@     return (HsGetField an expr' field')   exact (HsProjection an flds) = do     an0 <- markAnnKwL an lapOpen AnnOpenP-    flds' <- markAnnotated flds+    flds' <- mapM markAnnotated flds     an1 <- markAnnKwL an0 lapClose AnnCloseP     return (HsProjection an1 flds')   exact (ExprWithTySig an expr sig) = do@@ -2952,36 +2956,43 @@     an2 <- markEpAnnL an1 lidl AnnCloseS -- ']'     return (ArithSeq an2 s seqInfo') -  exact (HsBracket an (ExpBr a e)) = do-    an0 <- markEpAnnL an lidl AnnOpenEQ -- "[|"++  exact (HsTypedBracket an 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 (HsTypedBracket an2 e')++  exact (HsUntypedBracket 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+    return (HsUntypedBracket an2 (ExpBr a e'))++  exact (HsUntypedBracket 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+    return (HsUntypedBracket an1 (PatBr a e'))++  exact (HsUntypedBracket 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 -- "{"+    an1 <- markEpAnnL an0 lidl AnnOpenC  -- "{"   -- optional     e' <- markAnnotated e-    an2 <- markEpAnnL an1 lidl AnnCloseC -- "}"+    an2 <- markEpAnnL an1 lidl AnnCloseC -- "}"   -- optional     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+    return (HsUntypedBracket an3 (DecBrL a e'))++  exact (HsUntypedBracket 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+    return (HsUntypedBracket an1 (TypBr a e'))++  exact (HsUntypedBracket an (VarBr a b e)) = do+    (an0, e') <- if b       then do         an' <- markEpAnnL an lidl AnnSimpleQuote         e' <- markAnnotated e@@ -2990,17 +3001,8 @@         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'))-+    return (HsUntypedBracket an0 (VarBr a b e')) -  -- exact x@(HsRnBracketOut{})           = withPpr x-  -- exact x@(HsTcBracketOut{})           = withPpr x   exact (HsSpliceE a sp) = do     sp' <- markAnnotated sp     return (HsSpliceE a sp')@@ -3019,8 +3021,6 @@     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@@ -3030,15 +3030,13 @@ -- ---------------------------------------------------------------------  exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))-        => EpAnn AnnList -> HsStmtContext any -> LocatedAn an a+        => EpAnn AnnList -> HsDoFlavour -> 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)@@ -3152,70 +3150,65 @@ -- ---------------------------------------------------------------------  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"+    => ExactPrint (HsFieldBind (LocatedAn NoEpAnns (FieldOcc GhcPs)) body) where+  getAnnotationEntry x = fromAnn (hfbAnn x)+  setAnnotationAnchor (HsFieldBind an f arg isPun) anc cs = (HsFieldBind (setAnchorEpa an anc cs) f arg isPun)+  exact (HsFieldBind an f arg isPun) = do+    debugM $ "HsFieldBind"     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)+    (an0, arg') <- if isPun then return (an, arg)+             else do+      an0 <- markEpAnnL an lidl AnnEqual+      arg' <- markAnnotated arg+      return (an0, arg')+    return (HsFieldBind an0 f' arg' isPun)  -- ---------------------------------------------------------------------  instance (ExactPrint body)-    => ExactPrint (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"+    => ExactPrint (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body) where+  getAnnotationEntry x = fromAnn (hfbAnn x)+  setAnnotationAnchor (HsFieldBind an f arg isPun) anc cs = (HsFieldBind (setAnchorEpa an anc cs) f arg isPun)++  exact (HsFieldBind an f arg isPun) = do+    debugM $ "HsFieldBind 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)+    (an0, arg') <- if isPun then return (an, arg)+             else do+      an0 <- markEpAnnL an lidl AnnEqual+      arg' <- markAnnotated arg+      return (an0, arg')+    return (HsFieldBind an0 f' arg' isPun)  -- ---------------------------------------------------------------------  instance (ExactPrint (LocatedA body))-    => ExactPrint (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+    => ExactPrint (HsFieldBind (LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs)) (LocatedA body)) where+  getAnnotationEntry x = fromAnn (hfbAnn x)+  setAnnotationAnchor (HsFieldBind an f arg isPun) anc cs = (HsFieldBind (setAnchorEpa an anc cs) f arg isPun)+  exact (HsFieldBind an f arg isPun) = do     debugM $ "HsRecUpdField"     f' <- markAnnotated f     an0 <- if isPun then return an-                    else markEpAnnL an lidl AnnEqual+             else markEpAnnL an lidl AnnEqual     arg' <- if ((locA $ getLoc arg) == noSrcSpan )-      then return arg-      else markAnnotated arg-    return (HsRecField an0 f' arg' isPun)+              then return arg+              else markAnnotated arg+    return (HsFieldBind an0 f' arg' isPun)  -- ---------------------------------------------------------------------- instance-    (ExactPrint (HsRecField' (a GhcPs) body),-     ExactPrint (HsRecField' (b GhcPs) body))+    (ExactPrint (HsFieldBind (LocatedAn NoEpAnns (a GhcPs)) body),+     ExactPrint (HsFieldBind (LocatedAn NoEpAnns (b GhcPs)) body))     => ExactPrint-         (Either [LocatedA (HsRecField' (a GhcPs) body)]-                 [LocatedA (HsRecField' (b GhcPs) body)]) where+         (Either [LocatedA (HsFieldBind (LocatedAn NoEpAnns (a GhcPs)) body)]+                 [LocatedA (HsFieldBind (LocatedAn NoEpAnns (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') +  exact (Left rbinds) = Left <$> markAnnotated rbinds+  exact (Right pbinds) = Right <$> markAnnotated pbinds+ -- ---------------------------------------------------------------------  instance ExactPrint (FieldLabelStrings GhcPs) where@@ -3225,24 +3218,15 @@  -- --------------------------------------------------------------------- -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 (DotFieldOcc GhcPs) where+  getAnnotationEntry (DotFieldOcc an _) = fromAnn an -instance ExactPrint (HsFieldLabel GhcPs) where-  getAnnotationEntry (HsFieldLabel an _) = fromAnn an-  setAnnotationAnchor (HsFieldLabel an a) anc cs = HsFieldLabel (setAnchorEpa an anc cs) a+  setAnnotationAnchor (DotFieldOcc an a) anc cs = DotFieldOcc (setAnchorEpa an anc cs) a -  exact (HsFieldLabel an fs) = do+  exact (DotFieldOcc an fs) = do     an0 <- markLensKwM an lafDot  AnnDot     fs' <- markAnnotated fs-    return (HsFieldLabel an0 fs')+    return (DotFieldOcc an0 fs')  -- --------------------------------------------------------------------- @@ -3272,22 +3256,22 @@   getAnnotationEntry (HsCmdArrForm an _ _ _ _ ) = fromAnn an   getAnnotationEntry (HsCmdApp an _ _ )         = fromAnn an   getAnnotationEntry (HsCmdLam {})              = NoEntryVal-  getAnnotationEntry (HsCmdPar an _)            = fromAnn an+  getAnnotationEntry (HsCmdPar an _ _ _)        = fromAnn an   getAnnotationEntry (HsCmdCase an _ _)         = fromAnn an-  getAnnotationEntry (HsCmdLamCase an _)        = fromAnn an+  getAnnotationEntry (HsCmdLamCase an _ _)      = fromAnn an   getAnnotationEntry (HsCmdIf an _ _ _ _)       = fromAnn an-  getAnnotationEntry (HsCmdLet 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 (HsCmdPar an a b c)        anc cs = (HsCmdPar (setAnchorEpa an anc cs) a b c)   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 (HsCmdLamCase an a b)      anc cs = (HsCmdLamCase (setAnchorEpa an anc cs) a b)   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 (HsCmdLet an a b c d)      anc cs = (HsCmdLet (setAnchorEpa an anc cs) a b c d)   setAnnotationAnchor (HsCmdDo an a)             anc cs = (HsCmdDo (setAnchorEpa an anc cs) a)    exact (HsCmdArrApp an arr arg o isRightToLeft) = do@@ -3302,11 +3286,10 @@         arg' <- markAnnotated arg         an0 <- markKw (anns an)         arr' <- markAnnotated arr-        let an1 = an{anns = an0}+        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@@ -3331,11 +3314,11 @@     match' <- markAnnotated match     return (HsCmdLam a match') -  exact (HsCmdPar an e) = do-    an0 <- markOpeningParen an+  exact (HsCmdPar an lpar e rpar) = do+    lpar' <- markToken lpar     e' <- markAnnotated e-    an1 <- markClosingParen an0-    return (HsCmdPar an1 e')+    rpar' <- markToken rpar+    return (HsCmdPar an lpar' e' rpar')    exact (HsCmdCase an e alts) = do     an0 <- markLensKw an lhsCaseAnnCase AnnCase@@ -3347,11 +3330,12 @@     an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC     return (HsCmdCase an4 e' alts') -  exact (HsCmdLamCase an matches) = do+  exact (HsCmdLamCase an lc_variant matches) = do     an0 <- markEpAnnL an lidl AnnLam-    an1 <- markEpAnnL an0 lidl AnnCase+    an1 <- markEpAnnL an0 lidl (case lc_variant of LamCase -> AnnCase+                                                   LamCases -> AnnCases)     matches' <- markAnnotated matches-    return (HsCmdLamCase an1 matches')+    return (HsCmdLamCase an1 lc_variant matches')    exact (HsCmdIf an a e1 e2 e3) = do     an0 <- markLensKw an laiIf AnnIf@@ -3364,12 +3348,13 @@     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 (HsCmdLet an tkLet binds tkIn e) = do+    setLayoutBoth $ do -- Make sure the 'in' gets indented too+      tkLet' <- markToken tkLet+      binds' <- setLayoutBoth $ markAnnotated binds+      tkIn' <- markToken tkIn+      e' <- markAnnotated e+      return (HsCmdLet an tkLet' binds' tkIn' e')    exact (HsCmdDo an es) = do     debugM $ "HsCmdDo"@@ -3377,8 +3362,6 @@     es' <- markAnnotated es     return (HsCmdDo an0 es') -  -- exact x = error $ "exact HsCmd for:" ++ showAst x- -- ---------------------------------------------------------------------  instance (@@ -3845,7 +3828,7 @@   getAnnotationEntry (HsListTy an _)           = fromAnn an   getAnnotationEntry (HsTupleTy an _ _)        = fromAnn an   getAnnotationEntry (HsSumTy an _)            = fromAnn an-  getAnnotationEntry (HsOpTy _ _ _ _)          = NoEntryVal+  getAnnotationEntry (HsOpTy an _ _ _ _)       = fromAnn an   getAnnotationEntry (HsParTy an _)            = fromAnn an   getAnnotationEntry (HsIParamTy an _ _)       = fromAnn an   getAnnotationEntry (HsStarTy _ _)            = NoEntryVal@@ -3869,7 +3852,7 @@   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 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@@ -3912,9 +3895,9 @@     return (HsAppKindTy ss ty' ki')   exact (HsFunTy an mult ty1 ty2) = do     ty1' <- markAnnotated ty1-    (an', mult') <- markArrow an mult+    mult' <- markArrow mult     ty2' <- markAnnotated ty2-    return (HsFunTy an' mult' ty1' ty2')+    return (HsFunTy an mult' ty1' ty2')   exact (HsListTy an tys) = do     an0 <- markOpeningParen an     tys' <- markAnnotated tys@@ -3930,11 +3913,14 @@     tys' <- markAnnotated tys     an1 <- markClosingParen an0     return (HsSumTy an1 tys')-  exact (HsOpTy an t1 lo t2) = do+  exact (HsOpTy an promoted t1 lo t2) = do+    an0 <- if (isPromoted promoted)+        then markEpAnnL an lidl AnnSimpleQuote+        else return an     t1' <- markAnnotated t1     lo' <- markAnnotated lo     t2' <- markAnnotated t2-    return (HsOpTy an t1' lo' t2')+    return (HsOpTy an0 promoted t1' lo' t2')   exact (HsParTy an ty) = do     an0 <- markOpeningParen an     ty' <- markAnnotated ty@@ -3958,7 +3944,6 @@   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@@ -3976,7 +3961,6 @@         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@@ -4113,7 +4097,7 @@   setAnnotationAnchor = setAnchorAn    exact x@(L (SrcSpanAnn EpAnnNotUsed l) n) = do-    printUnicode (spanAsAnchor l) n+    _ <- printUnicode (spanAsAnchor l) n     return x   exact (L (SrcSpanAnn (EpAnn anc ann cs) ll) n) = do     ann' <-@@ -4132,6 +4116,13 @@           (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)           t' <- markTrailing t           return (NameAnnCommas a o' commas' c' t')+        NameAnnBars a o bars c t -> do+          let (kwo,kwc) = adornments a+          (AddEpAnn _ o') <- markKwC NoCaptureComments (AddEpAnn kwo o)+          bars' <- forM bars (\loc -> locFromAdd <$> markKwC NoCaptureComments (AddEpAnn AnnVbar loc))+          (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)+          t' <- markTrailing t+          return (NameAnnBars a o' bars' c' t')         NameAnnOnly a o c t -> do           (o',_,c') <- markName a o Nothing c           t' <- markTrailing t@@ -4147,7 +4138,7 @@           t' <- markTrailing t           return (NameAnnQuote q' name' t')         NameAnnTrailing t -> do-          anc' <- printUnicode anc n+          _anc' <- printUnicode anc n           t' <- markTrailing t           return (NameAnnTrailing t')     return (L (SrcSpanAnn (EpAnn anc ann' cs) ll) n)@@ -4304,11 +4295,12 @@     args' <-       case args of           (PrefixConGADT args0) -> do-            args0' <- mapM markScaled args0+            args0' <- mapM markAnnotated args0             return (PrefixConGADT args0')-          (RecConGADT fields) -> do+          (RecConGADT fields rarr) -> do             fields' <- markAnnotated fields-            return (RecConGADT fields')+            rarr' <- markUniToken rarr+            return (RecConGADT fields' rarr')     res_ty' <- markAnnotated res_ty     return (ConDeclGADT { con_g_ext = an2                         , con_names = cons'@@ -4370,20 +4362,12 @@  -- --------------------------------------------------------------------- -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+    arr' <- markArrow arr     return (HsScaled arr' t')  -- ---------------------------------------------------------------------@@ -4562,9 +4546,6 @@     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  -- ---------------------------------------------------------------------@@ -4592,7 +4573,7 @@   getAnnotationEntry (VarPat _ _)             = NoEntryVal   getAnnotationEntry (LazyPat an _)           = fromAnn an   getAnnotationEntry (AsPat an _ _)           = fromAnn an-  getAnnotationEntry (ParPat an _)            = fromAnn an+  getAnnotationEntry (ParPat an _ _ _)        = fromAnn an   getAnnotationEntry (BangPat an _)           = fromAnn an   getAnnotationEntry (ListPat an _)           = fromAnn an   getAnnotationEntry (TuplePat an _ _)        = fromAnn an@@ -4609,15 +4590,15 @@   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 (ParPat an a b c)         anc cs = (ParPat (setAnchorEpa an anc cs) a b c)   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 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)@@ -4644,11 +4625,12 @@     an0 <- markEpAnnL an lidl AnnAt     pat' <- markAnnotated pat     return (AsPat an0 n' pat')-  exact (ParPat an pat) = do-    an0 <- markAnnKwL an lap_open AnnOpenP+  exact (ParPat an lpar pat rpar) = do+    lpar' <- markToken lpar     pat' <- markAnnotated pat-    an1 <- markAnnKwL an0 lap_close AnnCloseP-    return (ParPat an1 pat')+    rpar' <- markToken rpar+    return (ParPat an lpar' pat' rpar')+   exact (BangPat an pat) = do     an0 <- markEpAnnL an lidl AnnBang     pat' <- markAnnotated pat

@@ -19,108 +19,108 @@   case kw of       -- Specifically handle all cases so that there are pattern match       -- warnings if new constructors are added.-      AnnAnyclass -> "anyclass"-      AnnOpen -> mkErr kw-      AnnClose-> mkErr kw-      AnnVal  -> mkErr kw-      AnnPackageName -> mkErr kw-      AnnHeader-> mkErr kw-      AnnFunId -> mkErr kw-      AnnInfix -> mkErr kw-      AnnValStr-> mkErr kw-      AnnName  -> mkErr kw-      AnnAs    -> "as"-      AnnAt    -> "@"-      AnnBang  -> "!"-      AnnBackquote-> "`"-      AnnBy    -> "by"-      AnnCase  -> "case"-      AnnClass  -> "class"-      AnnCloseB -> "|)"-      AnnCloseBU-> "⦈"-      AnnCloseC -> "}"-      AnnCloseP -> ")"-      AnnClosePH-> "#)"-      AnnCloseQ -> "|]"-      AnnCloseQU-> "⟧"-      AnnCloseS -> "]"-      AnnColon  -> ":"-      AnnComma  -> ","-      AnnCommaTuple-> ","-      AnnDarrow -> "=>"-      AnnData   -> "data"-      AnnDcolon -> "::"-      AnnDefault-> "default"-      AnnDeriving-> "deriving"-      AnnDo      -> "do"-      AnnDot     -> "."-      AnnDotdot  -> ".."-      AnnElse    -> "else"-      AnnEqual   -> "="-      AnnExport  -> "export"-      AnnFamily  -> "family"-      AnnForall  -> "forall"-      AnnForeign -> "foreign"-      AnnGroup   -> "group"-      AnnHiding  -> "hiding"-      AnnIf      -> "if"-      AnnImport  -> "import"-      AnnIn      -> "in"-      AnnInstance-> "instance"-      AnnLam     -> "\\"-      AnnLarrow  -> "<-"-      AnnLet     -> "let"-      AnnLollyU  -> "⊸"-      AnnMdo     -> "mdo"-      AnnMinus   -> "-"-      AnnModule  -> "module"-      AnnNewtype -> "newtype"-      AnnOf      -> "of"-      AnnOpenB   -> "(|"-      AnnOpenBU  ->  "⦇"-      AnnOpenC   -> "{"-      AnnOpenE   -> "[e|"-      AnnOpenEQ  -> "[|"-      AnnOpenEQU ->  "⟦"-      AnnOpenP   -> "("-      AnnOpenPH  -> "(#"-      AnnOpenS   -> "["-      AnnPattern -> "pattern"-      AnnPercent  -> "%"-      AnnPercentOne -> "%1"-      AnnProc    -> "proc"-      AnnQualified-> "qualified"-      AnnRarrow  -> "->"-      AnnRec     -> "rec"-      AnnRole    -> "role"-      AnnSafe    -> "safe"-      AnnSemi    -> ";"-      AnnSignature -> "signature"-      AnnStock   -> "stock"-      AnnStatic  -> "static"-      AnnThen    -> "then"-      AnnTilde   -> "~"-      AnnType    -> "type"-      AnnUnit    -> "()"-      AnnUsing   -> "using"-      AnnVbar    -> "|"-      AnnWhere   -> "where"-      Annlarrowtail-> "-<"-      Annrarrowtail-> ">-"-      AnnLarrowtail-> "-<<"-      AnnRarrowtail-> ">>-"-      AnnSimpleQuote -> "'"-      AnnThTyQuote   -> "''"-      AnnDollar      -> "$"-      AnnDollarDollar-> "$$"-      AnnDarrowU     -> "⇒"-      AnnDcolonU     -> "∷"-      AnnForallU     -> "∀"-      AnnLarrowU     -> "←"-      AnnLarrowtailU -> "⤛"-      AnnRarrowU     -> "→"-      AnnRarrowtailU -> "⤜"-      AnnlarrowtailU -> "⤙"-      AnnrarrowtailU -> "⤚"-      -- AnnTypeApp             -> "@"-      AnnVia -> "via"+      AnnAnyclass     -> "anyclass"+      AnnOpen         -> mkErr kw+      AnnClose        -> mkErr kw+      AnnVal          -> mkErr kw+      AnnPackageName  -> mkErr kw+      AnnHeader       -> mkErr kw+      AnnFunId        -> mkErr kw+      AnnInfix        -> mkErr kw+      AnnValStr       -> mkErr kw+      AnnName         -> mkErr kw+      AnnAs           -> "as"+      AnnAt           -> "@"+      AnnBang         -> "!"+      AnnBackquote    -> "`"+      AnnBy           -> "by"+      AnnCase         -> "case"+      AnnCases        -> "cases"+      AnnClass        -> "class"+      AnnCloseB       -> "|)"+      AnnCloseBU      -> "⦈"+      AnnCloseC       -> "}"+      AnnCloseP       -> ")"+      AnnClosePH      -> "#)"+      AnnCloseQ       -> "|]"+      AnnCloseQU      -> "⟧"+      AnnCloseS       -> "]"+      AnnColon        -> ":"+      AnnComma        -> ","+      AnnCommaTuple   -> ","+      AnnDarrow       -> "=>"+      AnnData         -> "data"+      AnnDcolon       -> "::"+      AnnDefault      -> "default"+      AnnDeriving     -> "deriving"+      AnnDo           -> "do"+      AnnDot          -> "."+      AnnDotdot       -> ".."+      AnnElse         -> "else"+      AnnEqual        -> "="+      AnnExport       -> "export"+      AnnFamily       -> "family"+      AnnForall       -> "forall"+      AnnForeign      -> "foreign"+      AnnGroup        -> "group"+      AnnHiding       -> "hiding"+      AnnIf           -> "if"+      AnnImport       -> "import"+      AnnIn           -> "in"+      AnnInstance     -> "instance"+      AnnLam          -> "\\"+      AnnLarrow       -> "<-"+      AnnLet          -> "let"+      AnnLollyU       -> "⊸"+      AnnMdo          -> "mdo"+      AnnMinus        -> "-"+      AnnModule       -> "module"+      AnnNewtype      -> "newtype"+      AnnOf           -> "of"+      AnnOpenB        -> "(|"+      AnnOpenBU       ->  "⦇"+      AnnOpenC        -> "{"+      AnnOpenE        -> "[e|"+      AnnOpenEQ       -> "[|"+      AnnOpenEQU      ->  "⟦"+      AnnOpenP        -> "("+      AnnOpenPH       -> "(#"+      AnnOpenS        -> "["+      AnnPattern      -> "pattern"+      AnnPercent      -> "%"+      AnnPercentOne   -> "%1"+      AnnProc         -> "proc"+      AnnQualified    -> "qualified"+      AnnRarrow       -> "->"+      AnnRec          -> "rec"+      AnnRole         -> "role"+      AnnSafe         -> "safe"+      AnnSemi         -> ";"+      AnnSignature    -> "signature"+      AnnStock        -> "stock"+      AnnStatic       -> "static"+      AnnThen         -> "then"+      AnnTilde        -> "~"+      AnnType         -> "type"+      AnnUnit         -> "()"+      AnnUsing        -> "using"+      AnnVbar         -> "|"+      AnnWhere        -> "where"+      Annlarrowtail   -> "-<"+      Annrarrowtail   -> ">-"+      AnnLarrowtail   -> "-<<"+      AnnRarrowtail   -> ">>-"+      AnnSimpleQuote  -> "'"+      AnnThTyQuote    -> "''"+      AnnDollar       -> "$"+      AnnDollarDollar -> "$$"+      AnnDarrowU      -> "⇒"+      AnnDcolonU      -> "∷"+      AnnForallU      -> "∀"+      AnnLarrowU      -> "←"+      AnnLarrowtailU  -> "⤛"+      AnnRarrowU      -> "→"+      AnnRarrowtailU  -> "⤜"+      AnnlarrowtailU  -> "⤙"+      AnnrarrowtailU  -> "⤚"+      AnnVia          -> "via"

@@ -18,7 +18,7 @@   def = mempty  instance Default AnnPragma where-  def = AnnPragma def  def def+  def = AnnPragma def def def  instance Semigroup EpAnnImportDecl where   (<>) = error "unimplemented"@@ -52,9 +52,6 @@ instance Default AnnsIf where   def = AnnsIf def def def def def -instance Default AnnsLet where-  def = AnnsLet def def- instance Default AnnProjection where   def = AnnProjection def def @@ -69,9 +66,6 @@  instance Default AnnKeywordId where   def = Annlarrowtail  {- gotta pick one -}--instance Default TrailingAnn where-  def = AddLollyAnnU {-gotta pick one -} def  instance Default AnnContext where   def = AnnContext Nothing [] []

@@ -53,15 +53,17 @@ import qualified Control.Monad.IO.Class as GHC import qualified GHC.Data.FastString    as GHC import qualified GHC.Data.StringBuffer  as GHC-import qualified GHC.Driver.Config      as GHC+-- import qualified GHC.Driver.Config      as GHC+import qualified GHC.Driver.Config.Parser as GHC+import qualified GHC.Driver.Errors.Types  as GHC import qualified GHC.Driver.Session     as GHC import qualified GHC.Parser             as GHC import qualified GHC.Parser.Header      as GHC import qualified GHC.Parser.Lexer       as GHC import qualified GHC.Parser.PostProcess as GHC-import qualified GHC.Parser.Errors.Ppr  as GHC+-- import qualified GHC.Parser.Errors.Ppr  as GHC import qualified GHC.Types.SrcLoc       as GHC-import qualified GHC.Utils.Error        as GHC+-- import qualified GHC.Utils.Error        as GHC  import qualified GHC.LanguageExtensions as LangExt @@ -79,8 +81,10 @@           -> ParseResult w parseWith dflags fileName parser s =   case runParser parser dflags fileName s of-    GHC.PFailed pst                     -> Left (fmap GHC.pprError $ GHC.getErrorMessages pst)-    GHC.POk _ pmod -> Right pmod+    GHC.PFailed pst+      -> Left (GHC.GhcPsMessage <$> GHC.getPsErrorMessages pst)+    GHC.POk _ pmod+      -> Right pmod   parseWithECP :: (GHC.DisambECP w)@@ -91,8 +95,10 @@           -> ParseResult (GHC.LocatedA w) parseWithECP dflags fileName parser s =     case runParser (parser >>= \p -> GHC.runPV $ GHC.unECP p) dflags fileName s of-      GHC.PFailed pst                     -> Left (fmap GHC.pprError $ GHC.getErrorMessages pst)-      GHC.POk _ pmod -> Right pmod+      GHC.PFailed pst+        -> Left (GHC.GhcPsMessage <$> GHC.getPsErrorMessages pst)+      GHC.POk _ pmod+        -> Right pmod  -- --------------------------------------------------------------------- @@ -184,8 +190,10 @@ parseModuleFromStringInternal dflags fileName str =   let (str1, lp) = stripLinePragmas str       res        = case runParser GHC.parseModule dflags fileName str1 of-        GHC.PFailed pst     -> Left (fmap GHC.pprError $ GHC.getErrorMessages pst)-        GHC.POk     _  pmod -> Right (lp, dflags, pmod)+        GHC.PFailed pst+          -> Left (GHC.GhcPsMessage <$> GHC.getPsErrorMessages pst)+        GHC.POk     _  pmod+          -> Right (lp, dflags, pmod)   in  postParseTransform res  parseModuleWithOptions :: LibDir -- ^ GHC libdir@@ -255,9 +263,10 @@         return (contents1,lp,dflags)   return $     case parseFile dflags' file fileContents of-      GHC.PFailed pst -> Left (fmap GHC.pprError $ GHC.getErrorMessages pst)-      GHC.POk _ pmod  ->-        Right $ (injectedComments, dflags', fixModuleTrailingComments pmod)+      GHC.PFailed pst+        -> Left (GHC.GhcPsMessage <$> GHC.getPsErrorMessages pst)+      GHC.POk _ pmod+        -> Right $ (injectedComments, dflags', fixModuleTrailingComments pmod)  -- | Internal function. Exposed if you want to muck with DynFlags -- before parsing. Or after parsing.@@ -300,8 +309,10 @@ -- See ghc tickets #15513, #15541. initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags initDynFlags file = do+  -- Based on GHC backpack driver doBackPack   dflags0         <- GHC.getSessionDynFlags-  src_opts        <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file+  let parser_opts0 = GHC.initParserOpts dflags0+  (_, src_opts)   <- GHC.liftIO $ GHC.getOptionsFromFile parser_opts0 file   (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 src_opts   -- Turn this on last to avoid T10942   let dflags2 = dflags1 `GHC.gopt_set` GHC.Opt_KeepRawTokenStream@@ -323,11 +334,13 @@ -- See ghc tickets #15513, #15541. initDynFlagsPure :: GHC.GhcMonad m => FilePath -> String -> m GHC.DynFlags initDynFlagsPure fp s = do+  -- AZ Note: "I" below appears to be Lennart Spitzner   -- I was told we could get away with using the unsafeGlobalDynFlags.   -- as long as `parseDynamicFilePragma` is impure there seems to be   -- no reason to use it.   dflags0 <- GHC.getSessionDynFlags-  let pragmaInfo = GHC.getOptions dflags0 (GHC.stringToStringBuffer $ s) fp+  let parser_opts0 = GHC.initParserOpts dflags0+  let (_, pragmaInfo) = GHC.getOptions parser_opts0 (GHC.stringToStringBuffer $ s) fp   (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 pragmaInfo   -- Turn this on last to avoid T10942   let dflags2 = dflags1 `GHC.gopt_set` GHC.Opt_KeepRawTokenStream

@@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-} -- | This module provides support for CPP, interpreter directives and line -- pragmas. module Language.Haskell.GHC.ExactPrint.Preprocess@@ -11,6 +12,7 @@     , CppOptions(..)    , defaultCppOptions+   , showErrorMessages    ) where  import qualified GHC            as GHC hiding (parseModule)@@ -19,18 +21,21 @@ import qualified GHC.Data.Bag          as GHC import qualified GHC.Data.FastString   as GHC import qualified GHC.Data.StringBuffer as GHC-import qualified GHC.Driver.Config     as GHC+-- import qualified GHC.Driver.Config     as GHC+import qualified GHC.Driver.Config.Parser     as GHC import qualified GHC.Driver.Env        as GHC+import qualified GHC.Driver.Errors.Types        as GHC import qualified GHC.Driver.Phases     as GHC import qualified GHC.Driver.Pipeline   as GHC import qualified GHC.Fingerprint.Type  as GHC-import qualified GHC.Parser.Errors.Ppr as GHC+-- import qualified GHC.Parser.Errors.Ppr as GHC import qualified GHC.Parser.Lexer      as GHC import qualified GHC.Settings          as GHC import qualified GHC.Types.SourceError as GHC-import qualified GHC.Types.SourceFile  as GHC import qualified GHC.Types.SrcLoc      as GHC-import qualified GHC.Utils.Error       as GHC+import qualified GHC.Types.SourceFile  as GHC+import qualified GHC.Types.Error  as GHC+-- import qualified GHC.Utils.Error       as GHC import qualified GHC.Utils.Fingerprint as GHC import GHC.Types.SrcLoc (mkSrcSpan, mkSrcLoc) import GHC.Data.FastString (mkFastString)@@ -219,15 +224,26 @@       new_env = hsc_env { GHC.hsc_dflags = injectCppOptions cppOptions dfs }   r <- GHC.liftIO $ GHC.preprocess new_env src_fn Nothing (Just (GHC.Cpp GHC.HsSrcFile))   case r of-    Left err -> error $ showErrorMessages err+    Left err -> error $ showErrorMessages $ fmap GHC.GhcDriverMessage err     Right (dflags', hspp_fn) -> do       buf <- GHC.liftIO $ GHC.hGetStringBuffer hspp_fn       txt <- GHC.liftIO $ readFileGhc hspp_fn       return (txt, buf, dflags')  showErrorMessages :: GHC.ErrorMessages -> String-showErrorMessages msgs = intercalate "\n" $ map show $ GHC.bagToList msgs+showErrorMessages msgs = intercalate "\n"+    $ map (show @(GHC.MsgEnvelope GHC.DiagnosticMessage) . fmap toDiagnosticMessage)+    $ GHC.bagToList+    $ GHC.getErrorMessages msgs +-- | Show Error Messages relies on show instance for MsgEnvelope DiagnosticMessage+-- We convert a known Diagnostic into this generic version+toDiagnosticMessage :: GHC.Diagnostic e => e -> GHC.DiagnosticMessage+toDiagnosticMessage msg = GHC.DiagnosticMessage { diagMessage = GHC.diagnosticMessage msg+                                                , diagReason  = GHC.diagnosticReason  msg+                                                , diagHints   = GHC.diagnosticHints   msg+                                                }+ injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags injectCppOptions CppOptions{..} dflags =   foldr addOptP dflags (map mkDefine cppDefine ++ map mkIncludeDir cppInclude ++ map mkInclude cppFile)@@ -281,7 +297,7 @@        -- (warns,errs) = GHC.getMessages pst dflags      -- throw $ GHC.mkSrcErr (GHC.unitBag $ GHC.mkPlainErrMsg dflags sspan err)      -- GHC.throwErrors (fmap GHC.mkParserErr (GHC.getErrorMessages pst))-     GHC.throwErrors (fmap GHC.pprError (GHC.getErrorMessages pst))+     GHC.throwErrors (fmap GHC.GhcPsMessage (GHC.getPsErrorMessages pst))  -- --------------------------------------------------------------------- 

@@ -20,10 +20,8 @@ ----------------------------------------------------------------------------- module Language.Haskell.GHC.ExactPrint.Transform         (-        -- * Delta is still here-          makeDeltaAst'         -- * The Transform Monad-        , Transform+          Transform         , TransformT(..)         , hoistTransform         , runTransform@@ -100,7 +98,7 @@  import Data.Maybe import Data.Generics-import Data.List (sort, sortBy)+import Data.List (sortBy)  import Data.Functor.Identity import Control.Monad.State@@ -215,7 +213,6 @@     rd = case last ns of       L (SrcSpanAnn EpAnnNotUsed   ll) _ -> realSrcSpan ll       L (SrcSpanAnn (EpAnn anc' _ _) _) _ -> anchor anc' -- TODO MovedAnchor?-    -- DP (line, col) = ss2delta (ss2pos $ anchor $ getLoc lc) r     dc' = case dca of       EpaSpan r -> AddEpAnn kw (EpaDelta (ss2delta (ss2posEnd rd) r) [])       EpaDelta _ _ -> AddEpAnn kw dca@@ -415,16 +412,22 @@ -- ---------------------------------------------------------------------  balanceCommentsList :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]-balanceCommentsList ds = balanceCommentsList'' (map tweakListComments ds)--balanceCommentsList'' :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]-balanceCommentsList'' [] = return []-balanceCommentsList'' [x] = return [x]-balanceCommentsList'' (a:b:ls) = do+balanceCommentsList [] = return []+balanceCommentsList [x] = return [x]+balanceCommentsList (a:b:ls) = do   (a',b') <- balanceComments a b-  r <- balanceCommentsList'' (b':ls)+  r <- balanceCommentsList (b':ls)   return (a':r) +balanceCommentsList' :: (Monad m) => [LocatedA a] -> TransformT m [LocatedA a]+balanceCommentsList' [] = return []+balanceCommentsList' [x] = return [x]+balanceCommentsList' (a:b:ls) = do+  logTr $ "balanceCommentsList' entered"+  (a',b') <- balanceComments' a b+  r <- balanceCommentsList' (b':ls)+  return (a':r)+ -- |The GHC parser puts all comments appearing between the end of one AST -- item and the beginning of the next as 'annPriorComments' for the second one. -- This function takes two adjacent AST items and moves any 'annPriorComments'@@ -497,8 +500,9 @@     stay = map snd stay'     (l'', grhss', binds', logInfo)       = case reverse grhss of-          [] -> (l, [], binds, (EpaComments [], SrcSpanAnn EpAnnNotUsed noSrcSpan))-          (L lg g@(GRHS EpAnnNotUsed _grs _rhs):gs) -> (l, reverse (L lg g:gs), binds, (EpaComments [], SrcSpanAnn EpAnnNotUsed noSrcSpan))+          [] -> (l, [], binds,                 (EpaComments [], SrcSpanAnn EpAnnNotUsed noSrcSpan))+          (L lg g@(GRHS EpAnnNotUsed _grs _rhs):gs)+            -> (l, reverse (L lg g:gs), binds, (EpaComments [], SrcSpanAnn EpAnnNotUsed noSrcSpan))           (L lg (GRHS ag grs rhs):gs) ->             let               anc1' = setFollowingComments anc1 stay@@ -509,7 +513,7 @@               -- ---------------------------------                (EpAnn anc an lgc) = ag-              lgc' = splitCommentsEnd (realSrcSpan lg) $ addCommentOrigDeltas lgc+              lgc' = splitCommentsEnd (realSrcSpan $ locA lg) $ addCommentOrigDeltas lgc               ag' = if moved                       then EpAnn anc an lgc'                       else EpAnn anc an (lgc' <> (EpaCommentsBalanced [] move))@@ -532,15 +536,6 @@       _ -> (ValBinds NoAnnSortKey emptyBag [], [])  -balanceCommentsList' :: (Monad m) => [LocatedA a] -> TransformT m [LocatedA a]-balanceCommentsList' [] = return []-balanceCommentsList' [x] = return [x]-balanceCommentsList' (a:b:ls) = do-  logTr $ "balanceCommentsList' entered"-  (a',b') <- balanceComments' a b-  r <- balanceCommentsList' (b':ls)-  return (a':r)- -- |Prior to moving an AST element, make sure any trailing comments belonging to -- it are attached to it, and not the following element. Of necessity this is a -- heuristic process, to be tuned later. Possibly a variant should be provided@@ -549,27 +544,29 @@ -- Many of these should in fact be following comments for the previous anchor balanceComments' :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b) balanceComments' la1 la2 = do-  logTr $ "balanceComments': (loc1,loc2)=" ++ showGhc (ss2range loc1,ss2range loc2)-  logTr $ "balanceComments': (anc1)=" ++ showAst (anc1)-  logTr $ "balanceComments': (cs1s)=" ++ showAst (cs1s)-  logTr $ "balanceComments': (sort cs1f)=" ++ showAst (sort cs1f)-  logTr $ "balanceComments': (cs1stay,cs1move)=" ++ showAst (cs1stay,cs1move)-  logTr $ "balanceComments': (an1',an2')=" ++ showAst (an1',an2')+  -- logTr $ "balanceComments': (loc1,loc2)=" ++ showGhc (ss2range loc1,ss2range loc2)+  -- logTr $ "balanceComments': (anc1)=" ++ showAst (anc1)+  -- logTr $ "balanceComments': (cs2p)=" ++ showAst (cs2p)+  -- logTr $ "balanceComments': (cs2f)=" ++ showAst (cs2f)+  -- logTr $ "balanceComments': (cs1stay,cs1move)=" ++ showAst (cs1stay,cs1move)+  -- logTr $ "balanceComments': (an1',an2')=" ++ showAst (an1',an2')   return (la1', la2')   where     simpleBreak n (r,_) = r > n-    L (SrcSpanAnn an1 loc1) f = la1-    L (SrcSpanAnn an2 loc2) s = la2+    L (SrcSpanAnn an1 _loc1) f = la1+    L (SrcSpanAnn an2 _loc2) s = la2     anc1 = addCommentOrigDeltas $ epAnnComments an1     anc2 = addCommentOrigDeltas $ epAnnComments an2 -    cs1s = splitCommentsEnd (anchorFromLocatedA la1) anc1-    cs1p = priorCommentsDeltas    (anchorFromLocatedA la1) (priorComments        cs1s)-    cs1f = trailingCommentsDeltas (anchorFromLocatedA la1) (getFollowingComments cs1s)+    -- Split comments into those before the span, in the span, and after the span+    (cs1prior,cs1m,cs1following) = splitCommentsAround (anchorFromLocatedA la1) anc1+    cs1p = priorCommentsDeltas    (anchorFromLocatedA la1) cs1prior+    cs1f = trailingCommentsDeltas (anchorFromLocatedA la1) cs1following -    cs2s = splitCommentsEnd (anchorFromLocatedA la2) anc2-    cs2p = priorCommentsDeltas    (anchorFromLocatedA la2) (priorComments        cs2s)-    cs2f = trailingCommentsDeltas (anchorFromLocatedA la2) (getFollowingComments cs2s)+    -- Split comments into those before the span, in the span, and after the span+    (cs2prior,cs2m,cs2following) = splitCommentsAround (anchorFromLocatedA la2) anc2+    cs2p = priorCommentsDeltas    (anchorFromLocatedA la2) cs2prior+    cs2f = trailingCommentsDeltas (anchorFromLocatedA la2) cs2following      -- Split cs1f into those that belong on an1 and ones that must move to an2     (cs1move,cs1stay) = break (simpleBreak 1) cs1f@@ -581,11 +578,12 @@     move = sortEpaComments $ map snd (cs1move ++ move'' ++ move')     stay = sortEpaComments $ map snd (cs1stay ++ stay') -    an1' = setCommentsSrcAnn (getLoc la1) (EpaCommentsBalanced (map snd cs1p) move)-    an2' = setCommentsSrcAnn (getLoc la2) (EpaCommentsBalanced stay (map snd cs2f))+    an1' = setCommentsSrcAnn (getLoc la1) (EpaCommentsBalanced ((map snd cs1p)++cs1m) move)+    an2' = setCommentsSrcAnn (getLoc la2) (EpaCommentsBalanced (cs2m++stay) (map snd cs2f))     la1' = L an1' f     la2' = L an2' s + -- | Like commentsDeltas, but calculates the delta from the end of the anchor, not the start trailingCommentsDeltas :: RealSrcSpan -> [LEpaComment]                -> [(Int, LEpaComment)]@@ -614,6 +612,8 @@         (ll,_) = ss2pos (anchor loc)  +-- ---------------------------------------------------------------------+ -- | Split comments into ones occuring before the end of the reference -- span, and those after it. splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments@@ -631,6 +631,7 @@     cs' = before     ts' = after <> ts + -- | Split comments into ones occuring before the start of the reference -- span, and those after it. splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments@@ -648,6 +649,21 @@     cs' = before     ts' = after <> ts ++-- | Split comments into ones occuring before the start of the reference+-- span, those in the span, and those after it.+splitCommentsAround :: RealSrcSpan -> EpAnnComments+                    -> ([LEpaComment], [LEpaComment], [LEpaComment])+splitCommentsAround p cs = (before,middle,after)+  where+    all_comments = priorComments cs ++ getFollowingComments cs+    cmpbefore (L (Anchor l _) _) = ss2pos l > ss2pos p+    cmpafter (L (Anchor l _) _) = ss2pos l > ss2posEnd p+    (before, both) = break cmpbefore all_comments+    (middle, after) = break cmpafter both++-- ---------------------------------------------------------------------+ moveLeadingComments :: (Data t, Data u, Monoid t, Monoid u)   => LocatedAn t a -> SrcAnn u -> (LocatedAn t a, SrcAnn u) moveLeadingComments from@(L (SrcSpanAnn EpAnnNotUsed _) _) to = (from, to)@@ -709,113 +725,15 @@                then MovedAnchor (DifferentLine 1 0)                else op' -spanOrigDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos-spanOrigDelta prior cur = dp-  where-    (r,c) = ss2posEnd prior-    dp = if r == 0-           then (ss2delta (r,c+1) cur)-           else (ss2delta (r,c)   cur)- -- --------------------------------------------------------------------- --- TODO: Until https://gitlab.haskell.org/ghc/ghc/-/issues/20715 is--- fixed we have to special-case a funbind.  Damn.-tweakListComments :: LHsDecl GhcPs -> LHsDecl GhcPs-tweakListComments a@(L _ (ValD _ (FunBind{}))) = tweakListCommentsFB a-tweakListComments a = tweakListComments' a --- A LocatedA item may have both trailing comments and trailing list items.--- Move any relevant comments preceding a list item into an EpaDelta instead.-tweakListComments' :: LocatedA a -> LocatedA a-tweakListComments' (L (SrcSpanAnn EpAnnNotUsed l) a) = L (SrcSpanAnn EpAnnNotUsed l) a-tweakListComments' (L (SrcSpanAnn (EpAnn anc an cs) l) a) = L (SrcSpanAnn (EpAnn anc an' cs') l) a-  where-    -- Note: until https://gitlab.haskell.org/ghc/ghc/-/issues/20718 is-    -- resolved, the comments may be in reverse order.-    (an', cs') = case cs of-      EpaComments [] -> (an,cs)-      EpaComments c -> go (\cc -> EpaComments cc) an (sortEpaComments c)-      EpaCommentsBalanced _ [] -> (an,cs)-      EpaCommentsBalanced p c -> go (\cc -> EpaCommentsBalanced (sortEpaComments p) cc) an (sortEpaComments c)--    go :: Data b => ([LEpaComment] -> b)-                      -> AnnListItem-                      -> [LEpaComment]-                      -> (AnnListItem, b)-    go f (AnnListItem []) c = (AnnListItem [], f c)-    go f (AnnListItem lis) c = process f ([],[]) lis (sortEpaComments c)--    process :: Data b => ([LEpaComment] -> b)-            -> ([TrailingAnn], [LEpaComment])-            -> [TrailingAnn]-            -> [LEpaComment]-            -> (AnnListItem, b)-    process f (ll,cc) [] cs0 = (AnnListItem (reverse ll), f (cc++cs0))-    process f (ll,cc) li [] = (AnnListItem (reverse $ ll++li), f cc)-    process f (ll,cc) (l0:li) cs0 = r-      where-        r = case trailingAnnLoc l0 of-          EpaSpan s -> r0-            where-              condp (L lc _) = anchor lc >= anchor anc-              (before,rest) = break condp cs0-              cond (L lc _) = anchor lc >= s-              (these,those) = break cond rest-              r0 = case these of-                [] -> process f (l0:ll,cc) li cs0-                priors ->-                      -- We have at least one comment preceding the list item-                      let-                        -- dp is the delta from the end of the last comment to-                        -- the start of the AddXXXAnn delta-                        dp = tweakDelta $ spanOrigDelta (anchor $ getLoc $ last priors) s--                        l' = EpaDelta dp (commentOrigDeltas these)-                        cs1 = those-                      in-                        process f (setTrailingAnnLoc l0 l':ll,before++cc) li cs1-          EpaDelta _d' _cs' -> process f (l0:ll,cc) li cs0- -- | For comment-related deltas starting on a new line we have an -- off-by-one problem. Adjust tweakDelta :: DeltaPos  -> DeltaPos tweakDelta (SameLine d) = SameLine d tweakDelta (DifferentLine l d) = DifferentLine l (d-1) --- TODO: Until https://gitlab.haskell.org/ghc/ghc/-/issues/20715 is--- fixed we have to special-case a funbind.  Damn.--- The problem seems to depend on whether the funbind has params--- or not.  If not, we can do a normal tweakListComments.-tweakListCommentsFB :: LHsDecl GhcPs -> LHsDecl GhcPs-tweakListCommentsFB (L l (ValD xv (FunBind x n (MG mx (L lm matches) o) t))) = r-  where-    -- We need to pass any comments from the outer location into the-    -- first match for processing-    (l',matches') = case matches of-      [] -> (l,matches)-      (L lm0 m:ms) -> (l1, L lm' m:ms)-                          `debug` ("tweakListCommentsFB:(l',lm')=" ++ showAst (l1,lm'))-      -- (L lm m:ms) -> error $ "lm'=\n" ++ showAst lm'-        where-          (l1,cs',as) = case l of-            SrcSpanAnn EpAnnNotUsed _ -> (l,[], [])-            SrcSpanAnn (EpAnn anc an (EpaComments cs))            l0-              -> (SrcSpanAnn (EpAnn anc (AnnListItem []) (EpaComments [])) l0, cs, lann_trailing an)-            SrcSpanAnn (EpAnn anc an (EpaCommentsBalanced ls ts)) l0-              -> (SrcSpanAnn (EpAnn anc (AnnListItem []) (EpaCommentsBalanced ls [])) l0, ts, lann_trailing an)--          lm' = case lm0 of-            SrcSpanAnn EpAnnNotUsed                               l0-              -> SrcSpanAnn (EpAnn (spanAsAnchor l0) (AnnListItem as) (EpaComments cs')) l0-            SrcSpanAnn (EpAnn anc (AnnListItem is) (EpaComments cs))            l0-              -> SrcSpanAnn (EpAnn anc (AnnListItem (as<>is)) (EpaComments (cs'<>cs))) l0-            SrcSpanAnn (EpAnn anc (AnnListItem is) (EpaCommentsBalanced ls ts)) l0-              -> SrcSpanAnn (EpAnn anc (AnnListItem (as<>is)) (EpaCommentsBalanced (cs'<>ls) ts)) l0--    r = (L l' (ValD xv (FunBind x n (MG mx (L lm (map tweakListComments' matches')) o) t)))-tweakListCommentsFB x = error $ "tweakListCommentsFB for " ++ showAst x- -- ---------------------------------------------------------------------  balanceSameLineComments :: (Monad m)@@ -866,15 +784,6 @@  -- --------------------------------------------------------------------- --- | Take an anchor and a preceding location, and generate an--- equivalent one with a 'MovedAnchor' delta.-deltaAnchor :: Anchor -> RealSrcSpan -> Anchor-deltaAnchor (Anchor anc _) ss = Anchor anc (MovedAnchor dp)-  where-    dp = pos2delta (ss2pos ss) (ss2pos anc)---- ---------------------------------------------------------------------- -- | Create a @SrcSpanAnn@ with a @MovedAnchor@ operation using the -- given @DeltaPos@. noAnnSrcSpanDP :: (Monoid ann) => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)@@ -1028,12 +937,7 @@         (l', rhs') <- case binds of           EmptyLocalBinds{} -> do             logTr $ "replaceDecls LMatch empty binds"-            -- modifyAnnsT (setPrecedingLines (ghead "LMatch.replaceDecls" newBinds) 1 4) -            -- only move the comment if the original where clause was empty.-            -- toMove <- balanceTrailingComments m m-            -- insertCommentBefore (mkAnnKey m) toMove (matchEpAnn AnnWhere)-            -- TODO: move trailing comments on the same line to before the binds             logDataWithAnnsTr "Match.replaceDecls:balancing comments:m" m             L l' m' <- balanceSameLineComments m             logDataWithAnnsTr "Match.replaceDecls:(m1')" (L l' m')@@ -1046,17 +950,16 @@ -- ---------------------------------------------------------------------  instance HasDecls (LocatedA (HsExpr GhcPs)) where-  hsDecls (L _ (HsLet _ decls _ex)) = hsDeclsValBinds decls-  hsDecls _                         = return []+  hsDecls (L _ (HsLet _ _ decls _ _ex)) = hsDeclsValBinds decls+  hsDecls _                             = return [] -  replaceDecls (L ll (HsLet x binds ex)) newDecls+  replaceDecls (L ll (HsLet x tkLet binds tkIn ex)) newDecls     = do         logTr "replaceDecls HsLet"         let lastAnc = realSrcSpan $ spanHsLocaLBinds binds         -- TODO: may be an intervening comment, take account for lastAnc-        let (x', ex',newDecls') = case x of-              EpAnnNotUsed -> (x, ex, newDecls)-              (EpAnn a (AnnsLet l i) cs) ->+        let (tkLet', tkIn', ex',newDecls') = case (tkLet, tkIn) of+              (L (TokenLoc l) ls, L (TokenLoc i) is) ->                 let                   off = case l of                           (EpaSpan r) -> LayoutStartCol $ snd $ ss2pos r@@ -1066,18 +969,21 @@                   newDecls'' = case newDecls of                     [] -> newDecls                     (d:ds) -> setEntryDPDecl d (SameLine 0) : ds-                in ( EpAnn a (AnnsLet l (addEpaLocationDelta off lastAnc i)) cs+                -- in ( EpAnn a (AnnsLet l (addEpaLocationDelta off lastAnc i)) cs+                in ( L (TokenLoc l) ls+                   , L (TokenLoc (addEpaLocationDelta off lastAnc i)) is                    , ex''                    , newDecls'')+              (_,_) -> (tkLet, tkIn, ex, newDecls)         binds' <- replaceDeclsValbinds WithoutWhere binds newDecls'-        return (L ll (HsLet x' binds' ex'))+        return (L ll (HsLet x tkLet' binds' tkIn' ex'))    -- TODO: does this make sense? Especially as no hsDecls for HsPar-  replaceDecls (L l (HsPar x e)) newDecls+  replaceDecls (L l (HsPar x lpar e rpar)) newDecls     = do         logTr "replaceDecls HsPar"         e' <- replaceDecls e newDecls-        return (L l (HsPar x e'))+        return (L l (HsPar x lpar e' rpar))   replaceDecls old _new = error $ "replaceDecls (LHsExpr GhcPs) undefined for:" ++ showGhc old  -- ---------------------------------------------------------------------@@ -1135,9 +1041,7 @@    replaceDecls (L l (LetStmt x lb)) newDecls     = do-        -- modifyAnnsT (captureOrder s newDecls)         lb'' <- replaceDeclsValbinds WithWhere lb newDecls-        -- let lb' = L (getLoc lb) lb''         return (L l (LetStmt x lb''))   replaceDecls (L l (LastStmt x e d se)) newDecls     = do@@ -1322,79 +1226,3 @@   decls <- liftT $ hsDecls t   decls' <- action decls   liftT $ replaceDecls t decls'---- ------------------------------------------------------------------------- type RWS r w s = RWST r w s Identity--- runRWS :: Monoid w => RWS r w s a -> r -> s -> (a, s, w)--- rws :: Monoid w => (r -> s -> (a, s, w)) -> RWS r w s a---- -- | Evaluate a computation with the given initial state and environment,--- -- returning the final value and output, discarding the final state.--- evalRWS :: (Monoid w)---         => RWS r w s a  -- ^RWS computation to execute---         -> r            -- ^initial environment---         -> s            -- ^initial value---         -> (a, w)       -- ^final value and output---- mkM :: (Monad m, Typeable a, Typeable b) => (b -> m b) -> a -> m a--type Delta a = RWS () [String] (Maybe Anchor) a----- | Generic top-down traversal through the given AST fragment,--- converting all ExactPrint Anchor's into ones with an equivalent--- MovedAnchor operation.  Initially ignores comments-makeDeltaAst' :: forall a. (Data a) => a -> a-makeDeltaAst' a = fst $ evalRWS (go a) () Nothing-  where-    go :: a -> Delta a-    go = everywhereM' (mkM   (locatedAnnImpl @AnnListItem) -- LocatedA-                      `extM` (locatedAnnImpl @NameAnn)     -- LocatedN-                      `extM` (locatedAnnImpl @AnnList)     -- LocatedL-                      `extM` (locatedAnnImpl @AnnPragma)   -- LocatedP-                      `extM` (locatedAnnImpl @AnnContext)  -- LocatedC-                      )--    locatedAnnImpl :: forall an. (Default an)-      => SrcAnn an -> Delta (SrcAnn an)-    locatedAnnImpl (SrcSpanAnn (EpAnn anc@(Anchor loc _op) an cs) l) = do-      -- error "locatedAnnImpl:EpAnn"-      ma <- get-      put (Just anc)-      let anchor' = case ma of-                      Nothing -> (Anchor loc (MovedAnchor (SameLine 0)))-                      Just (Anchor rl _op) -> deltaAnchor anc rl-      let cs' = case ma of-            Nothing -> cs <> mkComments ("from anc:Nothing") (Anchor loc UnchangedAnchor)-            Just anc' -> cs <> mkComments ("from anc:" ++ showGhc anc') anc'-      return (SrcSpanAnn (EpAnn anchor' an cs') l)--    locatedAnnImpl (SrcSpanAnn EpAnnNotUsed l) = do-      -- error $ "EpAnnNotUsed: " ++ showGhc l-      ma <- get-      let anc = spanAsAnchor l-      put (Just anc)-      let anchor' = case ma of-                      Nothing -> Anchor (realSrcSpan l) (MovedAnchor (SameLine 0))-                      Just (Anchor rl _op) -> deltaAnchor anc rl-      let cs' = case ma of-            Nothing -> mkComments ("EpAnnNotUsed:from anc:Nothing") (spanAsAnchor l)-            Just anc' -> mkComments ("EpAnnNotUsed:from anc:" ++ showGhc anc') anc'-      return (SrcSpanAnn (EpAnn anchor' def cs') l)---- | Monadic variation on everywhere', so Apply a monadic--- transformation everywhere in top-down manner-everywhereM' :: Monad m => GenericM m -> GenericM m-everywhereM' f x-  = do x' <- f x-       gmapM (everywhereM' f) x'---mkComments  :: String -> Anchor -> EpAnnComments-mkComments str anc = EpaComments [mkCommentAnc str anc]--mkCommentAnc :: String -> Anchor -> LEpaComment-mkCommentAnc str anc = L anc (EpaComment (EpaLineComment str) (anchor anc) )---- ---------------------------------------------------------------------

@@ -19,6 +19,7 @@   where import Control.Monad.State import Data.Function+import Data.List import Data.Maybe import Data.Ord (comparing) @@ -32,8 +33,7 @@ import GHC.Types.SrcLoc import GHC.Data.FastString import GHC.Utils.Outputable ( showPprUnsafe )--import Data.List (sortBy, elemIndex)+import qualified GHC.Data.Strict as Strict  import Debug.Trace import Language.Haskell.GHC.ExactPrint.Types@@ -46,29 +46,15 @@ -- debugEnabledFlag = True debugEnabledFlag = False --- |Global switch to enable debug tracing in ghc-exactprint Pretty-debugPEnabledFlag :: Bool-debugPEnabledFlag = True--- debugPEnabledFlag = False- -- |Provide a version of trace that comes at the end of the line, so it can -- easily be commented out when debugging different things. debug :: c -> String -> c debug c s = if debugEnabledFlag               then trace s c               else c---- |Provide a version of trace for the Pretty module, which can be enabled--- separately from 'debug' and 'debugM'-debugP :: String -> c -> c-debugP s c = if debugPEnabledFlag-               then trace s c-               else c- debugM :: Monad m => String -> m () debugM s = when debugEnabledFlag $ traceM s - -- ---------------------------------------------------------------------  warn :: c -> String -> c@@ -203,19 +189,17 @@ insertCppComments ::  ParsedSource -> [LEpaComment] -> ParsedSource insertCppComments (L l p) cs = L l p'   where-    ncs = EpaComments cs     an' = case GHC.hsmodAnn p of-      (EpAnn a an ocs) -> EpAnn a an (ocs <> ncs)+      (EpAnn a an ocs) -> EpAnn a an (EpaComments cs')+        where+          cs' = sortEpaComments $ priorComments ocs ++ getFollowingComments ocs ++ cs       unused -> unused     p' = p { GHC.hsmodAnn = an' }  -- ---------------------------------------------------------------------  ghcCommentText :: LEpaComment -> String-ghcCommentText (L _ (GHC.EpaComment (EpaDocCommentNext s) _))  = s-ghcCommentText (L _ (GHC.EpaComment (EpaDocCommentPrev s) _))  = s-ghcCommentText (L _ (GHC.EpaComment (EpaDocCommentNamed s) _)) = s-ghcCommentText (L _ (GHC.EpaComment (EpaDocSection _ s) _))    = s+ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _))      = exactPrintHsDocString s ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _))      = s ghcCommentText (L _ (GHC.EpaComment (EpaLineComment s) _))     = s ghcCommentText (L _ (GHC.EpaComment (EpaBlockComment s) _))    = s@@ -291,6 +275,9 @@  -- --------------------------------------------------------------------- +isSymbolRdrName :: RdrName -> Bool+isSymbolRdrName n = isSymOcc $ rdrNameOcc n+ rdrName2String :: RdrName -> String rdrName2String r =   case isExact_maybe r of@@ -308,6 +295,21 @@  -- --------------------------------------------------------------------- +-- occAttributes :: OccName.OccName -> String+-- occAttributes o = "(" ++ ns ++ vo ++ tv ++ tc ++ d ++ ds ++ s ++ v ++ ")"+--   where+--     -- ns = (showSDocUnsafe $ OccName.pprNameSpaceBrief $ occNameSpace o) ++ ", "+--     ns = (showSDocUnsafe $ OccName.pprNameSpaceBrief $ occNameSpace o) ++ ", "+--     vo = if isVarOcc     o then "Var "     else ""+--     tv = if isTvOcc      o then "Tv "      else ""+--     tc = if isTcOcc      o then "Tc "      else ""+--     d  = if isDataOcc    o then "Data "    else ""+--     ds = if isDataSymOcc o then "DataSym " else ""+--     s  = if isSymOcc     o then "Sym "     else ""+--     v  = if isValOcc     o then "Val "     else ""++ -- ---------------------------------------------------------------------+ locatedAnAnchor :: LocatedAn a t -> RealSrcSpan locatedAnAnchor (L (SrcSpanAnn EpAnnNotUsed l) _) = realSrcSpan l locatedAnAnchor (L (SrcSpanAnn (EpAnn a _ _) _) _) = anchor a@@ -353,31 +355,17 @@ moveAnchor (SrcSpanAnn (EpAnn anc _ cs) l) = SrcSpanAnn (EpAnn anc mempty cs) l  -- ----------------------------------------------------------------------trailingAnnToAddEpAnn :: TrailingAnn -> AddEpAnn-trailingAnnToAddEpAnn (AddSemiAnn ss)    = AddEpAnn AnnSemi ss-trailingAnnToAddEpAnn (AddCommaAnn ss)   = AddEpAnn AnnComma ss-trailingAnnToAddEpAnn (AddVbarAnn ss)    = AddEpAnn AnnVbar ss-trailingAnnToAddEpAnn (AddRarrowAnn ss)  = AddEpAnn AnnRarrow ss-trailingAnnToAddEpAnn (AddRarrowAnnU ss) = AddEpAnn AnnRarrowU ss-trailingAnnToAddEpAnn (AddLollyAnnU ss)  = AddEpAnn AnnLollyU ss  trailingAnnLoc :: TrailingAnn -> EpaLocation trailingAnnLoc (AddSemiAnn ss)    = ss trailingAnnLoc (AddCommaAnn ss)   = ss trailingAnnLoc (AddVbarAnn ss)    = ss-trailingAnnLoc (AddRarrowAnn ss)  = ss-trailingAnnLoc (AddRarrowAnnU ss) = ss-trailingAnnLoc (AddLollyAnnU ss)  = ss  setTrailingAnnLoc :: TrailingAnn -> EpaLocation -> TrailingAnn setTrailingAnnLoc (AddSemiAnn _)    ss = (AddSemiAnn ss) setTrailingAnnLoc (AddCommaAnn _)   ss = (AddCommaAnn ss) setTrailingAnnLoc (AddVbarAnn _)    ss = (AddVbarAnn ss)-setTrailingAnnLoc (AddRarrowAnn _)  ss = (AddRarrowAnn ss)-setTrailingAnnLoc (AddRarrowAnnU _) ss = (AddRarrowAnnU ss)-setTrailingAnnLoc (AddLollyAnnU _)  ss = (AddLollyAnnU ss) - addEpAnnLoc :: AddEpAnn -> EpaLocation addEpAnnLoc (AddEpAnn _ l) = l @@ -415,16 +403,16 @@  hackSrcSpanToAnchor :: SrcSpan -> Anchor hackSrcSpanToAnchor (UnhelpfulSpan s) = error $ "hackSrcSpanToAnchor : UnhelpfulSpan:" ++ show s-hackSrcSpanToAnchor (RealSrcSpan r Nothing) = Anchor r UnchangedAnchor-hackSrcSpanToAnchor (RealSrcSpan r (Just (BufSpan (BufPos s) (BufPos e))))+hackSrcSpanToAnchor (RealSrcSpan r Strict.Nothing) = Anchor r UnchangedAnchor+hackSrcSpanToAnchor (RealSrcSpan r (Strict.Just (BufSpan (BufPos s) (BufPos e))))   = if s <= 0 && e <= 0     then Anchor r (MovedAnchor (deltaPos (-s) (-e)))     else Anchor r UnchangedAnchor  hackAnchorToSrcSpan :: Anchor -> SrcSpan-hackAnchorToSrcSpan (Anchor r UnchangedAnchor) = RealSrcSpan r Nothing+hackAnchorToSrcSpan (Anchor r UnchangedAnchor) = RealSrcSpan r Strict.Nothing hackAnchorToSrcSpan (Anchor r (MovedAnchor dp))-  = RealSrcSpan r (Just (BufSpan (BufPos s) (BufPos e)))+  = RealSrcSpan r (Strict.Just (BufSpan (BufPos s) (BufPos e)))   where     s = - (getDeltaLine dp)     e = - (deltaColumn dp)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}@@ -28,19 +29,23 @@ -- ---------------------------------------------------------------------  data GHCVersion = GHC92+           | GHC94      deriving (Eq, Ord, Show)  ghcVersion :: GHCVersion+#if MIN_VERSION_ghc(9,4,0)+ghcVersion = GHC94+#else ghcVersion = GHC92+#endif  -- | Directories to automatically find roundtrip tests testDirs :: [FilePath] testDirs =   case ghcVersion of     GHC92  -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92"]--    -- GHC92  -> ["ghc92-copied"]-    -- GHC92  -> ["ghc92"]+    GHC94  -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94"]+    -- GHC94  -> ["ghc94"]  -- --------------------------------------------------------------------- @@ -86,7 +91,12 @@     "QuasiQuote.hs",     "RandomPGC.hs",     "HashTab.hs",-    "LinePragmas.hs"+    "LinePragmas.hs",++    -- All related to blending in CPP-as-comments+    "Cpp.hs",+    "Checkpoint.hs",+    "CommentPlacement6.hs"     ]  findTestsMD :: LibDir -> IO Test@@ -202,12 +212,41 @@    -- mkTestModChange libdir rmDecl4 "RmDecl4.hs"     -- mkParserTestMD libdir      "ghc92" "Foo.hs"     -- mkParserTest libdir      "ghc92" "Foo.hs"-    mkParserTestMD libdir      "ghc92" "Foo.hs"+    -- mkParserTestMD libdir      "ghc92" "Foo.hs"     -- mkParserTest libdir      "ghc92" "Foo2.hs"     -- mkParserTest libdir      "ghc710" "EmptyMostly.hs"     -- mkParserTestBC libdir "ghc710" "Control.hs"     -- mkParserTestBC libdir "ghc92" "CommentPlacement3.hs"     -- mkParserTestBC libdir "ghc92" "TopLevelSemis.hs"++    -- mkParserTest libdir      "ghc92" "ConstructorComment.hs"+    -- mkParserTest libdir      "ghc92" "Binary.hs"+    -- mkParserTest libdir      "ghc92" "Observer.hs"+    -- mkParserTest libdir      "ghc92" "Observer1.hs"++   -- mkTestModChange libdir addLocaLDecl1  "AddLocalDecl1.hs"+   -- mkTestModChange libdir addLocaLDecl3  "AddLocalDecl3.hs"++    -- mkParserTestBC libdir "ghc710" "MultiParamTypeClasses.hs"++    -- mkParserTestBC libdir "ghc710" "DataFamilies.hs"+    -- mkParserTestBC libdir "ghc710" "Cpp.hs"+    -- mkParserTestBC libdir "ghc80" "T4139.hs"++    -- mkParserTestBC libdir "ghc92" "Checkpoint.hs"++    -- mkParserTestBC libdir "ghc92" "CommentPlacement6.hs"+    -- mkParserTest libdir "ghc92" "CommentPlacement6.hs"++    -- mkParserTest libdir "ghc92" "TopLevelSemis.hs"+    -- mkParserTestBC libdir "ghc92" "TopLevelSemis.hs"+    -- mkParserTestMD libdir "ghc92" "TopLevelSemis.hs"++    -- mkParserTest libdir "ghc92" "TopLevelSemis1.hs"+    -- mkParserTestBC libdir "ghc92" "TopLevelSemis1.hs"+    -- mkParserTestMD libdir "ghc92" "TopLevelSemis1.hs"++    mkParserTest libdir "ghc94" "record-dot-four-out.hs"     -- Needs GHC changes 

@@ -31,16 +31,16 @@   import Language.Haskell.GHC.ExactPrint-import Language.Haskell.GHC.ExactPrint.ExactPrint+-- import Language.Haskell.GHC.ExactPrint.ExactPrint import Language.Haskell.GHC.ExactPrint.Utils import Language.Haskell.GHC.ExactPrint.Parsers import Language.Haskell.GHC.ExactPrint.Preprocess  import qualified Control.Monad.IO.Class as GHC import qualified GHC           as GHC hiding (parseModule)-import qualified GHC.Data.Bag          as GHC+-- import qualified GHC.Data.Bag          as GHC import qualified GHC.Driver.Session    as GHC-import qualified GHC.Utils.Error       as GHC+-- import qualified GHC.Utils.Error       as GHC  import qualified GHC.LanguageExtensions as LangExt @@ -107,7 +107,9 @@ noChange _libdir parsed = return parsed  changeBalanceComments :: Changer-changeBalanceComments _libdir (GHC.L l p) = do+changeBalanceComments _libdir top = do+  let (GHC.L l p) = makeDeltaAst top+  -- let (GHC.L l p) = top   let decls0 = GHC.hsmodDecls p       (decls,_,w) = runTransform (balanceCommentsList decls0)   let p2 = p { GHC.hsmodDecls = decls}@@ -199,10 +201,5 @@   case mm of    [] -> return Nothing    fs -> return (Just (snd $ head fs))---- -----------------------------------------------------------------------showErrorMessages :: GHC.ErrorMessages -> String-showErrorMessages m = show $ GHC.bagToList m  -- ---------------------------------------------------------------------

@@ -15,7 +15,7 @@ -- import qualified Data.ByteString as B  import Language.Haskell.GHC.ExactPrint-import Language.Haskell.GHC.ExactPrint.ExactPrint+-- import Language.Haskell.GHC.ExactPrint.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers import Language.Haskell.GHC.ExactPrint.Types import Language.Haskell.GHC.ExactPrint.Utils

@@ -7,7 +7,7 @@ module Test.Transform where  import Language.Haskell.GHC.ExactPrint-import Language.Haskell.GHC.ExactPrint.ExactPrint+-- import Language.Haskell.GHC.ExactPrint.ExactPrint import Language.Haskell.GHC.ExactPrint.Types import Language.Haskell.GHC.ExactPrint.Parsers import Language.Haskell.GHC.ExactPrint.Utils@@ -90,16 +90,6 @@  -- --------------------------------------------------------------------- --- changeWhereIn3a :: Changer--- changeWhereIn3a ans (GHC.L l p) = do---   let decls = GHC.hsmodDecls p---          -- (GHC.L _ (GHC.SigD sig))    = head $ drop 1 decls---       d1 = head $ drop 2 decls---       d2 = head $ drop 3 decls---   let (_p1,(ans',_),_w) = runTransform ans (balanceComments d1 d2)---   let p2 = p { GHC.hsmodDecls = d2:d1:decls}---   return (ans',GHC.L l p2)- -- | Check that balanceCommentsList is idempotent changeWhereIn3a :: Changer changeWhereIn3a _libdir (L l p) = do@@ -129,50 +119,6 @@  -- --------------------------------------------------------------------- --- -- | Add a local declaration with signature to LocalDecl, where there was no--- -- prior local decl. So it adds a "where" annotation.--- changeLocalDecls2 :: Changer--- changeLocalDecls2 ans (GHC.L l p) = do---   Right (declAnns, d@(GHC.L ld (GHC.ValD _ decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")---   Right (sigAnns, s@(GHC.L ls (GHC.SigD _ sig)))   <- withDynFlags (\df -> parseDecl df "sig"  "nn :: Int")---   let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns---   let  sigAnns' = setPrecedingLines (GHC.L ls  sig) 1 4 sigAnns---   -- putStrLn $ "changeLocalDecls:sigAnns=" ++ show sigAnns---   -- putStrLn $ "changeLocalDecls:declAnns=" ++ show declAnns---   -- putStrLn $ "\nchangeLocalDecls:sigAnns'=" ++ show sigAnns'---   let (p',(ans',_),_w) = runTransform ans doAddLocal---       doAddLocal = SYB.everywhereM (SYB.mkM replaceLocalBinds) p---       replaceLocalBinds :: GHC.LMatch GHC.GhcPs (GHC.LHsExpr GHC.GhcPs)---                         -> Transform (GHC.LMatch GHC.GhcPs (GHC.LHsExpr GHC.GhcPs))---       replaceLocalBinds m@(GHC.L lm (GHC.Match _ mln pats (GHC.GRHSs _ rhs (GHC.L _ GHC.EmptyLocalBinds{})))) = do---         newSpan <- uniqueSrcSpanT---         let---           newAnnKey = AnnKey (rs newSpan) (CN "HsValBinds")---           addWhere mkds =---             case Map.lookup (mkAnnKey m) mkds of---               Nothing -> error "wtf"---               Just ann -> Map.insert newAnnKey ann2 mkds2---                 where---                   ann1 = ann { annsDP = annsDP ann ++ [(G GHC.AnnWhere,DP (1,2))]---                              , annCapturedSpan = Just newAnnKey---                              , annSortKey = Just [rs ls, rs ld]---                              }---                   mkds2 = Map.insert (mkAnnKey m) ann1 mkds---                   ann2 = annNone---                              { annEntryDelta     = DP (1,0) }---         modifyAnnsT addWhere---         let decls = [s,d]---         -- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)---         modifyAnnsT (captureOrderAnnKey newAnnKey decls)---         let binds = (GHC.HsValBinds noExt (GHC.ValBinds noExt (GHC.listToBag $ [GHC.L ld decl])---                                     [GHC.L ls sig]))---         bindSpan <- uniqueSrcSpanT---         return (GHC.L lm (GHC.Match noExt mln pats (GHC.GRHSs noExt rhs (GHC.L bindSpan binds))))---       replaceLocalBinds x = return x---   -- putStrLn $ "log:" ++ intercalate "\n" w---   return (mergeAnnList [declAnns',sigAnns',ans'],GHC.L l p')-- -- | Add a local declaration with signature to LocalDecl, where there was no -- prior local decl. So it adds a "where" annotation. changeLocalDecls2 :: Changer@@ -204,41 +150,6 @@  -- --------------------------------------------------------------------- --- -- | Add a local declaration with signature to LocalDecl--- changeLocalDecls :: Changer--- changeLocalDecls ans (GHC.L l p) = do---   Right (declAnns, d@(GHC.L ld (GHC.ValD _ decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")---   Right (sigAnns, s@(GHC.L ls (GHC.SigD _ sig)))   <- withDynFlags (\df -> parseDecl df "sig"  "nn :: Int")---   let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns---   let  sigAnns' = setPrecedingLines (GHC.L ls  sig) 1 4 sigAnns---   -- putStrLn $ "changeLocalDecls:sigAnns=" ++ show sigAnns---   -- putStrLn $ "changeLocalDecls:declAnns=" ++ show declAnns---   -- putStrLn $ "\nchangeLocalDecls:sigAnns'=" ++ show sigAnns'---   let (p',(ans',_),_w) = runTransform ans doAddLocal---       doAddLocal = SYB.everywhereM (SYB.mkM replaceLocalBinds) p---       replaceLocalBinds :: GHC.LMatch GHC.GhcPs (GHC.LHsExpr GHC.GhcPs)---                         -> Transform (GHC.LMatch GHC.GhcPs (GHC.LHsExpr GHC.GhcPs))---       replaceLocalBinds m@(GHC.L lm (GHC.Match _ mln pats (GHC.GRHSs _ rhs (GHC.L lb (GHC.HsValBinds _ (GHC.ValBinds _ binds sigs)))))) = do---         a1 <- getAnnsT---         a' <- case sigs of---               []    -> return a1---               (s1:_) -> do---                 let a2 = setPrecedingLines s1 2 0 a1---                 return a2---         putAnnsT a'---         let oldDecls = GHC.sortLocated $ map wrapDecl (GHC.bagToList binds) ++ map wrapSig sigs---         let decls = s:d:oldDecls---         -- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)---         modifyAnnsT (captureOrder m decls)---         let binds' = (GHC.HsValBinds noExt---                           (GHC.ValBinds noExt (GHC.listToBag $ (GHC.L ld decl):GHC.bagToList binds)---                                           (GHC.L ls sig:sigs)))---         return (GHC.L lm (GHC.Match noExt mln pats (GHC.GRHSs noExt rhs (GHC.L lb binds'))))---       replaceLocalBinds x = return x---   -- putStrLn $ "log:" ++ intercalate "\n" w---   return (mergeAnnList [declAnns',sigAnns',ans'],GHC.L l p')-- -- | Add a local declaration with signature to LocalDecl changeLocalDecls :: Changer changeLocalDecls libdir top = do@@ -275,20 +186,6 @@ -- ---------------------------------------------------------------------  -- | Add a declaration to AddDecl--- changeAddDecl :: Changer--- changeAddDecl ans top = do---   Right (declAnns, decl) <- withDynFlags (\df -> parseDecl df "<interactive>" "nn = n2")---   -- putStrLn $ "changeDecl:(declAnns,decl)=" ++ showGhc (declAnns,decl)---   let declAnns' = setPrecedingLines decl 2 0 declAnns---   -- putStrLn $ "changeDecl:(declAnns',decl)=" ++ showGhc (declAnns',decl)----   let (p',(ans',_),_) = runTransform ans doAddDecl---       doAddDecl = SYB.everywhereM (SYB.mkM replaceTopLevelDecls) top---       replaceTopLevelDecls :: GHC.ParsedSource -> Transform (GHC.ParsedSource)---       replaceTopLevelDecls m = insertAtStart m decl---   return (mergeAnns declAnns' ans',p')---- | Add a declaration to AddDecl changeAddDecl :: Changer changeAddDecl libdir top = do   Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")@@ -301,24 +198,7 @@       replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource       replaceTopLevelDecls m = insertAtStart m decl'   return p'--- --------------------------------------------------------------------- --- -- |Remove a decl with a trailing comment, and remove the trailing comment too--- changeWhereIn3 :: Int -> Changer--- changeWhereIn3 declIndex ans p = return (ans',p')---   where---     (p',(ans',_),_) = runTransform ans doTransform---     doTransform = doRmDecl p----     doRmDecl (GHC.L l (GHC.HsModule lo mmn mexp imps decls mdepr haddock)) = do---       let---         -- declIndex = 2 -- zero based---         decls1 = take declIndex decls---         decls2 = drop (declIndex + 1) decls---         decls' = decls1 ++ decls2---       return (GHC.L l (GHC.HsModule lo mmn mexp imps decls' mdepr haddock))---       -- error $ "doRmDecl:decls2=" ++ showGhc (length decls,decls1,decls2)- -- ---------------------------------------------------------------------  changeRenameCase1 :: Changer@@ -335,7 +215,6 @@  changeLayoutIn3 :: Changer changeLayoutIn3 _libdir parsed = return (rename "anotherX" [((7,13),(7,14)),((7,37),(7,38)),((8,37),(8,38))] parsed)--- changeLayoutIn3 parsed = rename "anotherX" [((7,13),(7,14)),((7,37),(7,38))] parsed  changeLayoutIn4 :: Changer changeLayoutIn4 _libdir parsed = return (rename "io" [((7,8),(7,13)),((7,28),(7,33))] parsed)@@ -370,18 +249,8 @@         | cond (locA ln) = L ln newName     replaceRdr x = x - -- --------------------------------------------------------------------- --- changeWhereIn4 :: Changer--- changeWhereIn4 ans parsed---   = return (ans,SYB.everywhere (SYB.mkT replace) parsed)---   where---     replace :: GHC.Located GHC.RdrName -> GHC.Located GHC.RdrName---     replace (GHC.L ln _n)---       | ss2range ln == ((12,16),(12,17)) = GHC.L ln (GHC.mkRdrUnqual (GHC.mkVarOcc "p_2"))---     replace x = x- changeWhereIn4 :: Changer changeWhereIn4 _libdir parsed   = return (everywhere (mkT replace) (makeDeltaAst parsed))@@ -390,27 +259,15 @@     replace (L ln _n)       | ss2range (locA ln) == ((12,16),(12,17)) = L ln (mkRdrUnqual (mkVarOcc "p_2"))     replace x = x--- --------------------------------------------------------------------- --- changeLetIn1 :: Changer--- changeLetIn1 ans parsed---   = return (ans,SYB.everywhere (SYB.mkT replace) parsed)---   where---     replace :: GHC.HsExpr GHC.GhcPs -> GHC.HsExpr GHC.GhcPs---     replace (GHC.HsLet _ (GHC.L lb localDecls) expr@(GHC.L _ _))---       =---          let (GHC.HsValBinds x (GHC.ValBinds xv bagDecls sigs)) = localDecls---              bagDecls' = GHC.listToBag $ init $ GHC.bagToList bagDecls---          in (GHC.HsLet noExt (GHC.L lb (GHC.HsValBinds x (GHC.ValBinds xv bagDecls' sigs))) expr)----     replace x = x+-- ---------------------------------------------------------------------  changeLetIn1 :: Changer changeLetIn1 _libdir parsed   = return (everywhere (mkT replace) (makeDeltaAst parsed))   where     replace :: HsExpr GhcPs -> HsExpr GhcPs-    replace (HsLet (EpAnn anc (AnnsLet l _i) cs) localDecls expr)+    replace (HsLet an tkLet localDecls _ expr)       =          let (HsValBinds x (ValBinds xv bagDecls sigs)) = localDecls              [l2,_l1] = map wrapDecl $ bagToList bagDecls@@ -418,8 +275,9 @@              (L (SrcSpanAnn _ le) e) = expr              a = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan le) (MovedAnchor (SameLine 1))) mempty emptyComments) le)              expr' = L a e-         in (HsLet (EpAnn anc (AnnsLet l (EpaDelta (DifferentLine 1 0) [])) cs)-                (HsValBinds x (ValBinds xv bagDecls' sigs)) expr')+             tkIn' = L (TokenLoc (EpaDelta (DifferentLine 1 0) [])) HsTok+         in (HsLet an tkLet+                (HsValBinds x (ValBinds xv bagDecls' sigs)) tkIn' expr')      replace x = x @@ -456,27 +314,13 @@  -- --------------------------------------------------------------------- --- addLocaLDecl1 :: Changer--- addLocaLDecl1 ans lp = do---   Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")---   let declAnns' = setPrecedingLines newDecl 1 4 declAnns---       doAddLocal = do---         (d1:d2:_) <- hsDecls lp---         balanceComments d1 d2---         (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m d -> do---           return ((newDecl : d),Nothing)---         replaceDecls lp [d1', d2]----   (lp',(ans',_),_w) <- runTransformT (mergeAnns ans declAnns') doAddLocal---   -- putStrLn $ "log:\n" ++ intercalate "\n" _w---   return (ans',lp')- addLocaLDecl1 :: Changer-addLocaLDecl1 libdir lp = do+addLocaLDecl1 libdir top = do   Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")-  let decl' = setEntryDP (makeDeltaAst (L ld decl)) (DifferentLine 1 4)+  let decl' = setEntryDP (L ld decl) (DifferentLine 1 5)       doAddLocal = do-        (de1:d2:d3:_) <- hsDecls (makeDeltaAst lp)+        let lp = makeDeltaAst top+        (de1:d2:d3:_) <- hsDecls lp         (de1'',d2') <- balanceComments de1 d2         (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do           return ((wrapDecl decl' : d),Nothing)@@ -485,27 +329,8 @@   (lp',_,w) <- runTransformT doAddLocal   debugM $ "addLocaLDecl1:" ++ intercalate "\n" w   return lp'--- --------------------------------------------------------------------- --- addLocaLDecl2 :: Changer--- addLocaLDecl2 ans lp = do---   Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")---   let---       doAddLocal = do---          tlDecs <- hsDecls lp---          let parent = head tlDecs---          balanceComments parent (head $ tail tlDecs)----          (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \_m decls -> do---            transferEntryDPT (head decls) newDecl---            setEntryDPT (head decls) (DP (1, 0))---            return ((newDecl:decls),Nothing)----          replaceDecls lp (parent':tail tlDecs)----   let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns) doAddLocal---   -- putStrLn $ "log:\n" ++ intercalate "\n" _w---   return (ans',lp')+-- ---------------------------------------------------------------------  addLocaLDecl2 :: Changer addLocaLDecl2 libdir lp = do@@ -529,34 +354,13 @@  -- --------------------------------------------------------------------- --- addLocaLDecl3 :: Changer--- addLocaLDecl3 ans lp = do---   Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")---   let---       doAddLocal = do---          -- logDataWithAnnsTr "parsed:" lp---          logDataWithAnnsTr "newDecl:" newDecl---          tlDecs <- hsDecls lp---          let parent = head tlDecs---          balanceComments parent (head $ tail tlDecs)----          (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \m decls -> do---            setPrecedingLinesT newDecl 1 0---            moveTrailingComments m (last decls)---            return ((decls++[newDecl]),Nothing)----          replaceDecls lp (parent':tail tlDecs)----   let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns) doAddLocal---   -- putStrLn $ "log\n" ++ intercalate "\n" _w---   return (ans',lp')- addLocaLDecl3 :: Changer-addLocaLDecl3 libdir lp = do+addLocaLDecl3 libdir top = do   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   let       doAddLocal = do-         (de1:d2:_) <- hsDecls (makeDeltaAst lp)+         let lp = makeDeltaAst top+         (de1:d2:_) <- hsDecls lp          (de1'',d2') <- balanceComments de1 d2           (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do@@ -571,29 +375,6 @@  -- --------------------------------------------------------------------- --- addLocaLDecl4 :: Changer--- addLocaLDecl4 ans lp = do---   Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")---   Right (sigAnns, newSig)   <- withDynFlags (\df -> parseDecl df "sig"  "nn :: Int")---   -- putStrLn $ "addLocaLDecl4:lp=" ++ showGhc lp---   let---       doAddLocal = do---          tlDecs <- hsDecls lp---          let parent = head tlDecs----          setPrecedingLinesT newSig  1 0---          setPrecedingLinesT newDecl 1 0----          (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \_m decls -> do---            return ((decls++[newSig,newDecl]),Nothing)----          replaceDecls lp (parent':tail tlDecs)----   let (lp',(ans',_),_w) = runTransform (mergeAnnList [ans,declAnns,sigAnns]) doAddLocal---   -- putStrLn $ "log\n" ++ intercalate "\n" _w---   return (ans',lp')-- addLocaLDecl4 :: Changer addLocaLDecl4 libdir lp = do   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")@@ -616,22 +397,6 @@  -- --------------------------------------------------------------------- --- addLocaLDecl5 :: Changer--- addLocaLDecl5 ans lp = do---   let---       doAddLocal = do---          [s1,d1,d2,d3] <- hsDecls lp----          transferEntryDPT d2 d3----          (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m _decls -> do---            return ([d2],Nothing)---          replaceDecls lp [s1,d1',d3]----   (lp',(ans',_),_w) <- runTransformT ans doAddLocal---   -- putStrLn $ "log\n" ++ intercalate "\n" _w---   return (ans',lp')- addLocaLDecl5 :: Changer addLocaLDecl5 _libdir lp = do   let@@ -652,26 +417,6 @@  -- --------------------------------------------------------------------- --- addLocaLDecl6 :: Changer--- addLocaLDecl6 ans lp = do---   Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "x = 3")---   let declAnns' = setPrecedingLines newDecl 1 4 declAnns---       doAddLocal = do---         [d1,d2] <- hsDecls lp---         balanceComments d1 d2----         let GHC.L _ (GHC.ValD _ (GHC.FunBind _ _ (GHC.MG _ (GHC.L _ [m1,m2]) _) _)) = d1---         balanceComments m1 m2----         (d1',_) <- modifyValD (GHC.getLoc m1) d1 $ \_m decls -> do---            return ((newDecl : decls),Nothing)---         replaceDecls lp [d1', d2]----   (lp',(ans',_),_w) <- runTransformT (mergeAnns ans declAnns') doAddLocal---   -- putStrLn $ "log:\n" ++ intercalate "\n" _w---   return (ans',lp')-- addLocaLDecl6 :: Changer addLocaLDecl6 libdir lp = do   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3")@@ -712,24 +457,6 @@  -- --------------------------------------------------------------------- --- rmDecl2 :: Changer--- rmDecl2 ans lp = do---   let---       doRmDecl = do---         let---           go :: GHC.LHsExpr GHC.GhcPs -> Transform (GHC.LHsExpr GHC.GhcPs)---           go e@(GHC.L _ (GHC.HsLet{})) = do---             decs <- hsDecls e---             e' <- replaceDecls e (init decs)---             return e'---           go x = return x----         SYB.everywhereM (SYB.mkM go) lp----   let (lp',(ans',_),_w) = runTransform ans doRmDecl---   -- putStrLn $ "log:\n" ++ intercalate "\n" _w---   return (ans',lp')- rmDecl2 :: Changer rmDecl2 _libdir lp = do   let@@ -750,22 +477,6 @@   return lp' -- --------------------------------------------------------------------- --- rmDecl3 :: Changer--- rmDecl3 ans lp = do---   let---       doRmDecl = do---          [d1,d2] <- hsDecls lp----          (d1',Just sd1) <- modifyValD (GHC.getLoc d1) d1 $ \_m [sd1] -> do---            setPrecedingLinesDeclT sd1 2 0---            return ([],Just sd1)----          replaceDecls lp [d1',sd1,d2]----   (lp',(ans',_),_w) <- runTransformT ans doRmDecl---   -- putStrLn $ "log:\n" ++ intercalate "\n" _w---   return (ans',lp')- rmDecl3 :: Changer rmDecl3 _libdir lp = do   let@@ -784,25 +495,6 @@   return lp' -- --------------------------------------------------------------------- --- rmDecl4 :: Changer--- rmDecl4 ans lp = do---   let---       doRmDecl = do---          [d1] <- hsDecls lp----          (d1',Just sd1) <- modifyValD (GHC.getLoc d1) d1 $ \_m [sd1,sd2] -> do---            -- [sd1,sd2] <- hsDecls d1---            transferEntryDPT sd1 sd2----            setPrecedingLinesDeclT sd1 2 0---            -- d1' <- replaceDecls d1 [sd2]---            return ([sd2],Just sd1)----          replaceDecls lp [d1',sd1]----   (lp',(ans',_),_w) <- runTransformT ans doRmDecl---   return (ans',lp')- rmDecl4 :: Changer rmDecl4 _libdir lp = do   let@@ -824,41 +516,20 @@  -- --------------------------------------------------------------------- --- rmDecl5 :: Changer--- rmDecl5 ans lp = do---   let---       doRmDecl = do---         let---           go :: GHC.HsExpr GHC.GhcPs -> Transform (GHC.HsExpr GHC.GhcPs)---           go (GHC.HsLet _ (GHC.L l lb) expr) = do---             decs <- hsDeclsValBinds lb---             let dec = last decs---             transferEntryDPT (head decs) dec---             lb' <- replaceDeclsValbinds lb [dec]---             return (GHC.HsLet noExt (GHC.L l lb') expr)---           go x = return x----         SYB.everywhereM (SYB.mkM go) lp----   let (lp',(ans',_),_w) = runTransform ans doRmDecl---   -- putStrLn $ "log:" ++ intercalate "\n" _w---   return (ans',lp')- rmDecl5 :: Changer rmDecl5 _libdir lp = do   let       doRmDecl = do         let           go :: HsExpr GhcPs -> Transform (HsExpr GhcPs)-          go (HsLet a lb expr) = do+          go (HsLet a tkLet lb tkIn expr) = do             decs <- hsDeclsValBinds lb             let dec = last decs             -- _ <- transferEntryDPT (head decs) dec             lb' <- replaceDeclsValbinds WithoutWhere lb [dec]-            return (HsLet a lb' expr)+            return (HsLet a tkLet lb' tkIn expr)           go x = return x -        -- everywhereM (mkM go) (makeDeltaAst lp)         everywhereM (mkM go) lp    let (lp',_,_w) = runTransform doRmDecl@@ -867,24 +538,6 @@  -- --------------------------------------------------------------------- --- rmDecl6 :: Changer--- rmDecl6 ans lp = do---   let---       doRmDecl = do---          [d1] <- hsDecls lp----          (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m subDecs -> do---            let (ss1:_sd1:sd2:sds) = subDecs---            transferEntryDPT ss1 sd2----            return (sd2:sds,Nothing)----          replaceDecls lp [d1']----   (lp',(ans',_),_w) <- runTransformT ans doRmDecl---   -- putStrLn $ "log:" ++ intercalate "\n" _w---   return (ans',lp')- rmDecl6 :: Changer rmDecl6 _libdir lp = do   let@@ -904,24 +557,6 @@   return lp' -- --------------------------------------------------------------------- --- rmDecl7 :: Changer--- rmDecl7 ans lp = do---   let---       doRmDecl = do---          tlDecs <- hsDecls lp---          let [s1,d1,d2,d3] = tlDecs----          balanceComments d1 d2---          balanceComments d2 d3----          transferEntryDPT d2 d3----          replaceDecls lp [s1,d1,d3]----   let (lp',(ans',_),_w) = runTransform ans doRmDecl---   -- putStrLn $ "log:" ++ intercalate "\n" _w---   return (ans',lp')- rmDecl7 :: Changer rmDecl7 _libdir lp = do   let@@ -939,17 +574,6 @@   return lp' -- --------------------------------------------------------------------- --- rmTypeSig1 :: Changer--- rmTypeSig1 ans lp = do---   let doRmDecl = do---          tlDecs <- hsDecls lp---          let (s1:d1:d2) = tlDecs---              (GHC.L l (GHC.SigD x1 (GHC.TypeSig x2 names typ))) = s1---              s1' = (GHC.L l (GHC.SigD x1 (GHC.TypeSig x2 (tail names) typ)))---          replaceDecls lp (s1':d1:d2)----   let (lp',(ans',_),_w) = runTransform ans doRmDecl---   return (ans',lp') rmTypeSig1 :: Changer rmTypeSig1 _libdir lp = do   let doRmDecl = do@@ -968,21 +592,6 @@  -- --------------------------------------------------------------------- --- rmTypeSig2 :: Changer--- rmTypeSig2 ans lp = do---   let doRmDecl = do---          tlDecs <- hsDecls lp---          let [d1] = tlDecs----          (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m [s,d] -> do---            transferEntryDPT s d---            return ([d],Nothing)---          replaceDecls lp [d1']----   let (lp',(ans',_),_w) = runTransform ans doRmDecl---   -- putStrLn $ "log:" ++ intercalate "\n" _w---   return (ans',lp')- rmTypeSig2 :: Changer rmTypeSig2 _libdir lp = do   let doRmDecl = do@@ -1000,30 +609,6 @@  -- --------------------------------------------------------------------- --- addHiding1 :: Changer--- addHiding1 ans (GHC.L l p) = do---   let doTransform = do---         l0 <- uniqueSrcSpanT---         l1 <- uniqueSrcSpanT---         l2 <- uniqueSrcSpanT---         let---           [GHC.L li imp1,imp2] = GHC.hsmodImports p---           n1 = GHC.L l1 (GHC.mkVarUnqual (GHC.mkFastString "n1"))---           n2 = GHC.L l2 (GHC.mkVarUnqual (GHC.mkFastString "n2"))---           v1 = GHC.L l1 (GHC.IEVar noExt (GHC.L l1 (GHC.IEName n1)))---           v2 = GHC.L l2 (GHC.IEVar noExt (GHC.L l2 (GHC.IEName n2)))---           impHiding = GHC.L l0 [v1,v2]---           imp1' = imp1 { GHC.ideclHiding = Just (True,impHiding)}---           p' = p { GHC.hsmodImports = [GHC.L li imp1',imp2]}---         addSimpleAnnT impHiding (DP (0,1)) [((G GHC.AnnHiding),DP (0,0)),((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]---         addSimpleAnnT n1        (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]---         addSimpleAnnT v1        (DP (0,0)) [((G GHC.AnnComma),DP (0,0))]---         addSimpleAnnT n2        (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]---         return (GHC.L l p')----   let (lp',(ans',_),_w) = runTransform ans doTransform---   return (ans',lp')- addHiding1 :: Changer addHiding1 _libdir (L l p) = do   let doTransform = do@@ -1052,29 +637,6 @@   return lp' -- --------------------------------------------------------------------- --- addHiding2 :: Changer--- addHiding2 ans (GHC.L l p) = do---   let doTransform = do---         l1 <- uniqueSrcSpanT---         l2 <- uniqueSrcSpanT---         let---           [GHC.L li imp1] = GHC.hsmodImports p---           Just (_,GHC.L lh ns) = GHC.ideclHiding imp1---           n1 = GHC.L l1 (GHC.mkVarUnqual (GHC.mkFastString "n1"))---           n2 = GHC.L l2 (GHC.mkVarUnqual (GHC.mkFastString "n2"))---           v1 = GHC.L l1 (GHC.IEVar noExt (GHC.L l1 (GHC.IEName n1)))---           v2 = GHC.L l2 (GHC.IEVar noExt (GHC.L l2 (GHC.IEName n2)))---           imp1' = imp1 { GHC.ideclHiding = Just (True,GHC.L lh (ns ++ [v1,v2]))}---           p' = p { GHC.hsmodImports = [GHC.L li imp1']}---         addSimpleAnnT n1        (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]---         addSimpleAnnT v1        (DP (0,0)) [((G GHC.AnnComma),DP (0,0))]---         addSimpleAnnT n2        (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]---         addTrailingCommaT (last ns)---         return (GHC.L l p')----   let (lp',(ans',_),_w) = runTransform ans doTransform---   return (ans',lp')- addHiding2 :: Changer addHiding2 _libdir (L l p) = do   let doTransform = do@@ -1103,6 +665,7 @@   let (lp',_,_w) = runTransform doTransform   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp'+ -- ---------------------------------------------------------------------  cloneDecl1 :: Changer

@@ -0,0 +1,7 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedRecordUpdate #-}+{-# LANGUAGE RebindableSyntax #-}++data Foo = Foo {bar :: Foo}++operatorUpdate f = f{(+) = 1}

@@ -0,0 +1,7 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedRecordUpdate #-}+{-# LANGUAGE RebindableSyntax #-}++data Foo = Foo {bar :: Foo}++operatorUpdate f = f{+ = 1}

@@ -0,0 +1,9 @@+module CommentPlacement4 where++data family GMap k :: * -> *++data family Array e++-- data GMap () v = GMapUnit (Maybe v)+--               deriving Show+

@@ -0,0 +1,9 @@+module CommentPlacement5 where++bar :: Foo -> ()+bar a =+  case a of+    GInt -> ()+    -- GBool -> ()+bar _ = ()+

@@ -0,0 +1,27 @@+-- | Checkpoints in the blockchain (every 1000th blocks)++{-# LANGUAGE CPP #-}+module CommentPlacement6 where++#ifndef WITH_TESTNET++--8-----------------------------------------------------------------------------+-- * the real network++theGenesisBlock :: Hash256+theGenesisBlock = 1++--14----------------------------------------------------------------------------++#else++--18----------------------------------------------------------------------------+-- * testnet3++theGenesisBlock :: Hash256+theGenesisBlock = 2++#endif++--26----------------------------------------------------------------------------+

@@ -1,7 +1,7 @@ module Observer1 where -instance HasPdu (ObserverRegistry event) where-  data Pdu (ObserverRegistry event) r where+instance HasPdu Int where+  data Pdu Int r where     --a comment     RegisterObserver :: Int     --b comment

@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedRecordUpdate #-}+{-# LANGUAGE RebindableSyntax #-}++data Foo = Foo {bar :: Foo}++mfoo = fmap (.bar) $ Nothing++baz = (Foo 1).bar++fooplus f n = f{foo = f.bar + n}++nestedFoo f = f.bar.bar.bar.bar.bar++nestedFooUpdate f = f{bar.bar = f.bar} <> f{bar.bar.bar.bar}