packages feed

ghc-exactprint 1.9.0.0 → 1.10.0.0

raw patch · 7 files changed

+369/−454 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Language.Haskell.GHC.ExactPrint.Types: NormalLayout :: Rigidity
- Language.Haskell.GHC.ExactPrint.Types: RigidLayout :: Rigidity
- Language.Haskell.GHC.ExactPrint.Types: data Rigidity
- Language.Haskell.GHC.ExactPrint.Types: instance GHC.Classes.Eq Language.Haskell.GHC.ExactPrint.Types.Rigidity
- Language.Haskell.GHC.ExactPrint.Types: instance GHC.Classes.Ord Language.Haskell.GHC.ExactPrint.Types.Rigidity
- Language.Haskell.GHC.ExactPrint.Types: instance GHC.Internal.Show.Show Language.Haskell.GHC.ExactPrint.Types.Rigidity
- Language.Haskell.GHC.ExactPrint.ExactPrint: epOptions :: (forall ast. Data ast => Located ast -> a -> m a) -> (String -> m a) -> (String -> m a) -> Rigidity -> Bool -> EPOptions m a
+ Language.Haskell.GHC.ExactPrint.ExactPrint: epOptions :: (String -> m a) -> (String -> m a) -> EPOptions m a
- Language.Haskell.GHC.ExactPrint.Transform: balanceComments :: forall (m :: Type -> Type). Monad m => LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs, LHsDecl GhcPs)
+ Language.Haskell.GHC.ExactPrint.Transform: balanceComments :: LHsDecl GhcPs -> LHsDecl GhcPs -> (LHsDecl GhcPs, LHsDecl GhcPs)
- Language.Haskell.GHC.ExactPrint.Transform: balanceCommentsList :: forall (m :: Type -> Type). Monad m => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Transform: balanceCommentsList :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
- Language.Haskell.GHC.ExactPrint.Transform: balanceCommentsListA :: forall (m :: Type -> Type) a. Monad m => [LocatedA a] -> TransformT m [LocatedA a]
+ Language.Haskell.GHC.ExactPrint.Transform: balanceCommentsListA :: [LocatedA a] -> [LocatedA a]
- Language.Haskell.GHC.ExactPrint.Transform: hsDecls :: forall (m :: Type -> Type). (HasDecls t, Monad m) => t -> TransformT m [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Transform: hsDecls :: HasDecls t => t -> [LHsDecl GhcPs]
- Language.Haskell.GHC.ExactPrint.Transform: insertAfter :: HasDecls (LocatedA ast) => LocatedA old -> LocatedA ast -> LHsDecl GhcPs -> Transform (LocatedA ast)
+ Language.Haskell.GHC.ExactPrint.Transform: insertAfter :: HasDecls (LocatedA ast) => LocatedA old -> LocatedA ast -> LHsDecl GhcPs -> LocatedA ast
- Language.Haskell.GHC.ExactPrint.Transform: insertAt :: HasDecls ast => (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]) -> ast -> LHsDecl GhcPs -> Transform ast
+ Language.Haskell.GHC.ExactPrint.Transform: insertAt :: HasDecls ast => (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]) -> ast -> LHsDecl GhcPs -> ast
- Language.Haskell.GHC.ExactPrint.Transform: insertAtEnd :: HasDecls ast => ast -> LHsDecl GhcPs -> Transform ast
+ Language.Haskell.GHC.ExactPrint.Transform: insertAtEnd :: HasDecls ast => ast -> LHsDecl GhcPs -> ast
- Language.Haskell.GHC.ExactPrint.Transform: insertAtStart :: HasDecls ast => ast -> LHsDecl GhcPs -> Transform ast
+ Language.Haskell.GHC.ExactPrint.Transform: insertAtStart :: HasDecls ast => ast -> LHsDecl GhcPs -> ast
- Language.Haskell.GHC.ExactPrint.Transform: insertBefore :: HasDecls (LocatedA ast) => LocatedA old -> LocatedA ast -> LHsDecl GhcPs -> Transform (LocatedA ast)
+ Language.Haskell.GHC.ExactPrint.Transform: insertBefore :: HasDecls (LocatedA ast) => LocatedA old -> LocatedA ast -> LHsDecl GhcPs -> LocatedA ast
- Language.Haskell.GHC.ExactPrint.Transform: modifyValD :: HasTransform m => SrcSpan -> Decl -> (PMatch -> [Decl] -> m ([Decl], Maybe t)) -> m (Decl, Maybe t)
+ Language.Haskell.GHC.ExactPrint.Transform: modifyValD :: SrcSpan -> Decl -> (PMatch -> [Decl] -> ([Decl], Maybe t)) -> (Decl, Maybe t)
- Language.Haskell.GHC.ExactPrint.Transform: replaceDecls :: forall (m :: Type -> Type). (HasDecls t, Monad m) => t -> [LHsDecl GhcPs] -> TransformT m t
+ Language.Haskell.GHC.ExactPrint.Transform: replaceDecls :: HasDecls t => t -> [LHsDecl GhcPs] -> t
- Language.Haskell.GHC.ExactPrint.Transform: replaceDeclsPatBind :: forall (m :: Type -> Type). Monad m => LHsBind GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsBind GhcPs)
+ Language.Haskell.GHC.ExactPrint.Transform: replaceDeclsPatBind :: LHsBind GhcPs -> [LHsDecl GhcPs] -> LHsBind GhcPs
- Language.Haskell.GHC.ExactPrint.Transform: replaceDeclsPatBindD :: forall (m :: Type -> Type). Monad m => LHsDecl GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsDecl GhcPs)
+ Language.Haskell.GHC.ExactPrint.Transform: replaceDeclsPatBindD :: LHsDecl GhcPs -> [LHsDecl GhcPs] -> LHsDecl GhcPs
- Language.Haskell.GHC.ExactPrint.Transform: replaceDeclsValbinds :: forall (m :: Type -> Type). Monad m => WithWhere -> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
+ Language.Haskell.GHC.ExactPrint.Transform: replaceDeclsValbinds :: WithWhere -> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> HsLocalBinds GhcPs
- Language.Haskell.GHC.ExactPrint.Transform: transferEntryDP :: forall (m :: Type -> Type) t1 t2 a b. (Monad m, Typeable t1, Typeable t2) => LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
+ Language.Haskell.GHC.ExactPrint.Transform: transferEntryDP :: (Typeable t1, Typeable t2) => LocatedAn t1 a -> LocatedAn t2 b -> LocatedAn t2 b
- Language.Haskell.GHC.ExactPrint.Transform: transferEntryDP' :: forall (m :: Type -> Type). Monad m => LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs)
+ Language.Haskell.GHC.ExactPrint.Transform: transferEntryDP' :: LHsDecl GhcPs -> LHsDecl GhcPs -> LHsDecl GhcPs

Files

ChangeLog view
@@ -1,3 +1,6 @@+2024-05-21 v1.10.0.0+	* Make the Language.Haskell.GHC.ExactPrint.Transform API pure+	* Remove EPOoptions fields that had no effect 2024-05-16 v1.9.0.0 	* Support GHC 9.10.1 2022-12-19 v1.8.0.0
ghc-exactprint.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                ghc-exactprint-version:             1.9.0.0+version:             1.10.0.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
src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs view
@@ -26,7 +26,7 @@   , makeDeltaAst    -- * Configuration-  , EPOptions(epRigidity, epAstPrint, epTokenPrint, epWhitespacePrint, epUpdateAnchors)+  , EPOptions(epTokenPrint, epWhitespacePrint)   , stringOptions   , epOptions   , deltaOptions@@ -79,8 +79,7 @@ exactPrint :: ExactPrint ast => ast -> String exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast)) --- | The additional option to specify the rigidity and printing--- configuration.+-- | The additional option to specify the printing configuration. exactPrintWithOptions :: (ExactPrint ast, Monoid b, Monad m)                       => EPOptions m b                       -> ast@@ -88,9 +87,8 @@ exactPrintWithOptions r ast =     runEP r (markAnnotated ast) --- | Transform concrete annotations into relative annotations which--- are more useful when transforming an AST. This corresponds to the--- earlier 'relativiseApiAnns'.+-- | Transform concrete annotations into relative annotations.+-- This should be unnecessary from GHC 9.10 makeDeltaAst :: ExactPrint ast => ast -> ast makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated ast)) @@ -131,39 +129,27 @@ -- | The R part of RWS. The environment. Updated via 'local' as we -- enter a new AST element, having a different anchor point. data EPOptions m a = EPOptions-            {-              epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a-            , epTokenPrint :: String -> m a+            { epTokenPrint :: String -> m a             , epWhitespacePrint :: String -> m a-            , epRigidity :: Rigidity-            , epUpdateAnchors :: Bool             }  -- | Helper to create a 'EPOptions'-epOptions ::-      (forall ast . Data ast => GHC.Located ast -> a -> m a)-      -> (String -> m a)-      -> (String -> m a)-      -> Rigidity-      -> Bool-      -> EPOptions m a-epOptions astPrint tokenPrint wsPrint rigidity delta = EPOptions-             {-               epAstPrint = astPrint-             , epWhitespacePrint = wsPrint+epOptions :: (String -> m a)+          -> (String -> m a)+          -> EPOptions m a+epOptions tokenPrint wsPrint = EPOptions+             { epWhitespacePrint = wsPrint              , epTokenPrint = tokenPrint-             , epRigidity = rigidity-             , epUpdateAnchors = delta              }  -- | Options which can be used to print as a normal String. stringOptions :: EPOptions Identity String-stringOptions = epOptions (\_ b -> return b) return return NormalLayout False+stringOptions = epOptions return return  -- | Options which can be used to simply update the AST to be in delta -- form, without generating output deltaOptions :: EPOptions Identity ()-deltaOptions = epOptions (\_ _ -> return ()) (\_ -> return ()) (\_ -> return ()) NormalLayout True+deltaOptions = epOptions (\_ -> return ()) (\_ -> return ())  data EPWriter a = EPWriter               { output :: !a }
src/Language/Haskell/GHC/ExactPrint/Transform.hs view
@@ -157,6 +157,7 @@  -- |If we need to add new elements to the AST, they need their own -- 'SrcSpan' for this.+-- This should no longer be needed, we use an @EpaDelta@ location instead. uniqueSrcSpanT :: (Monad m) => TransformT m SrcSpan uniqueSrcSpanT = do   col <- get@@ -329,18 +330,15 @@  -- |Take the annEntryDelta associated with the first item and associate it with the second. -- Also transfer any comments occurring before it.-transferEntryDP :: (Monad m, Typeable t1, Typeable t2)-  => LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)-transferEntryDP (L (EpAnn anc1 an1 cs1) _) (L (EpAnn _anc2 an2 cs2) b) = do-  logTr $ "transferEntryDP': EpAnn,EpAnn"+transferEntryDP :: (Typeable t1, Typeable t2)+  => LocatedAn t1 a -> LocatedAn t2 b -> (LocatedAn t2 b)+transferEntryDP (L (EpAnn anc1 an1 cs1) _) (L (EpAnn _anc2 an2 cs2) b) =   -- Problem: if the original had preceding comments, blindly   -- transferring the location is not correct   case priorComments cs1 of-    [] -> return (L (EpAnn anc1 (combine an1 an2) cs2) b)+    [] -> (L (EpAnn anc1 (combine an1 an2) cs2) b)     -- TODO: what happens if the receiving side already has comments?-    (L anc _:_) -> do-      logDataWithAnnsTr "transferEntryDP':priorComments anc=" anc-      return (L (EpAnn anc1 (combine an1 an2) (cs1 <> cs2)) b)+    (L _ _:_) -> (L (EpAnn anc1 (combine an1 an2) (cs1 <> cs2)) b)   -- |If a and b are the same type return first arg, else return second@@ -350,10 +348,11 @@ -- |Take the annEntryDelta associated with the first item and associate it with the second. -- Also transfer any comments occurring before it. -- TODO: call transferEntryDP, and use pushDeclDP-transferEntryDP' :: (Monad m) => LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs)-transferEntryDP' la lb = do-  (L l2 b) <- transferEntryDP la lb-  return (L l2 (pushDeclDP b (SameLine 0)))+transferEntryDP' :: LHsDecl GhcPs -> LHsDecl GhcPs -> (LHsDecl GhcPs)+transferEntryDP' la lb =+  let+    (L l2 b) = transferEntryDP la lb+  in (L l2 (pushDeclDP b (SameLine 0)))   pushDeclDP :: HsDecl GhcPs -> DeltaPos -> HsDecl GhcPs@@ -372,16 +371,16 @@ -- | If we compile in haddock mode we get DocDecls, which we strip out -- while exact printing. Make sure we do not balance any comments on -- to them be stripping them out here already.-balanceCommentsList :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]+balanceCommentsList :: [LHsDecl GhcPs] -> [LHsDecl GhcPs] balanceCommentsList decls = balanceCommentsList' (filter notDocDecl decls) -balanceCommentsList' :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]-balanceCommentsList' [] = return []-balanceCommentsList' [x] = return [x]-balanceCommentsList' (a:b:ls) = do-  (a',b') <- balanceComments a b-  r <- balanceCommentsList' (b':ls)-  return (a':r)+balanceCommentsList' :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]+balanceCommentsList' [] = []+balanceCommentsList' [x] = [x]+balanceCommentsList' (a:b:ls) = (a':r)+  where+    (a',b') = balanceComments a b+    r = balanceCommentsList' (b':ls)  -- |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.@@ -389,28 +388,27 @@ -- from the second one to the 'annFollowingComments' of the first if they belong -- to it instead. This is typically required before deleting or duplicating -- either of the AST elements.-balanceComments :: (Monad m)-  => LHsDecl GhcPs -> LHsDecl GhcPs-  -> TransformT m (LHsDecl GhcPs, LHsDecl GhcPs)-balanceComments first second = do+balanceComments :: LHsDecl GhcPs -> LHsDecl GhcPs+                -> (LHsDecl GhcPs, LHsDecl GhcPs)+balanceComments first second =   case first of-    (L l (ValD x fb@(FunBind{}))) -> do-      (L l' fb',second') <- balanceCommentsFB (L l fb) second-      return (L l' (ValD x fb'), second')+    (L l (ValD x fb@(FunBind{}))) ->+      let+        (L l' fb',second') = balanceCommentsFB (L l fb) second+      in (L l' (ValD x fb'), second')     _ -> balanceCommentsA first second  -- |Once 'balanceCommentsA has been called to move trailing comments to a -- 'FunBind', these need to be pushed down from the top level to the last -- 'Match' if that 'Match' needs to be manipulated.-balanceCommentsFB :: (Monad m)-  => LHsBind GhcPs -> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b)-balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)))) second = do-  debugM $ "balanceCommentsFB entered: " ++ showGhc (ss2range $ locA lf)+balanceCommentsFB :: LHsBind GhcPs -> LocatedA b -> (LHsBind GhcPs, LocatedA b)+balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)))) second+  = balanceCommentsA (packFunBind bind) second'   -- There are comments on lf.  We need to   -- + Keep the prior ones here   -- + move the interior ones to the first match,   -- + move the trailing ones to the last match.-  let+  where     (before,middle,after) = case entry lf of         EpaSpan (RealSrcSpan ss _) ->           let@@ -426,40 +424,29 @@               getFollowingComments $ comments lf)      lf' = setCommentsEpAnn lf (EpaComments before)-  debugM $ "balanceCommentsFB (before, after): " ++ showAst (before, after)-  debugM $ "balanceCommentsFB lf': " ++ showAst lf'-  -- let matches' = case matches of-  let matches' :: [LocatedA (Match GhcPs (LHsExpr GhcPs))]-      matches' = case matches of-                    (L lm' m':ms') ->-                      (L (addCommentsToEpAnn lm' (EpaComments middle )) m':ms')-                    _ -> error "balanceCommentsFB"-  matches'' <- balanceCommentsListA matches'-  let (m,ms) = case reverse matches'' of-                 (L lm' m':ms') ->-                   (L (addCommentsToEpAnn lm' (EpaCommentsBalanced [] after)) m',ms')-                   -- (L (addCommentsToEpAnnS lm' (EpaCommentsBalanced [] after)) m',ms')-                 _ -> error "balanceCommentsFB4"-  debugM $ "balanceCommentsFB: (m,ms):" ++ showAst (m,ms)-  (m',second') <- balanceCommentsA m second-  m'' <- balanceCommentsMatch m'-  let (m''',lf'') = case ms of-        [] -> moveLeadingComments m'' lf'-        _  -> (m'',lf')-  debugM $ "balanceCommentsFB: (lf'', m'''):" ++ showAst (lf'',m''')-  debugM $ "balanceCommentsFB done"-  let bind = L lf'' (FunBind x n (MG o (L lm (reverse (m''':ms)))))-  debugM $ "balanceCommentsFB returning:" ++ showAst bind-  balanceCommentsA (packFunBind bind) second'+    matches' :: [LocatedA (Match GhcPs (LHsExpr GhcPs))]+    matches' = case matches of+                  (L lm' m0:ms') ->+                    (L (addCommentsToEpAnn lm' (EpaComments middle )) m0:ms')+                  _ -> error "balanceCommentsFB"+    matches'' = balanceCommentsListA matches'+    (m,ms) = case reverse matches'' of+               (L lm' m0:ms') ->+                 (L (addCommentsToEpAnn lm' (EpaCommentsBalanced [] after)) m0,ms')+               _ -> error "balanceCommentsFB4"+    (m',second') = balanceCommentsA m second+    m'' = balanceCommentsMatch m'+    (m''',lf'') = case ms of+      [] -> moveLeadingComments m'' lf'+      _  -> (m'',lf')+    bind = L lf'' (FunBind x n (MG o (L lm (reverse (m''':ms))))) balanceCommentsFB f s = balanceCommentsA f s  -- | Move comments on the same line as the end of the match into the -- GRHS, prior to the binds-balanceCommentsMatch :: (Monad m)-  => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))-balanceCommentsMatch (L l (Match am mctxt pats (GRHSs xg grhss binds))) = do-  logTr $ "balanceCommentsMatch: (logInfo)=" ++ showAst (logInfo)-  return (L l'' (Match am mctxt pats (GRHSs xg grhss' binds')))+balanceCommentsMatch :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs))+balanceCommentsMatch (L l (Match am mctxt pats (GRHSs xg grhss binds)))+  = (L l'' (Match am mctxt pats (GRHSs xg grhss' binds')))   where     simpleBreak (r,_) = r /= 0     an1 = l@@ -468,7 +455,7 @@     (move',stay') = break simpleBreak (trailingCommentsDeltas (anchorFromLocatedA (L l ())) cs1f)     move = map snd move'     stay = map snd stay'-    (l'', grhss', binds', logInfo)+    (l'', grhss', binds', _logInfo)       = case reverse grhss of           [] -> (l, [], binds,                 (EpaComments [], noSrcSpanA))           (L lg (GRHS ag grs rhs):gs) ->@@ -491,26 +478,24 @@ pushTrailingComments :: WithWhere -> EpAnnComments -> HsLocalBinds GhcPs -> (Bool, HsLocalBinds GhcPs) pushTrailingComments _ _cs b@EmptyLocalBinds{} = (False, b) pushTrailingComments _ _cs (HsIPBinds _ _) = error "TODO: pushTrailingComments:HsIPBinds"-pushTrailingComments w cs lb@(HsValBinds an _)-  = (True, HsValBinds an' vb)+pushTrailingComments w cs lb@(HsValBinds an _) = (True, HsValBinds an' vb)   where     decls = hsDeclsLocalBinds lb     (an', decls') = case reverse decls of       [] -> (addCommentsToEpAnn an cs, decls)       (L la d:ds) -> (an, L (addCommentsToEpAnn la cs) d:ds)-    (vb,_ws2) = case runTransform (replaceDeclsValbinds w lb (reverse decls')) of-      ((HsValBinds _ vb'), _, ws2') -> (vb', ws2')-      _ -> (ValBinds NoAnnSortKey emptyBag [], [])+    vb = case replaceDeclsValbinds w lb (reverse decls') of+      (HsValBinds _ vb') -> vb'+      _ -> ValBinds NoAnnSortKey emptyBag []  -balanceCommentsListA :: (Monad m) => [LocatedA a] -> TransformT m [LocatedA a]-balanceCommentsListA [] = return []-balanceCommentsListA [x] = return [x]-balanceCommentsListA (a:b:ls) = do-  logTr $ "balanceCommentsListA entered"-  (a',b') <- balanceCommentsA a b-  r <- balanceCommentsListA (b':ls)-  return (a':r)+balanceCommentsListA :: [LocatedA a] -> [LocatedA a]+balanceCommentsListA [] = []+balanceCommentsListA [x] = [x]+balanceCommentsListA (a:b:ls) = (a':r)+  where+    (a',b') = balanceCommentsA a b+    r = balanceCommentsListA (b':ls)  -- |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@@ -518,16 +503,8 @@ -- with a passed-in decision function. -- The initial situation is that all comments for a given anchor appear as prior comments -- Many of these should in fact be following comments for the previous anchor-balanceCommentsA :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)-balanceCommentsA la1 la2 = do-  debugM $ "balanceCommentsA: anchors=" ++ showAst (an1, an2)-  -- debugM $ "balanceCommentsA: (anc1)=" ++ showAst (anc1)-  -- debugM $ "balanceCommentsA: (anc2)=" ++ showAst (anc2)-  debugM $ "balanceCommentsA: (cs1f)=" ++ showAst (cs1f)-  debugM $ "balanceCommentsA: (cs2p, cs2f)=" ++ showAst (cs2p, cs2f)-  debugM $ "balanceCommentsA: (cs1stay,cs1move)=" ++ showAst (cs1stay,cs1move)-  debugM $ "balanceCommentsA: (an1',an2')=" ++ showAst (an1',an2')-  return (la1', la2')+balanceCommentsA :: LocatedA a -> LocatedA b -> (LocatedA a, LocatedA b)+balanceCommentsA la1 la2 = (la1', la2')   where     simpleBreak n (r,_) = r > n     L an1 f = la1@@ -700,15 +677,12 @@  -- --------------------------------------------------------------------- -balanceSameLineComments :: (Monad m)-  => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))-balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do-  logTr $ "balanceSameLineComments: (la)=" ++ showGhc (ss2range $ locA la)-  logTr $ "balanceSameLineComments: [logInfo]=" ++ showAst logInfo-  return (L la' (Match anm mctxt pats (GRHSs x grhss' lb)))+balanceSameLineComments :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs))+balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb)))+  = (L la' (Match anm mctxt pats (GRHSs x grhss' lb)))   where     simpleBreak n (r,_) = r > n-    (la',grhss', logInfo) = case reverse grhss of+    (la',grhss', _logInfo) = case reverse grhss of       [] -> (la,grhss,[])       (L lg (GRHS ga gs rhs):grs) -> (la'',reverse $ (L lg (GRHS ga' gs rhs)):grs,[(gac,(csp,csf))])         where@@ -770,24 +744,21 @@ -- | Insert a declaration into an AST element having sub-declarations -- (@HasDecls@) according to the given location function. insertAt :: (HasDecls ast)-              => (LHsDecl GhcPs-                  -> [LHsDecl GhcPs]-                  -> [LHsDecl GhcPs])-              -> ast-              -> LHsDecl GhcPs-              -> Transform ast-insertAt f t decl = do-  oldDecls <- hsDecls t-  oldDeclsb <- balanceCommentsList oldDecls-  let oldDecls' = oldDeclsb-  replaceDecls t (f decl oldDecls')+         => (LHsDecl GhcPs+              -> [LHsDecl GhcPs]+              -> [LHsDecl GhcPs])+         -> ast+         -> LHsDecl GhcPs+         -> ast+insertAt f t decl = replaceDecls t (f decl oldDecls')+  where+    oldDecls = hsDecls t+    oldDeclsb = balanceCommentsList oldDecls+    oldDecls' = oldDeclsb  -- |Insert a declaration at the beginning or end of the subdecls of the given -- AST item-insertAtStart, insertAtEnd :: (HasDecls ast)-              => ast-              -> LHsDecl GhcPs-              -> Transform ast+insertAtStart, insertAtEnd :: HasDecls ast => ast -> LHsDecl GhcPs -> ast  insertAtEnd   = insertAt (\x xs -> xs ++ [x]) @@ -802,11 +773,11 @@  -- |Insert a declaration at a specific location in the subdecls of the given -- AST item-insertAfter, insertBefore :: (HasDecls (LocatedA ast))+insertAfter, insertBefore :: HasDecls (LocatedA ast)                           => LocatedA old                           -> LocatedA ast                           -> LHsDecl GhcPs-                          -> Transform (LocatedA ast)+                          -> LocatedA ast insertAfter (getLocA -> k) = insertAt findAfter   where     findAfter x xs =@@ -833,10 +804,10 @@     -- given syntax phrase. They are always returned in the wrapped 'HsDecl'     -- form, even if orginating in local decls. This is safe, as annotations     -- never attach to the wrapper, only to the wrapped item.-    hsDecls :: (Monad m) => t -> TransformT m [LHsDecl GhcPs]+    hsDecls :: t -> [LHsDecl GhcPs]      -- | Replace the directly enclosed decl list by the given-    --  decl list. Runs in the 'Transform' monad to be able to update list order+    --  decl list. As parto of replacing it will update list order     --  annotations, and rebalance comments and other layout changes as needed.     --     -- For example, a call on replaceDecls for a wrapped 'FunBind' having no@@ -854,96 +825,86 @@     --   where     --     nn = 2     -- @-    replaceDecls :: (Monad m) => t -> [LHsDecl GhcPs] -> TransformT m t+    replaceDecls :: t -> [LHsDecl GhcPs] -> t  -- ---------------------------------------------------------------------  instance HasDecls ParsedSource where-  hsDecls (L _ (HsModule (XModulePs _ _lo _ _) _mn _exps _imps decls)) = return decls+  hsDecls (L _ (HsModule (XModulePs _ _lo _ _) _mn _exps _imps decls)) = decls    replaceDecls (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps _decls)) decls-    = do-        logTr "replaceDecls LHsModule"-        return (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps decls))+    = (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps decls))  -- ---------------------------------------------------------------------  instance HasDecls (LocatedA (HsDecl GhcPs)) where-  hsDecls (L _ (TyClD _ c@ClassDecl{}))  = return $ hsDeclsClassDecl c-  hsDecls decl = do-    error $ "hsDecls:decl=" ++ showAst decl-  replaceDecls (L l (TyClD e dec@ClassDecl{})) decls = do-    let decl' = replaceDeclsClassDecl dec decls-    return (L l (TyClD e decl'))-  replaceDecls decl _decls = do-    error $ "replaceDecls:decl=" ++ showAst decl+  hsDecls (L _ (TyClD _ c@ClassDecl{}))  = hsDeclsClassDecl c+  hsDecls decl = error $ "hsDecls:decl=" ++ showAst decl+  replaceDecls (L l (TyClD e dec@ClassDecl{})) decls =+    let+        decl' = replaceDeclsClassDecl dec decls+    in (L l (TyClD e decl'))+  replaceDecls decl _decls+      = error $ "replaceDecls:decl=" ++ showAst decl  -- ---------------------------------------------------------------------  instance HasDecls (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where-  hsDecls (L _ (Match _ _ _ (GRHSs _ _ lb))) = return $ hsDeclsLocalBinds lb+  hsDecls (L _ (Match _ _ _ (GRHSs _ _ lb))) = hsDeclsLocalBinds lb    replaceDecls (L l (Match xm c p (GRHSs xr rhs binds))) []-    = do-        logTr "replaceDecls LMatch empty decls"-        binds'' <- replaceDeclsValbinds WithoutWhere binds []-        return (L l (Match xm c p (GRHSs xr rhs binds'')))+    = let+        binds'' = replaceDeclsValbinds WithoutWhere binds []+      in (L l (Match xm c p (GRHSs xr rhs binds'')))    replaceDecls m@(L l (Match xm c p (GRHSs xr rhs binds))) newBinds-    = do-        logTr "replaceDecls LMatch nonempty decls"+    = let         -- Need to throw in a fresh where clause if the binds were empty,         -- in the annotations.-        (l', rhs') <- case binds of-          EmptyLocalBinds{} -> do-            logTr $ "replaceDecls LMatch empty binds"--            logDataWithAnnsTr "Match.replaceDecls:balancing comments:m" m-            L l' m' <- balanceSameLineComments m-            logDataWithAnnsTr "Match.replaceDecls:(m1')" (L l' m')-            return (l', grhssGRHSs $ m_grhss m')-          _ -> return (l, rhs)-        binds'' <- replaceDeclsValbinds WithWhere binds newBinds-        logDataWithAnnsTr "Match.replaceDecls:binds'" binds''-        return (L l' (Match xm c p (GRHSs xr rhs' binds'')))+        (l', rhs') = case binds of+          EmptyLocalBinds{} ->+            let+              L l0 m' = balanceSameLineComments m+            in (l0, grhssGRHSs $ m_grhss m')+          _ -> (l, rhs)+        binds'' = replaceDeclsValbinds WithWhere binds newBinds+      in (L l' (Match xm c p (GRHSs xr rhs' binds'')))  -- ---------------------------------------------------------------------  instance HasDecls (LocatedA (HsExpr GhcPs)) where-  hsDecls (L _ (HsLet _ decls _ex)) = return $ hsDeclsLocalBinds decls-  hsDecls _                         = return []+  hsDecls (L _ (HsLet _ decls _ex)) = hsDeclsLocalBinds decls+  hsDecls _                         = []    replaceDecls (L ll (HsLet (tkLet, tkIn) binds ex)) newDecls-    = do-        logTr "replaceDecls HsLet"-        let lastAnc = realSrcSpan $ spanHsLocaLBinds binds+    = let+        lastAnc = realSrcSpan $ spanHsLocaLBinds binds         -- TODO: may be an intervening comment, take account for lastAnc-        let (tkLet', tkIn', ex',newDecls') = case (tkLet, tkIn) of-              (EpTok l, EpTok i) ->-                let-                  off = case l of-                          (EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r-                          (EpaSpan (UnhelpfulSpan _)) -> LayoutStartCol 0-                          (EpaDelta (SameLine _) _) -> LayoutStartCol 0-                          (EpaDelta (DifferentLine _ c) _) -> LayoutStartCol c-                  ex'' = setEntryDPFromAnchor off i ex-                  newDecls'' = case newDecls of-                    [] -> newDecls-                    (d:ds) -> setEntryDPDecl d (SameLine 0) : ds-                in ( EpTok l-                   , EpTok (addEpaLocationDelta off lastAnc i)-                   , ex''-                   , newDecls'')-              (_,_) -> (tkLet, tkIn, ex, newDecls)-        binds' <- replaceDeclsValbinds WithoutWhere binds newDecls'-        return (L ll (HsLet (tkLet', tkIn') binds' ex'))+        (tkLet', tkIn', ex',newDecls') = case (tkLet, tkIn) of+          (EpTok l, EpTok i) ->+            let+              off = case l of+                      (EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r+                      (EpaSpan (UnhelpfulSpan _)) -> LayoutStartCol 0+                      (EpaDelta (SameLine _) _) -> LayoutStartCol 0+                      (EpaDelta (DifferentLine _ c) _) -> LayoutStartCol c+              ex'' = setEntryDPFromAnchor off i ex+              newDecls'' = case newDecls of+                [] -> newDecls+                (d:ds) -> setEntryDPDecl d (SameLine 0) : ds+            in ( EpTok l+               , EpTok (addEpaLocationDelta off lastAnc i)+               , ex''+               , newDecls'')+          (_,_) -> (tkLet, tkIn, ex, newDecls)+        binds' = replaceDeclsValbinds WithoutWhere binds newDecls'+      in (L ll (HsLet (tkLet', tkIn') binds' ex'))    -- TODO: does this make sense? Especially as no hsDecls for HsPar   replaceDecls (L l (HsPar x e)) newDecls-    = do-        logTr "replaceDecls HsPar"-        e' <- replaceDecls e newDecls-        return (L l (HsPar x e'))+    = let+        e' = replaceDecls e newDecls+      in (L l (HsPar x e'))   replaceDecls old _new = error $ "replaceDecls (LHsExpr GhcPs) undefined for:" ++ showGhc old  -- ---------------------------------------------------------------------@@ -970,53 +931,51 @@ -- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is -- idempotent.-replaceDeclsPatBindD :: (Monad m) => LHsDecl GhcPs -> [LHsDecl GhcPs]-                     -> TransformT m (LHsDecl GhcPs)-replaceDeclsPatBindD (L l (ValD x d)) newDecls = do-  (L _ d') <- replaceDeclsPatBind (L l d) newDecls-  return (L l (ValD x d'))+replaceDeclsPatBindD :: LHsDecl GhcPs -> [LHsDecl GhcPs] -> (LHsDecl GhcPs)+replaceDeclsPatBindD (L l (ValD x d)) newDecls =+  let+    (L _ d') = replaceDeclsPatBind (L l d) newDecls+  in (L l (ValD x d')) replaceDeclsPatBindD x _ = error $ "replaceDeclsPatBindD called for:" ++ showGhc x  -- | Replace the immediate declarations for a 'PatBind'. This -- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is -- idempotent.-replaceDeclsPatBind :: (Monad m) => LHsBind GhcPs -> [LHsDecl GhcPs]-                    -> TransformT m (LHsBind GhcPs)+replaceDeclsPatBind :: LHsBind GhcPs -> [LHsDecl GhcPs] -> (LHsBind GhcPs) replaceDeclsPatBind (L l (PatBind x a p (GRHSs xr rhss binds))) newDecls-    = do-        logTr "replaceDecls PatBind"-        binds'' <- replaceDeclsValbinds WithWhere binds newDecls-        return (L l (PatBind x a p (GRHSs xr rhss binds'')))+  =  (L l (PatBind x a p (GRHSs xr rhss binds'')))+  where+    binds'' = replaceDeclsValbinds WithWhere binds newDecls replaceDeclsPatBind x _ = error $ "replaceDeclsPatBind called for:" ++ showGhc x  -- ---------------------------------------------------------------------  instance HasDecls (LocatedA (Stmt GhcPs (LocatedA (HsExpr GhcPs)))) where-  hsDecls (L _ (LetStmt _ lb))      = return $ hsDeclsLocalBinds lb+  hsDecls (L _ (LetStmt _ lb))      = hsDeclsLocalBinds lb   hsDecls (L _ (LastStmt _ e _ _))  = hsDecls e   hsDecls (L _ (BindStmt _ _pat e)) = hsDecls e   hsDecls (L _ (BodyStmt _ e _ _))  = hsDecls e-  hsDecls _                         = return []+  hsDecls _                         = []    replaceDecls (L l (LetStmt x lb)) newDecls-    = do-        lb'' <- replaceDeclsValbinds WithWhere lb newDecls-        return (L l (LetStmt x lb''))+    = let+        lb'' = replaceDeclsValbinds WithWhere lb newDecls+      in (L l (LetStmt x lb''))   replaceDecls (L l (LastStmt x e d se)) newDecls-    = do-        e' <- replaceDecls e newDecls-        return (L l (LastStmt x e' d se))+    = let+        e' = replaceDecls e newDecls+      in (L l (LastStmt x e' d se))   replaceDecls (L l (BindStmt x pat e)) newDecls-    = do-      e' <- replaceDecls e newDecls-      return (L l (BindStmt x pat e'))+    = let+        e' = replaceDecls e newDecls+      in (L l (BindStmt x pat e'))    replaceDecls (L l (BodyStmt x e a b)) newDecls-    = do-      e' <- replaceDecls e newDecls-      return (L l (BodyStmt x e' a b))-  replaceDecls x _newDecls = return x+    = let+        e' = replaceDecls e newDecls+      in (L l (BodyStmt x e' a b))+  replaceDecls x _newDecls = x  -- ===================================================================== -- end of HasDecls instances@@ -1098,61 +1057,57 @@ -- care, as this does not manage the declaration order, the -- ordering should be done by the calling function from the 'HsLocalBinds' -- context in the AST.-replaceDeclsValbinds :: (Monad m)-                     => WithWhere+replaceDeclsValbinds :: WithWhere                      -> HsLocalBinds GhcPs -> [LHsDecl GhcPs]-                     -> TransformT m (HsLocalBinds GhcPs)-replaceDeclsValbinds _ _ [] = do-  return (EmptyLocalBinds NoExtField)+                     -> HsLocalBinds GhcPs+replaceDeclsValbinds _ _ [] = EmptyLocalBinds NoExtField replaceDeclsValbinds w b@(HsValBinds a _) new-    = do-        logTr "replaceDeclsValbinds"-        let oldSpan = spanHsLocaLBinds b-        an <- oldWhereAnnotation a w (realSrcSpan oldSpan)-        let decs = listToBag $ concatMap decl2Bind new-        let sigs = concatMap decl2Sig new-        let sortKey = captureOrderBinds new-        return (HsValBinds an (ValBinds sortKey decs sigs))+    = let+        oldSpan = spanHsLocaLBinds b+        an = oldWhereAnnotation a w (realSrcSpan oldSpan)+        decs = listToBag $ concatMap decl2Bind new+        sigs = concatMap decl2Sig new+        sortKey = captureOrderBinds new+      in (HsValBinds an (ValBinds sortKey decs sigs)) replaceDeclsValbinds _ (HsIPBinds {}) _new    = error "undefined replaceDecls HsIPBinds" replaceDeclsValbinds w (EmptyLocalBinds _) new-    = do-        logTr "replaceDecls HsLocalBinds"-        an <- newWhereAnnotation w-        let newBinds = concatMap decl2Bind new-            newSigs  = concatMap decl2Sig  new-        let decs = listToBag $ newBinds-        let sigs = newSigs-        let sortKey = captureOrderBinds new-        return (HsValBinds an (ValBinds sortKey decs sigs))+    = let+        an = newWhereAnnotation w+        newBinds = concatMap decl2Bind new+        newSigs  = concatMap decl2Sig  new+        decs = listToBag $ newBinds+        sigs = newSigs+        sortKey = captureOrderBinds new+      in (HsValBinds an (ValBinds sortKey decs sigs)) -oldWhereAnnotation :: (Monad m)-  => EpAnn AnnList -> WithWhere -> RealSrcSpan -> TransformT m (EpAnn AnnList)-oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = do-  -- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation, change the AnnList anchor to have the correct DP too-  let (AnnList ancl o c _r t) = an-  let w = case ww of-        WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])]-        WithoutWhere -> []-  (anc', ancl') <- do-        case ww of-          WithWhere -> return (anc, ancl)-          WithoutWhere -> return (anc, ancl)-  let an' = EpAnn anc'-                  (AnnList ancl' o c w t)-                  cs-  return an'+oldWhereAnnotation :: EpAnn AnnList -> WithWhere -> RealSrcSpan -> (EpAnn AnnList)+oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = an'+  -- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation,+  -- change the AnnList anchor to have the correct DP too+  where+    (AnnList ancl o c _r t) = an+    w = case ww of+      WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])]+      WithoutWhere -> []+    (anc', ancl') =+          case ww of+            WithWhere -> (anc, ancl)+            WithoutWhere -> (anc, ancl)+    an' = EpAnn anc'+                (AnnList ancl' o c w t)+                cs -newWhereAnnotation :: (Monad m) => WithWhere -> TransformT m (EpAnn AnnList)-newWhereAnnotation ww = do-  let anc  = EpaDelta (DifferentLine 1 3) []-  let anc2 = EpaDelta (DifferentLine 1 5) []-  let w = case ww of-        WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])]-        WithoutWhere -> []-  let an = EpAnn anc-                  (AnnList (Just anc2) Nothing Nothing w [])-                  emptyComments-  return an+newWhereAnnotation :: WithWhere -> (EpAnn AnnList)+newWhereAnnotation ww = an+  where+  anc  = EpaDelta (DifferentLine 1 3) []+  anc2 = EpaDelta (DifferentLine 1 5) []+  w = case ww of+    WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])]+    WithoutWhere -> []+  an = EpAnn anc+              (AnnList (Just anc2) Nothing Nothing w [])+              emptyComments  -- --------------------------------------------------------------------- @@ -1163,32 +1118,32 @@ -- declarations are extracted and returned after modification. For a -- 'FunBind' the supplied 'SrcSpan' is used to identify the specific -- 'Match' to be transformed, for when there are multiple of them.-modifyValD :: forall m t. (HasTransform m)-                => SrcSpan+modifyValD :: forall t.+                   SrcSpan                 -> Decl-                -> (PMatch -> [Decl] -> m ([Decl], Maybe t))-                -> m (Decl,Maybe t)+                -> (PMatch -> [Decl] -> ([Decl], Maybe t))+                -> (Decl,Maybe t) modifyValD p pb@(L ss (ValD _ (PatBind {} ))) f =   if (locA ss) == p-     then do-       let ds = hsDeclsPatBindD pb-       (ds',r) <- f (error "modifyValD.PatBind should not touch Match") ds-       pb' <- liftT $ replaceDeclsPatBindD pb ds'-       return (pb',r)-     else return (pb,Nothing)-modifyValD p decl f = do-  (decl',r) <- runStateT (everywhereM (mkM doModLocal) (unpackFunDecl decl)) Nothing-  return (packFunDecl decl',r)+     then+       let+           ds = hsDeclsPatBindD pb+           (ds',r) = f (error "modifyValD.PatBind should not touch Match") ds+           pb' = replaceDeclsPatBindD pb ds'+       in (pb',r)+     else (pb,Nothing)+modifyValD p decl f = (packFunDecl decl', r)   where-    doModLocal :: PMatch -> StateT (Maybe t) m PMatch+    (decl',r) = runState (everywhereM (mkM doModLocal) (unpackFunDecl decl)) Nothing+    doModLocal :: PMatch -> State (Maybe t) PMatch     doModLocal  (match@(L ss _) :: PMatch) = do          if (locA ss) == p            then do-             ds <- lift $ liftT $ hsDecls match-                `debug` ("modifyValD: match=" ++ showAst match)-             (ds',r) <- lift $ f match ds-             put r-             match' <- lift $ liftT $ replaceDecls match ds'+             let+               ds = hsDecls match+               (ds',r0) = f match ds+             put r0+             let match' = replaceDecls match ds'              return match'            else return match @@ -1208,6 +1163,6 @@              => ([LHsDecl GhcPs] -> m [LHsDecl GhcPs])              -> t -> m t modifyDeclsT action t = do-  decls <- liftT $ hsDecls t+  let decls = hsDecls t   decls' <- action decls-  liftT $ replaceDecls t decls'+  return $ replaceDecls t decls'
src/Language/Haskell/GHC/ExactPrint/Types.hs view
@@ -21,10 +21,6 @@  -- --------------------------------------------------------------------- -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 -- stream and does not have a well-defined position
tests/Test/Common.hs view
@@ -112,9 +112,8 @@   -- let (GHC.L l p) = makeDeltaAst top   let (GHC.L l p) = top   let decls0 = GHC.hsmodDecls p-      (decls,_,w) = runTransform (balanceCommentsList decls0)+      decls = balanceCommentsList decls0   let p2 = p { GHC.hsmodDecls = decls}-  debugM $ "changeBalanceComments:\n" ++ unlines w   return (GHC.L l p2)  changeMakeDelta :: Changer
tests/Test/Transform.hs view
@@ -95,9 +95,8 @@ changeWhereIn3a :: Changer changeWhereIn3a _libdir (L l p) = do   let decls0 = hsmodDecls p-      (decls,_,w) = runTransform (balanceCommentsList decls0)+      decls = balanceCommentsList decls0       (_de0:_:de1:_d2:_) = decls-  debugM $ unlines w   debugM $ "changeWhereIn3a:de1:" ++ showAst de1   let p2 = p { hsmodDecls = decls}   return (L l p2)@@ -107,13 +106,12 @@ changeWhereIn3b :: Changer changeWhereIn3b _libdir (L l p) = do   let decls0 = hsmodDecls p-      (decls,_,w) = runTransform (balanceCommentsList decls0)+      decls = balanceCommentsList decls0       (de0:tdecls@(_:de1:d2:_)) = decls       de0' = setEntryDP de0 (DifferentLine 2 0)       de1' = setEntryDP de1 (DifferentLine 2 0)       d2' = setEntryDP d2 (DifferentLine 2 0)       decls' = d2':de1':de0':tdecls-  debugM $ unlines w   debugM $ "changeWhereIn3b:de1':" ++ showAst de1'   let p2 = p { hsmodDecls = decls'}   return (L l p2)@@ -192,7 +190,7 @@   let (p',_,_w) = runTransform doAddDecl       doAddDecl = everywhereM (mkM replaceTopLevelDecls) top       replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource-      replaceTopLevelDecls m = insertAtStart m decl'+      replaceTopLevelDecls m = return $ insertAtStart m decl'   return p'  -- ---------------------------------------------------------------------@@ -314,16 +312,15 @@ addLocaLDecl1 libdir top = do   Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   let decl' = setEntryDP (L ld decl) (DifferentLine 1 5)-      doAddLocal = do-        let lp = top-        (de1:d2:d3:_) <- hsDecls lp-        (de1'',d2') <- balanceComments de1 d2-        (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do-          return ((wrapDecl decl' : d),Nothing)-        replaceDecls lp [de1', d2', d3]+      doAddLocal :: ParsedSource+      doAddLocal = replaceDecls lp [de1', d2', d3]+        where+          lp = top+          (de1:d2:d3:_) = hsDecls lp+          (de1'',d2') = balanceComments de1 d2+          (de1',_) = modifyValD (getLocA de1'') de1'' $ \_m d -> ((wrapDecl decl' : d),Nothing) -  (lp',_,w) <- runTransformT doAddLocal-  debugM $ "addLocaLDecl1:" ++ intercalate "\n" w+  let lp' = doAddLocal   return lp'  -- ---------------------------------------------------------------------@@ -332,20 +329,19 @@ addLocaLDecl2 libdir lp = do   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   let-      doAddLocal = do-         -- (de1:d2:_) <- hsDecls (makeDeltaAst lp)-         (de1:d2:_) <- hsDecls lp-         (de1'',d2') <- balanceComments de1 d2+      doAddLocal = replaceDecls lp [parent',d2']+        where+         (de1:d2:_) = hsDecls lp+         (de1'',d2') = balanceComments de1 d2 -         (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do-           newDecl' <- transferEntryDP' d (makeDeltaAst newDecl)-           let d' = setEntryDP d (DifferentLine 1 0)-           return ((newDecl':d':ds),Nothing)+         (parent',_) = modifyValD (getLocA de1) de1'' $ \_m (d:ds) ->+             let+               newDecl' = transferEntryDP' d (makeDeltaAst newDecl)+               d' = setEntryDP d (DifferentLine 1 0)+             in ((newDecl':d':ds),Nothing) -         replaceDecls lp [parent',d2'] -  (lp',_,_w) <- runTransformT doAddLocal-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doAddLocal   return lp'  -- ---------------------------------------------------------------------@@ -354,19 +350,18 @@ addLocaLDecl3 libdir top = do   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   let-      doAddLocal = do-         let lp = top-         (de1:d2:_) <- hsDecls lp-         (de1'',d2') <- balanceComments de1 d2--         (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do-           let newDecl' = setEntryDP newDecl (DifferentLine 1 0)-           return (((d:ds) ++ [newDecl']),Nothing)+      doAddLocal = replaceDecls (anchorEof lp) [parent',d2']+        where+         lp = top+         (de1:d2:_) = hsDecls lp+         (de1'',d2') = balanceComments de1 d2 -         replaceDecls (anchorEof lp) [parent',d2']+         (parent',_) = modifyValD (getLocA de1) de1'' $ \_m (d:ds) ->+           let+             newDecl' = setEntryDP newDecl (DifferentLine 1 0)+           in (((d:ds) ++ [newDecl']),Nothing) -  (lp',_,_w) <- runTransformT doAddLocal-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doAddLocal   return lp'  -- ---------------------------------------------------------------------@@ -376,19 +371,18 @@   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   Right newSig  <- withDynFlags libdir (\df -> parseDecl df "sig"  "nn :: Int")   let-      doAddLocal = do-         (parent:ds) <- hsDecls (makeDeltaAst lp)+      doAddLocal = replaceDecls (anchorEof lp) (parent':ds)+        where+          (parent:ds) = hsDecls (makeDeltaAst lp) -         let newDecl' = setEntryDP (makeDeltaAst newDecl) (DifferentLine 1 0)-         let newSig'  = setEntryDP (makeDeltaAst newSig)  (DifferentLine 1 5)+          newDecl' = setEntryDP (makeDeltaAst newDecl) (DifferentLine 1 0)+          newSig'  = setEntryDP (makeDeltaAst newSig)  (DifferentLine 1 5) -         (parent',_) <- modifyValD (getLocA parent) parent $ \_m decls -> do-           return ((decls++[newSig',newDecl']),Nothing)+          (parent',_) = modifyValD (getLocA parent) parent $ \_m decls ->+                         ((decls++[newSig',newDecl']),Nothing) -         replaceDecls (anchorEof lp) (parent':ds) -  (lp',_,_w) <- runTransformT doAddLocal-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doAddLocal   return lp'  -- ---------------------------------------------------------------------@@ -396,19 +390,19 @@ addLocaLDecl5 :: Changer addLocaLDecl5 _libdir lp = do   let-      doAddLocal = do-         decls <- hsDecls lp-         [s1,de1,d2,d3] <- balanceCommentsList decls+      doAddLocal = replaceDecls lp [s1,de1',d3']+        where+          decls = hsDecls lp+          [s1,de1,d2,d3] = balanceCommentsList decls -         let d3' = setEntryDP d3 (DifferentLine 2 0)+          d3' = setEntryDP d3 (DifferentLine 2 0) -         (de1',_) <- modifyValD (getLocA de1) de1 $ \_m _decls -> do-           let d2' = setEntryDP d2 (DifferentLine 1 0)-           return ([d2'],Nothing)-         replaceDecls lp [s1,de1',d3']+          (de1',_) = modifyValD (getLocA de1) de1 $ \_m _decls ->+                       let+                         d2' = setEntryDP d2 (DifferentLine 1 0)+                       in ([d2'],Nothing) -  (lp',_,_w) <- runTransformT doAddLocal-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doAddLocal   return lp'  -- ---------------------------------------------------------------------@@ -418,36 +412,35 @@   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3")   let       newDecl' = setEntryDP (makeDeltaAst newDecl) (DifferentLine 1 5)-      doAddLocal = do-        decls0 <- hsDecls lp-        [de1'',d2] <- balanceCommentsList decls0+      doAddLocal = replaceDecls lp [de1', d2]+        where+          decls0 = hsDecls lp+          [de1'',d2] = balanceCommentsList decls0 -        let de1 = captureMatchLineSpacing de1''-        let L _ (ValD _ (FunBind _ _ (MG _ (L _ ms)))) = de1-        let [ma1,_ma2] = ms+          de1 = captureMatchLineSpacing de1''+          L _ (ValD _ (FunBind _ _ (MG _ (L _ ms)))) = de1+          [ma1,_ma2] = ms -        (de1',_) <- modifyValD (getLocA ma1) de1 $ \_m decls -> do-           return ((newDecl' : decls),Nothing)-        replaceDecls lp [de1', d2]+          (de1',_) = modifyValD (getLocA ma1) de1 $ \_m decls ->+                       ((newDecl' : decls),Nothing) -  (lp',_,_w) <- runTransformT doAddLocal-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doAddLocal   return lp'  -- ---------------------------------------------------------------------  rmDecl1 :: Changer rmDecl1 _libdir lp = do-  let doRmDecl = do-         tlDecs0 <- hsDecls lp-         tlDecs <- balanceCommentsList tlDecs0-         let (de1:_s1:_d2:d3:ds) = tlDecs-         let d3' = setEntryDP d3 (DifferentLine 2 0)+  let+      doRmDecl = replaceDecls lp (de1:d3':ds)+        where+          tlDecs0 = hsDecls lp+          tlDecs = balanceCommentsList tlDecs0+          (de1:_s1:_d2:d3:ds) = tlDecs+          d3' = setEntryDP d3 (DifferentLine 2 0) -         replaceDecls lp (de1:d3':ds) -  (lp',_,_w) <- runTransformT doRmDecl-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doRmDecl   return lp'  -- ---------------------------------------------------------------------@@ -459,9 +452,9 @@         let           go :: GHC.LHsExpr GhcPs -> Transform (GHC.LHsExpr GhcPs)           go e@(GHC.L _ (GHC.HsLet{})) = do-            decs0 <- hsDecls e-            decs <- balanceCommentsList $ captureLineSpacing decs0-            e' <- replaceDecls e (init decs)+            let decs0 = hsDecls e+            let decs = balanceCommentsList $ captureLineSpacing decs0+            let e' = replaceDecls e (init decs)             return e'           go x = return x @@ -475,37 +468,31 @@ rmDecl3 :: Changer rmDecl3 _libdir lp = do   let-      doRmDecl = do-         -- [de1,d2] <- hsDecls (makeDeltaAst lp)-         [de1,d2] <- hsDecls lp--         (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1] -> do-           let sd1' = setEntryDP sd1 (DifferentLine 2 0)-           return ([],Just sd1')--         replaceDecls lp [de1',sd1,d2]+      doRmDecl = replaceDecls lp [de1',sd1,d2]+        where+          [de1,d2] = hsDecls lp+          (de1',Just sd1) = modifyValD (getLocA de1) de1 $ \_m [sd1] ->+                       let+                           sd1' = setEntryDP sd1 (DifferentLine 2 0)+                       in ([],Just sd1') -  (lp',_,_w) <- runTransformT doRmDecl-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doRmDecl   return lp'+ -- ---------------------------------------------------------------------  rmDecl4 :: Changer rmDecl4 _libdir lp = do   let-      doRmDecl = do-         [de1] <- hsDecls lp--         (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] -> do-           sd2' <- transferEntryDP' sd1 sd2--           let sd1' = setEntryDP sd1 (DifferentLine 2 0)-           return ([sd2'],Just sd1')--         replaceDecls (anchorEof lp) [de1',sd1]--  (lp',_,_w) <- runTransformT doRmDecl-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      doRmDecl = replaceDecls (anchorEof lp) [de1',sd1]+        where+         [de1] = hsDecls lp+         (de1',Just sd1) = modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] ->+           let+             sd2' = transferEntryDP' sd1 sd2+             sd1' = setEntryDP sd1 (DifferentLine 2 0)+           in ([sd2'],Just sd1')+      lp' = doRmDecl   return lp'  -- ---------------------------------------------------------------------@@ -520,8 +507,8 @@             let decs = hsDeclsLocalBinds lb             let hdecs : _ = decs             let dec = last decs-            _ <- transferEntryDP hdecs dec-            lb' <- replaceDeclsValbinds WithoutWhere lb [dec]+            -- _ <- transferEntryDP hdecs dec+            let lb' = replaceDeclsValbinds WithoutWhere lb [dec]             return (HsLet (tkLet, tkIn) lb' expr)           go x = return x @@ -536,20 +523,18 @@ rmDecl6 :: Changer rmDecl6 _libdir lp = do   let-      doRmDecl = do-         [de1] <- hsDecls lp--         (de1',_) <- modifyValD (getLocA de1) de1 $ \_m subDecs -> do-           let subDecs' = captureLineSpacing subDecs-           let (ss1:_sd1:sd2:sds) = subDecs'-           sd2' <- transferEntryDP' ss1 sd2--           return (sd2':sds,Nothing)+      doRmDecl = replaceDecls lp [de1']+        where+          [de1] = hsDecls lp -         replaceDecls lp [de1']+          (de1',_) = modifyValD (getLocA de1) de1 $ \_m subDecs ->+            let+              subDecs' = captureLineSpacing subDecs+              (ss1:_sd1:sd2:sds) = subDecs'+              sd2' = transferEntryDP' ss1 sd2+            in (sd2':sds,Nothing) -  (lp',_,_w) <- runTransformT doRmDecl-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doRmDecl   return lp'  -- ---------------------------------------------------------------------@@ -557,50 +542,42 @@ rmDecl7 :: Changer rmDecl7 _libdir lp = do   let-      doRmDecl = do-         -- tlDecs <- hsDecls (makeDeltaAst lp)-         tlDecs <- hsDecls lp-         [s1,de1,d2,d3] <- balanceCommentsList tlDecs--         d3' <- transferEntryDP' d2 d3--         replaceDecls lp [s1,de1,d3']+      doRmDecl = replaceDecls lp [s1,de1,d3']+        where+          tlDecs = hsDecls lp+          [s1,de1,d2,d3] = balanceCommentsList tlDecs+          d3' = transferEntryDP' d2 d3 -  (lp',_,_w) <- runTransformT doRmDecl-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doRmDecl   return lp'+ -- ---------------------------------------------------------------------  rmTypeSig1 :: Changer rmTypeSig1 _libdir lp = do-  let doRmDecl = do-         tlDecs <- hsDecls lp-         let (s0:de1:d2) = tlDecs-             s1 = captureTypeSigSpacing s0-             (L l (SigD x1 (TypeSig x2 [n1,n2] typ))) = s1-         L ln n2' <- transferEntryDP n1 n2-         let s1' = (L l (SigD x1 (TypeSig x2 [L (noTrailingN ln) n2'] typ)))-         replaceDecls lp (s1':de1:d2)+  let doRmDecl = replaceDecls lp (s1':de1:d2)+        where+          tlDecs = hsDecls lp+          (s0:de1:d2) = tlDecs+          s1 = captureTypeSigSpacing s0+          (L l (SigD x1 (TypeSig x2 [n1,n2] typ))) = s1+          L ln n2' = transferEntryDP n1 n2+          s1' = (L l (SigD x1 (TypeSig x2 [L (noTrailingN ln) n2'] typ))) -  let (lp',_,_w) = runTransform doRmDecl-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+      lp' = doRmDecl   return lp'  -- ---------------------------------------------------------------------  rmTypeSig2 :: Changer rmTypeSig2 _libdir lp = do-  let doRmDecl = do-         -- tlDecs <- hsDecls (makeDeltaAst lp)-         tlDecs <- hsDecls lp-         let [de1] = tlDecs--         (de1',_) <- modifyValD (getLocA de1) de1 $ \_m [_s,d] -> do-           return ([d],Nothing)-         replaceDecls lp [de1']+  let doRmDecl = replaceDecls lp [de1']+        where+          tlDecs = hsDecls lp+          [de1] = tlDecs+          (de1',_) = modifyValD (getLocA de1) de1 $ \_m [_s,d] -> ([d],Nothing) -  let (lp',_,_w) = runTransform doRmDecl-  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+  let lp' = doRmDecl   return lp'  -- ---------------------------------------------------------------------@@ -664,15 +641,14 @@  cloneDecl1 :: Changer cloneDecl1 _libdir lp = do-  let doChange = do-         tlDecs <- hsDecls (makeDeltaAst lp)-         let (d1':d2:ds) = tlDecs-         -- d2' <- fst <$> cloneT d2-         let d2' = d2-         let d2'' = setEntryDP d2' (DifferentLine 2 0)-         replaceDecls lp (d1':d2:d2'':ds)+  let doChange = replaceDecls lp (d1':d2:d2'':ds)+        where+          tlDecs = hsDecls (makeDeltaAst lp)+          (d1':d2:ds) = tlDecs+          d2' = d2+          d2'' = setEntryDP d2' (DifferentLine 2 0) -  let (lp',_,_w) = runTransform doChange+  let lp' = doChange   return lp'  -- ---------------------------------------------------------------------