ghc-exactprint 1.1.0 → 1.2.0

raw patch · 8 files changed

+91/−1187 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog +2/−0
• ghc-exactprint.cabal +1/−1
• src/Language/Haskell/GHC/ExactPrint.hs +2/−5
• src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs +6/−423
• src/Language/Haskell/GHC/ExactPrint/Transform.hs +31/−420
• src/Language/Haskell/GHC/ExactPrint/Types.hs +2/−105
• src/Language/Haskell/GHC/ExactPrint/Utils.hs +0/−186
• tests/Test/Transform.hs +47/−47

@@ -1,3 +1,5 @@+2021-08-23 v1.2+	* Remove types and functions from previous version, now obsolete 2021-08-23 v1.1 	* Add support for GHC 9.2 rc1, and this version drops support for 	prior GHC versions.

@@ -1,5 +1,5 @@ name:                ghc-exactprint-version:             1.1.0+version:             1.2.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

@@ -1,11 +1,8 @@ -- | @ghc-exactprint@ is a library to manage manipulating Haskell -- source files. There are four components. module Language.Haskell.GHC.ExactPrint-        ( -- * Relativising-          Anns-        , Comment-        , Annotation(..)-        , AnnKey(..)+        ( -- * Types+          Comment          -- * Parsing         , parseModule

@@ -92,8 +92,7 @@ -- enter a new AST element, having a different anchor point. data PrintOptions m a = PrintOptions             {-              epAnn :: !Annotation-            , epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a+              epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a             , epTokenPrint :: String -> m a             , epWhitespacePrint :: String -> m a             , epRigidity :: Rigidity@@ -108,8 +107,7 @@       -> PrintOptions m a printOptions astPrint tokenPrint wsPrint rigidity = PrintOptions              {-               epAnn = annNone-             , epAstPrint = astPrint+               epAstPrint = astPrint              , epWhitespacePrint = wsPrint              , epTokenPrint = tokenPrint              , epRigidity = rigidity@@ -280,9 +278,10 @@         flushComments (getFollowingComments cs)         -- flushComments [] -  let-    st = annNone { annEntryDelta = edp }-  withOffset st (advance edp >> exact a >> mflush)+  -- let+  --   st = annNone+  -- withOffset st (advance edp >> exact a >> mflush)+  (advance edp >> exact a >> mflush)    when (flush == NoFlushComments) $ do     when ((getFollowingComments cs) /= []) $ do@@ -874,13 +873,6 @@     markEpAnn an AnnInstance     mapM_ markAnnotated mov     markAnnotated typ-  -- markAST _ (GHC.DerivDecl _ (GHC.HsWC _ (GHC.HsIB _ typ)) ms mov) = do-  --   mark GHC.AnnDeriving-  --   markMaybe ms-  --   mark GHC.AnnInstance-  --   markMaybe mov-  --   markLocated typ-  --   markTrailingSemi  -- --------------------------------------------------------------------- @@ -1021,21 +1013,7 @@     markAnnotated lhs     markEpAnn' an ra_rest AnnEqual     markAnnotated rhs-  -- markAST l (GHC.HsRule _ ln act mtybndrs termbndrs lhs rhs) = do-  --   markLocated ln-  --   setContext (Set.singleton ExplicitNeverActive) $ markActivation l act --  --   mark GHC.AnnForall-  --   mapM_ markLocated termbndrs-  --   mark GHC.AnnDot--  --   markLocated lhs-  --   mark GHC.AnnEqual-  --   markLocated rhs-  --   inContext (Set.singleton Intercalate) $ mark GHC.AnnSemi-  --   markTrailingSemi- markActivation :: EpAnn a -> (a -> [AddEpAnn]) -> Activation -> Annotated () markActivation an fn act = do   case act of@@ -1100,10 +1078,6 @@ instance ExactPrint (RuleBndr GhcPs) where   getAnnotationEntry = const NoEntryVal -{--  = RuleBndr (XCRuleBndr pass)  (Located (IdP pass))-  | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (HsPatSigType pass)--}   exact (RuleBndr _ ln) = markAnnotated ln   exact (RuleBndrSig an ln (HsPS _ ty)) = do     markEpAnn an AnnOpenP -- "("@@ -1131,7 +1105,6 @@ exactHsFamInstLHS ::       EpAnn [AddEpAnn]    -> LocatedN RdrName-   -- -> Maybe [LHsTyVarBndr () GhcPs]    -> HsOuterTyVarBndrs () GhcPs    -> HsTyPats GhcPs    -> LexicalFixity@@ -1180,12 +1153,6 @@  -- --------------------------------------------------------------------- --- instance ExactPrint [LHsTyVarBndr () GhcPs] where---   getAnnotationEntry = const NoEntryVal---   exact bs = mapM_ markAnnotated bs---- ---------------------------------------------------------------------- instance ExactPrint (ClsInstDecl GhcPs) where   getAnnotationEntry cid = fromAnn (fst $ cid_ext cid) @@ -1194,10 +1161,6 @@                      , cid_sigs = sigs, cid_tyfam_insts = ats                      , cid_overlap_mode = mbOverlap                      , cid_datafam_insts = adts })-      -- | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part-      -- = top_matter--      -- | otherwise       -- Laid out       = do           top_matter           markEpAnn an AnnWhere@@ -1217,10 +1180,6 @@           mapM_ markAnnotated mbOverlap           markAnnotated inst_ty           markEpAnn an AnnWhere -- Optional-          -- text "instance" <+> ppOverlapPragma mbOverlap-          --                                    <+> ppr inst_ty-          -- markEpAnn an AnnOpenC -- Optional '{'-          -- markEpAnn an AnnCloseC -- Optional '}'  -- --------------------------------------------------------------------- @@ -1314,23 +1273,7 @@         markEpAnn an AnnWhere         markAnnotated mg -    -- case dir of-    --   GHC.ImplicitBidirectional -> mark GHC.AnnEqual-    --   _                         -> mark GHC.AnnLarrow -    -- markLocated def-    -- case dir of-    --   GHC.Unidirectional           -> return ()-    --   GHC.ImplicitBidirectional    -> return ()-    --   GHC.ExplicitBidirectional mg -> do-    --     mark GHC.AnnWhere-    --     mark GHC.AnnOpenC  -- '{'-    --     markMatchGroup l mg-    --     mark GHC.AnnCloseC -- '}'--    -- markTrailingSemi-- -- ---------------------------------------------------------------------  instance ExactPrint (RecordPatSynField GhcPs) where@@ -1342,7 +1285,6 @@ instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where   getAnnotationEntry (Match ann _ _ _) = fromAnn ann -  -- exact match@(Match EpAnnNotUsed _ _ _) = withPpr match   exact (Match an mctxt pats grhss) = do     exactMatch (Match an mctxt pats grhss) @@ -1351,7 +1293,6 @@ instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where   getAnnotationEntry (Match ann _ _ _) = fromAnn ann -  -- exact match@(Match EpAnnNotUsed _ _ _) = withPpr match   exact (Match an mctxt pats grhss) = do     exactMatch (Match an mctxt pats grhss) @@ -1548,8 +1489,6 @@   getAnnotationEntry (SCCFunSig a _ _ _) = fromAnn a   getAnnotationEntry (CompleteMatchSig a _ _ _) = fromAnn a --- instance Annotate (Sig GhcPs) where-   exact (TypeSig an vars ty)  = exactVarSig an vars ty    exact (PatSynSig an lns typ) = do@@ -1562,26 +1501,20 @@     | is_deflt  = markLocatedAAL an asRest AnnDefault >> exactVarSig an vars ty     | otherwise = exactVarSig an vars ty ---   markAST _ (IdSig {}) =---     traceM "warning: Introduced after renaming"-   exact (FixSig an (FixitySig _ names (Fixity src v fdir))) = do     let fixstr = case fdir of          InfixL -> "infixl"          InfixR -> "infixr"          InfixN -> "infix"     markLocatedAALS an id AnnInfix (Just fixstr)---     markSourceText src (show v)     markLocatedAALS an id AnnVal (Just (sourceTextToString src (show v)))     markAnnotated names     exact (InlineSig an ln inl) = do     markAnnOpen an (inl_src inl) "{-# INLINE"-    -- markActivation l (inl_act inl)     markActivation an id (inl_act inl)     markAnnotated ln-    -- markWithString AnnClose "#-}" -- '#-}'     debugM $ "InlineSig:an=" ++ showAst an     p <- getPosP     debugM $ "InlineSig: p=" ++ show p@@ -1602,24 +1535,12 @@     markAnnotated typ     markLocatedAALS an id AnnClose (Just "#-}") ---   markAST _ (SpecInstSig _ src typ) = do---     markAnnOpen src "{-# SPECIALISE"---     mark AnnInstance---     markLHsSigType typ---     markWithString AnnClose "#-}" -- '#-}'---     markTrailingSemi    exact (MinimalSig an src formula) = do     markAnnOpen an src "{-# MINIMAL"     markAnnotated formula     markLocatedAALS an id AnnClose (Just "#-}") ---   markAST _ (MinimalSig _ src formula) = do---     markAnnOpen src "{-# MINIMAL"---     markLocated formula---     markWithString AnnClose "#-}"---     markTrailingSemi-   exact (SCCFunSig an src ln ml) = do     markAnnOpen an src "{-# SCC"     markAnnotated ln@@ -1648,27 +1569,6 @@  -- --------------------------------------------------------------------- --- instance ExactPrint (FixitySig GhcPs) where---   getAnnotationEntry = const NoEntryVal----   exact (FixitySig an names (Fixity src v fdir)) = do---     let fixstr = case fdir of---          InfixL -> "infixl"---          InfixR -> "infixr"---          InfixN -> "infix"---     markAnnotated names---     markLocatedAALS an id AnnInfix (Just fixstr)--- --   markAST _ (FixSig _ (FixitySig _ lns (Fixity src v fdir))) = do--- --     let fixstr = case fdir of--- --          InfixL -> "infixl"--- --          InfixR -> "infixr"--- --          InfixN -> "infix"--- --     markWithString AnnInfix fixstr--- --     markSourceText src (show v)--- --     setContext (Set.singleton InfixOp) $ markListIntercalate lns--- --     markTrailingSemi--- ---------------------------------------------------------------------- instance ExactPrint (StandaloneKindSig GhcPs) where   getAnnotationEntry (StandaloneKindSig an _ _) = fromAnn an @@ -1717,31 +1617,10 @@   exact (BF.And ls) = do     markAnnotated ls   exact (BF.Parens x)  = do-    -- mark AnnOpenP -- '('     markAnnotated x-    -- mark AnnCloseP -- ')' --- instance  (Annotate name) => Annotate (GHC.BooleanFormula (GHC.Located name)) where---   markAST _ (GHC.Var x)  = do---     setContext (Set.singleton PrefixOp) $ markLocated x---     inContext (Set.fromList [AddVbar]) $ mark GHC.AnnVbar---     inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma---   markAST _ (GHC.Or ls)  = markListIntercalateWithFunLevelCtx markLocated 2 AddVbar ls---   markAST _ (GHC.And ls) = do---     markListIntercalateWithFunLevel markLocated 2 ls---     inContext (Set.fromList [AddVbar]) $ mark GHC.AnnVbar---     inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma---   markAST _ (GHC.Parens x)  = do---     mark GHC.AnnOpenP -- '('---     markLocated x---     mark GHC.AnnCloseP -- ')'---     inContext (Set.fromList [AddVbar]) $ mark GHC.AnnVbar---     inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma- -- --------------------------------------------------------------------- --- instance ExactPrint (LHsSigWcType GhcPs) where--- instance ExactPrint (HsWildCardBndrs GhcPs (LHsSigType GhcPs)) where instance (ExactPrint body) => ExactPrint (HsWildCardBndrs GhcPs body) where   getAnnotationEntry = const NoEntryVal   exact (HsWC _ ty) = markAnnotated ty@@ -1759,7 +1638,6 @@     markLocatedAA an ga_sep -- Mark the matchSeparator for these GRHSs     debugM $ "GRHS after matchSeparator"     markAnnotated expr-    -- markLocatedAA an ga_sep  instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where   getAnnotationEntry (GRHS ann _ _) = fromAnn ann@@ -1843,12 +1721,6 @@   exact (HsLit _an lit) = withPpr lit   exact (HsLam _ (MG _ (L _ [match]) _)) = do     markAnnotated match-      -- markExpr _ (HsLam _ (MG _ (L _ [match]) _)) = do-      --   setContext (Set.singleton LambdaExpr) $ do-      --   -- TODO: Change this, HsLam binds do not need obey layout rules.-      --   --       And will only ever have a single match-      --     markLocated match-      -- markExpr _ (HsLam _ _) = error $ "HsLam with other than one match"   exact (HsLam _ _) = error $ "HsLam with other than one match"    exact (HsLamCase an mg) = do@@ -1900,7 +1772,6 @@     debugM $ "ExplicitTuple done"    exact (ExplicitSum an _alt _arity expr) = do-    -- markEpAnn an AnnOpenPH     markAnnKw an aesOpen AnnOpenPH     markAnnKwAll an aesBarsBefore AnnVbar     markAnnotated expr@@ -1916,7 +1787,6 @@     setLayoutBoth $ markAnnotated alts     markEpAnn' an hsCaseAnnsRest AnnCloseC -  -- exact x@(HsCase EpAnnNotUsed   _ _) = withPpr x   exact (HsIf an e1 e2 e3) = do     markAnnKw an aiIf AnnIf     markAnnotated e1@@ -2090,35 +1960,7 @@     markLocatedAALS an apr_rest AnnValStr (Just txt) -- optional     markAnnCloseP an -      -- markExpr _ (GHC.HsPragE _ prag e) = do-      --   case prag of-      --     (GHC.HsPragSCC _ src csFStr) -> do-      --       markAnnOpen src "{-# SCC"-      --       let txt = sourceTextToString (GHC.sl_st csFStr) (GHC.unpackFS $ GHC.sl_fs csFStr)-      --       markWithStringOptional GHC.AnnVal    txt-      --       markWithString         GHC.AnnValStr txt-      --       markWithString GHC.AnnClose "#-}"-      --       markLocated e -      --     (GHC.HsPragTick _ src (str,(v1,v2),(v3,v4)) ((s1,s2),(s3,s4))) -> do-      --       -- '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'-      --       markAnnOpen src  "{-# GENERATED"-      --       markOffsetWithString GHC.AnnVal 0 (stringLiteralToString str) -- STRING--      --       let-      --         markOne n  v GHC.NoSourceText   = markOffsetWithString GHC.AnnVal n (show v)-      --         markOne n _v (GHC.SourceText s) = markOffsetWithString GHC.AnnVal n s--      --       markOne  1 v1 s1 -- INTEGER-      --       markOffset GHC.AnnColon 0 -- ':'-      --       markOne  2 v2 s2 -- INTEGER-      --       mark   GHC.AnnMinus   -- '-'-      --       markOne  3 v3 s3 -- INTEGER-      --       markOffset GHC.AnnColon 1 -- ':'-      --       markOne  4 v4 s4 -- INTEGER-      --       markWithString   GHC.AnnClose  "#-}"-      --       markLocated e- -- ---------------------------------------------------------------------  instance ExactPrint (HsSplice GhcPs) where@@ -2131,18 +1973,10 @@     markEpAnn an AnnDollarDollar     markAnnotated e -  -- = ppr_splice (text "$$") n e empty-  -- exact (HsTypedSplice _ BareSplice _ _ )-  -- = panic "Bare typed splice"  -- impossible   exact (HsUntypedSplice an decoration _n b) = do     when (decoration == DollarSplice) $ markEpAnn an AnnDollar     markAnnotated b -  -- exact (HsUntypedSplice _ DollarSplice n e)-  -- = ppr_splice (text "$")  n e empty-  -- exact (HsUntypedSplice _ BareSplice n e)-  -- = ppr_splice empty  n e empty-   exact (HsQuasiQuote _ _ q ss fs) = do     -- The quasiquote string does not honour layout offsets. Store     -- the colOffset for now.@@ -2157,8 +1991,6 @@     p <- getPosP     debugM $ "HsQuasiQuote:after:(p,ss)=" ++ show (p,ss2range ss) -  -- exact (HsSpliced _ _ thing)         = ppr thing-  -- exact (XSplice x)                   = case ghcPass @p of   exact x = error $ "exact HsSplice for:" ++ showAst x  -- ---------------------------------------------------------------------@@ -2190,7 +2022,6 @@  -- --------------------------------------------------------------------- --- instance (ExactPrint body) => ExactPrint (HsRecField GhcPs body) where instance (ExactPrint body)     => ExactPrint (HsRecField' (FieldOcc GhcPs) body) where   getAnnotationEntry x = fromAnn (hsRecFieldAnn x)@@ -2217,11 +2048,8 @@  -- --------------------------------------------------------------------- --- instance ExactPrint (HsRecUpdField GhcPs ) where instance (ExactPrint (LocatedA body))     => ExactPrint (HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA body)) where--- instance (ExactPrint body)-    -- => ExactPrint (HsRecField' (AmbiguousFieldOcc GhcPs) body) where   getAnnotationEntry x = fromAnn (hsRecFieldAnn x)   exact (HsRecField an f arg isPun) = do     debugM $ "HsRecUpdField"@@ -2354,14 +2182,6 @@     markAnnKw an alIn AnnIn     markAnnotated e ---   markAST _ (GHC.HsCmdLet _ (GHC.L _ binds) e) = do---     mark GHC.AnnLet---     markOptional GHC.AnnOpenC---     markLocalBindsWithLayout binds---     markOptional GHC.AnnCloseC---     mark GHC.AnnIn---     markLocated e-   exact (HsCmdDo an es) = do     debugM $ "HsCmdDo"     markEpAnn' an al_rest AnnDo@@ -2371,12 +2191,6 @@  -- --------------------------------------------------------------------- --- instance ExactPrint (CmdLStmt GhcPs) where---   getAnnotationEntry = const NoEntryVal---   exact (L _ a) = markAnnotated a---- ---------------------------------------------------------------------- instance (   ExactPrint (LocatedA (body GhcPs)),                  Anno (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ~ SrcSpanAnnA,@@ -2423,82 +2237,18 @@     debugM $ "ParStmt"     markAnnotated pbs -  -- markAST l (GHC.ParStmt _ pbs _ _) = do-  --   -- Within a given parallel list comprehension,one of the sections to be done-  --   -- in parallel. It is a normal list comprehension, so has a list of-  --   -- ParStmtBlock, one for each part of the sub- list comprehension --  --   ifInContext (Set.singleton Intercalate)-  --     (--  --     unsetContext Intercalate $-  --       markListWithContextsFunction-  --         (LC (Set.singleton Intercalate)  -- only-  --             Set.empty -- first-  --             Set.empty -- middle-  --             (Set.singleton Intercalate) -- last-  --         ) (markAST l) pbs-  --        )-  --     (-  --     unsetContext Intercalate $-  --       markListWithContextsFunction-  --         (LC Set.empty -- only-  --             (Set.fromList [AddVbar]) -- first-  --             (Set.fromList [AddVbar]) -- middle-  --             Set.empty                -- last-  --         ) (markAST l) pbs-  --      )-  --   markTrailingSemi----- pprStmt (TransStmt { trS_stmts = stmts, trS_by = by---                    , trS_using = using, trS_form = form })---   = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])-   exact (TransStmt an form stmts _b using by _ _ _) = do     debugM $ "TransStmt"     markAnnotated stmts     exactTransStmt an by using form -  -- markAST _ (GHC.TransStmt _ form stmts _b using by _ _ _) = do-  --   setContext (Set.singleton Intercalate) $ mapM_ markLocated stmts-  --   case form of-  --     GHC.ThenForm -> do-  --       mark GHC.AnnThen-  --       unsetContext Intercalate $ markLocated using-  --       case by of-  --         Just b -> do-  --           mark GHC.AnnBy-  --           unsetContext Intercalate $ markLocated b-  --         Nothing -> return ()-  --     GHC.GroupForm -> do-  --       mark GHC.AnnThen-  --       mark GHC.AnnGroup-  --       case by of-  --         Just b -> mark GHC.AnnBy >> markLocated b-  --         Nothing -> return ()-  --       mark GHC.AnnUsing-  --       markLocated using-  --   inContext (Set.singleton AddVbar)     $ mark GHC.AnnVbar-  --   inContext (Set.singleton Intercalate) $ mark GHC.AnnComma-  --   markTrailingSemi    exact (RecStmt an stmts _ _ _ _ _) = do     debugM $ "RecStmt"     markLocatedAAL an al_rest AnnRec     markAnnList True an (markAnnotated stmts) -  -- markAST _ (GHC.RecStmt _ stmts _ _ _ _ _) = do-  --   mark GHC.AnnRec-  --   markOptional GHC.AnnOpenC-  --   markInside GHC.AnnSemi-  --   markListWithLayout stmts-  --   markOptional GHC.AnnCloseC-  --   inContext (Set.singleton AddVbar)     $ mark GHC.AnnVbar-  --   inContext (Set.singleton Intercalate) $ mark GHC.AnnComma-  --   markTrailingSemi-   -- exact x = error $ "exact CmdLStmt for:" ++ showAst x   -- exact x = error $ "exact CmdLStmt for:" @@ -2659,26 +2409,12 @@                      KindSig  _ kind    -> markEpAnn an AnnDcolon >> markAnnotated kind                      TyVarSig _ tv_bndr -> markEpAnn an AnnEqual >> markAnnotated tv_bndr -      -- exact_inj = case mb_inj of-      --               Just (L _ (InjectivityAnn _ lhs rhs)) ->-      --                 hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]-      --               Nothing -> empty-      -- (pp_where, pp_eqns) = case info of-      --   ClosedTypeFamily mb_eqns ->-      --     ( text "where"-      --     , case mb_eqns of-      --         Nothing   -> text ".."-      --         Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )-      --   _ -> (empty, empty)  exactFlavour :: EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> EPP () exactFlavour an DataFamily            = markEpAnn an AnnData exactFlavour an OpenTypeFamily        = markEpAnn an AnnType exactFlavour an (ClosedTypeFamily {}) = markEpAnn an AnnType --- instance Outputable (FamilyInfo pass) where---   ppr info = pprFlavour info <+> text "family"- -- ---------------------------------------------------------------------  data DataDefnWithContext@@ -2733,29 +2469,21 @@     exact_tyvars :: [LHsTyVarBndr () GhcPs] -> EPP ()     exact_tyvars (varl:varsr)       | fixity == Infix && length varsr > 1 = do-         -- = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)-         --        , (ppr.unLoc) (head varsr), char ')'-         --        , hsep (map (ppr.unLoc) (tail vaprsr))]           markAnnotated varl           markAnnotated thing           markAnnotated (head varsr)           markAnnotated (tail varsr)           return ()       | fixity == Infix = do-         -- = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)-         -- , hsep (map (ppr.unLoc) varsr)]           markAnnotated varl           markAnnotated thing           markAnnotated varsr           return ()       | otherwise = do-          -- hsep [ pprPrefixOcc (unLoc thing)-          --      , hsep (map (ppr.unLoc) (varl:varsr))]           markAnnotated thing           mapM_ markAnnotated (varl:varsr)           return ()     exact_tyvars [] = do-      -- pprPrefixOcc (unLoc thing)       markAnnotated thing   mapM_ markAnnotated context   exact_tyvars tyvars@@ -2769,9 +2497,6 @@     markAnnotated lhs     markEpAnn an AnnRarrow     mapM_ markAnnotated rhs-    --               Just (L _ (InjectivityAnn _ lhs rhs)) ->-    --                 hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]-    --               Nothing -> empty  -- --------------------------------------------------------------------- @@ -2840,7 +2565,6 @@    exact (HsQualTy _ ctxt ty) = do     markAnnotated ctxt-    -- markEpAnn an AnnDarrow     markAnnotated ty   exact (HsTyVar an promoted name) = do     when (promoted == IsPromoted) $ markEpAnn an AnnSimpleQuote@@ -2946,10 +2670,6 @@   exact (HsDerivingClause { deriv_clause_ext      = an                           , deriv_clause_strategy = dcs                           , deriv_clause_tys      = dct }) = do-    -- = hsep [ text "deriving"-    --        , pp_strat_before-    --        , pp_dct dct-    --        , pp_strat_after ]     markEpAnn an AnnDeriving     exact_strat_before     markAnnotated dct@@ -2990,10 +2710,6 @@    exact (L (SrcSpanAnn EpAnnNotUsed _) a) = markAnnotated a   exact (L (SrcSpanAnn (EpAnn _ (AnnContext ma opens closes) _) _) a) = do-    -- case ma of-    --   Just (UnicodeSyntax, rs) -> markKw' AnnDarrowU rs-    --   Just (NormalSyntax,  rs) -> markKw' AnnDarrow  rs-    --   Nothing -> pure ()     mapM_ (markKwA AnnOpenP) (sort opens)     markAnnotated a     mapM_ (markKwA AnnCloseP) (sort closes)@@ -3009,7 +2725,6 @@    exact (DctSingle _ ty) = markAnnotated ty   exact (DctMulti _ tys) = do-    -- parens (interpp'SP tys)     markAnnotated tys  -- ---------------------------------------------------------------------@@ -3088,14 +2803,10 @@ exact_condecls :: EpAnn [AddEpAnn] -> [LConDecl GhcPs] -> EPP () exact_condecls an cs   | gadt_syntax                  -- In GADT syntax-  -- = hang (text "where") 2 (vcat (map ppr cs))   = do-      -- printStringAdvance "exact_condecls:gadt"       mapM_ markAnnotated cs   | otherwise                    -- In H98 syntax-  -- = equals <+> sep (punctuate (text " |") (map ppr cs))   = do-      -- printStringAdvance "exact_condecls:not gadt"       markEpAnn an AnnEqual       mapM_ markAnnotated cs   where@@ -3118,22 +2829,15 @@                     , con_mb_cxt = mcxt                     , con_args = args                     , con_doc = doc }) = do-    -- = sep [ ppr_mbDoc doc-    --       , pprHsForAll (mkHsForAllInvisTele ex_tvs) mcxt-    --       , ppr_details args ]     mapM_ markAnnotated doc     when has_forall $ markEpAnn an AnnForall     mapM_ markAnnotated ex_tvs     when has_forall $ markEpAnn an AnnDot-    -- exactHsForall (mkHsForAllInvisTele ex_tvs) mcxt     mapM_ markAnnotated mcxt     when (isJust mcxt) $ markEpAnn an AnnDarrow      exact_details args -    -- case args of-    --   InfixCon _ _ -> return ()-    --   _ -> markAnnotated con     where     --   -- In ppr_details: let's not print the multiplicities (they are always 1, by     --   -- definition) as they do not appear in an actual declaration.@@ -3160,17 +2864,12 @@     mapM_ markAnnotated cons     markEpAnn an AnnDcolon     annotationsToComments (epAnnAnns an)  [AnnOpenP, AnnCloseP]-    -- when has_forall $ markEpAnn an AnnForall     markAnnotated bndrs-    -- mapM_ markAnnotated qvars-    -- when has_forall $ markEpAnn an AnnDot     mapM_ markAnnotated mcxt     when (isJust mcxt) $ markEpAnn an AnnDarrow-    -- mapM_ markAnnotated args     case args of         (PrefixConGADT args') -> mapM_ markScaled args'         (RecConGADT fields)   -> markAnnotated fields-          -- mapM_ markAnnotated (unLoc fields)     markAnnotated res_ty  -- ---------------------------------------------------------------------@@ -3230,12 +2929,6 @@  -- --------------------------------------------------------------------- --- instance ExactPrint (LHsContext GhcPs) where---   getAnnotationEntry (L (SrcSpanAnn ann _) _) = fromAnn ann---   exact = withPpr---- ---------------------------------------------------------------------- instance ExactPrint (LocatedP CType) where   getAnnotationEntry = entryFromLocatedA @@ -3389,23 +3082,8 @@     printStringAtAA r "type"     markAnnotated n --- markIEWrapped :: EpAnn -> LIEWrappedName RdrName -> EPP ()--- markIEWrapped an (L _ (IEName n))---   = markAnnotated n--- markIEWrapped an (L _ (IEPattern n))---   = markEpAnn an AnnPattern >> markAnnotated n--- markIEWrapped an (L _ (IEType n))---   = markEpAnn an AnnType    >> markAnnotated n- -- --------------------------------------------------------------------- --- instance ExactPrint (LocatedA (Pat GhcPs)) where---   -- getAnnotationEntry (L (SrcSpanAnn ann _) _) = fromAnn ann---   getAnnotationEntry = entryFromLocatedA---   exact (L _ a) = do---     debugM $ "exact:LPat:" ++ showPprUnsafe a---     markAnnotated a- instance ExactPrint (Pat GhcPs) where   getAnnotationEntry (WildPat _)              = NoEntryVal   getAnnotationEntry (VarPat _ _)             = NoEntryVal@@ -3609,36 +3287,6 @@   p' <- getPosP   debugM $ "printQueuedComment: (p,p',dp,colOffset,undelta)=" ++ show (p,p',dp,colOffset,undelta p dp colOffset) -{---- Print version-printQueuedComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()-printQueuedComment Comment{commentContents} dp = do-  p <- getPos-  colOffset <- getLayoutOffset-  let (dr,dc) = undelta (0,0) dp colOffset-  -- do not lose comments against the left margin-  when (isGoodDelta (DP (dr,max 0 dc))) $-    printCommentAt (undelta p dp colOffset) commentContents---}---- ------------------------------------------------------------------------- withContext :: (Monad m, Monoid w)---             => [(KeywordId, DeltaPos)]---             -> Annotation---             -> EP w m a -> EP w m a--- withContext kds an x = withKds kds (withOffset an x)---- --------------------------------------------------------------------------- | Given an annotation associated with a specific SrcSpan,--- determines a new offset relative to the previous offset----withOffset :: (Monad m, Monoid w) => Annotation -> (EP w m a -> EP w m a)-withOffset a =-  local (\s -> s { epAnn = a })- ------------------------------------------------------------------------  setLayoutBoth :: (Monad m, Monoid w) => EP w m () -> EP w m ()@@ -3739,37 +3387,7 @@   -- -------------------------------------------------------------------------------------------------------------------------------------------------- |First move to the given location, then call exactP--- exactPC :: (Data ast, Monad m, Monoid w) => GHC.Located ast -> EP w m a -> EP w m a--- exactPC :: (Data ast, Data (GHC.SrcSpanLess ast), GHC.HasSrcSpan ast, Monad m, Monoid w)--- exactPC :: (Data ast, Monad m, Monoid w) => GHC.Located ast -> EP w m a -> EP w m a--- exactPC ast action =---     do---       return () `debug` ("exactPC entered for:" ++ show (mkAnnKey ast))---       ma <- getAndRemoveAnnotation ast---       let an@Ann{ annEntryDelta=edp---                 , annPriorComments=comments---                 , annFollowingComments=fcomments---                 , annsDP=kds---                 } = fromMaybe annNone ma---       PrintOptions{epAstPrint} <- ask---       r <- withContext kds an---        (mapM_ (uncurry printQueuedComment) comments---        >> advance edp---        >> censorM (epAstPrint ast) action---        <* mapM_ (uncurry printQueuedComment) fcomments)---       return r `debug` ("leaving exactPCfor:" ++ show (mkAnnKey ast)) --- censorM :: (Monoid w, Monad m) => (w -> m w) -> EP w m a -> EP w m a--- censorM f m = passM (liftM (\x -> (x,f)) m)---- passM :: (Monad m) => EP w m (a, w -> m w) -> EP w m a--- passM m = RWST $ \r s -> do---       ~((a, f),s', EPWriter w) <- runRWST m r s---       w' <- f w---       return (a, s', EPWriter w')- advance :: (Monad m, Monoid w) => DeltaPos -> EP w m () advance dp = do   p <- getPosP@@ -3777,15 +3395,6 @@   debugM $ "advance:(p,dp,colOffset,ws)=" ++ show (p,dp,colOffset,undelta p dp colOffset)   printWhitespace (undelta p dp colOffset) -{--Version from Print.advance-advance :: (Monad m, Monoid w) => DeltaPos -> EP w m ()-advance cl = do-  p <- getPos-  colOffset <- getLayoutOffset-  printWhitespace (undelta p cl colOffset)--}- -- ---------------------------------------------------------------------  adjustDeltaForOffsetM :: DeltaPos -> EPP DeltaPos@@ -3823,32 +3432,6 @@   if not layout && c == 0     then lift (epWhitespacePrint str) >>= \s -> tell EPWriter { output = s}     else lift (epTokenPrint      str) >>= \s -> tell EPWriter { output = s}---{----- Print.printString-printString :: (Monad m, Monoid w) => Bool -> String -> EP w m ()-printString layout str = do-  EPState{epPos = (_,c), epMarkLayout} <- get-  PrintOptions{epTokenPrint, epWhitespacePrint} <- ask-  when (epMarkLayout && layout) $-    modify (\s -> s { epLHS = LayoutStartCol c, epMarkLayout = False } )--  -- Advance position, taking care of any newlines in the string-  let strDP@(DP (cr,_cc)) = dpFromString str-  p <- getPos-  colOffset <- getLayoutOffset-  if cr == 0-    then setPos (undelta p strDP colOffset)-    else setPos (undelta p strDP 1)--  ---  if not layout && c == 0-    then lift (epWhitespacePrint str) >>= \s -> tell EPWriter { output = s}-    else lift (epTokenPrint      str) >>= \s -> tell EPWriter { output = s}---}  -------------------------------------------------------- 

@@ -31,26 +31,11 @@         -- * Transform monad operations         , logTr         , logDataWithAnnsTr-        , getAnnsT, putAnnsT, modifyAnnsT         , uniqueSrcSpanT -        , cloneT-        , graftT--        , getEntryDPT-        , setEntryDPT-        , transferEntryDPT-        , setPrecedingLinesDeclT-        , setPrecedingLinesT-        , addSimpleAnnT-        , addTrailingCommaT-        , removeTrailingCommaT-         -- ** Managing declarations, in Transform monad         , HasTransform (..)         , HasDecls (..)-        , hasDeclsSybTransform-        , hsDeclsGeneric         , hsDeclsPatBind, hsDeclsPatBindD         , replaceDeclsPatBind, replaceDeclsPatBindD         , modifyDeclsT@@ -79,8 +64,6 @@         , balanceComments         , balanceCommentsList         , balanceCommentsList'-        , balanceTrailingComments-        , moveTrailingComments         , anchorEof          -- ** Managing lists, pure functions@@ -93,19 +76,11 @@         , isUniqueSrcSpan          -- * Pure functions-        , mergeAnns-        , mergeAnnList-        , setPrecedingLinesDecl-        , setPrecedingLines-        , getEntryDP         , setEntryDP-        , setEntryDP'         , transferEntryDP         , transferEntryDP'-        , addTrailingComma         , wrapSig, wrapDecl         , decl2Sig, decl2Bind-        , deltaAnchor         ) where  import Language.Haskell.GHC.ExactPrint.Types@@ -119,15 +94,10 @@ import GHC.Data.FastString  import Data.Generics--- import Data.Data-import Data.List (sort, sortBy, find)-import Data.Maybe--import qualified Data.Map as Map+import Data.List (sort, sortBy)  import Data.Functor.Identity import Control.Monad.State-import Control.Monad.Writer   ------------------------------------------------------------------------------@@ -138,11 +108,11 @@ type Transform = TransformT Identity  -- |Monad transformer version of 'Transform' monad-newtype TransformT m a = TransformT { unTransformT :: RWST () [String] (Anns,Int) m a }+newtype TransformT m a = TransformT { unTransformT :: RWST () [String] Int m a }                 deriving (Monad,Applicative,Functor                          ,MonadReader ()                          ,MonadWriter [String]-                         ,MonadState (Anns,Int)+                         ,MonadState Int                          ,MonadTrans                          ) @@ -151,21 +121,21 @@  -- | Run a transformation in the 'Transform' monad, returning the updated -- annotations and any logging generated via 'logTr'-runTransform :: Anns -> Transform a -> (a,(Anns,Int),[String])-runTransform ans f = runTransformFrom 0 ans f+runTransform :: Transform a -> (a,Int,[String])+runTransform f = runTransformFrom 0 f -runTransformT :: Anns -> TransformT m a -> m (a,(Anns,Int),[String])-runTransformT ans f = runTransformFromT 0 ans f+runTransformT :: TransformT m a -> m (a,Int,[String])+runTransformT f = runTransformFromT 0 f  -- | Run a transformation in the 'Transform' monad, returning the updated -- annotations and any logging generated via 'logTr', allocating any new -- SrcSpans from the provided initial value.-runTransformFrom :: Int -> Anns -> Transform a -> (a,(Anns,Int),[String])-runTransformFrom seed ans f = runRWS (unTransformT f) () (ans,seed)+runTransformFrom :: Int -> Transform a -> (a,Int,[String])+runTransformFrom seed f = runRWS (unTransformT f) () seed  -- |Run a monad transformer stack for the 'TransformT' monad transformer-runTransformFromT :: Int -> Anns -> TransformT m a -> m (a,(Anns,Int),[String])-runTransformFromT seed ans f = runRWST (unTransformT f) () (ans,seed)+runTransformFromT :: Int -> TransformT m a -> m (a,Int,[String])+runTransformFromT seed f = runRWST (unTransformT f) () seed  -- | Change inner monad of 'TransformT'. hoistTransform :: (forall x. m x -> n x) -> TransformT m a -> TransformT n a@@ -181,31 +151,14 @@ logDataWithAnnsTr str ast = do   logTr $ str ++ showAst ast --- |Access the 'Anns' being modified in this transformation-getAnnsT :: (Monad m) => TransformT m Anns-getAnnsT = gets fst---- |Replace the 'Anns' after any changes-putAnnsT :: (Monad m) => Anns -> TransformT m ()-putAnnsT ans = do-  (_,col) <- get-  put (ans,col)---- |Change the stored 'Anns'-modifyAnnsT :: (Monad m) => (Anns -> Anns) -> TransformT m ()-modifyAnnsT f = do-  ans <- getAnnsT-  putAnnsT (f ans)- -- --------------------------------------------------------------------- --- |Once we have 'Anns', a 'SrcSpan' is used purely as part of an 'AnnKey'--- to index into the 'Anns'. If we need to add new elements to the AST, they--- need their own 'SrcSpan' for this.+-- |If we need to add new elements to the AST, they need their own+-- 'SrcSpan' for this. uniqueSrcSpanT :: (Monad m) => TransformT m SrcSpan uniqueSrcSpanT = do-  (an,col) <- get-  put (an,col + 1 )+  col <- get+  put (col + 1 )   let pos = mkSrcLoc (mkFastString "ghc-exactprint") (-1) col   return $ mkSrcSpan pos pos @@ -218,44 +171,7 @@ srcSpanStartLine' _ = 0  -- ------------------------------------------------------------------------ |Make a copy of an AST element, replacing the existing SrcSpans with new--- ones, and duplicating the matching annotations.-cloneT :: (Data a,Monad m) => a -> TransformT m (a, [(SrcSpan, SrcSpan)])-cloneT ast = do-  runWriterT $ everywhereM (return `ext2M` replaceLocated) ast-  where-    replaceLocated :: forall loc a m. (Typeable loc,Data a,Monad m)-                    => (GenLocated loc a) -> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a)-    replaceLocated (L l t) = do-      case cast l :: Maybe SrcSpan of-        Just ss -> do-          newSpan <- lift uniqueSrcSpanT-          lift $ modifyAnnsT (\anns -> case Map.lookup (mkAnnKey (L ss t)) anns of-                                  Nothing -> anns-                                  Just an -> Map.insert (mkAnnKey (L newSpan t)) an anns)-          tell [(ss, newSpan)]-          return $ fromJust . cast  $ L newSpan t-        Nothing -> return (L l t) --- ------------------------------------------------------------------------ |Slightly more general form of cloneT-graftT :: (Data a,Monad m) => Anns -> a -> TransformT m a-graftT origAnns = everywhereM (return `ext2M` replaceLocated)-  where-    replaceLocated :: forall loc a m. (Typeable loc, Data a, Monad m)-                    => GenLocated loc a -> TransformT m (GenLocated loc a)-    replaceLocated (L l t) = do-      case cast l :: Maybe SrcSpan of-        Just ss -> do-          newSpan <- uniqueSrcSpanT-          modifyAnnsT (\anns -> case Map.lookup (mkAnnKey (L ss t)) origAnns of-                                  Nothing -> anns-                                  Just an -> Map.insert (mkAnnKey (L newSpan t)) an anns)-          return $ fromJust $ cast $ L newSpan t-        Nothing -> return (L l t)---- ---------------------------------------------------------------------- -- |If a list has been re-ordered or had items added, capture the new order in -- the appropriate 'AnnSortKey' attached to the 'Annotation' for the list. captureOrder :: [LocatedA b] -> AnnSortKey@@ -279,7 +195,7 @@   where     (l1,_) = ss2pos $ rs $ getLocA de1     (l2,_) = ss2pos $ rs $ getLocA d2-    d2' = setEntryDP' d2 (deltaPos (l2-l1) 0)+    d2' = setEntryDP d2 (deltaPos (l2-l1) 0)  -- --------------------------------------------------------------------- @@ -349,130 +265,31 @@  -- --------------------------------------------------------------------- --- |Create a simple 'Annotation' without comments, and attach it to the first--- parameter.-addSimpleAnnT :: (Data a,Monad m)-              => Located a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()-addSimpleAnnT ast dp kds = do-  let ann = annNone { annEntryDelta = dp-                    , annsDP = kds-                    }-  modifyAnnsT (Map.insert (mkAnnKey ast) ann)---- ------------------------------------------------------------------------- |Add a trailing comma annotation, unless there is already one-addTrailingCommaT :: (Data a,Monad m) => Located a -> TransformT m ()-addTrailingCommaT ast = do-  modifyAnnsT (addTrailingComma ast (SameLine 0))---- ------------------------------------------------------------------------- |Remove a trailing comma annotation, if there is one one-removeTrailingCommaT :: (Data a,Monad m) => Located a -> TransformT m ()-removeTrailingCommaT ast = do-  modifyAnnsT (removeTrailingComma ast)---- ------------------------------------------------------------------------- |'Transform' monad version of 'getEntryDP'-getEntryDPT :: (Data a,Monad m) => Located a -> TransformT m DeltaPos-getEntryDPT ast = do-  anns <- getAnnsT-  return (getEntryDP anns ast)---- ------------------------------------------------------------------------- |'Transform' monad version of 'getEntryDP'-setEntryDPT :: (Monad m) => LocatedA a -> DeltaPos -> TransformT m ()-setEntryDPT ast dp = do-  modifyAnnsT (setEntryDP ast dp)---- ------------------------------------------------------------------------- |'Transform' monad version of 'transferEntryDP'-transferEntryDPT :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA b)-transferEntryDPT _a b = do-  return b-  -- modifyAnnsT (transferEntryDP a b)---- ------------------------------------------------------------------------- |'Transform' monad version of 'setPrecedingLinesDecl'-setPrecedingLinesDeclT :: (Monad m) => LHsDecl GhcPs -> Int -> Int -> TransformT m ()-setPrecedingLinesDeclT ld n c =-  modifyAnnsT (setPrecedingLinesDecl ld n c)---- ------------------------------------------------------------------------- |'Transform' monad version of 'setPrecedingLines'-setPrecedingLinesT ::  (Monad m) => LocatedA a -> Int -> Int -> TransformT m ()-setPrecedingLinesT ld n c =-  modifyAnnsT (setPrecedingLines ld n c)---- ------------------------------------------------------------------------- | Left bias pair union-mergeAnns :: Anns -> Anns -> Anns-mergeAnns-  = Map.union---- |Combine a list of annotations-mergeAnnList :: [Anns] -> Anns-mergeAnnList [] = error "mergeAnnList must have at lease one entry"-mergeAnnList (x:xs) = foldr mergeAnns x xs---- ------------------------------------------------------------------------- |Unwrap a HsDecl and call setPrecedingLines on it--- ++AZ++ TODO: get rid of this, it is a synonym only-setPrecedingLinesDecl :: LHsDecl GhcPs -> Int -> Int -> Anns -> Anns-setPrecedingLinesDecl ld n c ans = setPrecedingLines ld n c ans---- ------------------------------------------------------------------------- | Adjust the entry annotations to provide an `n` line preceding gap-setPrecedingLines :: LocatedA a -> Int -> Int -> Anns -> Anns-setPrecedingLines ast n c anne = setEntryDP ast (deltaPos n c) anne---- ------------------------------------------------------------------------- |Return the true entry 'DeltaPos' from the annotation for a given AST--- element. This is the 'DeltaPos' ignoring any comments.-getEntryDP :: (Data a) => Anns -> Located a -> DeltaPos-getEntryDP anns ast =-  case Map.lookup (mkAnnKey ast) anns of-    Nothing  -> SameLine 0-    Just ann -> annTrueEntryDelta ann---- ---------------------------------------------------------------------- setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs setEntryDPDecl decl@(L _  (ValD x (FunBind a b (MG c (L d ms ) e) f))) dp                    = L l' (ValD x (FunBind a b (MG c (L d ms') e) f))     where-      L l' _ = setEntryDP' decl dp+      L l' _ = setEntryDP decl dp       ms' :: [LMatch GhcPs (LHsExpr GhcPs)]       ms' = case ms of         [] -> []-        (m0':ms0) -> setEntryDP' m0' dp : ms0-setEntryDPDecl d dp = setEntryDP' d dp+        (m0':ms0) -> setEntryDP m0' dp : ms0+setEntryDPDecl d dp = setEntryDP d dp  -- ---------------------------------------------------------------------  -- |Set the true entry 'DeltaPos' from the annotation for a given AST -- element. This is the 'DeltaPos' ignoring any comments.--- setEntryDP' :: (Data a) => LocatedA a -> DeltaPos -> LocatedA a-setEntryDP' :: (Monoid t) => LocatedAn t a -> DeltaPos -> LocatedAn t a-setEntryDP' (L (SrcSpanAnn EpAnnNotUsed l) a) dp+setEntryDP :: (Monoid t) => LocatedAn t a -> DeltaPos -> LocatedAn t a+setEntryDP (L (SrcSpanAnn EpAnnNotUsed l) a) dp   = L (SrcSpanAnn            (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) mempty emptyComments)            l) a-setEntryDP' (L (SrcSpanAnn (EpAnn (Anchor r _) an (EpaComments [])) l) a) dp+setEntryDP (L (SrcSpanAnn (EpAnn (Anchor r _) an (EpaComments [])) l) a) dp   = L (SrcSpanAnn            (EpAnn (Anchor r (MovedAnchor dp)) an (EpaComments []))            l) a-setEntryDP' (L (SrcSpanAnn (EpAnn (Anchor r _) an cs) l) a) dp+setEntryDP (L (SrcSpanAnn (EpAnn (Anchor r _) an cs) l) a) dp   = case sort (priorComments cs) of       [] ->         L (SrcSpanAnn@@ -491,12 +308,7 @@                 -- TODO: this adjustment by 1 happens all over the place. Generalise it                 edp' = if line == 0 then SameLine col                                     else DifferentLine line col-                edp = edp' `debug` ("setEntryDP' :" ++ showGhc (edp', (ss2pos $ anchor $ getLoc lc), r))---- |Set the true entry 'DeltaPos' from the annotation for a given AST--- element. This is the 'DeltaPos' ignoring any comments.-setEntryDP :: LocatedA a -> DeltaPos -> Anns -> Anns-setEntryDP _ast _dp anns = anns+                edp = edp' `debug` ("setEntryDP :" ++ showGhc (edp', (ss2pos $ anchor $ getLoc lc), r))  -- --------------------------------------------------------------------- @@ -508,7 +320,7 @@ -- Set the entry DP for an element coming after an existing keyword annotation setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t setEntryDPFromAnchor _off (EpaDelta _) (L la a) = L la a-setEntryDPFromAnchor  off (EpaSpan anc) ll@(L la _) = setEntryDP' ll dp'+setEntryDPFromAnchor  off (EpaSpan anc) ll@(L la _) = setEntryDP ll dp'   where     r = case la of       (SrcSpanAnn EpAnnNotUsed l) -> realSrcSpan l@@ -556,43 +368,15 @@ pushDeclDP (ValD x (FunBind a b (MG c (L d  ms ) e) f)) dp           = ValD x (FunBind a b (MG c (L d' ms') e) f)     where-      L d' _ = setEntryDP' (L d ms) dp+      L d' _ = setEntryDP (L d ms) dp       ms' :: [LMatch GhcPs (LHsExpr GhcPs)]       ms' = case ms of         [] -> []-        (m0':ms0) -> setEntryDP' m0' dp : ms0+        (m0':ms0) -> setEntryDP m0' dp : ms0 pushDeclDP d _dp = d  -- --------------------------------------------------------------------- -addTrailingComma :: (Data a) => Located a -> DeltaPos -> Anns -> Anns-addTrailingComma a dp anns =-  case Map.lookup (mkAnnKey a) anns of-    Nothing -> anns-    Just an ->-      case find isAnnComma (annsDP an) of-        Nothing -> Map.insert (mkAnnKey a) (an { annsDP = annsDP an ++ [(G AnnComma,dp)]}) anns-        Just _  -> anns-      where-        isAnnComma (G AnnComma,_) = True-        isAnnComma _              = False---- -----------------------------------------------------------------------removeTrailingComma :: (Data a) => Located a -> Anns -> Anns-removeTrailingComma a anns =-  case Map.lookup (mkAnnKey a) anns of-    Nothing -> anns-    Just an ->-      case find isAnnComma (annsDP an) of-        Nothing -> anns-        Just _  -> Map.insert (mkAnnKey a) (an { annsDP = filter (not.isAnnComma) (annsDP an) }) anns-      where-        isAnnComma (G AnnComma,_) = True-        isAnnComma _              = False---- ---------------------------------------------------------------------- balanceCommentsList :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs] balanceCommentsList [] = return [] balanceCommentsList [x] = return [x]@@ -601,7 +385,7 @@   r <- balanceCommentsList (b':ls)   return (a':r) --- |The relatavise phase puts all comments appearing between the end of one AST+-- |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' -- from the second one to the 'annFollowingComments' of the first if they belong@@ -685,11 +469,11 @@ pushTrailingComments w cs lb@(HsValBinds an _)   = (True, HsValBinds an' vb)   where-    (decls, _, _ws1) = runTransform mempty (hsDeclsValBinds lb)+    (decls, _, _ws1) = runTransform (hsDeclsValBinds lb)     (an', decls') = case reverse decls of       [] -> (addCommentsToEpAnn (spanHsLocaLBinds lb) an cs, decls)       (L la d:ds) -> (an, L (addCommentsToSrcAnn la cs) d:ds)-    (vb,_ws2) = case runTransform mempty (replaceDeclsValbinds w lb decls') of+    (vb,_ws2) = case runTransform (replaceDeclsValbinds w lb decls') of       ((HsValBinds _ vb'), _, ws2') -> (vb', ws2')       _ -> (ValBinds NoAnnSortKey emptyBag [], []) @@ -815,7 +599,6 @@ -- `MovedAnchor` operation based on the original location, only if it -- does not already have one. commentOrigDelta :: LEpaComment -> LEpaComment--- commentOrigDelta c@(L (GHC.Anchor _ (GHC.MovedAnchor _)) _) = c commentOrigDelta (L (GHC.Anchor la _) (GHC.EpaComment t pp))   = (L (GHC.Anchor la op) (GHC.EpaComment t pp))   where@@ -863,59 +646,6 @@  -- --------------------------------------------------------------------- ---- |After moving an AST element, make sure any comments that may belong--- with the following element in fact do. Of necessity this is a heuristic--- process, to be tuned later. Possibly a variant should be provided with a--- passed-in decision function.-balanceTrailingComments :: (Monad m) => (Data a,Data b) => Located a -> Located b-                        -> TransformT m [(Comment, DeltaPos)]-balanceTrailingComments first second = do-  let-    k1 = mkAnnKey first-    k2 = mkAnnKey second-    moveComments p ans = (ans',move)-      where-        an1 = gfromJust "balanceTrailingComments k1" $ Map.lookup k1 ans-        an2 = gfromJust "balanceTrailingComments k2" $ Map.lookup k2 ans-        cs1f = annFollowingComments an1-        (move,stay) = break p cs1f-        an1' = an1 { annFollowingComments = stay }-        ans' = Map.insert k1 an1' $ Map.insert k2 an2 ans--    simpleBreak (_,SameLine _) = False-    simpleBreak (_,DifferentLine _ _) = True--  ans <- getAnnsT-  let (ans',mov) = moveComments simpleBreak ans-  putAnnsT ans'-  return mov---- ------------------------------------------------------------------------- ++AZ++ TODO: This needs to be renamed/reworked, based on what it actually gets used for--- |Move any 'annFollowingComments' values from the 'Annotation' associated to--- the first parameter to that of the second.-moveTrailingComments :: (Data a,Data b)-                     => Located a -> Located b -> Transform ()-moveTrailingComments first second = do-  let-    k1 = mkAnnKey first-    k2 = mkAnnKey second-    moveComments ans = ans'-      where-        an1 = gfromJust "moveTrailingComments k1" $ Map.lookup k1 ans-        an2 = gfromJust "moveTrailingComments k2" $ Map.lookup k2 ans-        cs1f = annFollowingComments an1-        cs2f = annFollowingComments an2-        an1' = an1 { annFollowingComments = [] }-        an2' = an2 { annFollowingComments = cs1f ++ cs2f }-        ans' = Map.insert k1 an1' $ Map.insert k2 an2' ans--  modifyAnnsT moveComments---- ---------------------------------------------------------------------- anchorEof :: ParsedSource -> ParsedSource anchorEof (L l m@(HsModule an _lo _mn _exps _imps _decls _ _)) = L l (m { hsmodAnn = an' })   where@@ -923,15 +653,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 = ss2delta (ss2pos anc) ss---- ---------------------------------------------------------------------- -- | Create a @SrcSpanAnn@ with a @MovedAnchor@ operation using the -- given @DeltaPos@. noAnnSrcSpanDP :: (Monoid ann) => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)@@ -1083,7 +804,7 @@         (l', rhs') <- case binds of           EmptyLocalBinds{} -> do             logTr $ "replaceDecls LMatch empty binds"-            modifyAnnsT (setPrecedingLines (ghead "LMatch.replaceDecls" newBinds) 1 4)+            -- modifyAnnsT (setPrecedingLines (ghead "LMatch.replaceDecls" newBinds) 1 4)              -- only move the comment if the original where clause was empty.             -- toMove <- balanceTrailingComments m m@@ -1175,21 +896,7 @@ replaceDeclsPatBind (L l (PatBind x a (GRHSs xr rhss binds) b)) newDecls     = do         logTr "replaceDecls PatBind"-        -- Need to throw in a fresh where clause if the binds were empty,-        -- in the annotations.-        case binds of-          EmptyLocalBinds{} -> do-            let-              addWhere _mkds =-                error "TBD"-            modifyAnnsT addWhere-            modifyAnnsT (setPrecedingLines (ghead "LMatch.replaceDecls" newDecls) 1 4)--          _ -> return ()--        -- modifyAnnsT (captureOrderAnnKey (mkAnnKey p) newDecls)         binds'' <- replaceDeclsValbinds WithWhere binds newDecls-        -- let binds' = L (getLoc binds) binds''         return (L l (PatBind x a (GRHSs xr rhss binds'') b)) replaceDeclsPatBind x _ = error $ "replaceDeclsPatBind called for:" ++ showGhc x @@ -1226,102 +933,6 @@ -- ===================================================================== -- end of HasDecls instances -- =====================================================================---- ------------------------------------------------------------------------- |Do a transformation on an AST fragment by providing a function to process--- the general case and one specific for a 'LHsBind'. This is required--- because a 'FunBind' may have multiple 'Match' items, so we cannot--- gurantee that 'replaceDecls' after 'hsDecls' is idempotent.-hasDeclsSybTransform :: (Data t2,Monad m)-       => (forall t. HasDecls t => t -> m t)-             -- ^Worker function for the general case-       -> (LHsBind GhcPs -> m (LHsBind GhcPs))-             -- ^Worker function for FunBind/PatBind-       -> t2 -- ^Item to be updated-       -> m t2-hasDeclsSybTransform workerHasDecls workerBind t = trf t-  where-    trf = mkM   parsedSource-         `extM` lmatch-         `extM` lexpr-         `extM` lstmt-         `extM` lhsbind-         `extM` lvald--    parsedSource (p::ParsedSource) = workerHasDecls p--    lmatch (lm::LMatch GhcPs (LHsExpr GhcPs))-      = workerHasDecls lm--    lexpr (le::LHsExpr GhcPs)-      = workerHasDecls le--    lstmt (d::LStmt GhcPs (LHsExpr GhcPs))-      = workerHasDecls d--    lhsbind (b@(L _ FunBind{}):: LHsBind GhcPs)-      = workerBind b-    lhsbind b@(L _ PatBind{})-      = workerBind b-    lhsbind x = return x--    lvald (L l (ValD x d)) = do-      (L _ d') <- lhsbind (L l d)-      return (L l (ValD x d'))-    lvald x = return x---- ------------------------------------------------------------------------- |A 'FunBind' wraps up one or more 'Match' items. 'hsDecls' cannot--- return anything for these as there is not meaningful 'replaceDecls' for it.--- This function provides a version of 'hsDecls' that returns the 'FunBind'--- decls too, where they are needed for analysis only.-hsDeclsGeneric :: (Data t,Monad m) => t -> TransformT m [LHsDecl GhcPs]-hsDeclsGeneric t = q t-  where-    q = return []-        `mkQ`  parsedSource-        `extQ` lmatch-        `extQ` lexpr-        `extQ` lstmt-        `extQ` lhsbind-        `extQ` lhsbindd-        `extQ` llocalbinds-        `extQ` localbinds--    parsedSource (p::ParsedSource) = hsDecls p--    lmatch (lm::LMatch GhcPs (LHsExpr GhcPs)) = hsDecls lm--    lexpr (le::LHsExpr GhcPs) = hsDecls le--    lstmt (d::LStmt GhcPs (LHsExpr GhcPs)) = hsDecls d--    -- -----------------------------------    lhsbind :: (Monad m) => LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]-    lhsbind (L _ (FunBind _ _ (MG _ (L _ matches) _) _)) = do-        dss <- mapM hsDecls matches-        return (concat dss)-    lhsbind p@(L _ (PatBind{})) = do-      hsDeclsPatBind p-    lhsbind _ = return []--    -- -----------------------------------    lhsbindd (L l (ValD _ d)) = lhsbind (L l d)-    lhsbindd _ = return []--    -- -----------------------------------    llocalbinds :: (Monad m) => Located (HsLocalBinds GhcPs) -> TransformT m [LHsDecl GhcPs]-    llocalbinds (L _ ds) = localbinds ds--    -- -----------------------------------    localbinds :: (Monad m) => HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]-    localbinds d = hsDeclsValBinds d  -- --------------------------------------------------------------------- 

@@ -13,120 +13,16 @@  import GHC hiding (EpaComment) import GHC.Utils.Outputable hiding ( (<>) )-import Data.Data (Data, toConstr,cast) -import qualified Data.Map as Map- -- ------------------------------------------------------------------------ | This structure holds a complete set of annotations for an AST-type Anns = Map.Map AnnKey Annotation -emptyAnns :: Anns-emptyAnns = Map.empty---- | For every @Located a@, use the @SrcSpan@ and constructor name of--- a as the key, to store the standard annotation.--- These are used to maintain context in the AP and EP monads-data AnnKey   = AnnKey RealSrcSpan AnnConName-                  deriving (Eq, Data, Ord)---- More compact Show instance-instance Show AnnKey where-  show (AnnKey ss cn) = "AnnKey " ++ showPprUnsafe ss ++ " " ++ show cn--mkAnnKeyPrim :: (Data a) => Located a -> AnnKey-mkAnnKeyPrim (L l a) = AnnKey (realSrcSpan l) (annGetConstr a)--mkAnnKeyPrimA :: (Data a) => LocatedA a -> AnnKey-mkAnnKeyPrimA (L l a) = AnnKey (realSrcSpan $ locA l) (annGetConstr a)---- Holds the name of a constructor-data AnnConName = CN { unConName :: String }-                 deriving (Eq, Ord, Data)---- More compact show instance-instance Show AnnConName where-  show (CN s) = "CN " ++ show s--annGetConstr :: (Data a) => a -> AnnConName-annGetConstr a = CN (show $ toConstr a)---- |Make an unwrapped @AnnKey@ for the @LHsDecl@ case, a normal one otherwise.-mkAnnKey :: (Data a) => Located a -> AnnKey-mkAnnKey ld =-  case cast ld :: Maybe (LHsDecl GhcPs) of-    Just d -> declFun mkAnnKeyPrimA d-    Nothing -> mkAnnKeyPrim ld-- type Pos = (Int,Int)  -- --------------------------------------------------------------------- -annNone :: Annotation-annNone = Ann (SameLine 0) [] [] [] Nothing Nothing--data Annotation = Ann-  {-    -- The first three fields relate to interfacing up into the AST-    annEntryDelta      :: !DeltaPos-    -- ^ Offset used to get to the start of the SrcSpan, from whatever the prior-    -- output was, including all annPriorComments (field below).-  , annPriorComments   :: ![(Comment,  DeltaPos)]-    -- ^ Comments coming after the last non-comment output of the preceding-    -- element but before the SrcSpan being annotated by this Annotation. If-    -- these are changed then annEntryDelta (field above) must also change to-    -- match.-  , annFollowingComments   :: ![(Comment,  DeltaPos)]-    -- ^ Comments coming after the last output for the element subject to this-    -- Annotation. These will only be added by AST transformations, and care-    -- must be taken not to disturb layout of following elements.--  -- The next three fields relate to interacing down into the AST-  , annsDP             :: ![(KeywordId, DeltaPos)]-    -- ^ Annotations associated with this element.-  , annSortKey         :: !(Maybe [RealSrcSpan])-    -- ^ Captures the sort order of sub elements. This is needed when the-    -- sub-elements have been split (as in a HsLocalBind which holds separate-    -- binds and sigs) or for infix patterns where the order has been-    -- re-arranged. It is captured explicitly so that after the Delta phase a-    -- SrcSpan is used purely as an index into the annotations, allowing-    -- transformations of the AST including the introduction of new Located-    -- items or re-arranging existing ones.-  , annCapturedSpan    :: !(Maybe AnnKey)-    -- ^ Occasionally we must calculate a SrcSpan for an unlocated list of-    -- elements which we must remember for the Print phase. e.g. the statements-    -- in a HsLet or HsDo. These must be managed as a group because they all-    -- need eo be vertically aligned for the Haskell layout rules, and this-    -- guarantees this property in the presence of AST edits.--  } deriving (Eq)---- -----------------------------------------------------------------------declFun :: (forall a . Data a => LocatedA a -> b) -> LHsDecl GhcPs -> b-declFun f (L l de) =-  case de of-      TyClD _ d       -> f (L l d)-      InstD _ d       -> f (L l d)-      DerivD _ d      -> f (L l d)-      ValD _ d        -> f (L l d)-      SigD _ d        -> f (L l d)-      KindSigD _ d    -> f (L l d)-      DefD _ d        -> f (L l d)-      ForD _ d        -> f (L l d)-      WarningD _ d    -> f (L l d)-      AnnD _ d        -> f (L l d)-      RuleD _ d       -> f (L l d)-      SpliceD _ d     -> f (L l d)-      DocD _ d        -> f (L l d)-      RoleAnnotD _ d  -> f (L l d)---- ---------------------------------------------------------------------- data Rigidity = NormalLayout | RigidLayout deriving (Eq, Ord, Show) -+-- ---------------------------------------------------------------------  -- | A Haskell comment. The @AnnKeywordId@ is present if it has been converted -- from an @AnnKeywordId@ because the annotation must be interleaved into the@@ -182,6 +78,7 @@  instance Show LayoutStartCol where   show (LayoutStartCol sc) = "(LayoutStartCol " ++ show sc ++ ")"+ -- ---------------------------------------------------------------------  -- Duplicated here so it can be used in show instances

@@ -34,11 +34,8 @@ import GHC.Data.FastString import GHC.Utils.Outputable (showSDocUnsafe, showPprUnsafe) -import qualified GHC.Types.Name.Occurrence as OccName (OccName(..),pprNameSpaceBrief)- import Control.Arrow -import qualified Data.Map as Map import Data.List (sortBy, elemIndex)  import Debug.Trace@@ -140,16 +137,6 @@     len = length (keywordToString (G kw))     sp = range2rs ((l,c),(l,c+len)) --- | Add together two @DeltaPos@ taking into account newlines------ > DP (0, 1) `addDP` DP (0, 2) == DP (0, 3)--- > DP (0, 9) `addDP` DP (1, 5) == DP (1, 5)--- > DP (1, 4) `addDP` DP (1, 3) == DP (2, 3)-addDP :: DeltaPos -> DeltaPos -> DeltaPos-addDP dp (DifferentLine c d) = DifferentLine (getDeltaLine dp+c) d-addDP (DifferentLine a b) (SameLine  d) = DifferentLine a (b+d)-addDP (SameLine b)        (SameLine  d) = SameLine (b+d)- -- ---------------------------------------------------------------------  adjustDeltaForOffset :: Int -> LayoutStartCol -> DeltaPos -> DeltaPos@@ -208,22 +195,6 @@  -- --------------------------------------------------------------------- -isListComp :: HsStmtContext name -> Bool-isListComp cts = case cts of-          ListComp  -> True-          MonadComp -> True--          DoExpr {}    -> False-          MDoExpr {}   -> False-          ArrowExpr    -> False-          GhciStmtCtxt -> False--          PatGuard {}      -> False-          ParStmtCtxt {}   -> False-          TransStmtCtxt {} -> False---- ---------------------------------------------------------------------- isGadt :: [LConDecl (GhcPass p)] -> Bool isGadt [] = True isGadt ((L _ (ConDeclGADT{})):_) = True@@ -231,12 +202,6 @@  -- --------------------------------------------------------------------- --- Is a RdrName of type Exact? SYB query, so can be extended to other types too-isExactName :: (Data name) => name -> Bool-isExactName = False `mkQ` isExact---- ---------------------------------------------------------------------- insertCppComments ::  ParsedSource -> [LEpaComment] -> ParsedSource insertCppComments (L l p) cs = L l p'   where@@ -287,25 +252,6 @@ sortAnchorLocated :: [GenLocated Anchor a] -> [GenLocated Anchor a] sortAnchorLocated = sortBy (compare `on` (anchor . getLoc)) -getAnnotationEP :: (Data a) =>  Located a  -> Anns -> Maybe Annotation-getAnnotationEP  la as =-  Map.lookup (mkAnnKey la) as---- | The "true entry" is the distance from the last concrete element to the--- start of the current element.-annTrueEntryDelta :: Annotation -> DeltaPos-annTrueEntryDelta Ann{annEntryDelta, annPriorComments} =-  foldr addDP (SameLine 0) (map (\(a, b) -> addDP b (dpFromString $ commentContents a)) annPriorComments )-    `addDP` annEntryDelta---- | Return the DP of the first item that generates output, either a comment or the entry DP-annLeadingCommentEntryDelta :: Annotation -> DeltaPos-annLeadingCommentEntryDelta Ann{annPriorComments,annEntryDelta} = dp-  where-    dp = case annPriorComments of-      [] -> annEntryDelta-      ((_,ed):_) -> ed- -- | Calculates the distance from the start of a string to the end of -- a string. dpFromString ::  String -> DeltaPos@@ -320,9 +266,6 @@  -- --------------------------------------------------------------------- -isSymbolRdrName :: RdrName -> Bool-isSymbolRdrName n = isSymOcc $ rdrNameOcc n- rdrName2String :: RdrName -> String rdrName2String r =   case isExact_maybe r of@@ -340,21 +283,6 @@  -- --------------------------------------------------------------------- -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@@ -365,117 +293,3 @@ showAst ast   = showSDocUnsafe     $ showAstData NoBlankSrcSpan NoBlankEpAnnotations ast---- ------------------------------------------------------------------------ Putting these here for the time being, to avoid import loops--ghead :: String -> [a] -> a-ghead  info []    = error $ "ghead "++info++" []"-ghead _info (h:_) = h--glast :: String -> [a] -> a-glast  info []    = error $ "glast " ++ info ++ " []"-glast _info h     = last h--gtail :: String -> [a] -> [a]-gtail  info []   = error $ "gtail " ++ info ++ " []"-gtail _info h    = tail h--gfromJust :: String -> Maybe a -> a-gfromJust _info (Just h) = h-gfromJust  info Nothing = error $ "gfromJust " ++ info ++ " Nothing"---- ------------------------------------------------------------------------- -- Copied from syb for the test----- -- | Generic queries of type \"r\",--- --   i.e., take any \"a\" and return an \"r\"--- ----- type GenericQ r = forall a. Data a => a -> r----- -- | Make a generic query;--- --   start from a type-specific case;--- --   return a constant otherwise--- ----- mkQ :: ( Typeable a---        , Typeable b---        )---     => r---     -> (b -> r)---     -> a---     -> r--- (r `mkQ` br) a = case cast a of---                         Just b  -> br b---                         Nothing -> r---- -- | Make a generic monadic transformation;--- --   start from a type-specific case;--- --   resort to return otherwise--- ----- mkM :: ( Monad m---        , Typeable a---        , Typeable b---        )---     => (b -> m b)---     -> a---     -> m a--- mkM = extM return---- -- | Flexible type extension--- ext0 :: (Typeable a, Typeable b) => c a -> c b -> c a--- ext0 def ext = maybe def id (gcast ext)----- -- | Extend a generic query by a type-specific case--- extQ :: ( Typeable a---         , Typeable b---         )---      => (a -> q)---      -> (b -> q)---      -> a---      -> q--- extQ f g a = maybe (f a) g (cast a)---- -- | Flexible type extension--- ext2 :: (Data a, Typeable t)---      => c a---      -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))---      -> c a--- ext2 def ext = maybe def id (dataCast2 ext)----- -- | Extend a generic monadic transformation by a type-specific case--- extM :: ( Typeable a---         , Typeable b---         )---      => (a -> m a) -> (b -> m b) -> a -> m a--- extM def ext = unM ((M def) `ext0` (M ext))---- -- | Type extension of monadic transformations for type constructors--- ext2M :: (Data d, Typeable t)---       => (forall e. Data e => e -> m e)---       -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> m (t d1 d2))---       -> d -> m d--- ext2M def ext = unM ((M def) `ext2` (M ext))---- -- | The type constructor for transformations--- newtype M m x = M { unM :: x -> m x }---- -- | Generic monadic transformations,--- --   i.e., take an \"a\" and compute an \"a\"--- ----- type GenericM m = forall a. Data a => a -> m a---- -- | Monadic variation on everywhere--- everywhereM :: forall m. Monad m => GenericM m -> GenericM m---- -- Bottom-up order is also reflected in order of do-actions--- everywhereM f = go---   where---     go :: GenericM m---     go x = do---       x' <- gmapM go x---       f x'

@@ -97,7 +97,7 @@ changeWhereIn3a :: Changer changeWhereIn3a _libdir (L l p) = do   let decls0 = hsmodDecls p-      (decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0)+      (decls,_,w) = runTransform (balanceCommentsList decls0)       (_de0:_:de1:_d2:_) = decls   debugM $ unlines w   debugM $ "changeWhereIn3a:de1:" ++ showAst de1@@ -109,11 +109,11 @@ changeWhereIn3b :: Changer changeWhereIn3b _libdir (L l p) = do   let decls0 = hsmodDecls p-      (decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0)+      (decls,_,w) = runTransform (balanceCommentsList decls0)       (de0:_:de1:d2:_) = decls-      de0' = setEntryDP' de0 (DifferentLine 2 0)-      de1' = setEntryDP' de1 (DifferentLine 2 0)-      d2' = setEntryDP' d2 (DifferentLine 2 0)+      de0' = setEntryDP de0 (DifferentLine 2 0)+      de1' = setEntryDP de1 (DifferentLine 2 0)+      d2' = setEntryDP d2 (DifferentLine 2 0)       decls' = d2':de1':de0':(tail decls)   debugM $ unlines w   debugM $ "changeWhereIn3b:de1':" ++ showAst de1'@@ -172,9 +172,9 @@ changeLocalDecls2 libdir (L l p) = do   Right d@(L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   Right s@(L ls (SigD _ sig))  <- withDynFlags libdir (\df -> parseDecl df "sig"  "nn :: Int")-  let decl' = setEntryDP' (L ld decl) (DifferentLine 1 0)-  let  sig' = setEntryDP' (L ls  sig) (SameLine 2)-  let (p',(_,_),_w) = runTransform mempty doAddLocal+  let decl' = setEntryDP (L ld decl) (DifferentLine 1 0)+  let  sig' = setEntryDP (L ls  sig) (SameLine 2)+  let (p',_,_w) = runTransform doAddLocal       doAddLocal = everywhereM (mkM replaceLocalBinds) p       replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)                         -> Transform (LMatch GhcPs (LHsExpr GhcPs))@@ -236,9 +236,9 @@ changeLocalDecls libdir (L l p) = do   Right s@(L ls (SigD _ sig))  <- withDynFlags libdir (\df -> parseDecl df "sig"  "nn :: Int")   Right d@(L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")-  let decl' = setEntryDP' (L ld decl) (DifferentLine 1 0)-  let  sig' = setEntryDP' (L ls sig)  (SameLine 0)-  let (p',(_,_),_w) = runTransform mempty doAddLocal+  let decl' = setEntryDP (L ld decl) (DifferentLine 1 0)+  let  sig' = setEntryDP (L ls sig)  (SameLine 0)+  let (p',_,_w) = runTransform doAddLocal       doAddLocal = everywhereM (mkM replaceLocalBinds) p       replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)                         -> Transform (LMatch GhcPs (LHsExpr GhcPs))@@ -248,7 +248,7 @@         let oldDecls' = captureLineSpacing oldDecls         let oldBinds     = concatMap decl2Bind oldDecls'             (os:oldSigs) = concatMap decl2Sig  oldDecls'-            os' = setEntryDP' os (DifferentLine 2 0)+            os' = setEntryDP os (DifferentLine 2 0)         let sortKey = captureOrder decls         let (EpAnn anc (AnnList (Just (Anchor anc2 _)) a b c dd) cs) = van         let van' = (EpAnn anc (AnnList (Just (Anchor anc2 (MovedAnchor (DifferentLine 1 5)))) a b c dd) cs)@@ -280,9 +280,9 @@ changeAddDecl :: Changer changeAddDecl libdir top = do   Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")-  let decl' = setEntryDP' decl (DifferentLine 2 0)+  let decl' = setEntryDP decl (DifferentLine 2 0) -  let (p',(_,_),_) = runTransform mempty doAddDecl+  let (p',_,_) = runTransform doAddDecl       doAddDecl = everywhereM (mkM replaceTopLevelDecls) top       replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource       replaceTopLevelDecls m = insertAtStart m decl'@@ -458,7 +458,7 @@ addLocaLDecl1 :: Changer addLocaLDecl1 libdir lp = do   Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")-  let decl' = setEntryDP' (L ld decl) (DifferentLine 1 5)+  let decl' = setEntryDP (L ld decl) (DifferentLine 1 5)       doAddLocal = do         (de1:d2:d3:_) <- hsDecls lp         (de1'',d2') <- balanceComments de1 d2@@ -466,7 +466,7 @@           return ((wrapDecl decl' : d),Nothing)         replaceDecls lp [de1', d2', d3] -  (lp',(_,_),w) <- runTransformT mempty doAddLocal+  (lp',_,w) <- runTransformT doAddLocal   debugM $ "addLocaLDecl1:" ++ intercalate "\n" w   return lp' -- ---------------------------------------------------------------------@@ -501,12 +501,12 @@           (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do            newDecl' <- transferEntryDP' d newDecl-           let d' = setEntryDP' d (DifferentLine 1 0)+           let d' = setEntryDP d (DifferentLine 1 0)            return ((newDecl':d':ds),Nothing)           replaceDecls lp [parent',d2'] -  (lp',(_,_),_w) <- runTransformT mempty doAddLocal+  (lp',_,_w) <- runTransformT doAddLocal   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' @@ -543,12 +543,12 @@          (de1'',d2') <- balanceComments de1 d2           (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do-           let newDecl' = setEntryDP' newDecl (DifferentLine 1 0)+           let newDecl' = setEntryDP newDecl (DifferentLine 1 0)            return (((d:ds) ++ [newDecl']),Nothing)           replaceDecls (anchorEof lp) [parent',d2'] -  (lp',(_,_),_w) <- runTransformT mempty doAddLocal+  (lp',_,_w) <- runTransformT doAddLocal   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' @@ -585,15 +585,15 @@       doAddLocal = do          (parent:ds) <- hsDecls lp -         let newDecl' = setEntryDP' newDecl (DifferentLine 1 0)-         let newSig'  = setEntryDP' newSig  (DifferentLine 1 5)+         let newDecl' = setEntryDP newDecl (DifferentLine 1 0)+         let newSig'  = setEntryDP newSig  (DifferentLine 1 5)           (parent',_) <- modifyValD (getLocA parent) parent $ \_m decls -> do            return ((decls++[newSig',newDecl']),Nothing)           replaceDecls (anchorEof lp) (parent':ds) -  (lp',(_,_),_w) <- runTransformT mempty doAddLocal+  (lp',_,_w) <- runTransformT doAddLocal   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' @@ -622,14 +622,14 @@          decls <- hsDecls lp          [s1,de1,d2,d3] <- balanceCommentsList decls -         let d3' = setEntryDP' d3 (DifferentLine 2 0)+         let d3' = setEntryDP d3 (DifferentLine 2 0)           (de1',_) <- modifyValD (getLocA de1) de1 $ \_m _decls -> do-           let d2' = setEntryDP' d2 (DifferentLine 1 0)+           let d2' = setEntryDP d2 (DifferentLine 1 0)            return ([d2'],Nothing)          replaceDecls lp [s1,de1',d3'] -  (lp',(_,_),_w) <- runTransformT mempty doAddLocal+  (lp',_,_w) <- runTransformT doAddLocal   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' @@ -659,7 +659,7 @@ addLocaLDecl6 libdir lp = do   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3")   let-      newDecl' = setEntryDP' newDecl (DifferentLine 1 5)+      newDecl' = setEntryDP newDecl (DifferentLine 1 5)       doAddLocal = do         decls0 <- hsDecls lp         [de1'',d2] <- balanceCommentsList decls0@@ -672,7 +672,7 @@            return ((newDecl' : decls),Nothing)         replaceDecls lp [de1', d2] -  (lp',(_,_),_w) <- runTransformT mempty doAddLocal+  (lp',_,_w) <- runTransformT doAddLocal   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' -- ---------------------------------------------------------------------@@ -710,7 +710,7 @@           replaceDecls lp (de1:ds) -  (lp',(_,_),_w) <- runTransformT mempty doRmDecl+  (lp',_,_w) <- runTransformT doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' @@ -749,7 +749,7 @@          everywhereM (mkM go) lp -  let (lp',(_,_),_w) = runTransform mempty doRmDecl+  let (lp',_,_w) = runTransform doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' -- ---------------------------------------------------------------------@@ -777,12 +777,12 @@          [de1,d2] <- hsDecls lp           (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1] -> do-           let sd1' = setEntryDP' sd1 (DifferentLine 2 0)+           let sd1' = setEntryDP sd1 (DifferentLine 2 0)            return ([],Just sd1')           replaceDecls lp [de1',sd1,d2] -  (lp',(_,_),_w) <- runTransformT mempty doRmDecl+  (lp',_,_w) <- runTransformT doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' -- ---------------------------------------------------------------------@@ -815,12 +815,12 @@          (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] -> do            sd2' <- transferEntryDP' sd1 sd2 -           let sd1' = setEntryDP' sd1 (DifferentLine 2 0)+           let sd1' = setEntryDP sd1 (DifferentLine 2 0)            return ([sd2'],Just sd1')           replaceDecls (anchorEof lp) [de1',sd1] -  (lp',(_,_),_w) <- runTransformT mempty doRmDecl+  (lp',_,_w) <- runTransformT doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' -- ---------------------------------------------------------------------@@ -854,14 +854,14 @@           go (HsLet a lb expr) = do             decs <- hsDeclsValBinds lb             let dec = last decs-            _ <- transferEntryDPT (head decs) dec+            -- _ <- transferEntryDPT (head decs) dec             lb' <- replaceDeclsValbinds WithoutWhere lb [dec]             return (HsLet a lb' expr)           go x = return x          everywhereM (mkM go) lp -  let (lp',(_,_),_w) = runTransform mempty doRmDecl+  let (lp',_,_w) = runTransform doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' @@ -899,7 +899,7 @@           replaceDecls lp [de1'] -  (lp',(_,_),_w) <- runTransformT mempty doRmDecl+  (lp',_,_w) <- runTransformT doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' -- ---------------------------------------------------------------------@@ -933,7 +933,7 @@           replaceDecls lp [s1,de1,d3'] -  (lp',(_,_),_w) <- runTransformT mempty doRmDecl+  (lp',_,_w) <- runTransformT doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' -- ---------------------------------------------------------------------@@ -960,7 +960,7 @@          let s1' = (L l (SigD x1 (TypeSig x2 [n2'] typ)))          replaceDecls lp (s1':de1:d2) -  let (lp',(_,_),_w) = runTransform mempty doRmDecl+  let (lp',_,_w) = runTransform doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' @@ -988,11 +988,10 @@          let [de1] = tlDecs           (de1',_) <- modifyValD (getLocA de1) de1 $ \_m [s,d] -> do-           d' <- transferEntryDPT s d-           return ([d'],Nothing)+           return ([d],Nothing)          replaceDecls lp [de1'] -  let (lp',(_,_),_w) = runTransform mempty doRmDecl+  let (lp',_,_w) = runTransform doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' @@ -1045,7 +1044,7 @@           p' = p { hsmodImports = [L li imp1',imp2]}         return (L l p') -  let (lp',(_ans',_),_w) = runTransform mempty doTransform+  let (lp',_,_w) = runTransform doTransform   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' -- ---------------------------------------------------------------------@@ -1098,7 +1097,7 @@           p' = p { hsmodImports = [L li imp1']}         return (L l p') -  let (lp',(_ans',_),_w) = runTransform mempty doTransform+  let (lp',_,_w) = runTransform doTransform   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp' -- ---------------------------------------------------------------------@@ -1108,11 +1107,12 @@   let doChange = do          tlDecs <- hsDecls lp          let (d1':d2:ds) = tlDecs-         d2' <- fst <$> cloneT d2-         let d2'' = setEntryDP' d2' (DifferentLine 2 0)+         -- d2' <- fst <$> cloneT d2+         let d2' = d2+         let d2'' = setEntryDP d2' (DifferentLine 2 0)          replaceDecls lp (d1':d2:d2'':ds) -  let (lp',(_ans',_),_w) = runTransform mempty doChange+  let (lp',_,_w) = runTransform doChange   return lp'  -- ---------------------------------------------------------------------