diff --git a/ChangeLog b/ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,22 @@
+2015-09-28 v0.4.0.0
+	* Rework HasDecls so that there are only instances for which it is
+	idempotent. Provide functions for managing an LHsBind which is not
+	idempotent, and performing general transformations on an AST
+	including FunBinds.
+	* Manage LHsDecl instances so that the Annotation always attaches
+	to the wrapped item, so that they can be seamlessly used in a top
+	level (wrapped) or local (unwrapped) context.
+	* Tweak transformations based on HaRe integration.
+	* This release supports the HaRe 8.0 release, which finally works
+	with GHC 7.10.2
+	* Rename `exactPrintWithAnns` to `exactPrint`. This will possibly
+	break earlier client libraries, but is a simple rename.
+	* Bring in semanticPrintM which allows wrapper functions to be
+	provided for the generated output, for use when emitting e.g. HTML
+	marked up source.
+
 2015-08-13 v0.3.1.1
-	* Add missing test files to sdist
+	* Add missing test files to sdist, closes #23
 
 2015-08-02 v0.3.1
 
diff --git a/ghc-exactprint.cabal b/ghc-exactprint.cabal
--- a/ghc-exactprint.cabal
+++ b/ghc-exactprint.cabal
@@ -1,5 +1,5 @@
 name:                ghc-exactprint
-version:             0.3.1.1
+version:             0.4.0.0
 synopsis:            ExactPrint for GHC
 description:         Using the API Annotations available from GHC 7.10.2, this
                      library provides a means to round trip any code that can
diff --git a/src/Language/Haskell/GHC/ExactPrint.hs b/src/Language/Haskell/GHC/ExactPrint.hs
--- a/src/Language/Haskell/GHC/ExactPrint.hs
+++ b/src/Language/Haskell/GHC/ExactPrint.hs
@@ -17,7 +17,6 @@
         , module Language.Haskell.GHC.ExactPrint.Transform
 
         -- * Printing
-        , exactPrintWithAnns
         , exactPrint
 
         ) where
diff --git a/src/Language/Haskell/GHC/ExactPrint/Annotate.hs b/src/Language/Haskell/GHC/ExactPrint/Annotate.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Annotate.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Annotate.hs
@@ -26,7 +26,8 @@
          annotate
        , AnnotationF(..)
        , Annotated
-       , Annotate(..)) where
+       , Annotate(..)
+       ) where
 
 import Data.Maybe ( fromMaybe )
 #if __GLASGOW_HASKELL__ <= 710
@@ -190,7 +191,7 @@
 -- | Constructs a syntax tree which contains information about which
 -- annotations are required by each element.
 markLocated :: (Annotate ast) => GHC.Located ast -> Annotated ()
-markLocated a = withLocated a markAST
+markLocated ast = withLocated ast markAST
 
 withLocated :: Data a
             => GHC.Located a
@@ -268,7 +269,7 @@
     markMany GHC.AnnSemi -- possible leading semis
     mapM_ markLocated imps
 
-    mapM_ markLocated decs
+    mapM_ (\(GHC.L l ast) -> markAST l ast) decs
 
     mark GHC.AnnCloseC -- Possible '}'
 
@@ -492,13 +493,17 @@
    markTrailingSemi
 
 -- ---------------------------------------------------------------------
+
 instance Annotate GHC.ModuleName where
    markAST l mname =
     markExternal l GHC.AnnVal (GHC.moduleNameString mname)
 
-instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)
-  => Annotate (GHC.HsDecl name) where
-  markAST l decl = do
+-- ---------------------------------------------------------------------
+
+-- instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)
+markLHsDecl :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)
+            => GHC.LHsDecl name -> Annotated ()
+markLHsDecl (GHC.L l decl) =
     case decl of
       GHC.TyClD d       -> markLocated (GHC.L l d)
       GHC.InstD d       -> markLocated (GHC.L l d)
@@ -518,6 +523,10 @@
       GHC.QuasiQuoteD d -> markLocated (GHC.L l d)
 #endif
 
+instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)
+            => Annotate (GHC.HsDecl name) where
+  markAST l d = markLHsDecl (GHC.L l d)
+
 -- ---------------------------------------------------------------------
 
 instance (Annotate name)
@@ -1660,11 +1669,7 @@
                       else markWithString GHC.AnnClose "#)"
 
 
-  -- We set the layout for HsCase and HsIf even though they need not obey
-  -- layout rules as when moving these expressions it's useful that they
-  -- maintain "internal integrity", that is to say the subparts remain
-  -- indented relative to each other.
-  markAST l (GHC.HsCase e1 matches) = setLayoutFlag $ do
+  markAST l (GHC.HsCase e1 matches) = do
     mark GHC.AnnCase
     markLocated e1
     mark GHC.AnnOf
@@ -1673,6 +1678,10 @@
     markMatchGroup l matches
     mark GHC.AnnCloseC
 
+  -- We set the layout for HsIf even though it need not obey layout rules as
+  -- when moving these expressions it's useful that they maintain "internal
+  -- integrity", that is to say the subparts remain indented relative to each
+  -- other.
   markAST _ (GHC.HsIf _ e1 e2 e3) = setLayoutFlag $ do
     mark GHC.AnnIf
     markLocated e1
@@ -1831,7 +1840,7 @@
   markAST _ (GHC.HsBracket (GHC.DecBrL ds)) = do
     markWithString GHC.AnnOpen "[d|"
     mark GHC.AnnOpenC
-    mapM_ markLocated ds
+    mapM_ (\(GHC.L l d) -> markAST l d) ds
     mark GHC.AnnCloseC
     markWithString GHC.AnnClose "|]"
   -- Introduced after the renamer
diff --git a/src/Language/Haskell/GHC/ExactPrint/Delta.hs b/src/Language/Haskell/GHC/ExactPrint/Delta.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Delta.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Delta.hs
@@ -65,7 +65,7 @@
 import Language.Haskell.GHC.ExactPrint.Lookup
 import Language.Haskell.GHC.ExactPrint.Types
 import Language.Haskell.GHC.ExactPrint.Annotate (AnnotationF(..), Annotated
-                                                , annotate,  Annotate(..))
+                                                , annotate, Annotate(..))
 
 import qualified GHC
 import qualified SrcLoc         as GHC
diff --git a/src/Language/Haskell/GHC/ExactPrint/Parsers.hs b/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
@@ -142,7 +142,7 @@
 -- parseModule = parseModuleWithCpp defaultCppOptions
 -- @
 --
--- Note: 'GHC.ParsedSource' is a synonym for @Located (HsModule RdrName)@
+-- Note: 'GHC.ParsedSource' is a synonym for 'GHC.Located' ('GHC.HsModule' 'GHC.RdrName')
 parseModule :: FilePath -> IO (Either (GHC.SrcSpan, String) (Anns, (GHC.Located (GHC.HsModule GHC.RdrName))))
 parseModule = parseModuleWithCpp defaultCppOptions
 
diff --git a/src/Language/Haskell/GHC/ExactPrint/Print.hs b/src/Language/Haskell/GHC/ExactPrint/Print.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Print.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Print.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RankNTypes #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -13,9 +14,9 @@
 -----------------------------------------------------------------------------
 module Language.Haskell.GHC.ExactPrint.Print
         (
-          exactPrintWithAnns
-
-        , exactPrint
+        exactPrint
+        , semanticPrint
+        , semanticPrintM
 
         ) where
 
@@ -24,7 +25,6 @@
 import Language.Haskell.GHC.ExactPrint.Annotate
   (AnnotationF(..), Annotated, Annotate(..), annotate)
 import Language.Haskell.GHC.ExactPrint.Lookup (keywordToString, unicodeString)
-import Language.Haskell.GHC.ExactPrint.Delta ( relativiseApiAnns )
 
 import Control.Monad.RWS
 import Data.Data (Data)
@@ -33,60 +33,86 @@
 import Data.Maybe (fromMaybe)
 
 import Control.Monad.Trans.Free
-
+import Control.Monad.Identity
 
 import qualified GHC
 
 ------------------------------------------------------------------------------
 -- Printing of source elements
 
--- | Print an AST exactly as specified by the annotations on the nodes in the tree.
--- The output of this function should exactly match the source file.
-exactPrint :: Annotate ast => GHC.Located ast -> GHC.ApiAnns -> String
-exactPrint ast ghcAnns = exactPrintWithAnns ast relativeAnns
-  where
-    relativeAnns = relativiseApiAnns ast ghcAnns
-
 -- | Print an AST with a map of potential modified `Anns`. The usual way to
--- generate such a map is by calling `relativiseApiAnns`.
-exactPrintWithAnns :: Annotate ast
+-- generate such a map is by using one of the parsers in
+-- "Language.Haskell.GHC.ExactPrint.Parsers".
+exactPrint :: Annotate ast
                      => GHC.Located ast
                      -> Anns
                      -> String
-exactPrintWithAnns ast an = runEP (annotate ast) an
+exactPrint = semanticPrint (\_ b -> b) id id
 
+-- | A more general version of `semanticPrint`.
+semanticPrintM :: (Annotate ast, Monoid b, Monad m) =>
+              (forall a . Data a => GHC.Located a -> b -> m b) -- ^ How to surround an AST fragment
+              -> (String -> m b) -- ^ How to output a token
+              -> (String -> m b) -- ^ How to output whitespace
+              -> GHC.Located ast
+              -> Anns
+              -> m b
+semanticPrintM astOut tokenOut whiteOut ast as =  runEP astOut tokenOut whiteOut (annotate ast) as
 
+
+-- | A more general version of 'exactPrint' which allows the customisation
+-- of the output whilst retaining the original source formatting. This is
+-- useful for smarter syntax highlighting.
+semanticPrint :: (Annotate ast, Monoid b) =>
+              (forall a . Data a => GHC.Located a -> b -> b) -- ^ How to surround an AST fragment
+              -> (String -> b) -- ^ How to output a token
+              -> (String -> b) -- ^ How to output whitespace
+              -> GHC.Located ast
+              -> Anns
+              -> b
+semanticPrint a b c d e = runIdentity (semanticPrintM (\ast s -> Identity (a ast s)) (return . b) (return . c) d e)
+
+
 ------------------------------------------------------
 -- The EP monad and basic combinators
 
-data EPReader = EPReader
+data EPReader m a = EPReader
             {
               epAnn :: !Annotation
+            , epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a
+            , epTokenPrint :: String -> m a
+            , epWhitespacePrint :: String -> m a
             }
 
-data EPWriter = EPWriter
-              { output :: !(Endo String) }
+data EPWriter a = EPWriter
+              { output :: !a }
 
-instance Monoid EPWriter where
+instance Monoid w => Monoid (EPWriter w) where
   mempty = EPWriter mempty
   (EPWriter a) `mappend` (EPWriter b) = EPWriter (a <> b)
 
 data EPState = EPState
              { epPos    :: !Pos -- ^ Current output position
              , epAnns   :: !Anns
-             , epAnnKds :: ![[(KeywordId, DeltaPos)]] -- MP: Could this be moved to the local state with suitable refactoring?
+             , epAnnKds :: ![[(KeywordId, DeltaPos)]] -- MP: Could this be moved to the local statE w mith suitable refactoring?
              , epMarkLayout :: Bool
              , epLHS :: LayoutStartCol
              }
 
 ---------------------------------------------------------
 
-type EP a = RWS EPReader EPWriter EPState a
+type EP w m a = RWST (EPReader m w) (EPWriter w) EPState m a
 
-runEP :: Annotated () -> Anns -> String
-runEP action ans =
-  flip appEndo "" . output . snd
-  . (\next -> execRWS next initialEPReader (defaultEPState ans))
+
+
+runEP :: (Monad m, Monoid a) =>
+      (forall ast . Data ast => GHC.Located ast -> a -> m a)
+      -> (String -> m a)
+      -> (String -> m a)
+      -> Annotated () -> Anns -> m a
+runEP astPrint wsPrint tokenPrint action ans =
+  fmap (output . snd) .
+    (\next -> execRWST next (initialEPReader astPrint tokenPrint wsPrint) (defaultEPState ans))
   . printInterpret $ action
 
 -- ---------------------------------------------------------------------
@@ -100,18 +126,25 @@
              , epMarkLayout = False
              }
 
-initialEPReader :: EPReader
-initialEPReader  = EPReader
+initialEPReader ::
+      (forall ast . Data ast => GHC.Located ast -> a -> m a)
+      -> (String -> m a)
+      -> (String -> m a)
+      -> EPReader m a
+initialEPReader astPrint tokenPrint wsPrint  = EPReader
              {
                epAnn = annNone
+             , epAstPrint = astPrint
+             , epWhitespacePrint = wsPrint
+             , epTokenPrint = tokenPrint
              }
 
 -- ---------------------------------------------------------------------
 
-printInterpret :: Annotated a -> EP a
-printInterpret = iterTM go
+printInterpret :: forall w m a . (Monad m, Monoid w) => Annotated a -> EP w m a
+printInterpret m = iterTM go (hoistFreeT (return . runIdentity) m)
   where
-    go :: AnnotationF (EP a) -> EP a
+    go :: (Monad m, Monoid w) => AnnotationF (EP w m a) -> EP w m a
     go (MarkEOF next) =
       printStringAtMaybeAnn (G GHC.AnnEofPos) "" >> next
     go (MarkPrim kwid mstr next) =
@@ -147,14 +180,14 @@
 
 -------------------------------------------------------------------------
 
-storeOriginalSrcSpanPrint :: EP AnnKey
+storeOriginalSrcSpanPrint :: (Monad m, Monoid w) => EP w m AnnKey
 storeOriginalSrcSpanPrint = do
   Ann{..} <- asks epAnn
   case annCapturedSpan of
     Nothing -> error "Missing captured SrcSpan"
     Just v  -> return v
 
-printStoredString :: EP ()
+printStoredString :: (Monad m, Monoid w) => EP w m ()
 printStoredString = do
   kd <- gets epAnnKds
 
@@ -166,7 +199,7 @@
     ((AnnString ss,_):_) -> printStringAtMaybeAnn (AnnString ss) ss
     _                    -> return ()
 
-withSortKey :: [(GHC.SrcSpan, Annotated ())] -> EP ()
+withSortKey :: (Monad m, Monoid w) => [(GHC.SrcSpan, Annotated ())] -> EP w m ()
 withSortKey xs = do
   Ann{..} <- asks epAnn
   let ordered = case annSortKey of
@@ -181,12 +214,12 @@
 
 -------------------------------------------------------------------------
 
-allAnns :: GHC.AnnKeywordId -> EP ()
+allAnns :: (Monad m, Monoid w) => GHC.AnnKeywordId -> EP w m ()
 allAnns kwid = printStringAtMaybeAnnAll (G kwid) (keywordToString (G kwid))
 
 -------------------------------------------------------------------------
 -- |First move to the given location, then call exactP
-exactPC :: Data ast => GHC.Located ast -> EP a -> EP a
+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))
@@ -196,38 +229,49 @@
                 , annFollowingComments=fcomments
                 , annsDP=kds
                 } = fromMaybe annNone ma
+      EPReader{epAstPrint} <- ask
       r <- withContext kds an
        (mapM_ (uncurry printQueuedComment) comments
        >> advance edp
-       >> action
+       >> censorM (epAstPrint ast) action
        <* mapM_ (uncurry printQueuedComment) fcomments)
       return r `debug` ("leaving exactPCfor:" ++ show (mkAnnKey ast))
 
-advance :: DeltaPos -> EP ()
+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 :: (Monoid w, 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 cl = do
   p <- getPos
   colOffset <- getLayoutOffset
   printWhitespace (undelta p cl colOffset)
 
-getAndRemoveAnnotation :: (Data a) => GHC.Located a -> EP (Maybe Annotation)
+getAndRemoveAnnotation :: (Monad m, Monoid w, Data a) => GHC.Located a -> EP w m (Maybe Annotation)
 getAndRemoveAnnotation a = gets ((getAnnotationEP a) . epAnns)
 
-markPrim :: KeywordId -> Maybe String -> EP ()
+markPrim :: (Monad m, Monoid w) => KeywordId -> Maybe String -> EP w m ()
 markPrim kwid mstr =
   let annString = fromMaybe (keywordToString kwid) mstr
   in printStringAtMaybeAnn kwid annString
 
-withContext :: [(KeywordId, DeltaPos)]
+withContext :: (Monad m, Monoid w)
+            => [(KeywordId, DeltaPos)]
             -> Annotation
-            -> EP a -> EP a
-withContext kds an = withKds kds . withOffset an
+            -> 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 :: Annotation -> (EP a -> EP a)
+withOffset :: (Monad m, Monoid w) => Annotation -> (EP w m a -> EP w m a)
 withOffset a =
   local (\s -> s { epAnn = a })
 
@@ -235,7 +279,7 @@
 -- ---------------------------------------------------------------------
 --
 -- Necessary as there are destructive gets of Kds across scopes
-withKds :: [(KeywordId, DeltaPos)] -> EP a -> EP a
+withKds :: (Monad m, Monoid w) => [(KeywordId, DeltaPos)] -> EP w m a -> EP w m a
 withKds kd action = do
   modify (\s -> s { epAnnKds = kd : epAnnKds s })
   r <- action
@@ -244,7 +288,7 @@
 
 ------------------------------------------------------------------------
 
-setLayout :: EP () -> EP ()
+setLayout :: (Monad m, Monoid w) => EP w m () -> EP w m ()
 setLayout k = do
   oldLHS <- gets epLHS
   modify (\a -> a { epMarkLayout = True } )
@@ -252,27 +296,27 @@
                               , epLHS = oldLHS } )
   k <* reset
 
-getPos :: EP Pos
+getPos :: (Monad m, Monoid w) => EP w m Pos
 getPos = gets epPos
 
-setPos :: Pos -> EP ()
+setPos :: (Monad m, Monoid w) => Pos -> EP w m ()
 setPos l = modify (\s -> s {epPos = l})
 
 -- |Get the current column offset
-getLayoutOffset :: EP LayoutStartCol
+getLayoutOffset :: (Monad m, Monoid w) => EP w m LayoutStartCol
 getLayoutOffset = gets epLHS
 
 -- ---------------------------------------------------------------------
 
-printStringAtMaybeAnn :: KeywordId -> String -> EP ()
+printStringAtMaybeAnn :: (Monad m, Monoid w) => KeywordId -> String -> EP w m ()
 printStringAtMaybeAnn an str = printStringAtMaybeAnnThen an str (return ())
 
-printStringAtMaybeAnnAll :: KeywordId -> String -> EP ()
+printStringAtMaybeAnnAll :: (Monad m, Monoid w) => KeywordId -> String -> EP w m ()
 printStringAtMaybeAnnAll an str = go
   where
     go = printStringAtMaybeAnnThen an str go
 
-printStringAtMaybeAnnThen :: KeywordId -> String -> EP () -> EP ()
+printStringAtMaybeAnnThen :: (Monad m, Monoid w) => KeywordId -> String -> EP w m () -> EP w m ()
 printStringAtMaybeAnnThen an str next = do
   annFinal <- getAnnFinal an
   case (annFinal, an) of
@@ -295,7 +339,7 @@
 -- ---------------------------------------------------------------------
 
 -- |destructive get, hence use an annotation once only
-getAnnFinal :: KeywordId -> EP (Maybe ([(Comment, DeltaPos)], DeltaPos))
+getAnnFinal :: (Monad m, Monoid w) => KeywordId -> EP w m (Maybe ([(Comment, DeltaPos)], DeltaPos))
 getAnnFinal kw = do
   kd <- gets epAnnKds
   case kd of
@@ -324,7 +368,7 @@
 
 -- |This should be the final point where things are mode concrete,
 -- before output. Hence the point where comments can be inserted
-printStringAtLsDelta :: [(Comment, DeltaPos)] -> DeltaPos -> String -> EP ()
+printStringAtLsDelta :: (Monad m, Monoid w) => [(Comment, DeltaPos)] -> DeltaPos -> String -> EP w m ()
 printStringAtLsDelta cs cl s = do
   p <- getPos
   colOffset <- getLayoutOffset
@@ -340,7 +384,7 @@
 isGoodDeltaWithOffset dp colOffset = isGoodDelta (DP (undelta (0,0) dp colOffset))
 
 -- AZ:TODO: harvest the commonality between this and printStringAtLsDelta
-printQueuedComment :: Comment -> DeltaPos -> EP ()
+printQueuedComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()
 printQueuedComment Comment{commentContents} dp = do
   p <- getPos
   colOffset <- getLayoutOffset
@@ -354,12 +398,12 @@
 -- ---------------------------------------------------------------------
 
 -- |non-destructive get
-peekAnnFinal :: KeywordId -> EP (Maybe DeltaPos)
+peekAnnFinal :: (Monad m, Monoid w) => KeywordId -> EP w m (Maybe DeltaPos)
 peekAnnFinal kw = do
   (r, _) <- (\kd -> destructiveGetFirst kw ([], kd)) <$> gets (ghead "peekAnnFinal" . epAnnKds)
   return (snd <$> r)
 
-countAnnsEP :: KeywordId -> EP Int
+countAnnsEP :: (Monad m, Monoid w) => KeywordId -> EP w m Int
 countAnnsEP an = length <$> peekAnnFinal an
 
 -- ---------------------------------------------------------------------
@@ -368,32 +412,39 @@
 -- ---------------------------------------------------------------------
 -- Printing functions
 
-printString :: Bool -> String -> EP ()
+printString :: (Monad m, Monoid w) => Bool -> String -> EP w m ()
 printString layout str = do
   EPState{epPos = (l,c), epMarkLayout} <- get
+  EPReader{epTokenPrint, epWhitespacePrint} <- ask
   when (epMarkLayout && layout) (
                       modify (\s -> s { epLHS = LayoutStartCol c, epMarkLayout = False } ))
   setPos (l, c + length str)
-  tell (mempty {output = Endo $ showString str })
+  --
+  -- tell (mempty {output = Endo $ showString str })
 
-newLine :: EP ()
+  if not layout && c == 0
+    then lift (epWhitespacePrint str) >>= \s -> tell (EPWriter { output = s})
+    else lift (epTokenPrint str) >>= \s -> tell (EPWriter { output = s})
+
+
+newLine :: (Monad m, Monoid w) => EP w m ()
 newLine = do
     (l,_) <- getPos
     printString False "\n"
     setPos (l+1,1)
 
-padUntil :: Pos -> EP ()
+padUntil :: (Monad m, Monoid w) => Pos -> EP w m ()
 padUntil (l,c) = do
     (l1,c1) <- getPos
     if | l1 == l && c1 <= c -> printString False $ replicate (c - c1) ' '
        | l1 < l             -> newLine >> padUntil (l,c)
        | otherwise          -> return ()
 
-printWhitespace :: Pos -> EP ()
+printWhitespace :: (Monad m, Monoid w) => Pos -> EP w m ()
 printWhitespace = padUntil
 
-printCommentAt :: Pos -> String -> EP ()
+printCommentAt :: (Monad m, Monoid w) => Pos -> String -> EP w m ()
 printCommentAt p str = printWhitespace p >> printString False str
 
-printStringAt :: Pos -> String -> EP ()
+printStringAt :: (Monad m, Monoid w) => Pos -> String -> EP w m ()
 printStringAt p str = printWhitespace p >> printString True str
diff --git a/src/Language/Haskell/GHC/ExactPrint/Transform.hs b/src/Language/Haskell/GHC/ExactPrint/Transform.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Transform.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Transform.hs
@@ -1,9 +1,11 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 -----------------------------------------------------------------------------
 -- |
@@ -12,7 +14,7 @@
 -- This module is currently under heavy development, and no promises are made
 -- about API stability. Use with care.
 --
--- We weclome any feedback / contributions on this, as it is the main point of
+-- We welcome any feedback / contributions on this, as it is the main point of
 -- the library.
 --
 -----------------------------------------------------------------------------
@@ -20,22 +22,41 @@
         (
         -- * The Transform Monad
           Transform
+        , TransformT(..)
         , runTransform
+        , runTransformFrom
+        , runTransformFromT
 
         -- * Transform monad operations
         , logTr
+        , logDataWithAnnsTr
         , getAnnsT, putAnnsT, modifyAnnsT
         , uniqueSrcSpanT
 
-        , wrapSigT,wrapDeclT
-        , pushDeclAnnT
-        , decl2BindT,decl2SigT
+        , cloneT
 
         , getEntryDPT
+        , setEntryDPT
+        , transferEntryDPT
+        , setPrecedingLinesDeclT
+        , setPrecedingLinesT
         , addSimpleAnnT
+        , addTrailingCommaT
+        , removeTrailingCommaT
 
-        -- ** Managing lists, Transform monad
+        -- ** Managing declarations, in Transform monad
+        , HasTransform (..)
         , HasDecls (..)
+        , hasDeclsSybTransform
+        , hsDeclsGeneric
+        , hsDeclsPatBind, hsDeclsPatBindD
+        , replaceDeclsPatBind, replaceDeclsPatBindD
+        , modifyDeclsT
+        , modifyValD
+        -- *** Utility, does not manage layout
+        , hsDeclsValBinds, replaceDeclsValbinds
+
+        -- ** Managing lists, Transform monad
         , insertAtStart
         , insertAtEnd
         , insertAfter
@@ -53,16 +74,17 @@
         -- * Operations
         , isUniqueSrcSpan
 
-
-        -- * Managing decls
-        , declFun
-
         -- * Pure functions
         , mergeAnns
         , mergeAnnList
         , setPrecedingLinesDecl
         , setPrecedingLines
         , getEntryDP
+        , setEntryDP
+        , transferEntryDP
+        , addTrailingComma
+        , wrapSig, wrapDecl
+        , decl2Sig, decl2Bind
 
         ) where
 
@@ -79,9 +101,16 @@
 import qualified Data.Generics as SYB
 
 import Data.Data
+import Data.List
+import Data.Maybe
 
 import qualified Data.Map as Map
 
+import Data.Functor.Identity
+-- import Control.Monad.Identity
+import Control.Monad.State
+import Control.Monad.Writer
+
 -- import Debug.Trace
 
 ------------------------------------------------------------------------------
@@ -89,29 +118,57 @@
 
 -- | Monad type for updating the AST and managing the annotations at the same
 -- time. The W state is used to generate logging information if required.
-type Transform a = RWS () [String] (Anns,Int) a
+type Transform = TransformT Identity
 
+-- |Monad transformer version of 'Transform' monad
+newtype TransformT m a = TransformT { runTransformT :: RWST () [String] (Anns,Int) m a }
+                deriving (Monad,Applicative,Functor
+                         ,MonadReader ()
+                         ,MonadWriter [String]
+                         ,MonadState (Anns,Int)
+                         -- ,MonadTrans
+                         )
+
+
+
 -- | 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 = runRWS f () (ans,0)
+runTransform ans f = runTransformFrom 0 ans 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 (runTransformT f) () (ans,seed)
+
+-- |Run a monad transformer stack for the 'TransformT' monad transformer
+runTransformFromT :: (Monad m) => Int -> Anns -> TransformT m a -> m (a,(Anns,Int),[String])
+runTransformFromT seed ans f = runRWST (runTransformT f) () (ans,seed)
+
 -- |Log a string to the output of the Monad
-logTr :: String -> Transform ()
+logTr :: (Monad m) => String -> TransformT m ()
 logTr str = tell [str]
 
+-- |Log a representation of the given AST with annotations to the output of the
+-- Monad
+logDataWithAnnsTr :: (Monad m) => (SYB.Data a) => String -> a -> TransformT m ()
+logDataWithAnnsTr str ast = do
+  anns <- getAnnsT
+  logTr $ str ++ showAnnData anns 0 ast
+
 -- |Access the 'Anns' being modified in this transformation
-getAnnsT :: Transform Anns
+getAnnsT :: (Monad m) => TransformT m Anns
 getAnnsT = gets fst
 
 -- |Replace the 'Anns' after any changes
-putAnnsT :: Anns -> Transform ()
+putAnnsT :: (Monad m) => Anns -> TransformT m ()
 putAnnsT ans = do
   (_,col) <- get
   put (ans,col)
 
 -- |Change the stored 'Anns'
-modifyAnnsT :: (Anns -> Anns) -> Transform ()
+modifyAnnsT :: (Monad m) => (Anns -> Anns) -> TransformT m ()
 modifyAnnsT f = do
   ans <- getAnnsT
   putAnnsT (f ans)
@@ -133,15 +190,24 @@
 isUniqueSrcSpan ss = srcSpanStartLine ss == -1
 
 -- ---------------------------------------------------------------------
-{-
--- TODO: I suspect this may be needed in future.
-
 -- |Make a copy of an AST element, replacing the existing SrcSpans with new
 -- ones, and duplicating the matching annotations.
-cloneT :: GHC.Located a -> Transform (GHC.Located a)
-cloneT _ast = do
-  error "Transform.cloneT undefined"
--}
+cloneT :: (Data a,Typeable a) => a -> Transform (a, [(GHC.SrcSpan, GHC.SrcSpan)])
+cloneT ast = do
+  runWriterT $ SYB.everywhereM (return `SYB.ext2M` replaceLocated) ast
+  where
+    replaceLocated :: forall loc a. (Typeable loc,Typeable a, Data a)
+                    => (GHC.GenLocated loc a) -> WriterT [(GHC.SrcSpan, GHC.SrcSpan)] Transform (GHC.GenLocated loc a)
+    replaceLocated (GHC.L l t) = do
+      case cast l :: Maybe GHC.SrcSpan of
+        Just ss -> do
+          newSpan <- lift uniqueSrcSpanT
+          lift $ modifyAnnsT (\anns -> case Map.lookup (mkAnnKey (GHC.L ss t)) anns of
+                                  Nothing -> anns
+                                  Just an -> Map.insert (mkAnnKey (GHC.L newSpan t)) an anns)
+          tell [(ss, newSpan)]
+          return $ fromJust . cast  $ GHC.L newSpan t
+        Nothing -> return (GHC.L l t)
 
 -- ---------------------------------------------------------------------
 
@@ -178,113 +244,15 @@
 
 -- ---------------------------------------------------------------------
 
--- |Convert a 'GHC.LSig' into a 'GHC.LHsDecl', duplicating the 'GHC.LSig'
--- annotation for the 'GHC.LHsDecl'. This needs to be set up so that the
--- original annotation is restored after a 'pushDeclAnnT' call.
-wrapSigT :: GHC.LSig GHC.RdrName -> Transform (GHC.LHsDecl GHC.RdrName)
-wrapSigT d@(GHC.L _ s) = do
-  newSpan <- uniqueSrcSpanT
-  let
-    f ans = case Map.lookup (mkAnnKey d) ans of
-      Nothing -> ans
-      Just ann ->
-                  Map.insert (mkAnnKey (GHC.L newSpan s)) ann
-                $ Map.insert (mkAnnKey (GHC.L newSpan (GHC.SigD s))) ann ans
-  modifyAnnsT f
-  return (GHC.L newSpan (GHC.SigD s))
-
--- ---------------------------------------------------------------------
-
--- |Convert a 'GHC.LHsBind' into a 'GHC.LHsDecl', duplicating the 'GHC.LHsBind'
--- annotation for the 'GHC.LHsDecl'. This needs to be set up so that the
--- original annotation is restored after a 'pushDeclAnnT' call.
-wrapDeclT :: GHC.LHsBind GHC.RdrName -> Transform (GHC.LHsDecl GHC.RdrName)
-wrapDeclT d@(GHC.L _ s) = do
-  newSpan <- uniqueSrcSpanT
-  let
-    f ans = case Map.lookup (mkAnnKey d) ans of
-      Nothing -> ans
-      Just ann ->
-                  Map.insert (mkAnnKey (GHC.L newSpan           s )) ann
-                $ Map.insert (mkAnnKey (GHC.L newSpan (GHC.ValD s))) ann ans
-  modifyAnnsT f
-  return (GHC.L newSpan (GHC.ValD s))
-
--- ---------------------------------------------------------------------
-
--- |Copy the top level annotation to a new SrcSpan and the unwrapped decl. This
--- is required so that 'decl2Sig' and 'decl2Bind' will produce values that have
--- the required annotations.
-pushDeclAnnT :: GHC.LHsDecl GHC.RdrName -> Transform (GHC.LHsDecl GHC.RdrName)
-pushDeclAnnT ld@(GHC.L l decl) = do
-  newSpan <- uniqueSrcSpanT
-  let
-    blend ann Nothing = ann
-    blend ann (Just annd)
-      = annd { annEntryDelta        = annEntryDelta ann
-             , annPriorComments     = annPriorComments     ann  ++ annPriorComments     annd
-             , annFollowingComments = annFollowingComments annd ++ annFollowingComments ann
-             }
-    duplicateAnn d ans =
-      case Map.lookup (mkAnnKey ld) ans of
-        Nothing -> error $ "pushDeclAnnT:no key found for:" ++ show (mkAnnKey ld)
-        -- Nothing -> Anns ans
-        Just ann -> Map.insert (mkAnnKey (GHC.L newSpan d))
-                                      (blend ann (Map.lookup (mkAnnKey (GHC.L l d)) ans))
-                                      ans
-  case decl of
-    GHC.TyClD d       -> modifyAnnsT (duplicateAnn d)
-    GHC.InstD d       -> modifyAnnsT (duplicateAnn d)
-    GHC.DerivD d      -> modifyAnnsT (duplicateAnn d)
-    GHC.ValD d        -> modifyAnnsT (duplicateAnn d)
-    GHC.SigD d        -> modifyAnnsT (duplicateAnn d)
-    GHC.DefD d        -> modifyAnnsT (duplicateAnn d)
-    GHC.ForD d        -> modifyAnnsT (duplicateAnn d)
-    GHC.WarningD d    -> modifyAnnsT (duplicateAnn d)
-    GHC.AnnD d        -> modifyAnnsT (duplicateAnn d)
-    GHC.RuleD d       -> modifyAnnsT (duplicateAnn d)
-    GHC.VectD d       -> modifyAnnsT (duplicateAnn d)
-    GHC.SpliceD d     -> modifyAnnsT (duplicateAnn d)
-    GHC.DocD d        -> modifyAnnsT (duplicateAnn d)
-    GHC.RoleAnnotD d  -> modifyAnnsT (duplicateAnn d)
-#if __GLASGOW_HASKELL__ < 711
-    GHC.QuasiQuoteD d -> modifyAnnsT (duplicateAnn d)
-#endif
-  return (GHC.L newSpan decl)
-
--- ---------------------------------------------------------------------
-
--- |Unwrap a 'GHC.LHsDecl' to its underlying 'GHC.LHsBind', transferring the top
--- level annotation to a new unique 'GHC.SrcSpan' in the process.
-decl2BindT :: GHC.LHsDecl GHC.RdrName -> Transform [GHC.LHsBind GHC.RdrName]
-decl2BindT vd@(GHC.L _ (GHC.ValD d)) = do
-  newSpan <- uniqueSrcSpanT
-  logTr $ "decl2BindT:newSpan=" ++ showGhc newSpan
-  let
-    duplicateAnn ans =
-      case Map.lookup (mkAnnKey vd) ans of
-        Nothing -> ans
-        Just ann -> Map.insert (mkAnnKey (GHC.L newSpan d)) ann ans
-  modifyAnnsT duplicateAnn
-  return [GHC.L newSpan d]
-decl2BindT _ = return []
+-- |Convert a 'GHC.LSig' into a 'GHC.LHsDecl'
+wrapSig :: GHC.LSig GHC.RdrName -> GHC.LHsDecl GHC.RdrName
+wrapSig (GHC.L l s) = GHC.L l (GHC.SigD s)
 
 -- ---------------------------------------------------------------------
 
--- |Unwrap a 'GHC.LHsDecl' to its underlying 'GHC.LSig', transferring the top
--- level annotation to a new unique 'GHC.SrcSpan' in the process.
-decl2SigT :: GHC.LHsDecl GHC.RdrName -> Transform [GHC.LSig GHC.RdrName]
-decl2SigT vs@(GHC.L _ (GHC.SigD s)) = do
-  newSpan <- uniqueSrcSpanT
-  logTr $ "decl2SigT:newSpan=" ++ showGhc newSpan
-  let
-    duplicateAnn ans =
-      case Map.lookup (mkAnnKey vs) ans of
-        Nothing -> ans
-        Just ann -> Map.insert (mkAnnKey (GHC.L newSpan s)) ann ans
-  modifyAnnsT duplicateAnn
-  return [GHC.L newSpan s]
-decl2SigT _ = return []
+-- |Convert a 'GHC.LHsBind' into a 'GHC.LHsDecl'
+wrapDecl :: GHC.LHsBind GHC.RdrName -> GHC.LHsDecl GHC.RdrName
+wrapDecl (GHC.L l s) = GHC.L l (GHC.ValD s)
 
 -- ---------------------------------------------------------------------
 
@@ -299,6 +267,20 @@
 
 -- ---------------------------------------------------------------------
 
+-- |Add a trailing comma annotation, unless there is already one
+addTrailingCommaT :: (Data a) => GHC.Located a -> Transform ()
+addTrailingCommaT ast = do
+  modifyAnnsT (addTrailingComma ast (DP (0,0)))
+
+-- ---------------------------------------------------------------------
+
+-- |Remove a trailing comma annotation, if there is one one
+removeTrailingCommaT :: (Data a) => GHC.Located a -> Transform ()
+removeTrailingCommaT ast = do
+  modifyAnnsT (removeTrailingComma ast)
+
+-- ---------------------------------------------------------------------
+
 -- |'Transform' monad version of 'getEntryDP'
 getEntryDPT :: (Data a) => GHC.Located a -> Transform DeltaPos
 getEntryDPT ast = do
@@ -307,6 +289,34 @@
 
 -- ---------------------------------------------------------------------
 
+-- |'Transform' monad version of 'getEntryDP'
+setEntryDPT :: (Data a) => GHC.Located a -> DeltaPos -> Transform ()
+setEntryDPT ast dp = do
+  modifyAnnsT (setEntryDP ast dp)
+
+-- ---------------------------------------------------------------------
+
+-- |'Transform' monad version of 'transferEntryDP'
+transferEntryDPT :: (Data a,Data b) => GHC.Located a -> GHC.Located b -> Transform ()
+transferEntryDPT a b =
+  modifyAnnsT (transferEntryDP a b)
+
+-- ---------------------------------------------------------------------
+
+-- |'Transform' monad version of 'setPrecedingLinesDecl'
+setPrecedingLinesDeclT ::  GHC.LHsDecl GHC.RdrName -> Int -> Int -> Transform ()
+setPrecedingLinesDeclT ld n c =
+  modifyAnnsT (setPrecedingLinesDecl ld n c)
+
+-- ---------------------------------------------------------------------
+
+-- |'Transform' monad version of 'setPrecedingLines'
+setPrecedingLinesT ::  (SYB.Data a) => GHC.Located a -> Int -> Int -> Transform ()
+setPrecedingLinesT ld n c =
+  modifyAnnsT (setPrecedingLines ld n c)
+
+-- ---------------------------------------------------------------------
+
 -- | Left bias pair union
 mergeAnns :: Anns -> Anns -> Anns
 mergeAnns
@@ -320,42 +330,15 @@
 -- ---------------------------------------------------------------------
 
 -- |Unwrap a HsDecl and call setPrecedingLines on it
+-- ++AZ++ TODO: get rid of this, it is a synonym only
 setPrecedingLinesDecl :: GHC.LHsDecl GHC.RdrName -> Int -> Int -> Anns -> Anns
-setPrecedingLinesDecl ld n c ans =
-  declFun (\a -> setPrecedingLines a n c ans') ld
-  where
-    ans' = Map.insert (mkAnnKey ld) annNone ans
-
-declFun :: (forall a . Data a => GHC.Located a -> b) -> GHC.LHsDecl GHC.RdrName -> b
-declFun f (GHC.L l de) =
-  case de of
-      GHC.TyClD d       -> f (GHC.L l d)
-      GHC.InstD d       -> f (GHC.L l d)
-      GHC.DerivD d      -> f (GHC.L l d)
-      GHC.ValD d        -> f (GHC.L l d)
-      GHC.SigD d        -> f (GHC.L l d)
-      GHC.DefD d        -> f (GHC.L l d)
-      GHC.ForD d        -> f (GHC.L l d)
-      GHC.WarningD d    -> f (GHC.L l d)
-      GHC.AnnD d        -> f (GHC.L l d)
-      GHC.RuleD d       -> f (GHC.L l d)
-      GHC.VectD d       -> f (GHC.L l d)
-      GHC.SpliceD d     -> f (GHC.L l d)
-      GHC.DocD d        -> f (GHC.L l d)
-      GHC.RoleAnnotD d  -> f (GHC.L l d)
-#if __GLASGOW_HASKELL__ < 711
-      GHC.QuasiQuoteD d -> f (GHC.L l d)
-#endif
+setPrecedingLinesDecl ld n c ans = setPrecedingLines ld n c ans
 
 -- ---------------------------------------------------------------------
 
 -- | Adjust the entry annotations to provide an `n` line preceding gap
 setPrecedingLines :: (SYB.Data a) => GHC.Located a -> Int -> Int -> Anns -> Anns
-setPrecedingLines ast n c anne =
-  Map.alter go (mkAnnKey ast) anne
-  where
-    go Nothing  = Just (annNone { annEntryDelta = DP (n, c) })
-    go (Just a) = Just (a       { annEntryDelta = DP (n, c) })
+setPrecedingLines ast n c anne = setEntryDP ast (DP (n,c)) anne
 
 -- ---------------------------------------------------------------------
 
@@ -369,20 +352,114 @@
 
 -- ---------------------------------------------------------------------
 
+-- |Set the true entry 'DeltaPos' from the annotation for a given AST
+-- element. This is the 'DeltaPos' ignoring any comments.
+setEntryDP :: (Data a) => GHC.Located a -> DeltaPos -> Anns -> Anns
+setEntryDP ast dp anns =
+  case Map.lookup (mkAnnKey ast) anns of
+    Nothing  -> Map.insert (mkAnnKey ast) (annNone { annEntryDelta = dp}) anns
+    Just ann -> Map.insert (mkAnnKey ast) (ann'    { annEntryDelta = annCommentEntryDelta ann' dp}) anns
+      where
+        ann' = setCommentEntryDP ann dp
+
+-- ---------------------------------------------------------------------
+
+-- |When setting an entryDP, the leading comment needs to be adjusted too
+setCommentEntryDP :: Annotation -> DeltaPos -> Annotation
+-- setCommentEntryDP ann dp = error $ "setCommentEntryDP:ann'=" ++ show ann'
+setCommentEntryDP ann dp = ann'
+  where
+    ann' = case (annPriorComments ann) of
+      [] -> ann
+      [(pc,_)]     -> ann { annPriorComments = [(pc,dp)] }
+      ((pc,_):pcs) -> ann { annPriorComments = ((pc,dp):pcs) }
+
+-- ---------------------------------------------------------------------
+
+-- |Take the annEntryDelta associated with the first item and associate it with the second.
+-- Also transfer any comments occuring before it.
+transferEntryDP :: (SYB.Data a, SYB.Data b) => GHC.Located a -> GHC.Located b -> Anns -> Anns
+transferEntryDP a b anns = (const anns2) anns
+  where
+    maybeAnns = do -- Maybe monad
+      anA <- Map.lookup (mkAnnKey a) anns
+      anB <- Map.lookup (mkAnnKey b) anns
+      let anB'  = Ann
+            { annEntryDelta        = DP (0,0) -- Need to adjust for comments after
+            , annPriorComments     = annPriorComments     anB
+            , annFollowingComments = annFollowingComments anB
+            , annsDP               = annsDP          anB
+            , annSortKey           = annSortKey      anB
+            , annCapturedSpan      = annCapturedSpan anB
+            }
+      return ((Map.insert (mkAnnKey b) anB' anns),annLeadingCommentEntryDelta anA)
+    (anns',dp) = fromMaybe
+                  (error $ "transferEntryDP: lookup failed (a,b)=" ++ show (mkAnnKey a,mkAnnKey b))
+                  maybeAnns
+    anns2 = setEntryDP b dp anns'
+
+-- ---------------------------------------------------------------------
+
+addTrailingComma :: (SYB.Data a) => GHC.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 GHC.AnnComma,dp)]}) anns
+        Just _  -> anns
+      where
+        isAnnComma (G GHC.AnnComma,_) = True
+        isAnnComma _                  = False
+
+-- ---------------------------------------------------------------------
+
+removeTrailingComma :: (SYB.Data a) => GHC.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 GHC.AnnComma,_) = True
+        isAnnComma _                  = False
+
+-- ---------------------------------------------------------------------
+
+-- |The relatavise phase 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
+-- to it instead. This is typically required before deleting or duplicating
+-- either of the AST elements.
+balanceComments :: (Data a,Data b) => GHC.Located a -> GHC.Located b -> Transform ()
+balanceComments first second = do
+  -- ++AZ++ : replace the nested casts with appropriate SYB.gmapM
+  -- logTr $ "balanceComments entered"
+  -- logDataWithAnnsTr "first" first
+  case cast first :: Maybe (GHC.LHsDecl GHC.RdrName) of
+    Just (GHC.L l (GHC.ValD fb@(GHC.FunBind{}))) -> do
+      balanceCommentsFB (GHC.L l fb) second
+    _ -> case cast first :: Maybe (GHC.LHsBind GHC.RdrName) of
+      Just fb'@(GHC.L _ (GHC.FunBind{})) -> do
+        balanceCommentsFB fb' second
+      _ -> balanceComments' first second
+
 -- |Prior to moving an AST element, make sure any trailing comments belonging to
 -- it are attached to it, and not the following element. Of necessity this is a
 -- heuristic process, to be tuned later. Possibly a variant should be provided
 -- with a passed-in decision function.
-balanceComments :: (Data a,Data b) => GHC.Located a -> GHC.Located b -> Transform ()
-balanceComments first second = do
+balanceComments' :: (Data a,Data b) => GHC.Located a -> GHC.Located b -> Transform ()
+balanceComments' first second = do
   let
     k1 = mkAnnKey first
     k2 = mkAnnKey second
     moveComments p ans = ans'
       where
-        an1 = gfromJust "balanceComments k1" $ Map.lookup k1 ans
-        an2 = gfromJust "balanceComments k2" $ Map.lookup k2 ans
-        -- cs1b = annPriorComments     an1
+        an1 = gfromJust "balanceComments' k1" $ Map.lookup k1 ans
+        an2 = gfromJust "balanceComments' k2" $ Map.lookup k2 ans
         cs1f = annFollowingComments an1
         cs2b = annPriorComments an2
         (move,stay) = break p cs2b
@@ -394,13 +471,24 @@
 
   modifyAnnsT (moveComments simpleBreak)
 
+-- |Once 'balanceComments' has been called to move trailing comments to a
+-- 'GHC.FunBind', these need to be pushed down from the top level to the last
+-- 'GHC.Match' if that 'GHC.Match' needs to be manipulated.
+balanceCommentsFB :: (Data b) => GHC.LHsBind GHC.RdrName -> GHC.Located b -> Transform ()
+balanceCommentsFB (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) second = do
+  -- logTr $ "balanceCommentsFB entered"
+  balanceComments' (last matches) second
+balanceCommentsFB f s = balanceComments' f s
+
 -- ---------------------------------------------------------------------
 
+
 -- |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 :: (Data a,Data b) => GHC.Located a -> GHC.Located b -> Transform [(Comment, DeltaPos)]
+balanceTrailingComments :: (Monad m) => (Data a,Data b) => GHC.Located a -> GHC.Located b
+                        -> TransformT m [(Comment, DeltaPos)]
 balanceTrailingComments first second = do
   let
     k1 = mkAnnKey first
@@ -412,16 +500,10 @@
         cs1f = annFollowingComments an1
         (move,stay) = break p cs1f
         an1' = an1 { annFollowingComments = stay }
-        an2' = an2 -- { annPriorComments = move ++ cs2b }
-        -- an1' = an1 { annFollowingComments = [] }
-        -- an2' = an2 { annPriorComments = cs1f ++ cs2b }
-        ans' = Map.insert k1 an1' $ Map.insert k2 an2' ans
-        -- ans' = error $ "balanceTrailingComments:(k1,k2)=" ++ showGhc (k1,k2)
-        -- ans' = error $ "balanceTrailingComments:(cs1b,cs1f,cs2b,annFollowingComments an2)=" ++ showGhc (cs1b,cs1f,cs2b,annFollowingComments an2)
+        ans' = Map.insert k1 an1' $ Map.insert k2 an2 ans
 
     simpleBreak (_,DP (r,_c)) = r > 0
 
-  -- modifyAnnsT (modifyKeywordDeltas (moveComments simpleBreak))
   ans <- getAnnsT
   let (ans',mov) = moveComments simpleBreak ans
   putAnnsT ans'
@@ -429,6 +511,7 @@
 
 -- ---------------------------------------------------------------------
 
+-- ++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)
@@ -451,20 +534,21 @@
 
 -- ---------------------------------------------------------------------
 
+-- |Insert a declaration into an AST element having sub-declarations
+-- (@HasDecls@) according to the given location function.
 insertAt :: (Data ast, HasDecls (GHC.Located ast))
-              => (GHC.SrcSpan -> [GHC.SrcSpan] -> [GHC.SrcSpan])
+              => (GHC.LHsDecl GHC.RdrName
+                  -> [GHC.LHsDecl GHC.RdrName]
+                  -> [GHC.LHsDecl GHC.RdrName])
               -> GHC.Located ast
               -> GHC.LHsDecl GHC.RdrName
               -> Transform (GHC.Located ast)
-insertAt f m decl = do
-  let newKey = GHC.getLoc decl
-      modKey = mkAnnKey m
-      newValue a@Ann{..} = a { annSortKey = f newKey <$> annSortKey }
-  oldDecls <- hsDecls m
-  modifyAnnsT (Map.adjust newValue modKey)
-
-  replaceDecls m (decl : oldDecls )
+insertAt f t decl = do
+  oldDecls <- hsDecls t
+  replaceDecls t (f decl oldDecls)
 
+-- |Insert a declaration at the beginning or end of the subdecls of the given
+-- AST item
 insertAtStart, insertAtEnd :: (Data ast, HasDecls (GHC.Located ast))
               => GHC.Located ast
               -> GHC.LHsDecl GHC.RdrName
@@ -473,31 +557,38 @@
 insertAtStart = insertAt (:)
 insertAtEnd   = insertAt (\x xs -> xs ++ [x])
 
+-- |Insert a declaration at a specific location in the subdecls of the given
+-- AST item
 insertAfter, insertBefore :: (Data ast, HasDecls (GHC.Located ast))
                           => GHC.Located old
                           -> GHC.Located ast
                           -> GHC.LHsDecl GHC.RdrName
                           -> Transform (GHC.Located ast)
--- insertAfter (mkAnnKey -> k) = insertAt findAfter
 insertAfter (GHC.getLoc -> k) = insertAt findAfter
   where
     findAfter x xs =
-      let (fs, b:bs) = span (/= k) xs
+      let (fs, b:bs) = span (\(GHC.L l _) -> l /= k) xs
       in fs ++ (b : x : bs)
 insertBefore (GHC.getLoc -> k) = insertAt findBefore
   where
     findBefore x xs =
-      let (fs, bs) = span (/= k) xs
+      let (fs, bs) = span (\(GHC.L l _) -> l /= k) xs
       in fs ++ (x : bs)
 
--- ---------------------------------------------------------------------
+-- =====================================================================
+-- start of HasDecls instances
+-- =====================================================================
 
+-- |Provide a means to get and process the immediate child declartions of a
+-- given AST element.
 class (Data t) => HasDecls t where
+-- ++AZ++: TODO: add tests to confirm that hsDecls followed by replaceDecls is idempotent
 
     -- | Return the 'GHC.HsDecl's that are directly enclosed in the
     -- given syntax phrase. They are always returned in the wrapped 'GHC.HsDecl'
-    -- form, even if orginating in local decls.
-    hsDecls :: t -> Transform [GHC.LHsDecl GHC.RdrName]
+    -- 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 [GHC.LHsDecl GHC.RdrName]
 
     -- | Replace the directly enclosed decl list by the given
     --  decl list. Runs in the 'Transform' monad to be able to update list order
@@ -518,7 +609,7 @@
     --   where
     --     nn = 2
     -- @
-    replaceDecls :: t -> [GHC.LHsDecl GHC.RdrName] -> Transform t
+    replaceDecls :: (Monad m) => t -> [GHC.LHsDecl GHC.RdrName] -> TransformT m t
 
 -- ---------------------------------------------------------------------
 
@@ -526,40 +617,20 @@
   hsDecls (GHC.L _ (GHC.HsModule _mn _exps _imps decls _ _)) = return decls
   replaceDecls m@(GHC.L l (GHC.HsModule mn exps imps _decls deps haddocks)) decls
     = do
+        logTr "replaceDecls LHsModule"
         modifyAnnsT (captureOrder m decls)
         return (GHC.L l (GHC.HsModule mn exps imps decls deps haddocks))
 
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.MatchGroup GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where
-  hsDecls (GHC.MG matches _ _ _) = hsDecls matches
-
-  replaceDecls (GHC.MG matches a r o) newDecls
-    = do
-        matches' <- replaceDecls matches newDecls
-        return (GHC.MG matches' a r o)
-
--- ---------------------------------------------------------------------
-
-instance HasDecls [GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)] where
-  hsDecls ms = do
-    ds <- mapM hsDecls ms
-    return (concat ds)
-
-  replaceDecls [] _        = error "empty match list in replaceDecls [GHC.LMatch GHC.Name]"
-  replaceDecls ms newDecls
-    = do
-        -- ++AZ++: TODO: this one looks dodgy
-        m' <- replaceDecls (ghead "replaceDecls" ms) newDecls
-        return (m':tail ms)
-
--- ---------------------------------------------------------------------
-
 instance HasDecls (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where
-  hsDecls (GHC.L _ (GHC.Match _ _ _ grhs)) = hsDecls grhs
+  hsDecls d@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ lb))) = do
+    decls <- hsDeclsValBinds lb
+    orderedDecls d decls
 
   replaceDecls m@(GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds))) []
     = do
+        logTr "replaceDecls LMatch"
         let
           noWhere (G GHC.AnnWhere,_) = False
           noWhere _                  = True
@@ -569,18 +640,19 @@
               Nothing -> error "wtf"
               Just ann -> Map.insert (mkAnnKey m) ann1 mkds
                 where
-                  ann1 = ann { annsDP = filter noWhere (annsDP ann) 
+                  ann1 = ann { annsDP = filter noWhere (annsDP ann)
                                  }
         modifyAnnsT removeWhere
 
-        binds' <- replaceDecls binds []
+        binds' <- replaceDeclsValbinds binds []
         return (GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds')))
 
   replaceDecls m@(GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds))) newBinds
     = do
+        logTr "replaceDecls LMatch"
         -- Need to throw in a fresh where clause if the binds were empty,
         -- in the annotations.
-        newBinds2 <- case binds of
+        case binds of
           GHC.EmptyLocalBinds -> do
             let
               addWhere mkds =
@@ -591,172 +663,345 @@
                       ann1 = ann { annsDP = annsDP ann ++ [(G GHC.AnnWhere,DP (1,2))]
                                  }
             modifyAnnsT addWhere
-            newBinds' <- mapM pushDeclAnnT newBinds
-            modifyAnnsT (captureOrderAnnKey (mkAnnKey m) newBinds')
-            modifyAnnsT (setPrecedingLinesDecl (ghead "LMatch.replaceDecls" newBinds') 1 4)
-            return newBinds'
+            modifyAnnsT (setPrecedingLines (ghead "LMatch.replaceDecls" newBinds) 1 4)
 
-          _ -> do
-            -- ++AZ++ TODO: move the duplicate code out of the case statement
-            newBinds' <- mapM pushDeclAnnT newBinds
-            modifyAnnsT (captureOrderAnnKey (mkAnnKey m) newBinds')
-            return newBinds'
+            -- only move the comment if the original where clause was empty.
+            toMove <- balanceTrailingComments m m
+            insertCommentBefore (mkAnnKey m) toMove (matchApiAnn GHC.AnnWhere)
+          _ -> return ()
 
-        binds' <- replaceDecls binds newBinds2
+        modifyAnnsT (captureOrderAnnKey (mkAnnKey m) newBinds)
+        binds' <- replaceDeclsValbinds binds newBinds
+        -- logDataWithAnnsTr "Match.replaceDecls:binds'" binds'
         return (GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds')))
 
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where
-  hsDecls (GHC.GRHSs _ lb) = hsDecls lb
+instance HasDecls (GHC.LHsExpr GHC.RdrName) where
+  hsDecls ls@(GHC.L _ (GHC.HsLet decls _ex)) = do
+    ds <- hsDeclsValBinds decls
+    orderedDecls ls ds
+  hsDecls _                               = return []
 
-  replaceDecls (GHC.GRHSs rhss b) new
+  replaceDecls e@(GHC.L l (GHC.HsLet decls ex)) newDecls
     = do
-        b' <- replaceDecls b new
-        return (GHC.GRHSs rhss b')
+        logTr "replaceDecls HsLet"
+        modifyAnnsT (captureOrder e newDecls)
+        decls' <- replaceDeclsValbinds decls newDecls
+        return (GHC.L l (GHC.HsLet decls' ex))
+  replaceDecls (GHC.L l (GHC.HsPar e)) newDecls
+    = do
+        logTr "replaceDecls HsPar"
+        e' <- replaceDecls e newDecls
+        return (GHC.L l (GHC.HsPar e'))
+  replaceDecls old _new = error $ "replaceDecls (GHC.LHsExpr GHC.RdrName) undefined for:" ++ showGhc old
 
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.HsLocalBinds GHC.RdrName) where
-  hsDecls lb = case lb of
-    GHC.HsValBinds (GHC.ValBindsIn bs sigs) -> do
-      bds <- mapM wrapDeclT (GHC.bagToList bs)
-      sds <- mapM wrapSigT sigs
-      -- ++AZ++ TODO: return in annotated order
-      return (bds ++ sds)
-    GHC.HsValBinds (GHC.ValBindsOut _ _) -> error $ "hsDecls.ValbindsOut not valid"
-    GHC.HsIPBinds _     -> return []
-    GHC.EmptyLocalBinds -> return []
+-- | Extract the immediate declarations for a 'GHC.PatBind' wrapped in a 'GHC.ValD'. This
+-- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
+-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is
+-- idempotent.
+hsDeclsPatBindD :: (Monad m) => GHC.LHsDecl GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]
+hsDeclsPatBindD (GHC.L l (GHC.ValD d)) = hsDeclsPatBind (GHC.L l d)
+hsDeclsPatBindD x = error $ "hsDeclsPatBindD called for:" ++ showGhc x
 
-  replaceDecls (GHC.HsValBinds _b) new
-    = do
-        let decs = GHC.listToBag $ concatMap decl2Bind new
-        let sigs = concatMap decl2Sig new
-        return (GHC.HsValBinds (GHC.ValBindsIn decs sigs))
+-- | Extract the immediate declarations for a 'GHC.PatBind'. This
+-- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
+-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is
+-- idempotent.
+hsDeclsPatBind :: (Monad m) => GHC.LHsBind GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]
+hsDeclsPatBind d@(GHC.L _ (GHC.PatBind _ (GHC.GRHSs _grhs lb) _ _ _)) = do
+  decls <- hsDeclsValBinds lb
+  orderedDecls d decls
+hsDeclsPatBind x = error $ "hsDeclsPatBind called for:" ++ showGhc x
 
-  replaceDecls (GHC.HsIPBinds _b) _new    = error "undefined replaceDecls HsIPBinds"
+-- -------------------------------------
 
-  replaceDecls (GHC.EmptyLocalBinds) new
+-- | Replace the immediate declarations for a 'GHC.PatBind' wrapped in a 'GHC.ValD'. This
+-- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
+-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is
+-- idempotent.
+replaceDeclsPatBindD :: (Monad m) => GHC.LHsDecl GHC.RdrName -> [GHC.LHsDecl GHC.RdrName]
+                     -> TransformT m (GHC.LHsDecl GHC.RdrName)
+replaceDeclsPatBindD (GHC.L l (GHC.ValD d)) newDecls = do
+  (GHC.L _ d') <- replaceDeclsPatBind (GHC.L l d) newDecls
+  return (GHC.L l (GHC.ValD d'))
+replaceDeclsPatBindD x _ = error $ "replaceDeclsPatBindD called for:" ++ showGhc x
+
+-- | Replace the immediate declarations for a 'GHC.PatBind'. This
+-- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
+-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is
+-- idempotent.
+replaceDeclsPatBind :: (Monad m) => GHC.LHsBind GHC.RdrName -> [GHC.LHsDecl GHC.RdrName]
+                    -> TransformT m (GHC.LHsBind GHC.RdrName)
+replaceDeclsPatBind p@(GHC.L l (GHC.PatBind a (GHC.GRHSs rhss binds) b c d)) newDecls
     = do
-        let newBinds = map decl2Bind new
-            newSigs  = map decl2Sig  new
-        ans <- getAnnsT
-        logTr $ "replaceDecls:newBinds=" ++ showAnnData ans 0 newBinds
-        let decs = GHC.listToBag $ concat newBinds
-        let sigs = concat newSigs
-        return (GHC.HsValBinds (GHC.ValBindsIn decs sigs))
+        logTr "replaceDecls PatBind"
+        -- Need to throw in a fresh where clause if the binds were empty,
+        -- in the annotations.
+        case binds of
+          GHC.EmptyLocalBinds -> do
+            let
+              addWhere mkds =
+                case Map.lookup (mkAnnKey p) mkds of
+                  Nothing -> error "wtf"
+                  Just ann -> Map.insert (mkAnnKey p) ann1 mkds
+                    where
+                      ann1 = ann { annsDP = annsDP ann ++ [(G GHC.AnnWhere,DP (1,2))]
+                                 }
+            modifyAnnsT addWhere
+            modifyAnnsT (setPrecedingLines (ghead "LMatch.replaceDecls" newDecls) 1 4)
 
+          _ -> return ()
+
+        modifyAnnsT (captureOrderAnnKey (mkAnnKey p) newDecls)
+        binds' <- replaceDeclsValbinds binds newDecls
+        return (GHC.L l (GHC.PatBind a (GHC.GRHSs rhss binds') b c d))
+replaceDeclsPatBind x _ = error $ "replaceDeclsPatBind called for:" ++ showGhc x
+
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.LHsExpr GHC.RdrName) where
-  hsDecls (GHC.L _ (GHC.HsLet decls _ex)) = hsDecls decls
-  hsDecls _                               = return []
+instance HasDecls (GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where
+  hsDecls ls@(GHC.L _ (GHC.LetStmt lb))       = do
+    decls <- hsDeclsValBinds lb
+    orderedDecls ls decls
+  hsDecls (GHC.L _ (GHC.LastStmt e _))        = hsDecls e
+  hsDecls (GHC.L _ (GHC.BindStmt _pat e _ _)) = hsDecls e
+  hsDecls (GHC.L _ (GHC.BodyStmt e _ _ _))    = hsDecls e
+  hsDecls _                                   = return []
 
-  replaceDecls (GHC.L l (GHC.HsLet decls ex)) newDecls
+  replaceDecls s@(GHC.L l (GHC.LetStmt lb)) newDecls
     = do
-        decls' <- replaceDecls decls newDecls
-        return (GHC.L l (GHC.HsLet decls' ex))
-  replaceDecls old _new = error $ "replaceDecls (GHC.LHsExpr GHC.RdrName) undefined for:" ++ showGhc old
+        modifyAnnsT (captureOrder s newDecls)
+        lb' <- replaceDeclsValbinds lb newDecls
+        return (GHC.L l (GHC.LetStmt lb'))
+  replaceDecls (GHC.L l (GHC.LastStmt e se)) newDecls
+    = do
+        e' <- replaceDecls e newDecls
+        return (GHC.L l (GHC.LastStmt e' se))
+  replaceDecls (GHC.L l (GHC.BindStmt pat e a b)) newDecls
+    = do
+      e' <- replaceDecls e newDecls
+      return (GHC.L l (GHC.BindStmt pat e' a b))
+  replaceDecls (GHC.L l (GHC.BodyStmt e a b c)) newDecls
+    = do
+      e' <- replaceDecls e newDecls
+      return (GHC.L l (GHC.BodyStmt e' a b c))
+  replaceDecls x _newDecls = return x
 
+-- =====================================================================
+-- end of HasDecls instances
+-- =====================================================================
+
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.LHsBinds GHC.RdrName) where
-  hsDecls binds = hsDecls $ GHC.bagToList binds
-  replaceDecls old _new = error $ "replaceDecls (GHC.LHsBinds name) undefined for:" ++ (showGhc old)
+-- |Do a transformation on an AST fragment by providing a function to process
+-- the general case and one specific for a 'GHC.LHsBind'. This is required
+-- because a 'GHC.FunBind' may have multiple 'GHC.Match' items, so we cannot
+-- gurantee that 'replaceDecls' after 'hsDecls' is idempotent.
+hasDeclsSybTransform :: (SYB.Data t2, SYB.Typeable t2,Monad m)
+       => (forall t. HasDecls t => t -> m t)
+             -- ^Worker function for the general case
+       -> (GHC.LHsBind GHC.RdrName -> m (GHC.LHsBind GHC.RdrName))
+             -- ^Worker function for FunBind/PatBind
+       -> t2 -- ^Item to be updated
+       -> m t2
+hasDeclsSybTransform workerHasDecls workerBind t = trf t
+  where
+    trf = SYB.mkM   parsedSource
+         `SYB.extM` lmatch
+         `SYB.extM` lexpr
+         `SYB.extM` lstmt
+         `SYB.extM` lhsbind
+         `SYB.extM` lvald
 
+    parsedSource (p::GHC.ParsedSource) = workerHasDecls p
+
+    lmatch (lm::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
+      = workerHasDecls lm
+
+    lexpr (le::GHC.LHsExpr GHC.RdrName)
+      = workerHasDecls le
+
+    lstmt (d::GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName))
+      = workerHasDecls d
+
+    lhsbind (b@(GHC.L _ GHC.FunBind{}):: GHC.LHsBind GHC.RdrName)
+      = workerBind b
+    lhsbind b@(GHC.L _ GHC.PatBind{})
+      = workerBind b
+    lhsbind x = return x
+
+    lvald (GHC.L l (GHC.ValD d)) = do
+      (GHC.L _ d') <- lhsbind (GHC.L l d)
+      return (GHC.L l (GHC.ValD d'))
+    lvald x = return x
+
 -- ---------------------------------------------------------------------
 
-instance HasDecls [GHC.LHsBind GHC.RdrName] where
-  hsDecls bs = mapM wrapDeclT bs
+-- |A 'GHC.FunBind' wraps up one or more 'GHC.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 'GHC.FunBind'
+-- decls too, where they are needed for analysis only.
+hsDeclsGeneric :: (SYB.Data t,SYB.Typeable t) => t -> Transform [GHC.LHsDecl GHC.RdrName]
+hsDeclsGeneric t = q t
+  where
+    q = return []
+        `SYB.mkQ`  parsedSource
+        `SYB.extQ` lmatch
+        `SYB.extQ` lexpr
+        `SYB.extQ` lstmt
+        `SYB.extQ` lhsbind
+        `SYB.extQ` lhsbindd
+        `SYB.extQ` localbinds
 
-  replaceDecls _bs newDecls
-    = do
-        return $ concatMap decl2Bind newDecls
+    parsedSource (p::GHC.ParsedSource) = hsDecls p
 
+    lmatch (lm::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = hsDecls lm
+
+    lexpr (le::GHC.LHsExpr GHC.RdrName) = hsDecls le
+
+    lstmt (d::GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = hsDecls d
+
+    -- ---------------------------------
+
+    lhsbind :: GHC.LHsBind GHC.RdrName -> Transform [GHC.LHsDecl GHC.RdrName]
+    lhsbind (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) = do
+        dss <- mapM hsDecls matches
+        return (concat dss)
+    lhsbind p@(GHC.L _ (GHC.PatBind{})) = do
+      hsDeclsPatBind p
+    lhsbind _ = return []
+
+    -- ---------------------------------
+
+    lhsbindd (GHC.L l (GHC.ValD d)) = lhsbind (GHC.L l d)
+    lhsbindd _ = return []
+
+    -- ---------------------------------
+
+    localbinds :: GHC.HsLocalBinds GHC.RdrName -> Transform [GHC.LHsDecl GHC.RdrName]
+    localbinds d = hsDeclsValBinds d
+
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.LHsBind GHC.RdrName) where
-  hsDecls (GHC.L _ (GHC.FunBind _ _ matches _ _ _)) = hsDecls matches
-  hsDecls (GHC.L _ (GHC.PatBind _ rhs _ _ _))       = hsDecls rhs
-  hsDecls (GHC.L _ (GHC.VarBind _ rhs _))           = hsDecls rhs
-  hsDecls (GHC.L _ (GHC.AbsBinds _ _ _ _ binds))    = hsDecls binds
-  hsDecls (GHC.L _ (GHC.PatSynBind _))      = error "hsDecls: PatSynBind to implement"
+-- |Look up the annotated order and sort the decls accordingly
+orderedDecls :: (Data a,Monad m) => GHC.Located a -> [GHC.LHsDecl GHC.RdrName] -> TransformT m [GHC.LHsDecl GHC.RdrName]
+orderedDecls parent decls = do
+  ans <- getAnnsT
+  case getAnnotationEP parent ans of
+    Nothing -> error $ "orderedDecls:no annotation for:" ++ showAnnData emptyAnns 0 parent
+    Just ann -> case annSortKey ann of
+      Nothing -> do
+        return decls
+      Just keys -> do
+        let ds = map (\s -> (GHC.getLoc s,s)) decls
+            ordered = orderByKey ds keys
+        return ordered
 
+-- ---------------------------------------------------------------------
 
-  replaceDecls (GHC.L l fn@(GHC.FunBind a b (GHC.MG matches f g h) c d e)) newDecls
-    = do
-        matches' <- replaceDecls matches newDecls
-        case matches' of
-          [] -> return () -- Should be impossible
-          ms -> do
-            case (GHC.grhssLocalBinds $ GHC.m_grhss $ GHC.unLoc $ last matches) of
-              GHC.EmptyLocalBinds -> do
-                -- only move the comment if the original where clause was empty.
-                toMove <- balanceTrailingComments (GHC.L l (GHC.ValD fn)) (last matches')
-                insertCommentBefore (mkAnnKey $ last ms) toMove (matchApiAnn GHC.AnnWhere)
-              lbs -> do
-                decs <- hsDecls lbs
-                balanceComments (last decs) (GHC.L l (GHC.ValD fn))
-        return (GHC.L l (GHC.FunBind a b (GHC.MG matches' f g h) c d e))
+-- | Utility function for extracting decls from 'GHC.HsLocalBinds'. Use with
+-- care, as this does not necessarily return the declarations in order, the
+-- ordering should be done by the calling function from the 'GHC.HsLocalBinds'
+-- context in the AST.
+hsDeclsValBinds :: (Monad m) => GHC.HsLocalBinds GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]
+hsDeclsValBinds lb = case lb of
+    GHC.HsValBinds (GHC.ValBindsIn bs sigs) -> do
+      let
+        bds = map wrapDecl (GHC.bagToList bs)
+        sds = map wrapSig sigs
+      return (bds ++ sds)
+    GHC.HsValBinds (GHC.ValBindsOut _ _) -> error $ "hsDecls.ValbindsOut not valid"
+    GHC.HsIPBinds _     -> return []
+    GHC.EmptyLocalBinds -> return []
 
-  replaceDecls (GHC.L l (GHC.PatBind a rhs b c d)) newDecls
-    = do
-        rhs' <- replaceDecls rhs newDecls
-        return (GHC.L l (GHC.PatBind a rhs' b c d))
-  replaceDecls (GHC.L l (GHC.VarBind a rhs b)) newDecls
+-- | Utility function for returning decls to 'GHC.HsLocalBinds'. Use with
+-- care, as this does not manage the declaration order, the
+-- ordering should be done by the calling function from the 'GHC.HsLocalBinds'
+-- context in the AST.
+replaceDeclsValbinds :: (Monad m)
+                     => GHC.HsLocalBinds GHC.RdrName -> [GHC.LHsDecl GHC.RdrName]
+                     -> TransformT m (GHC.HsLocalBinds GHC.RdrName)
+replaceDeclsValbinds _ [] = do
+  return (GHC.EmptyLocalBinds)
+replaceDeclsValbinds (GHC.HsValBinds _b) new
     = do
-        rhs' <- replaceDecls rhs newDecls
-        return (GHC.L l (GHC.VarBind a rhs' b))
-  replaceDecls (GHC.L l (GHC.AbsBinds a b c d binds)) newDecls
+        logTr "replaceDecls HsLocalBinds"
+        let decs = GHC.listToBag $ concatMap decl2Bind new
+        let sigs = concatMap decl2Sig new
+        return (GHC.HsValBinds (GHC.ValBindsIn decs sigs))
+replaceDeclsValbinds (GHC.HsIPBinds _b) _new    = error "undefined replaceDecls HsIPBinds"
+replaceDeclsValbinds (GHC.EmptyLocalBinds) new
     = do
-        binds' <- replaceDecls binds newDecls
-        return (GHC.L l (GHC.AbsBinds a b c d binds'))
-  replaceDecls (GHC.L _ (GHC.PatSynBind _)) _ = error "replaceDecls: PatSynBind to implement"
+        logTr "replaceDecls HsLocalBinds"
+        let newBinds = map decl2Bind new
+            newSigs  = map decl2Sig  new
+        let decs = GHC.listToBag $ concat newBinds
+        let sigs = concat newSigs
+        return (GHC.HsValBinds (GHC.ValBindsIn decs sigs))
 
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where
-  hsDecls (GHC.LetStmt lb)          = hsDecls lb
-  hsDecls (GHC.LastStmt e _)        = hsDecls e
-  hsDecls (GHC.BindStmt _pat e _ _) = hsDecls e
-  hsDecls (GHC.BodyStmt e _ _ _)    = hsDecls e
-  hsDecls _                         = return []
+type Decl  = GHC.LHsDecl GHC.RdrName
+type Match = GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)
 
-  replaceDecls (GHC.LetStmt lb) newDecls
-    = do
-      lb' <- replaceDecls lb newDecls
-      return (GHC.LetStmt lb')
-  replaceDecls (GHC.LastStmt e se) newDecls
-    = do
-        e' <- replaceDecls e newDecls
-        return (GHC.LastStmt e' se)
-  replaceDecls (GHC.BindStmt pat e a b) newDecls
-    = do
-      e' <- replaceDecls e newDecls
-      return (GHC.BindStmt pat e' a b)
-  replaceDecls (GHC.BodyStmt e a b c) newDecls
-    = do
-      e' <- replaceDecls e newDecls
-      return (GHC.BodyStmt e' a b c)
-  replaceDecls x newDecls = return x
+-- |Modify a 'GHC.LHsBind' wrapped in a 'GHC.ValD'. For a 'GHC.PatBind' the
+-- declarations are extracted and returned after modification. For a
+-- 'GHC.FunBind' the supplied 'GHC.SrcSpan' is used to identify the specific
+-- 'GHC.Match' to be transformed, for when there are multiple of them.
+modifyValD :: forall m t. (HasTransform m)
+                => GHC.SrcSpan
+                -> Decl
+                -> (Match -> [Decl] -> m ([Decl], Maybe t))
+                -> m (Decl,Maybe t)
+modifyValD p pb@(GHC.L ss (GHC.ValD (GHC.PatBind {} ))) f =
+  if ss == p
+     then do
+       ds <- liftT $ 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 ast f = do
+  (ast',r) <- runStateT (SYB.everywhereM (SYB.mkM doModLocal) ast) Nothing
+  return (ast',r)
+  where
+    doModLocal :: Match -> StateT (Maybe t) m Match
+    doModLocal  (match@(GHC.L ss _) :: Match) = do
+         let
+         if ss == p
+           then do
+             ds <- lift $ liftT $ hsDecls match
+             (ds',r) <- lift $ f match ds
+             put r
+             match' <- lift $ liftT $ replaceDecls match ds'
+             return match'
+           else return match
 
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.LHsDecl GHC.RdrName) where
-  hsDecls (GHC.L l (GHC.ValD d)) = hsDecls (GHC.L l d)
-  -- hsDecls (GHC.L l (GHC.SigD d)) = hsDecls (GHC.L l d)
-  hsDecls _                      = return []
+-- |Used to integrate a @Transform@ into other Monad stacks
+class (Monad m) => (HasTransform m) where
+  liftT :: Transform a -> m a
 
-  replaceDecls (GHC.L l (GHC.ValD d)) newDecls = do
-    (GHC.L l1 d1) <- replaceDecls (GHC.L l d) newDecls
-    return (GHC.L l1 (GHC.ValD d1))
-  -- replaceDecls (GHC.L l (GHC.SigD d)) newDecls = do
-  --   (GHC.L l1 d1) <- replaceDecls (GHC.L l d) newDecls
-  --   return (GHC.L l1 (GHC.SigD d1))
-  replaceDecls _d _  = error $ "LHsDecl.replaceDecls:not implemented"
+instance HasTransform (TransformT Identity) where
+  liftT = id
 
 -- ---------------------------------------------------------------------
 
+-- | Apply a transformation to the decls contained in @t@
+modifyDeclsT :: (HasDecls t,HasTransform m)
+             => ([GHC.LHsDecl GHC.RdrName] -> m [GHC.LHsDecl GHC.RdrName])
+             -> t -> m t
+modifyDeclsT action t = do
+  decls <- liftT $ hsDecls t
+  decls' <- action decls
+  liftT $ replaceDecls t decls'
+
+-- ---------------------------------------------------------------------
+
 matchApiAnn :: GHC.AnnKeywordId -> (KeywordId,DeltaPos) -> Bool
 matchApiAnn mkw (kw,_)
   = case kw of
@@ -767,8 +1012,8 @@
 -- We comments extracted from annPriorComments or annFollowingComments, which
 -- need to move to just before the item identified by the predicate, if it
 -- fires, else at the end of the annotations.
-insertCommentBefore :: AnnKey -> [(Comment, DeltaPos)]
-                    -> ((KeywordId, DeltaPos) -> Bool) -> Transform ()
+insertCommentBefore :: (Monad m) => AnnKey -> [(Comment, DeltaPos)]
+                    -> ((KeywordId, DeltaPos) -> Bool) -> TransformT m ()
 insertCommentBefore key toMove p = do
   let
     doInsert ans =
@@ -777,7 +1022,6 @@
         Just ann -> Map.insert key ann' ans
           where
             (before,after) = break p (annsDP ann)
-            -- ann' = error $ "insertCommentBefore:" ++ showGhc (before,after)
             ann' = ann { annsDP = before ++ (map comment2dp toMove) ++ after}
 
   modifyAnnsT doInsert
diff --git a/src/Language/Haskell/GHC/ExactPrint/Types.hs b/src/Language/Haskell/GHC/ExactPrint/Types.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Types.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Types.hs
@@ -1,6 +1,9 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Language.Haskell.GHC.ExactPrint.Types
   ( -- * Core Types
    Anns
@@ -21,10 +24,11 @@
   , annGetConstr
   -- * Internal Types
   , LayoutStartCol(..)
+  , declFun
 
   ) where
 
-import Data.Data (Data, Typeable, toConstr)
+import Data.Data (Data, Typeable, toConstr,cast)
 
 import qualified DynFlags       as GHC
 import qualified GHC
@@ -43,7 +47,9 @@
     , commentIdentifier :: !GHC.SrcSpan -- ^ Needed to uniquely identify two comments with the same contents
     , commentOrigin     :: !(Maybe GHC.AnnKeywordId) -- ^ We sometimes turn syntax into comments in order to process them properly.
     }
-  deriving (Eq,Show,Typeable,Data, Ord)
+  deriving (Eq,Typeable,Data,Ord)
+instance Show Comment where
+  show (Comment cs ss o) = "(Comment " ++ show cs ++ " " ++ showGhc ss ++ " " ++ show o ++ ")"
 
 instance GHC.Outputable Comment where
   ppr x = GHC.text (show x)
@@ -71,6 +77,7 @@
 
 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).
@@ -83,6 +90,8 @@
     -- ^ 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 [GHC.SrcSpan])
@@ -126,9 +135,15 @@
 instance Show AnnKey where
   show (AnnKey ss cn) = "AnnKey " ++ showGhc ss ++ " " ++ show cn
 
-mkAnnKey :: (Data a) => GHC.Located a -> AnnKey
-mkAnnKey (GHC.L l a) = AnnKey l (annGetConstr a)
+mkAnnKeyPrim :: (Data a) => GHC.Located a -> AnnKey
+mkAnnKeyPrim (GHC.L l a) = AnnKey l (annGetConstr a)
 
+-- |Make an unwrapped @AnnKey@ for the @LHsDecl@ case, a normal one otherwise.
+mkAnnKey :: (Data a) => GHC.Located a -> AnnKey
+mkAnnKey ld =
+  case cast ld :: Maybe (GHC.LHsDecl GHC.RdrName) of
+    Just d -> declFun mkAnnKeyPrim d
+    Nothing -> mkAnnKeyPrim ld
 
 -- Holds the name of a constructor
 data AnnConName = CN { unConName :: String }
@@ -178,6 +193,27 @@
   ppr a     = GHC.text (show a)
 
 -- ---------------------------------------------------------------------
+
+declFun :: (forall a . Data a => GHC.Located a -> b) -> GHC.LHsDecl GHC.RdrName -> b
+declFun f (GHC.L l de) =
+  case de of
+      GHC.TyClD d       -> f (GHC.L l d)
+      GHC.InstD d       -> f (GHC.L l d)
+      GHC.DerivD d      -> f (GHC.L l d)
+      GHC.ValD d        -> f (GHC.L l d)
+      GHC.SigD d        -> f (GHC.L l d)
+      GHC.DefD d        -> f (GHC.L l d)
+      GHC.ForD d        -> f (GHC.L l d)
+      GHC.WarningD d    -> f (GHC.L l d)
+      GHC.AnnD d        -> f (GHC.L l d)
+      GHC.RuleD d       -> f (GHC.L l d)
+      GHC.VectD d       -> f (GHC.L l d)
+      GHC.SpliceD d     -> f (GHC.L l d)
+      GHC.DocD d        -> f (GHC.L l d)
+      GHC.RoleAnnotD d  -> f (GHC.L l d)
+#if __GLASGOW_HASKELL__ < 711
+      GHC.QuasiQuoteD d -> f (GHC.L l d)
+#endif
 
 
 -- ---------------------------------------------------------------------
diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Utils.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
@@ -1,5 +1,7 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Language.Haskell.GHC.ExactPrint.Utils
   (
    -- * Manipulating Positons
@@ -20,7 +22,7 @@
   , comment2dp
 
     -- * GHC Functions
-  ,  srcSpanStartLine
+  , srcSpanStartLine
   , srcSpanEndLine
   , srcSpanStartColumn
   , srcSpanEndColumn
@@ -33,12 +35,13 @@
   -- * Manipulating Annotations
   , getAnnotationEP
   , annTrueEntryDelta
+  , annCommentEntryDelta
+  , annLeadingCommentEntryDelta
 
   -- * General Utility
   , orderByKey
 
 
-
   -- * For tests
   , debug
   , debugM
@@ -135,9 +138,10 @@
     fl = l + dl
     fc = if dl == 0 then c  + dc
                     else co + dc
+
 -- | Add together two @DeltaPos@ taking into account newlines
 --
--- > DP (0, 1) `addDP` DP (0, 2) == DP (0,3)
+-- > 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
@@ -145,6 +149,33 @@
   if c >= 1 then DP (a+c, d)
             else DP (a, b + d)
 
+-- | "Subtract" two @DeltaPos@ from each other, in the sense of calculating the
+-- remaining delta for the second after the first has been applied.
+-- invariant : if c = a `addDP` b
+--             then a `stepDP` c == b
+--
+-- Cases where first DP is <= than second
+-- > DP (0, 1) `addDP` DP (0, 2) == DP (0, 1)
+-- > DP (1, 1) `addDP` DP (2, 0) == DP (1, 0)
+-- > DP (1, 3) `addDP` DP (1, 4) == DP (0, 1)
+-- > DP (1, 4) `addDP` DP (1, 4) == DP (1, 4)
+--
+-- Cases where first DP is > than second
+-- > DP (0,  3) `addDP` DP (0, 2) == DP (0,1)  -- advance one at least
+-- > DP (3,  3) `addDP` DP (2, 4) == DP (1, 4) -- go one line forward and to expected col
+-- > DP (3,  3) `addDP` DP (0, 4) == DP (0, 1) -- maintain col delta at least
+-- > DP (1, 21) `addDP` DP (1, 4) == DP (1, 4) -- go one line forward and to expected col
+stepDP :: DeltaPos -> DeltaPos -> DeltaPos
+stepDP (DP (a,b)) (DP (c,d))
+  | (a,b) == (c,d) = DP (a,b)
+  | a == c = if b < d then DP (0,d - b)
+                      else if d == 0
+                             then DP (1,0)
+                             -- else DP (0,1)
+                             else DP (c,d)
+  | a < c = DP (c - a,d)
+  | otherwise = DP (1,d)
+
 -- ---------------------------------------------------------------------
 
 ss2pos :: GHC.SrcSpan -> Pos
@@ -242,6 +273,23 @@
   foldr addDP (DP (0,0)) (map (\(a, b) -> addDP b (dpFromString $ commentContents a)) annPriorComments )
     `addDP` annEntryDelta
 
+-- | Take an annotation and a required "true entry" and calculate an equivalent
+-- one relative to the last comment in the annPriorComments.
+annCommentEntryDelta :: Annotation -> DeltaPos -> DeltaPos
+annCommentEntryDelta Ann{annPriorComments} trueDP = dp
+  where
+    commentDP =
+      foldr addDP (DP (0,0)) (map (\(a, b) -> addDP b (dpFromString $ commentContents a)) annPriorComments )
+    dp = stepDP commentDP trueDP
+
+-- | 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
@@ -333,13 +381,23 @@
                       srcSpan s
                       ++ indent (n + 1) ++
                       show (getAnnotationEP (GHC.L s a) anns)
+                      -- ++ case showWrappedDeclAnns (GHC.L s a) of
+                      --   Nothing -> ""
+                      --   Just annStr  -> indent (n + 1) ++ annStr
                     Nothing -> "nnnnnnnn"
                   ++ showAnnData anns (n+1) a
                   ++ ")"
 
--- ---------------------------------------------------------------------
-
+{-
+        showWrappedDeclAnns :: (Data a) => GHC.Located a -> Maybe String
+        showWrappedDeclAnns t = everything mappend (Nothing `mkQ` showDecl) t
+          where
+            showDecl :: GHC.LHsDecl GHC.RdrName -> Maybe String
+            showDecl d = Just $ declFun doShowAnn  d
 
+        doShowAnn :: (Data a) => GHC.Located a -> String
+        doShowAnn a =  show (getAnnotationEP a anns)
+-}
  -- ---------------------------------------------------------------------
 
 showSDoc_ :: GHC.SDoc -> String
diff --git a/tests/Test.hs b/tests/Test.hs
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -39,6 +39,14 @@
      then exitFailure
      else return () -- exitSuccess
 
+transform :: IO ()
+transform = hSilence [stderr] $ do
+  cnts <- fst <$> runTestText (putTextToHandle stdout True) (TestList transformTests)
+  putStrLn $ show cnts
+  if errors cnts > 0 || failures cnts > 0
+     then exitFailure
+     else return () -- exitSuccess
+
 -- ---------------------------------------------------------------------
 
 tests :: Test
@@ -234,6 +242,7 @@
   , mkParserTest "T10196.hs"
   , mkParserTest "StringGap.hs"
   , mkParserTest "RedundantDo.hs"
+  , mkParserTest "TypeSignature.hs"
   ]
 
   ++ transformTests
@@ -463,16 +472,31 @@
     -- , manipulateAstTestWFname "WhereIn3.hs"                 "WhereIn3"
     -- , manipulateAstTestWFnameMod changeWhereIn3a "WhereIn3a.hs" "WhereIn3a"
     -- , manipulateAstTestWFname "Imports.hs"              "Imports"
-    , manipulateAstTestWFname "T10196.hs"               "T10196"
+    -- , manipulateAstTestWFname "T10196.hs"               "T10196"
     , manipulateAstTestWFnameMod addLocaLDecl1 "AddLocalDecl1.hs" "AddLocaLDecl1"
-    , manipulateAstTestWFnameMod addLocaLDecl2 "AddLocalDecl2.hs" "AddLocaLDecl2"
-    , manipulateAstTestWFnameMod addLocaLDecl3 "AddLocalDecl3.hs" "AddLocaLDecl3"
-    , manipulateAstTestWFnameMod rmDecl1       "RmDecl1.hs"       "RmDecl1"
+    -- , manipulateAstTestWFnameMod addLocaLDecl2 "AddLocalDecl2.hs" "AddLocaLDecl2"
+    -- , manipulateAstTestWFnameMod addLocaLDecl3 "AddLocalDecl3.hs" "AddLocaLDecl3"
+    -- , manipulateAstTestWFnameMod addLocaLDecl4 "AddLocalDecl4.hs" "AddLocaLDecl4"
+    -- , manipulateAstTestWFnameMod addLocaLDecl5 "AddLocalDecl5.hs" "AddLocaLDecl5"
+    -- , manipulateAstTestWFnameMod addLocaLDecl6 "AddLocalDecl6.hs" "AddLocaLDecl6"
+    -- , manipulateAstTestWFnameMod rmDecl1       "RmDecl1.hs"       "RmDecl1"
     -- , manipulateAstTestWFname "RmDecl2.hs"                        "RmDecl2"
-    , manipulateAstTestWFnameMod rmDecl2       "RmDecl2.hs"       "RmDecl2"
-    , manipulateAstTestWFnameMod rmDecl3       "RmDecl3.hs"       "RmDecl3"
-    , manipulateAstTestWFnameMod rmTypeSig1    "RmTypeSig1.hs"    "RmTypeSig1"
-    , manipulateAstTestWFname "StringGap.hs"                      "StringGap"
+    -- , manipulateAstTestWFnameMod rmDecl2       "RmDecl2.hs"       "RmDecl2"
+    -- , manipulateAstTestWFnameMod rmDecl3       "RmDecl3.hs"       "RmDecl3"
+    -- , manipulateAstTestWFnameMod rmDecl4       "RmDecl4.hs"       "RmDecl4"
+    -- , manipulateAstTestWFnameMod rmDecl5       "RmDecl5.hs"       "RmDecl5"
+    -- , manipulateAstTestWFname "RmDecl5.hs"                        "RmDecl5"
+    -- , manipulateAstTestWFnameMod rmDecl6       "RmDecl6.hs"       "RmDecl6"
+    -- , manipulateAstTestWFnameMod rmDecl7       "RmDecl7.hs"       "RmDecl7"
+    -- , manipulateAstTestWFname "TypeSignature.hs"                  "TypeSignature"
+    -- , manipulateAstTestWFnameMod rmTypeSig1    "RmTypeSig1.hs"    "RmTypeSig1"
+    -- , manipulateAstTestWFnameMod rmTypeSig2    "RmTypeSig2.hs"    "RmTypeSig2"
+    -- , manipulateAstTestWFname "StringGap.hs"                      "StringGap"
+    -- , manipulateAstTestWFnameMod addHiding1    "AddHiding1.hs"    "AddHiding1"
+    -- , manipulateAstTestWFnameMod addHiding2    "AddHiding2.hs"    "AddHiding2"
+    -- , manipulateAstTestWFnameMod cloneDecl1    "CloneDecl1.hs"    "CloneDecl1"
+    -- , manipulateAstTestWFname "SimpleDo.hs"                      "Main"
+    -- , manipulateAstTestWFnameMod changeRename2    "Rename2.hs"  "Main"
     {-
     , manipulateAstTestWFname "Lhs.lhs"                  "Main"
     , manipulateAstTestWFname "Foo.hs"                   "Main"
diff --git a/tests/Test/Common.hs b/tests/Test/Common.hs
--- a/tests/Test/Common.hs
+++ b/tests/Test/Common.hs
@@ -155,7 +155,7 @@
 runRoundTrip !anns !parsedOrig cs =
   let
     !relAnns = relativiseApiAnnsWithComments cs parsedOrig anns
-    !printed = exactPrintWithAnns parsedOrig relAnns
+    !printed = exactPrint parsedOrig relAnns
   in (printed,  relAnns)
 
 -- ---------------------------------------------------------------------`
diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs
--- a/tests/Test/Transform.hs
+++ b/tests/Test/Transform.hs
@@ -18,11 +18,13 @@
 import qualified FastString     as GHC
 
 import qualified Data.Generics as SYB
+-- import qualified GHC.SYB.Utils as SYB
 
 import Control.Monad
 import System.FilePath
 import System.IO
 import qualified Data.Map as Map
+-- import Data.List
 import Data.Maybe
 
 import System.IO.Silently
@@ -46,6 +48,7 @@
   , mkTestModChange changeLayoutLet3  "LayoutLet3.hs"  "LayoutLet3"
   , mkTestModChange changeLayoutLet3  "LayoutLet4.hs"  "LayoutLet4"
   , mkTestModChange changeRename1     "Rename1.hs"     "Main"
+  , mkTestModChange changeRename2     "Rename2.hs"     "Main"
   , mkTestModChange changeLayoutIn1   "LayoutIn1.hs"   "LayoutIn1"
   , mkTestModChange changeLayoutIn3   "LayoutIn3.hs"   "LayoutIn3"
   , mkTestModChange changeLayoutIn3   "LayoutIn3a.hs"  "LayoutIn3a"
@@ -115,7 +118,7 @@
                              { annEntryDelta     = DP (1,0) }
         modifyAnnsT addWhere
         let decls = [s,d]
-        logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
+        -- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
         modifyAnnsT (captureOrderAnnKey newAnnKey decls)
         return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs
                         (GHC.HsValBinds
@@ -149,11 +152,9 @@
                 let a2 = setPrecedingLines s1 2 0 a1
                 return a2
         putAnnsT a'
-        let wrapDecl (GHC.L l' w) = GHC.L l' (GHC.ValD w)
-            wrapSig (GHC.L l' w) = GHC.L l' (GHC.SigD w)
         let oldDecls = GHC.sortLocated $ map wrapDecl (GHC.bagToList binds) ++ map wrapSig sigs
         let decls = s:d:oldDecls
-        logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
+        -- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
         modifyAnnsT (captureOrder m decls)
         return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs
                         (GHC.HsValBinds
@@ -323,6 +324,9 @@
 changeRename1 :: Changer
 changeRename1 ans parsed = return (ans,rename "bar2" [((3,1),(3,4))] parsed)
 
+changeRename2 :: Changer
+changeRename2 ans parsed = return (ans,rename "joe" [((2,1),(2,5))] parsed)
+
 changeLayoutLet3 :: Changer
 changeLayoutLet3 ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((9,14),(9,17))] parsed)
 
@@ -448,7 +452,7 @@
                    Just (change,_) -> change ann parsed
 
   let
-    printed = exactPrintWithAnns parsed' ann' -- `debug` ("ann=" ++ (show $ map (\(s,a) -> (ss2span s, a)) $ Map.toList ann))
+    printed = exactPrint parsed' ann' -- `debug` ("ann=" ++ (show $ map (\(s,a) -> (ss2span s, a)) $ Map.toList ann))
     outcome = if printed == contents
                 then "Match\n"
                 else "Fail\n"
@@ -552,97 +556,173 @@
     mkTestModChange addLocaLDecl1  "AddLocalDecl1.hs"  "AddLocalDecl1"
   , mkTestModChange addLocaLDecl2  "AddLocalDecl2.hs"  "AddLocalDecl2"
   , mkTestModChange addLocaLDecl3  "AddLocalDecl3.hs"  "AddLocalDecl3"
+  , mkTestModChange addLocaLDecl4  "AddLocalDecl4.hs"  "AddLocalDecl4"
+  , mkTestModChange addLocaLDecl5  "AddLocalDecl5.hs"  "AddLocalDecl5"
+  , mkTestModChange addLocaLDecl6  "AddLocalDecl6.hs"  "AddLocalDecl6"
 
   , mkTestModChange rmDecl1 "RmDecl1.hs" "RmDecl1"
   , mkTestModChange rmDecl2 "RmDecl2.hs" "RmDecl2"
   , mkTestModChange rmDecl3 "RmDecl3.hs" "RmDecl3"
+  , mkTestModChange rmDecl4 "RmDecl4.hs" "RmDecl4"
+  , mkTestModChange rmDecl5 "RmDecl5.hs" "RmDecl5"
+  , mkTestModChange rmDecl6 "RmDecl6.hs" "RmDecl6"
+  , mkTestModChange rmDecl7 "RmDecl7.hs" "RmDecl7"
 
   , mkTestModChange rmTypeSig1 "RmTypeSig1.hs" "RmTypeSig1"
+  , mkTestModChange rmTypeSig2 "RmTypeSig2.hs" "RmTypeSig2"
+
+  , mkTestModChange addHiding1 "AddHiding1.hs" "AddHiding1"
+  , mkTestModChange addHiding2 "AddHiding2.hs" "AddHiding2"
+
+  , mkTestModChange cloneDecl1 "CloneDecl1.hs" "CloneDecl1"
   ]
 
 -- ---------------------------------------------------------------------
 
 addLocaLDecl1 :: Changer
 addLocaLDecl1 ans lp = do
-  Right (declAnns, newDecl@(GHC.L ld (GHC.ValD decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
-  let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns
+  Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
+  let declAnns' = setPrecedingLines newDecl 1 4 declAnns
+      doAddLocal = do
+        (d1:d2:_) <- hsDecls lp
+        balanceComments d1 d2
+        (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m d -> do
+          return ((newDecl : d),Nothing)
+        replaceDecls lp [d1', d2]
 
+  let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns') doAddLocal
+  -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl2 :: Changer
+addLocaLDecl2 ans lp = do
+  Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
+  let
       doAddLocal = do
          tlDecs <- hsDecls lp
          let parent = head tlDecs
-         decls <- hsDecls parent
          balanceComments parent (head $ tail tlDecs)
 
-         modifyAnnsT (setPrecedingLines newDecl 1 4)
+         (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \_m decls -> do
+           transferEntryDPT (head decls) newDecl
+           setEntryDPT (head decls) (DP (1, 0))
+           return ((newDecl:decls),Nothing)
 
-         parent' <- replaceDecls parent (newDecl:decls)
          replaceDecls lp (parent':tail tlDecs)
 
-  let (lp',(ans',_),_w) = runTransform ans doAddLocal
-  return (mergeAnnList [declAnns',ans'],lp')
+  let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns) doAddLocal
+  -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+  return (ans',lp')
 
 -- ---------------------------------------------------------------------
 
-addLocaLDecl2 :: Changer
-addLocaLDecl2 ans lp = do
-  Right (declAnns, newDecl@(GHC.L ld (GHC.ValD decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
-  let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns
-
+addLocaLDecl3 :: Changer
+addLocaLDecl3 ans lp = do
+  Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
+  let
       doAddLocal = do
+         -- logDataWithAnnsTr "parsed:" lp
+         logDataWithAnnsTr "newDecl:" newDecl
          tlDecs <- hsDecls lp
          let parent = head tlDecs
-         decls <- hsDecls parent
          balanceComments parent (head $ tail tlDecs)
 
-         DP (r,c) <- getEntryDPT (head decls)
-         modifyAnnsT (setPrecedingLines newDecl r c)
-         modifyAnnsT (setPrecedingLines (head decls) 1 0)
+         (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \m decls -> do
+           setPrecedingLinesT newDecl 1 0
+           moveTrailingComments m (last decls)
+           return ((decls++[newDecl]),Nothing)
 
-         parent' <- replaceDecls parent (newDecl:decls)
          replaceDecls lp (parent':tail tlDecs)
 
-  let (lp',(ans',_),_w) = runTransform ans doAddLocal
-  return (mergeAnnList [declAnns',ans'],lp')
+  let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns) doAddLocal
+  -- putStrLn $ "log\n" ++ intercalate "\n" _w
+  return (ans',lp')
 
 -- ---------------------------------------------------------------------
 
-addLocaLDecl3 :: Changer
-addLocaLDecl3 ans lp = do
-  Right (declAnns, newDecl@(GHC.L ld (GHC.ValD decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
-  let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns
-
+addLocaLDecl4 :: Changer
+addLocaLDecl4 ans lp = do
+  Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
+  Right (sigAnns, newSig)   <- withDynFlags (\df -> parseDecl df "sig"  "nn :: Int")
+  -- putStrLn $ "addLocaLDecl4:lp=" ++ showGhc lp
+  let
       doAddLocal = do
          tlDecs <- hsDecls lp
          let parent = head tlDecs
-         decls <- hsDecls parent
-         balanceComments parent (head $ tail tlDecs)
 
-         modifyAnnsT (setPrecedingLines newDecl 1 0)
+         setPrecedingLinesT newSig  1 0
+         setPrecedingLinesT newDecl 1 0
 
-         moveTrailingComments parent (last decls)
-         parent' <- replaceDecls parent (decls++[newDecl])
+         (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \_m decls -> do
+           return ((decls++[newSig,newDecl]),Nothing)
+
          replaceDecls lp (parent':tail tlDecs)
 
+  let (lp',(ans',_),_w) = runTransform (mergeAnnList [ans,declAnns,sigAnns]) doAddLocal
+  -- putStrLn $ "log\n" ++ intercalate "\n" _w
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl5 :: Changer
+addLocaLDecl5 ans lp = do
+  let
+      doAddLocal = do
+         [s1,d1,d2,d3] <- hsDecls lp
+
+         transferEntryDPT d2 d3
+
+         (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m _decls -> do
+           return ([d2],Nothing)
+         replaceDecls lp [s1,d1',d3]
+
   let (lp',(ans',_),_w) = runTransform ans doAddLocal
-  return (mergeAnnList [declAnns',ans'],lp')
+  -- putStrLn $ "log\n" ++ intercalate "\n" _w
+  return (ans',lp')
 
 -- ---------------------------------------------------------------------
 
+addLocaLDecl6 :: Changer
+addLocaLDecl6 ans lp = do
+  Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "x = 3")
+  let declAnns' = setPrecedingLines newDecl 1 4 declAnns
+      doAddLocal = do
+        [d1,d2] <- hsDecls lp
+        balanceComments d1 d2
+
+        let GHC.L _ (GHC.ValD (GHC.FunBind  _ _ (GHC.MG [m1,m2] _ _ _) _ _ _)) = d1
+        balanceComments m1 m2
+
+        (d1',_) <- modifyValD (GHC.getLoc m1) d1 $ \_m decls -> do
+           return ((newDecl : decls),Nothing)
+        replaceDecls lp [d1', d2]
+
+  let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns') doAddLocal
+  -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+  return (ans',lp')
+-- ---------------------------------------------------------------------
+
 rmDecl1 :: Changer
 rmDecl1 ans lp = do
   let doRmDecl = do
          tlDecs <- hsDecls lp
          let (d1:s1:d2:ds) = tlDecs
 
-         -- First delete the decl only
+         -- First delete the decl (d2) only
+         balanceComments s1 d2 -- ++AZ++
          balanceComments d2 (head ds)
          lp1 <- replaceDecls lp (d1:s1:ds)
+         -- return lp1
 
          -- Then delete the sig separately
          tlDecs1 <- hsDecls lp1
          let (d1':s1':ds') = tlDecs1
+         -- transferEntryDPT s1' (head ds')  -- required in HaRe.
          balanceComments d1' s1'
          balanceComments s1' (head ds')
+         transferEntryDPT s1' (head ds')  -- required in HaRe.
          replaceDecls lp (d1':ds')
 
   let (lp',(ans',_),_w) = runTransform ans doRmDecl
@@ -655,35 +735,118 @@
   let
       doRmDecl = do
         let
+          go :: GHC.LHsExpr GHC.RdrName -> Transform (GHC.LHsExpr GHC.RdrName)
+          go e@(GHC.L _ (GHC.HsLet{})) = do
+            decs <- hsDecls e
+            e' <- replaceDecls e (init decs)
+            return e'
+          go x = return x
+
+        SYB.everywhereM (SYB.mkM go) lp
+
+  let (lp',(ans',_),_w) = runTransform ans doRmDecl
+  -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl3 :: Changer
+rmDecl3 ans lp = do
+  let
+      doRmDecl = do
+         [d1,d2] <- hsDecls lp
+
+         (d1',Just sd1) <- modifyValD (GHC.getLoc d1) d1 $ \_m [sd1] -> do
+           setPrecedingLinesDeclT sd1 2 0
+           return ([],Just sd1)
+
+         replaceDecls lp [d1',sd1,d2]
+
+  let (lp',(ans',_),_w) = runTransform ans doRmDecl
+  -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl4 :: Changer
+rmDecl4 ans lp = do
+  let
+      doRmDecl = do
+         [d1] <- hsDecls lp
+
+         (d1',Just sd1) <- modifyValD (GHC.getLoc d1) d1 $ \_m [sd1,sd2] -> do
+           -- [sd1,sd2] <- hsDecls d1
+           transferEntryDPT sd1 sd2
+
+           setPrecedingLinesDeclT sd1 2 0
+           -- d1' <- replaceDecls d1 [sd2]
+           return ([sd2],Just sd1)
+
+         replaceDecls lp [d1',sd1]
+
+  let (lp',(ans',_),_w) = runTransform ans doRmDecl
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl5 :: Changer
+rmDecl5 ans lp = do
+  let
+      doRmDecl = do
+        let
           go :: GHC.HsExpr GHC.RdrName -> Transform (GHC.HsExpr GHC.RdrName)
           go (GHC.HsLet lb expr) = do
-            decs <- hsDecls lb
-            lb' <- replaceDecls lb (init decs)
+            decs <- hsDeclsValBinds lb
+            let dec = last decs
+            transferEntryDPT (head decs) dec
+            lb' <- replaceDeclsValbinds lb [dec]
             return (GHC.HsLet lb' expr)
           go x = return x
 
         SYB.everywhereM (SYB.mkM go) lp
 
   let (lp',(ans',_),_w) = runTransform ans doRmDecl
+  -- putStrLn $ "log:" ++ intercalate "\n" _w
   return (ans',lp')
 
 -- ---------------------------------------------------------------------
 
-rmDecl3 :: Changer
-rmDecl3 ans lp = do
+rmDecl6 :: Changer
+rmDecl6 ans lp = do
   let
       doRmDecl = do
+         [d1] <- hsDecls lp
+
+         (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m subDecs -> do
+           let (ss1:_sd1:sd2:sds) = subDecs
+           transferEntryDPT ss1 sd2
+
+           return (sd2:sds,Nothing)
+
+         replaceDecls lp [d1']
+
+  let (lp',(ans',_),_w) = runTransform ans doRmDecl
+  -- putStrLn $ "log:" ++ intercalate "\n" _w
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl7 :: Changer
+rmDecl7 ans lp = do
+  let
+      doRmDecl = do
          tlDecs <- hsDecls lp
-         let [d1] = tlDecs
+         let [s1,d1,d2,d3] = tlDecs
 
-         subDecs <- hsDecls d1
-         let [sd1] = subDecs
+         balanceComments d1 d2
+         balanceComments d2 d3
 
-         modifyAnnsT (setPrecedingLinesDecl sd1 2 0)
-         d1' <- replaceDecls d1 []
-         replaceDecls lp [d1',sd1]
+         transferEntryDPT d2 d3
 
+         replaceDecls lp [s1,d1,d3]
+
   let (lp',(ans',_),_w) = runTransform ans doRmDecl
+  -- putStrLn $ "log:" ++ intercalate "\n" _w
   return (ans',lp')
 
 -- ---------------------------------------------------------------------
@@ -698,6 +861,86 @@
          replaceDecls lp (s1':d1:d2)
 
   let (lp',(ans',_),_w) = runTransform ans doRmDecl
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmTypeSig2 :: Changer
+rmTypeSig2 ans lp = do
+  let doRmDecl = do
+         tlDecs <- hsDecls lp
+         let [d1] = tlDecs
+
+         (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m [s,d] -> do
+           transferEntryDPT s d
+           return ([d],Nothing)
+         replaceDecls lp [d1']
+
+  let (lp',(ans',_),_w) = runTransform ans doRmDecl
+  -- putStrLn $ "log:" ++ intercalate "\n" _w
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+addHiding1 :: Changer
+addHiding1 ans (GHC.L l p) = do
+  let doTransform = do
+        l0 <- uniqueSrcSpanT
+        l1 <- uniqueSrcSpanT
+        l2 <- uniqueSrcSpanT
+        let
+          [GHC.L li imp1,imp2] = GHC.hsmodImports p
+          n1 = GHC.L l1 (GHC.mkVarUnqual (GHC.mkFastString "n1"))
+          n2 = GHC.L l2 (GHC.mkVarUnqual (GHC.mkFastString "n2"))
+          v1 = GHC.L l1 (GHC.IEVar n1)
+          v2 = GHC.L l2 (GHC.IEVar n2)
+          impHiding = GHC.L l0 [v1,v2]
+          imp1' = imp1 { GHC.ideclHiding = Just (True,impHiding)}
+          p' = p { GHC.hsmodImports = [GHC.L li imp1',imp2]}
+        addSimpleAnnT impHiding (DP (0,1)) [((G GHC.AnnHiding),DP (0,0)),((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]
+        addSimpleAnnT n1        (DP (0,0)) [((G GHC.AnnVal),DP (0,0)),((G GHC.AnnComma),DP (0,0))]
+        addSimpleAnnT n2        (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]
+        return (GHC.L l p')
+
+  let (lp',(ans',_),_w) = runTransform ans doTransform
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+addHiding2 :: Changer
+addHiding2 ans (GHC.L l p) = do
+  let doTransform = do
+        l1 <- uniqueSrcSpanT
+        l2 <- uniqueSrcSpanT
+        let
+          [GHC.L li imp1] = GHC.hsmodImports p
+          Just (_,GHC.L lh ns) = GHC.ideclHiding imp1
+          (GHC.L _ (GHC.IEVar ln)) = last ns
+          n1 = GHC.L l1 (GHC.mkVarUnqual (GHC.mkFastString "n1"))
+          n2 = GHC.L l2 (GHC.mkVarUnqual (GHC.mkFastString "n2"))
+          v1 = GHC.L l1 (GHC.IEVar n1)
+          v2 = GHC.L l2 (GHC.IEVar n2)
+          imp1' = imp1 { GHC.ideclHiding = Just (True,GHC.L lh (ns ++ [v1,v2]))}
+          p' = p { GHC.hsmodImports = [GHC.L li imp1']}
+        addSimpleAnnT n1        (DP (0,0)) [((G GHC.AnnVal),DP (0,0)),((G GHC.AnnComma),DP (0,0))]
+        addSimpleAnnT n2        (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]
+        addTrailingCommaT ln
+        return (GHC.L l p')
+
+  let (lp',(ans',_),_w) = runTransform ans doTransform
+  return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+cloneDecl1 :: Changer
+cloneDecl1 ans lp = do
+  let doChange = do
+         tlDecs <- hsDecls lp
+         let (d1:d2:ds) = tlDecs
+         d2' <- fst <$> cloneT d2
+         replaceDecls lp (d1:d2:d2':ds)
+
+  let (lp',(ans',_),_w) = runTransform ans doChange
   return (ans',lp')
 
 -- ---------------------------------------------------------------------
diff --git a/tests/examples/AddHiding1.hs b/tests/examples/AddHiding1.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddHiding1.hs
@@ -0,0 +1,7 @@
+module AddHiding1 where
+
+import Data.Maybe
+
+import Data.Maybe hiding (n1,n2)
+
+f = 1
diff --git a/tests/examples/AddHiding1.hs.expected b/tests/examples/AddHiding1.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddHiding1.hs.expected
@@ -0,0 +1,7 @@
+module AddHiding1 where
+
+import Data.Maybe hiding (n1,n2)
+
+import Data.Maybe hiding (n1,n2)
+
+f = 1
diff --git a/tests/examples/AddHiding2.hs b/tests/examples/AddHiding2.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddHiding2.hs
@@ -0,0 +1,5 @@
+module AddHiding2 where
+
+import Data.Maybe hiding (f1,f2)
+
+f = 1
diff --git a/tests/examples/AddHiding2.hs.expected b/tests/examples/AddHiding2.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddHiding2.hs.expected
@@ -0,0 +1,5 @@
+module AddHiding2 where
+
+import Data.Maybe hiding (f1,f2,n1,n2)
+
+f = 1
diff --git a/tests/examples/AddLocalDecl4.hs b/tests/examples/AddLocalDecl4.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddLocalDecl4.hs
@@ -0,0 +1,3 @@
+module AddLocalDecl4 where
+
+toplevel x = c * x
diff --git a/tests/examples/AddLocalDecl4.hs.expected b/tests/examples/AddLocalDecl4.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddLocalDecl4.hs.expected
@@ -0,0 +1,6 @@
+module AddLocalDecl4 where
+
+toplevel x = c * x
+  where
+    nn :: Int
+    nn = 2
diff --git a/tests/examples/AddLocalDecl5.hs b/tests/examples/AddLocalDecl5.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddLocalDecl5.hs
@@ -0,0 +1,8 @@
+module AddLocalDecl5 where
+
+toplevel :: Integer -> Integer
+toplevel x = c * x
+
+-- c,d :: Integer
+c = 7
+d = 9
diff --git a/tests/examples/AddLocalDecl5.hs.expected b/tests/examples/AddLocalDecl5.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddLocalDecl5.hs.expected
@@ -0,0 +1,9 @@
+module AddLocalDecl5 where
+
+toplevel :: Integer -> Integer
+toplevel x = c * x
+  where
+    -- c,d :: Integer
+    c = 7
+
+d = 9
diff --git a/tests/examples/AddLocalDecl6.hs b/tests/examples/AddLocalDecl6.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddLocalDecl6.hs
@@ -0,0 +1,9 @@
+module AddLocalDecl6 where
+
+foo [] = 1 -- comment 0
+foo xs = 2 -- comment 1
+
+bar [] = 1 -- comment 2
+  where
+    x = 3
+bar xs = 2 -- comment 3
diff --git a/tests/examples/AddLocalDecl6.hs.expected b/tests/examples/AddLocalDecl6.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddLocalDecl6.hs.expected
@@ -0,0 +1,11 @@
+module AddLocalDecl6 where
+
+foo [] = 1 -- comment 0
+  where
+    x = 3
+foo xs = 2 -- comment 1
+
+bar [] = 1 -- comment 2
+  where
+    x = 3
+bar xs = 2 -- comment 3
diff --git a/tests/examples/Base.hs b/tests/examples/Base.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/Base.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE BangPatterns, CPP, RankNTypes, MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveDataTypeable, UnliftedFFITypes #-}
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE RoleAnnotations #-}
+#endif
+{-# OPTIONS_HADDOCK hide #-}
+
+-- Flat unboxed arrays: instances
+
+instance IArray UArray Bool where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _ _) = (l,u)
+    {-# INLINE numElements #-}
+    numElements (UArray _ _ n _) = n
+    {-# INLINE unsafeArray #-}
+    unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
+    {-# INLINE unsafeAt #-}
+    unsafeAt (UArray _ _ _ arr#) (I# i#) =
+        ((indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
+        `neWord#` int2Word# 0#)
+
+    {-# INLINE unsafeReplace #-}
+    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
+    {-# INLINE unsafeAccum #-}
+    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
+    {-# INLINE unsafeAccumArray #-}
+    unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
diff --git a/tests/examples/CloneDecl1.hs b/tests/examples/CloneDecl1.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/CloneDecl1.hs
@@ -0,0 +1,10 @@
+module CloneDecl1 where
+
+z = 3
+
+foo a b =
+  let
+    x = a + b + z
+    y = a * b - z
+  in
+    x + y
diff --git a/tests/examples/CloneDecl1.hs.expected b/tests/examples/CloneDecl1.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/CloneDecl1.hs.expected
@@ -0,0 +1,17 @@
+module CloneDecl1 where
+
+z = 3
+
+foo a b =
+  let
+    x = a + b + z
+    y = a * b - z
+  in
+    x + y
+
+foo a b =
+  let
+    x = a + b + z
+    y = a * b - z
+  in
+    x + y
diff --git a/tests/examples/Error.hs b/tests/examples/Error.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/Error.hs
@@ -0,0 +1,110 @@
+
+module GameData.Data where
+#include "Utils.cpp"
+import qualified Data.List as L
+import qualified Data.List.Zipper as LZ
+import Gamgine.Control (applyIf)
+import qualified Gamgine.Zipper as GZ
+import qualified GameData.Level as LV
+import qualified GameData.Entity as E
+IMPORT_LENS_AS_LE
+
+
+data Data = Data {
+   levels :: LZ.Zipper LV.Level
+   }
+
+LENS(levels)
+
+instance E.ApplyToEntity Data where
+   eMap f = LE.modL currentLevelL (E.eMap f)
+   eFilter p = LE.modL currentLevelL (E.eFilter p)
+
+
+currentLevelL    = currentLevelLens
+currentLevelLens = LE.lens getCurrentLevel setCurrentLevel
+   where
+      getCurrentLevel       = LZ.cursor . levels
+      setCurrentLevel level = LE.modL levelsL $ LZ.replace level
+
+
+newData :: [LV.Level] -> Data
+newData = Data . LZ.fromList
+
+
+allLevels :: Data -> [LV.Level]
+allLevels = LZ.toList . levels
+
+
+atLastLevel :: Data -> Bool
+atLastLevel = GZ.atLast . levels
+
+
+atFirstLevel :: Data -> Bool
+atFirstLevel = GZ.atFirst . levels
+
+
+levelFinished :: Data -> Bool
+levelFinished = LV.allStarsCollected . LE.getL currentLevelL
+
+
+gameFinished :: Data -> Bool
+gameFinished d = levelFinished d && atLastLevel d
+
+
+toNextLevel :: Data -> Data
+toNextLevel d@Data {levels = lvs}
+   | LZ.emptyp lvs || GZ.atLast lvs = d
+   | otherwise =
+      let lvs      = levels d
+          (c', n') = LV.changeLevels (GZ.current lvs) (GZ.next lvs)
+          in d {levels = LZ.replace n' . LZ.right . LZ.replace c' $ lvs}
+
+
+toPreviousLevel :: Data -> Data
+toPreviousLevel d@Data {levels = lvs}
+   | LZ.emptyp lvs || GZ.atFirst lvs = d
+   | otherwise =
+      let (c', p') = LV.changeLevels (GZ.current lvs) (GZ.previous lvs)
+          in d {levels = LZ.replace p' . LZ.left . LZ.replace c' $ lvs}
+
+
+data AddLevel = BeforeCurrent | AfterCurrent | AfterLast
+
+addEmptyLevel :: AddLevel -> Data -> Data
+addEmptyLevel BeforeCurrent d@Data {levels = lvs} =
+   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
+       in d {levels = LZ.insert nlv' . LZ.replace c' $ lvs}
+
+addEmptyLevel AfterCurrent d@Data {levels = lvs} =
+   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
+       in d {levels = LZ.insert nlv' . LZ.right . LZ.replace c' $ lvs}
+
+addEmptyLevel AfterLast d@Data {levels = lvs} =
+   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
+       in d {levels = LZ.insert nlv' . LZ.end . LZ.replace c' $ lvs}
+
+
+data MoveLevel = Forward | Backward
+
+moveCurrentLevel :: MoveLevel -> Data -> Data
+moveCurrentLevel Forward d@Data {levels = lvs}
+   | LZ.beginp lvs = d
+   | otherwise     =
+      let (p, c) = (GZ.previous lvs, GZ.current lvs)
+          in d {levels = LZ.replace c . LZ.left . LZ.replace p $ lvs}
+
+moveCurrentLevel Backward d@Data {levels = lvs}
+   | GZ.atLast lvs = d
+   | otherwise     =
+      let (c, n) = (GZ.current lvs, GZ.next lvs)
+          in d {levels = LZ.replace c . LZ.right . LZ.replace n $ lvs}
+
+
+removeCurrentLevel :: Data -> Data
+removeCurrentLevel d@Data {levels = lvs}
+   | GZ.atFirst lvs && GZ.atLast lvs =
+      let (_, nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
+          in d {levels = LZ.replace nlv' lvs}
+
+   | otherwise = d {levels = applyIf LZ.endp LZ.left . LZ.delete $ lvs}
diff --git a/tests/examples/Join.hs b/tests/examples/Join.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/Join.hs
@@ -0,0 +1,7 @@
+
+forkOS_entry :: StablePtr (IO ()) -> IO ()
+forkOS_entry stableAction = do
+        action <- deRefStablePtr stableAction
+        action
+
+
diff --git a/tests/examples/Lambda.hs b/tests/examples/Lambda.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/Lambda.hs
@@ -0,0 +1,2 @@
+
+i = \x -> x
diff --git a/tests/examples/NormaliseLayout.hs b/tests/examples/NormaliseLayout.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/NormaliseLayout.hs
@@ -0,0 +1,5 @@
+module Main where
+
+foo x = baz
+  where foo = 2
+        two = 4 where bax = 4
diff --git a/tests/examples/NormaliseLayout.hs.expected b/tests/examples/NormaliseLayout.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/NormaliseLayout.hs.expected
@@ -0,0 +1,1 @@
+module Main where
diff --git a/tests/examples/Rename2.hs b/tests/examples/Rename2.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/Rename2.hs
@@ -0,0 +1,4 @@
+
+foo' x = case (odd x) of
+  True -> "Odd"
+  False -> "Even"
diff --git a/tests/examples/Rename2.hs.expected b/tests/examples/Rename2.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/Rename2.hs.expected
@@ -0,0 +1,4 @@
+
+joe x = case (odd x) of
+  True -> "Odd"
+  False -> "Even"
diff --git a/tests/examples/RmDecl3.hs b/tests/examples/RmDecl3.hs
--- a/tests/examples/RmDecl3.hs
+++ b/tests/examples/RmDecl3.hs
@@ -5,4 +5,5 @@
   where
     zz = 1
 
+foo = 3
 -- EOF
diff --git a/tests/examples/RmDecl3.hs.expected b/tests/examples/RmDecl3.hs.expected
--- a/tests/examples/RmDecl3.hs.expected
+++ b/tests/examples/RmDecl3.hs.expected
@@ -5,4 +5,5 @@
 
 zz = 1
 
+foo = 3
 -- EOF
diff --git a/tests/examples/RmDecl4.hs b/tests/examples/RmDecl4.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmDecl4.hs
@@ -0,0 +1,9 @@
+module RmDecl4 where
+
+-- Remove first declaration from a where clause, last should still be indented
+ff y = y + zz + xx
+  where
+    zz = 1
+    xx = 2
+
+-- EOF
diff --git a/tests/examples/RmDecl4.hs.expected b/tests/examples/RmDecl4.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmDecl4.hs.expected
@@ -0,0 +1,10 @@
+module RmDecl4 where
+
+-- Remove first declaration from a where clause, last should still be indented
+ff y = y + zz + xx
+  where
+    xx = 2
+
+zz = 1
+
+-- EOF
diff --git a/tests/examples/RmDecl5.hs b/tests/examples/RmDecl5.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmDecl5.hs
@@ -0,0 +1,6 @@
+module RmDecl5 where
+
+sumSquares x y = let sq 0=0
+                     sq z=z^pow
+                     pow=2
+                 in sq x + sq y
diff --git a/tests/examples/RmDecl5.hs.expected b/tests/examples/RmDecl5.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmDecl5.hs.expected
@@ -0,0 +1,4 @@
+module RmDecl5 where
+
+sumSquares x y = let pow=2
+                 in sq x + sq y
diff --git a/tests/examples/RmDecl6.hs b/tests/examples/RmDecl6.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmDecl6.hs
@@ -0,0 +1,11 @@
+module RmDecl6 where
+
+foo a = baz
+  where
+    baz :: Int
+    baz = x  + a
+
+    x = 1
+
+    y :: Int -> Int -> Int
+    y a b = undefined
diff --git a/tests/examples/RmDecl6.hs.expected b/tests/examples/RmDecl6.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmDecl6.hs.expected
@@ -0,0 +1,8 @@
+module RmDecl6 where
+
+foo a = baz
+  where
+    x = 1
+
+    y :: Int -> Int -> Int
+    y a b = undefined
diff --git a/tests/examples/RmDecl7.hs b/tests/examples/RmDecl7.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmDecl7.hs
@@ -0,0 +1,8 @@
+module RmDecl7 where
+
+toplevel :: Integer -> Integer
+toplevel x = c * x
+
+-- c,d :: Integer
+c = 7
+d = 9
diff --git a/tests/examples/RmDecl7.hs.expected b/tests/examples/RmDecl7.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmDecl7.hs.expected
@@ -0,0 +1,6 @@
+module RmDecl7 where
+
+toplevel :: Integer -> Integer
+toplevel x = c * x
+
+d = 9
diff --git a/tests/examples/RmTypeSig2.hs b/tests/examples/RmTypeSig2.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmTypeSig2.hs
@@ -0,0 +1,7 @@
+module RmTypeSig2 where
+
+-- Pattern bind
+tup@(h,t) = (1,ff)
+  where
+    ff :: Int
+    ff = 15
diff --git a/tests/examples/RmTypeSig2.hs.expected b/tests/examples/RmTypeSig2.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/RmTypeSig2.hs.expected
@@ -0,0 +1,6 @@
+module RmTypeSig2 where
+
+-- Pattern bind
+tup@(h,t) = (1,ff)
+  where
+    ff = 15
diff --git a/tests/examples/SegFault.hs b/tests/examples/SegFault.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/SegFault.hs
@@ -0,0 +1,133 @@
+{-# INCLUDE "Parrot_hsc.h" #-}
+{-# LINE 1 "Parrot.hsc" #-}
+{-# OPTIONS_GHC -fglasgow-exts -cpp -fno-full-laziness -fno-cse #-}
+{-# LINE 2 "Parrot.hsc" #-}
+
+{-# LINE 3 "Parrot.hsc" #-}
+
+module Pugs.Embed.Parrot where
+import Data.IORef
+import System.Cmd
+import System.Process
+import System.Directory
+import System.IO
+import System.IO.Unsafe
+import Data.Maybe
+import Control.Monad
+import Pugs.Compat (getEnv, _PUGS_HAVE_POSIX)
+import Pugs.Internals (encodeUTF8)
+
+findExecutable' :: String -> IO (Maybe FilePath)
+findExecutable' cmd = do
+    dir <- getEnv "PARROT_PATH"
+    if isJust dir then (do
+        rv  <- findExecutableInDirectory (fromJust dir) cmd
+        if isJust rv then return rv else findExecutable'') else do
+    findExecutable''
+    where
+    findExecutable'' = do
+        rv  <- findExecutable cmd
+        if isJust rv then return rv else do
+        cwd <- getCurrentDirectory
+        rv  <- findExecutableInDirectory cwd cmd
+        if isJust rv then return rv else do
+        return Nothing
+
+findExecutableInDirectory :: FilePath -> FilePath -> IO (Maybe FilePath)
+findExecutableInDirectory dir cmd = do
+    let file | _PUGS_HAVE_POSIX = dir ++ ('/':cmd)
+             | otherwise        = dir ++ ('\\':cmd) ++ ".exe"
+    ok <- doesFileExist file
+    return $ if ok then (Just file) else Nothing
+
+findParrot :: IO FilePath
+findParrot = do
+    rv <- findExecutable' "parrot"
+    case rv of
+        Nothing     -> fail "Cannot find the parrot executable in PATH"
+        Just cmd    -> return cmd
+
+evalParrotFile :: FilePath -> IO ()
+evalParrotFile file = do
+    cmd <- findParrot
+    -- parrot -j is fatal on systems where jit is not supported,
+    -- so we use the next fastest CGP core.
+    args <- getEnv "PUGS_PARROT_OPTS"
+    let args' | isJust args && fromJust args /= "" = fromJust args
+              | otherwise                          = "-f"
+    rawSystem cmd [args', file]
+    return ()
+
+evalParrot :: String -> IO ()
+evalParrot str = do
+    tmp         <- getTemporaryDirectory
+    (file, fh)  <- openTempFile tmp "pugs.pir"
+    hPutStr fh str
+    hClose fh
+    evalParrotFile file
+    removeFile file
+
+evalPGE :: FilePath -> String -> String -> [(String, String)] -> IO String
+evalPGE path match rule subrules = do
+    (inp, out, err, pid) <- initPGE path
+    (`mapM` subrules) $ \(name, rule) -> do
+        let nameStr = escape name
+            ruleStr = escape rule
+        hPutStrLn inp $ unwords
+            ["add_rule", show (length nameStr), show (length ruleStr)]
+        hPutStrLn inp nameStr
+        hPutStrLn inp ruleStr
+    let matchStr = escape match
+        ruleStr  = escape rule
+    hPutStrLn inp $ unwords
+        ["match", show (length matchStr), show (length ruleStr)]
+    hPutStrLn inp $ matchStr
+    hPutStrLn inp $ ruleStr
+    hFlush inp
+    rv <- hGetLine out
+    case rv of
+        ('O':'K':' ':sizeStr) -> do
+            size <- readIO sizeStr
+            rv   <- sequence (replicate size (hGetChar out))
+            ln   <- hGetLine out
+            return $ rv ++ ln
+        _ -> do
+            errMsg  <- hGetContents err
+            rv      <- waitForProcess pid
+            writeIORef _ParrotInterp Nothing
+            let msg | null errMsg = show rv
+                    | otherwise   = errMsg
+            fail $ "*** Running external 'parrot' failed:\n" ++ msg
+    where
+    escape = escape . encodeUTF8
+    _escape "" = ""
+    _escape ('\\':xs) = "\\\\" ++ _escape xs
+    _escape ('\n':xs) = "\\n" ++ _escape xs
+    _escape (x:xs) = (x:_escape xs)
+
+initPGE :: FilePath -> IO ParrotInterp
+initPGE path = do
+    rv <- readIORef _ParrotInterp
+    case rv of
+        Just interp@(_, _, _, pid) -> do
+            gone <- getProcessExitCode pid
+            if isNothing gone then return interp else do
+            writeIORef _ParrotInterp Nothing
+            initPGE path
+        Nothing -> do
+            cmd <- findParrot
+            interp <- runInteractiveProcess cmd ["run_pge.pir"] (Just path) Nothing
+            writeIORef _ParrotInterp (Just interp)
+            return interp
+
+type ParrotInterp = (Handle, Handle, Handle, ProcessHandle)
+
+{-# NOINLINE _ParrotInterp #-}
+_ParrotInterp :: IORef (Maybe ParrotInterp)
+_ParrotInterp = unsafePerformIO $ newIORef Nothing
+
+_DoCompile :: Maybe (IORef (String -> FilePath -> String -> IO String))
+_DoCompile = Nothing
+
+
+{-# LINE 387 "Parrot.hsc" #-}
diff --git a/tests/examples/SegFault2.hs b/tests/examples/SegFault2.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/SegFault2.hs
@@ -0,0 +1,202 @@
+{-# LANGUAGE CPP #-}
+
+module UHC.Light.Compiler.CHR.Constraint
+( Constraint (..)
+, mkReduction
+, cnstrReducablePart
+, UnresolvedTrace (..)
+, cnstrMpSingletonL, cnstrMpFromList
+, ConstraintToInfoTraceMp
+, cnstrTraceMpSingleton, cnstrTraceMpLiftTrace, cnstrTraceMpElimTrace, cnstrTraceMpFromList
+, ConstraintToInfoMap
+, emptyCnstrMp
+, cnstrMpUnion, cnstrMpUnions
+, cnstrRequiresSolve )
+where
+import UHC.Light.Compiler.Base.Common
+import UHC.Light.Compiler.Ty
+import UHC.Light.Compiler.CHR
+import UHC.Light.Compiler.CHR.Key
+import UHC.Light.Compiler.Base.TreeTrie
+import UHC.Light.Compiler.Substitutable
+import UHC.Util.Pretty as PP
+import UHC.Util.Utils
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import UHC.Light.Compiler.VarMp
+import Control.Monad
+import UHC.Util.Binary
+import UHC.Util.Serialize
+import Data.Typeable
+import Data.Generics (Data)
+import UHC.Light.Compiler.Opts.Base
+
+
+
+
+{-# LINE 37 "src/ehc/CHR/Constraint.chs" #-}
+-- | A Constraint is abstracted over the exact predicate, but differentiates on the role: to prove, can be assumed, and side effect of reduction
+data Constraint p info
+  = Prove           { cnstrPred :: !p }             -- proof obligation
+  | Assume          { cnstrPred :: !p }             -- assumed constraint
+  | Reduction                                       -- 'side effect', residual info used by (e.g.) codegeneration
+                    { cnstrPred :: !p               -- the pred to which reduction was done
+                    , cnstrInfo :: !info            -- additional reduction specific info w.r.t. codegeneration
+                    , cnstrFromPreds :: ![p]        -- the preds from which reduction was done
+                    , cnstrVarMp :: VarMp           -- additional bindings for type (etc.) variables, i.e. improving substitution
+                    }
+  deriving (Eq, Ord, Show)
+
+{-# LINE 53 "src/ehc/CHR/Constraint.chs" #-}
+mkReduction :: p -> info -> [p] -> Constraint p info
+mkReduction p i ps
+  = Reduction p i ps
+              varlookupEmpty
+
+{-# LINE 62 "src/ehc/CHR/Constraint.chs" #-}
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable  Constraint
+#else
+deriving instance Typeable2 Constraint
+#endif
+deriving instance (Data x, Data y) => Data (Constraint x y)
+
+{-# LINE 71 "src/ehc/CHR/Constraint.chs" #-}
+-- | Dissection of Constraint, including reconstruction function
+cnstrReducablePart :: Constraint p info -> Maybe (String,p,p->Constraint p info)
+cnstrReducablePart (Prove  p) = Just ("Prf",p,Prove)
+cnstrReducablePart (Assume p) = Just ("Ass",p,Assume)
+cnstrReducablePart _          = Nothing
+
+{-# LINE 84 "src/ehc/CHR/Constraint.chs" #-}
+instance (CHRMatchable env p s) => CHRMatchable env (Constraint p info) s where
+  chrMatchTo env s c1 c2
+    = do { (_,p1,_) <- cnstrReducablePart c1
+         ; (_,p2,_) <- cnstrReducablePart c2
+         ; chrMatchTo env s p1 p2
+         }
+
+{-# LINE 93 "src/ehc/CHR/Constraint.chs" #-}
+instance TTKeyable p => TTKeyable (Constraint p info) where
+  toTTKey' o c -- = maybe [] (\(s,p,_) -> ttkAdd (TT1K_One $ Key_Str s) [toTTKey' o p]) $ cnstrReducablePart c
+    = case cnstrReducablePart c of
+        Just (s,p,_) -> ttkAdd' (TT1K_One $ Key_Str s) cs
+                     where (_,cs) = toTTKeyParentChildren' o p
+        _            -> panic "TTKeyable (Constraint p info).toTTKey'" -- ttkEmpty
+
+{-# LINE 102 "src/ehc/CHR/Constraint.chs" #-}
+instance (VarExtractable p v,VarExtractable info v) => VarExtractable (Constraint p info) v where
+  varFreeSet c
+    = case cnstrReducablePart c of
+        Just (_,p,_) -> varFreeSet p
+        _            -> Set.empty
+
+instance (VarUpdatable p s,VarUpdatable info s) => VarUpdatable (Constraint p info) s where
+  varUpd s      (Prove     p       ) = Prove      (varUpd s p)
+  varUpd s      (Assume    p       ) = Assume     (varUpd s p)
+  varUpd s      r@(Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=ps})
+                                     = r {cnstrPred=varUpd s p, cnstrInfo=varUpd s i, cnstrFromPreds=map (varUpd s) ps}
+
+{-# LINE 120 "src/ehc/CHR/Constraint.chs" #-}
+-- | The trace of an unresolved predicate
+data UnresolvedTrace p info
+  = UnresolvedTrace_None                                    -- no trace required when all is resolved
+  | UnresolvedTrace_Red                                     -- ok reduction, with failure deeper down
+      { utraceRedFrom       :: p
+      , utraceInfoTo2From   :: info
+      , utraceRedTo         :: [UnresolvedTrace p info]
+      }
+  | UnresolvedTrace_Fail                                    -- failed reduction
+      { utraceRedFrom       :: p
+      -- , utraceInfoTo2From    :: info
+      , utraceRedTo         :: [UnresolvedTrace p info]
+      }
+  | UnresolvedTrace_Overlap                                 -- choice could not be made
+      { utraceRedFrom       :: p
+      , utraceRedChoices    :: [(info,[UnresolvedTrace p info])]
+      }
+  deriving Show
+
+instance Eq p => Eq (UnresolvedTrace p info) where
+  t1 == t2 = True -- utraceRedFrom t1 == utraceRedFrom t2
+
+instance (PP p, PP info) => PP (UnresolvedTrace p info) where
+  pp x = case x of
+           UnresolvedTrace_None             -> PP.empty
+           UnresolvedTrace_Red      p i us  -> p >|< ":" >#< i >-< indent 2 (vlist $ map pp us)
+           UnresolvedTrace_Fail     p   us  -> p >|< ": FAIL" >-< indent 2 (vlist $ map pp us)
+           UnresolvedTrace_Overlap  p uss   -> p >|< ": OVERLAP" >-< indent 2 (vlist $ map (\(i,u) -> i >-< indent 2 (vlist $ map pp u)) uss)
+
+{-# LINE 155 "src/ehc/CHR/Constraint.chs" #-}
+-- | Map from constraint to something
+type ConstraintMp' p info x = Map.Map (Constraint p info) [x]
+
+{-# LINE 160 "src/ehc/CHR/Constraint.chs" #-}
+cnstrMpSingletonL :: Constraint p i -> [x] -> ConstraintMp' p i x
+cnstrMpSingletonL c xs = Map.singleton c xs
+
+cnstrMpSingleton :: Constraint p i -> x -> ConstraintMp' p i x
+cnstrMpSingleton c x = cnstrMpSingletonL c [x]
+
+cnstrMpFromList :: (Ord p, Ord i) => [(Constraint p i,x)] -> ConstraintMp' p i x
+cnstrMpFromList l = Map.fromListWith (++) [ (c,[x]) | (c,x) <- l ]
+
+cnstrMpMap :: (Ord p, Ord i) => (x -> y) -> ConstraintMp' p i x -> ConstraintMp' p i y
+cnstrMpMap f = Map.map (map f)
+
+{-# LINE 174 "src/ehc/CHR/Constraint.chs" #-}
+-- | Map from constraint to info + trace
+type ConstraintToInfoTraceMp p info = ConstraintMp' p info (info,[UnresolvedTrace p info])
+
+{-# LINE 179 "src/ehc/CHR/Constraint.chs" #-}
+cnstrTraceMpFromList :: (Ord p, Ord i) => [(Constraint p i,(i,[UnresolvedTrace p i]))] -> ConstraintToInfoTraceMp p i
+cnstrTraceMpFromList = cnstrMpFromList
+
+cnstrTraceMpSingleton :: Constraint p i -> i -> [UnresolvedTrace p i] -> ConstraintToInfoTraceMp p i
+cnstrTraceMpSingleton c i ts = cnstrMpSingleton c (i,ts)
+
+cnstrTraceMpElimTrace :: (Ord p, Ord i) => ConstraintToInfoTraceMp p i -> ConstraintToInfoMap p i
+cnstrTraceMpElimTrace = cnstrMpMap fst
+
+cnstrTraceMpLiftTrace :: (Ord p, Ord i) => ConstraintToInfoMap p i -> ConstraintToInfoTraceMp p i
+cnstrTraceMpLiftTrace = cnstrMpMap (\x -> (x,[]))
+
+{-# LINE 193 "src/ehc/CHR/Constraint.chs" #-}
+-- | Map from constraint to info
+type ConstraintToInfoMap     p info = ConstraintMp' p info info
+
+{-# LINE 198 "src/ehc/CHR/Constraint.chs" #-}
+emptyCnstrMp :: ConstraintMp' p info x
+emptyCnstrMp = Map.empty
+
+{-# LINE 208 "src/ehc/CHR/Constraint.chs" #-}
+cnstrMpUnion :: (Ord p, Ord i) => ConstraintMp' p i x -> ConstraintMp' p i x -> ConstraintMp' p i x
+cnstrMpUnion = Map.unionWith (++)
+
+cnstrMpUnions :: (Ord p, Ord i) => [ConstraintMp' p i x] -> ConstraintMp' p i x
+cnstrMpUnions = Map.unionsWith (++)
+
+{-# LINE 220 "src/ehc/CHR/Constraint.chs" #-}
+-- | Predicate for whether solving is required
+cnstrRequiresSolve :: Constraint p info -> Bool
+cnstrRequiresSolve (Reduction {}) = False
+cnstrRequiresSolve _              = True
+
+{-# LINE 231 "src/ehc/CHR/Constraint.chs" #-}
+instance (PP p, PP info) => PP (Constraint p info) where
+  pp (Prove     p     ) = "Prove"  >#< p
+  pp (Assume    p     ) = "Assume" >#< p
+  pp (Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=ps})
+                        = "Red"    >#< p >#< "<" >#< i >#< "<" >#< ppBracketsCommas ps
+
+{-# LINE 243 "src/ehc/CHR/Constraint.chs" #-}
+instance (Serialize p, Serialize i) => Serialize (Constraint p i) where
+  sput (Prove     a      ) = sputWord8 0 >> sput a
+  sput (Assume    a      ) = sputWord8 1 >> sput a
+  sput (Reduction a b c d) = sputWord8 2 >> sput a >> sput b >> sput c >> sput d
+  sget = do t <- sgetWord8
+            case t of
+              0 -> liftM  Prove     sget
+              1 -> liftM  Assume    sget
+              2 -> liftM4 Reduction sget sget sget sget
+
diff --git a/tests/examples/SimpleDo.hs b/tests/examples/SimpleDo.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/SimpleDo.hs
@@ -0,0 +1,4 @@
+
+foo = do
+  let    x = 1 -- a comment
+  return x
diff --git a/tests/examples/TypeSignature.hs b/tests/examples/TypeSignature.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/TypeSignature.hs
@@ -0,0 +1,12 @@
+module TypeSignature where
+
+{- Lifting baz to the top level should bring in xx and a as parameters,
+   and update the signature to include these
+-}
+foo a = (baz xx a)
+  where
+    xx :: Int -> Int -> Int
+    xx p1 p2 = p1 + p2
+
+baz :: (Int -> Int -> Int) -> Int ->Int
+baz xx a = xx 1 a