{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.GHC.ExactPrint.Transform
--
-- This module is currently under heavy development, and no promises are made
-- about API stability. Use with care.
--
-- We welcome any feedback / contributions on this, as it is the main point of
-- the library.
--
-----------------------------------------------------------------------------
module Language.Haskell.GHC.ExactPrint.Transform
        (
        -- * The Transform Monad
          Transform
        , TransformT(..)
        , hoistTransform
        , runTransform
        , runTransformT
        , runTransformFrom
        , runTransformFromT

        -- * Transform monad operations
        , logTr
        , logDataWithAnnsTr
        , uniqueSrcSpanT

        -- ** Managing declarations, in Transform monad
        , HasTransform (..)
        , HasDecls (..)
        , hsDeclsPatBind, hsDeclsPatBindD
        , replaceDeclsPatBind, replaceDeclsPatBindD
        , modifyDeclsT
        , modifyValD
        -- *** Utility, does not manage layout
        , hsDeclsValBinds, replaceDeclsValbinds
        , WithWhere(..)

        -- ** New gen functions
        , noAnnSrcSpanDP
        , noAnnSrcSpanDP0
        , noAnnSrcSpanDP1
        , noAnnSrcSpanDPn
        , d0, d1, dn
        , addComma

        -- ** Managing lists, Transform monad
        , insertAt
        , insertAtStart
        , insertAtEnd
        , insertAfter
        , insertBefore

        -- *** Low level operations used in 'HasDecls'
        , balanceComments
        , balanceCommentsList
        , balanceCommentsListA
        , anchorEof

        -- ** Managing lists, pure functions
        , captureOrderBinds
        , captureLineSpacing
        , captureMatchLineSpacing
        , captureTypeSigSpacing

        -- * Operations
        , isUniqueSrcSpan

        -- * Pure functions
        , setEntryDP, setEntryDPDecl
        , getEntryDP
        , transferEntryDP
        , transferEntryDP'
        , wrapSig, wrapDecl
        , decl2Sig, decl2Bind
        ) where

import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Utils

import Control.Monad.RWS
import qualified Control.Monad.Fail as Fail

import GHC  hiding (parseModule, parsedSource)
import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Types.SrcLoc

import Data.Data
import Data.Maybe
import Data.Generics

import Data.Functor.Identity
import Control.Monad.State

------------------------------------------------------------------------------
-- Transformation of source elements

-- | 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 = TransformT Identity

-- |Monad transformer version of 'Transform' monad
newtype TransformT m a = TransformT { forall (m :: * -> *) a. TransformT m a -> RWST () [String] Int m a
unTransformT :: RWST () [String] Int m a }
                deriving (Applicative (TransformT m)
Applicative (TransformT m) =>
(forall a b.
 TransformT m a -> (a -> TransformT m b) -> TransformT m b)
-> (forall a b. TransformT m a -> TransformT m b -> TransformT m b)
-> (forall a. a -> TransformT m a)
-> Monad (TransformT m)
forall a. a -> TransformT m a
forall a b. TransformT m a -> TransformT m b -> TransformT m b
forall a b.
TransformT m a -> (a -> TransformT m b) -> TransformT m b
forall (m :: * -> *). Monad m => Applicative (TransformT m)
forall (m :: * -> *) a. Monad m => a -> TransformT m a
forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> TransformT m b -> TransformT m b
forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> (a -> TransformT m b) -> TransformT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> (a -> TransformT m b) -> TransformT m b
>>= :: forall a b.
TransformT m a -> (a -> TransformT m b) -> TransformT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> TransformT m b -> TransformT m b
>> :: forall a b. TransformT m a -> TransformT m b -> TransformT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> TransformT m a
return :: forall a. a -> TransformT m a
Monad,Functor (TransformT m)
Functor (TransformT m) =>
(forall a. a -> TransformT m a)
-> (forall a b.
    TransformT m (a -> b) -> TransformT m a -> TransformT m b)
-> (forall a b c.
    (a -> b -> c)
    -> TransformT m a -> TransformT m b -> TransformT m c)
-> (forall a b. TransformT m a -> TransformT m b -> TransformT m b)
-> (forall a b. TransformT m a -> TransformT m b -> TransformT m a)
-> Applicative (TransformT m)
forall a. a -> TransformT m a
forall a b. TransformT m a -> TransformT m b -> TransformT m a
forall a b. TransformT m a -> TransformT m b -> TransformT m b
forall a b.
TransformT m (a -> b) -> TransformT m a -> TransformT m b
forall a b c.
(a -> b -> c) -> TransformT m a -> TransformT m b -> TransformT m c
forall (m :: * -> *). Monad m => Functor (TransformT m)
forall (m :: * -> *) a. Monad m => a -> TransformT m a
forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> TransformT m b -> TransformT m a
forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> TransformT m b -> TransformT m b
forall (m :: * -> *) a b.
Monad m =>
TransformT m (a -> b) -> TransformT m a -> TransformT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TransformT m a -> TransformT m b -> TransformT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> TransformT m a
pure :: forall a. a -> TransformT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
TransformT m (a -> b) -> TransformT m a -> TransformT m b
<*> :: forall a b.
TransformT m (a -> b) -> TransformT m a -> TransformT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TransformT m a -> TransformT m b -> TransformT m c
liftA2 :: forall a b c.
(a -> b -> c) -> TransformT m a -> TransformT m b -> TransformT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> TransformT m b -> TransformT m b
*> :: forall a b. TransformT m a -> TransformT m b -> TransformT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> TransformT m b -> TransformT m a
<* :: forall a b. TransformT m a -> TransformT m b -> TransformT m a
Applicative,(forall a b. (a -> b) -> TransformT m a -> TransformT m b)
-> (forall a b. a -> TransformT m b -> TransformT m a)
-> Functor (TransformT m)
forall a b. a -> TransformT m b -> TransformT m a
forall a b. (a -> b) -> TransformT m a -> TransformT m b
forall (m :: * -> *) a b.
Functor m =>
a -> TransformT m b -> TransformT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TransformT m a -> TransformT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TransformT m a -> TransformT m b
fmap :: forall a b. (a -> b) -> TransformT m a -> TransformT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> TransformT m b -> TransformT m a
<$ :: forall a b. a -> TransformT m b -> TransformT m a
Functor
                         ,MonadReader ()
                         ,MonadWriter [String]
                         ,MonadState Int
                         ,(forall (m :: * -> *). Monad m => Monad (TransformT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> TransformT m a)
-> MonadTrans TransformT
forall (m :: * -> *). Monad m => Monad (TransformT m)
forall (m :: * -> *) a. Monad m => m a -> TransformT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> TransformT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> TransformT m a
MonadTrans
                         )

instance Fail.MonadFail m => Fail.MonadFail (TransformT m) where
    fail :: forall a. String -> TransformT m a
fail String
msg = RWST () [String] Int m a -> TransformT m a
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (RWST () [String] Int m a -> TransformT m a)
-> RWST () [String] Int m a -> TransformT m a
forall a b. (a -> b) -> a -> b
$ (() -> Int -> m (a, Int, [String])) -> RWST () [String] Int m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((() -> Int -> m (a, Int, [String])) -> RWST () [String] Int m a)
-> (() -> Int -> m (a, Int, [String])) -> RWST () [String] Int m a
forall a b. (a -> b) -> a -> b
$ \()
_ Int
_ -> String -> m (a, Int, [String])
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg

-- | Run a transformation in the 'Transform' monad, returning the updated
-- annotations and any logging generated via 'logTr'
runTransform :: Transform a -> (a,Int,[String])
runTransform :: forall a. Transform a -> (a, Int, [String])
runTransform Transform a
f = Int -> Transform a -> (a, Int, [String])
forall a. Int -> Transform a -> (a, Int, [String])
runTransformFrom Int
0 Transform a
f

runTransformT :: TransformT m a -> m (a,Int,[String])
runTransformT :: forall (m :: * -> *) a. TransformT m a -> m (a, Int, [String])
runTransformT TransformT m a
f = Int -> TransformT m a -> m (a, Int, [String])
forall (m :: * -> *) a.
Int -> TransformT m a -> m (a, Int, [String])
runTransformFromT Int
0 TransformT m a
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 -> Transform a -> (a,Int,[String])
runTransformFrom :: forall a. Int -> Transform a -> (a, Int, [String])
runTransformFrom Int
seed Transform a
f = RWS () [String] Int a -> () -> Int -> (a, Int, [String])
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS (Transform a -> RWS () [String] Int a
forall (m :: * -> *) a. TransformT m a -> RWST () [String] Int m a
unTransformT Transform a
f) () Int
seed

-- |Run a monad transformer stack for the 'TransformT' monad transformer
runTransformFromT :: Int -> TransformT m a -> m (a,Int,[String])
runTransformFromT :: forall (m :: * -> *) a.
Int -> TransformT m a -> m (a, Int, [String])
runTransformFromT Int
seed TransformT m a
f = RWST () [String] Int m a -> () -> Int -> m (a, Int, [String])
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (TransformT m a -> RWST () [String] Int m a
forall (m :: * -> *) a. TransformT m a -> RWST () [String] Int m a
unTransformT TransformT m a
f) () Int
seed

-- | Change inner monad of 'TransformT'.
hoistTransform :: (forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform forall x. m x -> n x
nt (TransformT RWST () [String] Int m a
m) = RWST () [String] Int n a -> TransformT n a
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT ((m (a, Int, [String]) -> n (a, Int, [String]))
-> RWST () [String] Int m a -> RWST () [String] Int n a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST m (a, Int, [String]) -> n (a, Int, [String])
forall x. m x -> n x
nt RWST () [String] Int m a
m)

-- |Log a string to the output of the Monad
logTr :: (Monad m) => String -> TransformT m ()
logTr :: forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
str = [String] -> TransformT m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
str]

-- |Log a representation of the given AST with annotations to the output of the
-- Monad
logDataWithAnnsTr :: (Monad m) => (Data a) => String -> a -> TransformT m ()
logDataWithAnnsTr :: forall (m :: * -> *) a.
(Monad m, Data a) =>
String -> a -> TransformT m ()
logDataWithAnnsTr String
str a
ast = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Data a => a -> String
showAst a
ast

-- ---------------------------------------------------------------------

-- |If we need to add new elements to the AST, they need their own
-- 'SrcSpan' for this.
uniqueSrcSpanT :: (Monad m) => TransformT m SrcSpan
uniqueSrcSpanT :: forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT = do
  col <- TransformT m Int
forall s (m :: * -> *). MonadState s m => m s
get
  put (col + 1 )
  let pos = FastString -> Int -> Int -> SrcLoc
mkSrcLoc (String -> FastString
mkFastString String
"ghc-exactprint") (-Int
1) Int
col
  return $ mkSrcSpan pos pos

-- |Test whether a given 'SrcSpan' was generated by 'uniqueSrcSpanT'
isUniqueSrcSpan :: SrcSpan -> Bool
isUniqueSrcSpan :: SrcSpan -> Bool
isUniqueSrcSpan SrcSpan
ss = SrcSpan -> Int
srcSpanStartLine' SrcSpan
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1

srcSpanStartLine' :: SrcSpan -> Int
srcSpanStartLine' :: SrcSpan -> Int
srcSpanStartLine' (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s
srcSpanStartLine' SrcSpan
_ = Int
0

-- ---------------------------------------------------------------------

captureMatchLineSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs
captureMatchLineSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs
captureMatchLineSpacing (L SrcSpanAnnA
l (ValD XValD GhcPs
x (FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (MG XMG GhcPs (LHsExpr GhcPs)
c (L SrcSpanAnnL
d [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms )))))
                       = SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
x (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
c (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
d [LMatch GhcPs (LHsExpr GhcPs)]
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms'))))
    where
      ms' :: [LMatch GhcPs (LHsExpr GhcPs)]
      ms' :: [LMatch GhcPs (LHsExpr GhcPs)]
ms' = [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall e. [LocatedA e] -> [LocatedA e]
captureLineSpacing [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms
captureMatchLineSpacing LHsDecl GhcPs
d = LHsDecl GhcPs
d

captureLineSpacing :: [LocatedA e] -> [LocatedA e]
captureLineSpacing :: forall e. [LocatedA e] -> [LocatedA e]
captureLineSpacing [] = []
captureLineSpacing [LocatedA e
d] = [LocatedA e
d]
captureLineSpacing [LocatedA e]
ds = ((Int, Int, LocatedA e) -> LocatedA e)
-> [(Int, Int, LocatedA e)] -> [LocatedA e]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_,Int
_,LocatedA e
x) -> LocatedA e
x) ([(Int, Int, LocatedA e)] -> [LocatedA e])
-> [(Int, Int, LocatedA e)] -> [LocatedA e]
forall a b. (a -> b) -> a -> b
$ [(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]
forall e. [(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]
go ((LocatedA e -> (Int, Int, LocatedA e))
-> [LocatedA e] -> [(Int, Int, LocatedA e)]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA e -> (Int, Int, LocatedA e)
forall e. LocatedA e -> (Int, Int, LocatedA e)
to [LocatedA e]
ds)
  where
    to :: LocatedA e -> (Int, Int, LocatedA e)
    to :: forall e. LocatedA e -> (Int, Int, LocatedA e)
to LocatedA e
d = ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
rss, (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
rss,LocatedA e
d)
      where
        rss :: RealSrcSpan
rss = SrcSpan -> RealSrcSpan
rs (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LocatedA e -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
getHasLoc LocatedA e
d

    go :: [(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]
    go :: forall e. [(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]
go [] = []
    go [(Int, Int, LocatedA e)
d] = [(Int, Int, LocatedA e)
d]
    go ((Int
ls1,Int
le1,LocatedA e
de1):(Int
ls2,Int
le2,LocatedA e
d2):[(Int, Int, LocatedA e)]
ds0) = (Int
ls1,Int
le1,LocatedA e
de1)(Int, Int, LocatedA e)
-> [(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]
forall a. a -> [a] -> [a]
:[(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]
forall e. [(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]
go ((Int
ls2,Int
le2,LocatedA e
d2')(Int, Int, LocatedA e)
-> [(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]
forall a. a -> [a] -> [a]
:[(Int, Int, LocatedA e)]
ds0)
         [(Int, Int, LocatedA e)] -> String -> [(Int, Int, LocatedA e)]
forall c. c -> String -> c
`debug` (String
"captureLineSpacing: (le1,ls2,getLoc d2,getLoc d2')=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, SrcSpanAnnA, SrcSpanAnnA) -> String
forall a. Data a => a -> String
showAst (Int
le1,Int
ls2,LocatedA e -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedA e
d2,LocatedA e -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedA e
d2'))
      where
        d2' :: LocatedA e
d2' = LocatedA e -> DeltaPos -> LocatedA e
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedA e
d2 (Int -> Int -> DeltaPos
deltaPos (Int
ls2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
le1) Int
0)

-- ---------------------------------------------------------------------

captureTypeSigSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs
captureTypeSigSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs
captureTypeSigSpacing (L SrcSpanAnnA
l (SigD XSigD GhcPs
x (TypeSig (AnnSig AddEpAnn
dc [AddEpAnn]
rs') [LIdP GhcPs]
ns (HsWC XHsWC GhcPs (LHsSigType GhcPs)
xw LHsSigType GhcPs
ty))))
  = (SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
x (XTypeSig GhcPs
-> [LIdP GhcPs]
-> HsWildCardBndrs GhcPs (LHsSigType GhcPs)
-> Sig GhcPs
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig (AddEpAnn -> [AddEpAnn] -> AnnSig
AnnSig AddEpAnn
dc' [AddEpAnn]
rs') [LIdP GhcPs]
ns (XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC XHsWC GhcPs (LHsSigType GhcPs)
XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
xw LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'))))
  where
    -- we want DPs for the distance from the end of the ns to the
    -- AnnDColon, and to the start of the ty
    AddEpAnn AnnKeywordId
kw EpaLocation
dca = AddEpAnn
dc
    rd :: RealSrcSpan
rd = case [GenLocated SrcSpanAnnN (IdP GhcPs)]
-> GenLocated SrcSpanAnnN (IdP GhcPs)
forall a. HasCallStack => [a] -> a
last [LIdP GhcPs]
[GenLocated SrcSpanAnnN (IdP GhcPs)]
ns of
      L (EpAnn EpaLocation
anc' NameAnn
_ EpAnnComments
_) IdP GhcPs
_ -> EpaLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor EpaLocation
anc' -- TODO MovedAnchor?
    dc' :: AddEpAnn
dc' = case EpaLocation
dca of
      EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_) -> AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kw (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta ((Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
rd) RealSrcSpan
r) [])
      EpaLocation
_                         -> AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kw EpaLocation
dca

    -- ---------------------------------

    ty' :: LHsSigType GhcPs
    ty' :: LHsSigType GhcPs
ty' = case LHsSigType GhcPs
ty of
      (L (EpAnn EpaLocation
anc0 AnnListItem
a EpAnnComments
c) HsSigType GhcPs
b)
        -> let
              anc' :: EpaLocation
anc' = case EpaLocation
anc0 of
                EpaDelta DeltaPos
_ [LEpaComment]
_ -> EpaLocation
anc0
                EpaLocation
_ -> case EpaLocation
dca of
                  EpaSpan SrcSpan
_ -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
1) []
                  EpaDelta DeltaPos
_ [LEpaComment]
cs0 -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
1) [LEpaComment]
cs0
           in (SrcSpanAnnA
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc' AnnListItem
a EpAnnComments
c) HsSigType GhcPs
b)

captureTypeSigSpacing LHsDecl GhcPs
s = LHsDecl GhcPs
s

-- ---------------------------------------------------------------------

setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs
setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs
setEntryDPDecl decl :: LHsDecl GhcPs
decl@(L SrcSpanAnnA
_  (ValD XValD GhcPs
x (FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (MG XMG GhcPs (LHsExpr GhcPs)
c (L SrcSpanAnnL
d [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms ))))) DeltaPos
dp
                   = SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
x (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
c (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
d [LMatch GhcPs (LHsExpr GhcPs)]
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms'))))
    where
      L SrcSpanAnnA
l' HsDecl GhcPs
_ = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DeltaPos -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl DeltaPos
dp
      ms' :: [LMatch GhcPs (LHsExpr GhcPs)]
      ms' :: [LMatch GhcPs (LHsExpr GhcPs)]
ms' = case [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms of
        [] -> []
        (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m0':[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0) -> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> DeltaPos
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m0' DeltaPos
dp LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
: [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0
setEntryDPDecl LHsDecl GhcPs
d DeltaPos
dp = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DeltaPos -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
d DeltaPos
dp

-- ---------------------------------------------------------------------

-- |Set the true entry 'DeltaPos' from the annotation for a given AST
-- element. This is the 'DeltaPos' ignoring any comments.
setEntryDP :: LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP :: forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (L (EpAnn (EpaSpan (UnhelpfulSpan UnhelpfulSpanReason
_)) t
an EpAnnComments
cs) a
a) DeltaPos
dp
  = EpAnn t -> a -> GenLocated (EpAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> t -> EpAnnComments -> EpAnn t
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp []) t
an EpAnnComments
cs) a
a
setEntryDP (L (EpAnn (EpaSpan SrcSpan
_) t
an (EpaComments [])) a
a) DeltaPos
dp
  = EpAnn t -> a -> GenLocated (EpAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> t -> EpAnnComments -> EpAnn t
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp []) t
an ([LEpaComment] -> EpAnnComments
EpaComments [])) a
a
setEntryDP (L (EpAnn (EpaDelta DeltaPos
d [LEpaComment]
csd) t
an EpAnnComments
cs) a
a) DeltaPos
dp
  = EpAnn t -> a -> GenLocated (EpAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> t -> EpAnnComments -> EpAnn t
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
d' [LEpaComment]
csd') t
an EpAnnComments
cs') a
a
  where
    (DeltaPos
d', [LEpaComment]
csd', EpAnnComments
cs') = case EpAnnComments
cs of
      EpaComments (LEpaComment
h:[LEpaComment]
t) ->
        let
          (DeltaPos
dp0,LEpaComment
c') = LEpaComment -> (DeltaPos, LEpaComment)
forall e.
GenLocated NoCommentsLocation e
-> (DeltaPos, GenLocated NoCommentsLocation e)
go LEpaComment
h
        in
          (DeltaPos
dp0, LEpaComment
c'LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
t[LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++[LEpaComment]
csd, [LEpaComment] -> EpAnnComments
EpaComments [])
      EpaComments [] ->
          (DeltaPos
dp, [LEpaComment]
csd, EpAnnComments
cs)
      EpaCommentsBalanced (LEpaComment
h:[LEpaComment]
t) [LEpaComment]
ts ->
        let
          (DeltaPos
dp0,LEpaComment
c') = LEpaComment -> (DeltaPos, LEpaComment)
forall e.
GenLocated NoCommentsLocation e
-> (DeltaPos, GenLocated NoCommentsLocation e)
go LEpaComment
h
        in
          (DeltaPos
dp0, LEpaComment
c'LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
t[LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++[LEpaComment]
csd, [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
ts)
      EpaCommentsBalanced [] [LEpaComment]
ts ->
           case [LEpaComment]
csd of
             [] -> (DeltaPos
d, [LEpaComment]
csd, [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
ts)
             (LEpaComment
h:[LEpaComment]
t) ->
                let
                  (DeltaPos
dp0,LEpaComment
c') = LEpaComment -> (DeltaPos, LEpaComment)
forall e.
GenLocated NoCommentsLocation e
-> (DeltaPos, GenLocated NoCommentsLocation e)
go LEpaComment
h
                in
                  (DeltaPos
dp0, LEpaComment
c'LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
t, [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
ts)
    go :: GenLocated NoCommentsLocation e -> (DeltaPos, GenLocated NoCommentsLocation e)
    go :: forall e.
GenLocated NoCommentsLocation e
-> (DeltaPos, GenLocated NoCommentsLocation e)
go (L (EpaDelta DeltaPos
_ NoComments
c0) e
c) = (DeltaPos
d,  NoCommentsLocation -> e -> GenLocated NoCommentsLocation e
forall l e. l -> e -> GenLocated l e
L (DeltaPos -> NoComments -> NoCommentsLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp NoComments
c0) e
c)
    go (L (EpaSpan SrcSpan
_)     e
c) = (DeltaPos
d,  NoCommentsLocation -> e -> GenLocated NoCommentsLocation e
forall l e. l -> e -> GenLocated l e
L (DeltaPos -> NoComments -> NoCommentsLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp NoComments
NoComments) e
c)
setEntryDP (L (EpAnn (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_)) t
an EpAnnComments
cs) a
a) DeltaPos
dp
  = case [LEpaComment] -> [LEpaComment]
sortEpaComments (EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs) of
      [] ->
        EpAnn t -> a -> GenLocated (EpAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> t -> EpAnnComments -> EpAnn t
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp []) t
an EpAnnComments
cs) a
a
      (L NoCommentsLocation
ca EpaComment
c:[LEpaComment]
cs') ->
        EpAnn t -> a -> GenLocated (EpAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> t -> EpAnnComments -> EpAnn t
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
edp [LEpaComment]
csd) t
an EpAnnComments
cs'') a
a
              where
                cs'' :: EpAnnComments
cs'' = EpAnnComments -> [LEpaComment] -> EpAnnComments
setPriorComments EpAnnComments
cs []
                csd :: [LEpaComment]
csd = NoCommentsLocation -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L (DeltaPos -> NoComments -> NoCommentsLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp NoComments
NoComments) EpaComment
cLEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment] -> [LEpaComment]
commentOrigDeltas [LEpaComment]
cs'
                lc :: LEpaComment
lc = [LEpaComment] -> LEpaComment
forall a. HasCallStack => [a] -> a
last ([LEpaComment] -> LEpaComment) -> [LEpaComment] -> LEpaComment
forall a b. (a -> b) -> a -> b
$ (NoCommentsLocation -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L NoCommentsLocation
ca EpaComment
cLEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
cs')
                delta :: DeltaPos
delta = case LEpaComment -> NoCommentsLocation
forall l e. GenLocated l e -> l
getLoc LEpaComment
lc of
                          EpaSpan (RealSrcSpan RealSrcSpan
rr Maybe BufSpan
_) -> (Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
rr) RealSrcSpan
r
                          EpaSpan SrcSpan
_ -> (Int -> DeltaPos
SameLine Int
0)
                          EpaDelta DeltaPos
_dp NoComments
_ -> Int -> Int -> DeltaPos
DifferentLine Int
1 Int
0
                line :: Int
line = DeltaPos -> Int
getDeltaLine DeltaPos
delta
                col :: Int
col = DeltaPos -> Int
deltaColumn DeltaPos
delta
                edp' :: DeltaPos
edp' = if Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> DeltaPos
SameLine Int
col
                                    else Int -> Int -> DeltaPos
DifferentLine Int
line Int
col
                edp :: DeltaPos
edp = DeltaPos
edp' DeltaPos -> String -> DeltaPos
forall c. c -> String -> c
`debug` (String
"setEntryDP :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (DeltaPos, (Int, Int), RealSrcSpan) -> String
forall a. Outputable a => a -> String
showGhc (DeltaPos
edp', (RealSrcSpan -> (Int, Int)
ss2pos (RealSrcSpan -> (Int, Int)) -> RealSrcSpan -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ NoCommentsLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor (NoCommentsLocation -> RealSrcSpan)
-> NoCommentsLocation -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> NoCommentsLocation
forall l e. GenLocated l e -> l
getLoc LEpaComment
lc), RealSrcSpan
r))


-- ---------------------------------------------------------------------

getEntryDP :: LocatedAn t a -> DeltaPos
getEntryDP :: forall t a. LocatedAn t a -> DeltaPos
getEntryDP (L (EpAnn (EpaDelta DeltaPos
dp [LEpaComment]
_) t
_ EpAnnComments
_) a
_) = DeltaPos
dp
getEntryDP GenLocated (EpAnn t) a
_ = Int -> DeltaPos
SameLine Int
1

-- ---------------------------------------------------------------------

addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta LayoutStartCol
_off RealSrcSpan
_anc (EpaDelta DeltaPos
d [LEpaComment]
cs) = DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
d [LEpaComment]
cs
addEpaLocationDelta LayoutStartCol
_off RealSrcSpan
_anc (EpaSpan (UnhelpfulSpan UnhelpfulSpanReason
_)) = DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) []
addEpaLocationDelta  LayoutStartCol
off  RealSrcSpan
anc (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_))
  = DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset LayoutStartCol
off (RealSrcSpan -> RealSrcSpan -> DeltaPos
ss2deltaEnd RealSrcSpan
anc RealSrcSpan
r)) []

-- Set the entry DP for an element coming after an existing keyword annotation
setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t
setEntryDPFromAnchor :: forall t. LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t
setEntryDPFromAnchor LayoutStartCol
_off (EpaDelta DeltaPos
_ [LEpaComment]
_) (L SrcSpanAnnA
la t
a) = SrcSpanAnnA -> t -> GenLocated SrcSpanAnnA t
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
la t
a
setEntryDPFromAnchor LayoutStartCol
_off (EpaSpan (UnhelpfulSpan UnhelpfulSpanReason
_)) (L SrcSpanAnnA
la t
a) = SrcSpanAnnA -> t -> GenLocated SrcSpanAnnA t
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
la t
a
setEntryDPFromAnchor  LayoutStartCol
off (EpaSpan (RealSrcSpan RealSrcSpan
anc Maybe BufSpan
_)) ll :: GenLocated SrcSpanAnnA t
ll@(L SrcSpanAnnA
la t
_) = GenLocated SrcSpanAnnA t -> DeltaPos -> GenLocated SrcSpanAnnA t
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP GenLocated SrcSpanAnnA t
ll DeltaPos
dp'
  where
    dp' :: DeltaPos
dp' = case SrcSpanAnnA
la of
      (EpAnn (EpaSpan (RealSrcSpan RealSrcSpan
r' Maybe BufSpan
_)) AnnListItem
_ EpAnnComments
_) -> LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset LayoutStartCol
off (RealSrcSpan -> RealSrcSpan -> DeltaPos
ss2deltaEnd RealSrcSpan
anc RealSrcSpan
r')
      (EpAnn (EpaSpan SrcSpan
_) AnnListItem
_ EpAnnComments
_)                  -> LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset LayoutStartCol
off (Int -> DeltaPos
SameLine Int
0)
      (EpAnn (EpaDelta DeltaPos
dp [LEpaComment]
_) AnnListItem
_ EpAnnComments
_)              -> LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset LayoutStartCol
off DeltaPos
dp

-- ---------------------------------------------------------------------

-- |Take the annEntryDelta associated with the first item and associate it with the second.
-- Also transfer any comments occurring before it.
transferEntryDP :: (Monad m, Typeable t1, Typeable t2)
  => LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP :: forall (m :: * -> *) t1 t2 a b.
(Monad m, Typeable t1, Typeable t2) =>
LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP (L (EpAnn EpaLocation
anc1 t1
an1 EpAnnComments
cs1) a
_) (L (EpAnn EpaLocation
_anc2 t2
an2 EpAnnComments
cs2) b
b) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"transferEntryDP': EpAnn,EpAnn"
  -- Problem: if the original had preceding comments, blindly
  -- transferring the location is not correct
  case EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs1 of
    [] -> GenLocated (EpAnn t2) b -> TransformT m (GenLocated (EpAnn t2) b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn t2 -> b -> GenLocated (EpAnn t2) b
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> t2 -> EpAnnComments -> EpAnn t2
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc1 (t1 -> t2 -> t2
forall a b. (Typeable a, Typeable b) => a -> b -> b
combine t1
an1 t2
an2) EpAnnComments
cs2) b
b)
    -- TODO: what happens if the receiving side already has comments?
    (L NoCommentsLocation
anc EpaComment
_:[LEpaComment]
_) -> do
      String -> NoCommentsLocation -> TransformT m ()
forall (m :: * -> *) a.
(Monad m, Data a) =>
String -> a -> TransformT m ()
logDataWithAnnsTr String
"transferEntryDP':priorComments anc=" NoCommentsLocation
anc
      GenLocated (EpAnn t2) b -> TransformT m (GenLocated (EpAnn t2) b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn t2 -> b -> GenLocated (EpAnn t2) b
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> t2 -> EpAnnComments -> EpAnn t2
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc1 (t1 -> t2 -> t2
forall a b. (Typeable a, Typeable b) => a -> b -> b
combine t1
an1 t2
an2) (EpAnnComments
cs1 EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
<> EpAnnComments
cs2)) b
b)


-- |If a and b are the same type return first arg, else return second
combine :: (Typeable a, Typeable b) => a -> b -> b
combine :: forall a b. (Typeable a, Typeable b) => a -> b -> b
combine a
x b
y = b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
y (a -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x)

-- |Take the annEntryDelta associated with the first item and associate it with the second.
-- Also transfer any comments occurring before it.
-- TODO: call transferEntryDP, and use pushDeclDP
transferEntryDP' :: (Monad m) => LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs)
transferEntryDP' :: forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs)
transferEntryDP' LHsDecl GhcPs
la LHsDecl GhcPs
lb = do
  (L l2 b) <- GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) t1 t2 a b.
(Monad m, Typeable t1, Typeable t2) =>
LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
la LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
lb
  return (L l2 (pushDeclDP b (SameLine 0)))


pushDeclDP :: HsDecl GhcPs -> DeltaPos -> HsDecl GhcPs
pushDeclDP :: HsDecl GhcPs -> DeltaPos -> HsDecl GhcPs
pushDeclDP (ValD XValD GhcPs
x (FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (MG XMG GhcPs (LHsExpr GhcPs)
c (L SrcSpanAnnL
d  [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms )))) DeltaPos
dp
          = XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
x (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
c (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
d' [LMatch GhcPs (LHsExpr GhcPs)]
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms')))
    where
      L SrcSpanAnnL
d' [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ = GenLocated
  SrcSpanAnnL
  [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> DeltaPos
-> GenLocated
     SrcSpanAnnL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
d [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms) DeltaPos
dp
      ms' :: [LMatch GhcPs (LHsExpr GhcPs)]
      ms' :: [LMatch GhcPs (LHsExpr GhcPs)]
ms' = case [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms of
        [] -> []
        (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m0':[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0) -> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> DeltaPos
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m0' DeltaPos
dp LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
: [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0
pushDeclDP HsDecl GhcPs
d DeltaPos
_dp = HsDecl GhcPs
d

-- ---------------------------------------------------------------------

-- | If we compile in haddock mode we get DocDecls, which we strip out
-- while exact printing. Make sure we do not balance any comments on
-- to them be stripping them out here already.
balanceCommentsList :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
balanceCommentsList :: forall (m :: * -> *).
Monad m =>
[LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
balanceCommentsList [LHsDecl GhcPs]
decls = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
[LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
balanceCommentsList' ((GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. (a -> Bool) -> [a] -> [a]
filter LHsDecl GhcPs -> Bool
GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Bool
notDocDecl [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls)

balanceCommentsList' :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
balanceCommentsList' :: forall (m :: * -> *).
Monad m =>
[LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
balanceCommentsList' [] = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
balanceCommentsList' [LHsDecl GhcPs
x] = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return [LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
x]
balanceCommentsList' (LHsDecl GhcPs
a:LHsDecl GhcPs
b:[LHsDecl GhcPs]
ls) = do
  (a',b') <- LHsDecl GhcPs
-> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs, LHsDecl GhcPs)
forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs
-> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs, LHsDecl GhcPs)
balanceComments LHsDecl GhcPs
a LHsDecl GhcPs
b
  r <- balanceCommentsList' (b':ls)
  return (a':r)

-- |The GHC parser puts all comments appearing between the end of one AST
-- item and the beginning of the next as 'annPriorComments' for the second one.
-- This function takes two adjacent AST items and moves any 'annPriorComments'
-- from the second one to the 'annFollowingComments' of the first if they belong
-- to it instead. This is typically required before deleting or duplicating
-- either of the AST elements.
balanceComments :: (Monad m)
  => LHsDecl GhcPs -> LHsDecl GhcPs
  -> TransformT m (LHsDecl GhcPs, LHsDecl GhcPs)
balanceComments :: forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs
-> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs, LHsDecl GhcPs)
balanceComments LHsDecl GhcPs
first LHsDecl GhcPs
second = do
  case LHsDecl GhcPs
first of
    (L SrcSpanAnnA
l (ValD XValD GhcPs
x fb :: HsBindLR GhcPs GhcPs
fb@(FunBind{}))) -> do
      (L l' fb',second') <- LHsBind GhcPs
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT
     m (LHsBind GhcPs, GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) b.
Monad m =>
LHsBind GhcPs
-> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b)
balanceCommentsFB (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
fb) LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
second
      return (L l' (ValD x fb'), second')
    LHsDecl GhcPs
_ -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT
     m
     (GenLocated SrcSpanAnnA (HsDecl GhcPs),
      GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceCommentsA LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
first LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
second

-- |Once 'balanceCommentsA has been called to move trailing comments to a
-- 'FunBind', these need to be pushed down from the top level to the last
-- 'Match' if that 'Match' needs to be manipulated.
balanceCommentsFB :: (Monad m)
  => LHsBind GhcPs -> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b)
balanceCommentsFB :: forall (m :: * -> *) b.
Monad m =>
LHsBind GhcPs
-> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b)
balanceCommentsFB (L SrcSpanAnnA
lf (FunBind XFunBind GhcPs GhcPs
x LIdP GhcPs
n (MG XMG GhcPs (LHsExpr GhcPs)
o (L SrcSpanAnnL
lm [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches)))) LocatedA b
second = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsFB entered: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Int, Int), (Int, Int)) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan -> ((Int, Int), (Int, Int))
ss2range (SrcSpan -> ((Int, Int), (Int, Int)))
-> SrcSpan -> ((Int, Int), (Int, Int))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
lf)
  -- There are comments on lf.  We need to
  -- + Keep the prior ones here
  -- + move the interior ones to the first match,
  -- + move the trailing ones to the last match.
  let
    ([LEpaComment]
before,[LEpaComment]
middle,[LEpaComment]
after) = case SrcSpanAnnA -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry SrcSpanAnnA
lf of
        EpaSpan (RealSrcSpan RealSrcSpan
ss Maybe BufSpan
_) ->
          let
            split :: EpAnnComments
split = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd RealSrcSpan
ss (SrcSpanAnnA -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments SrcSpanAnnA
lf)
            split2 :: EpAnnComments
split2 = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsStart RealSrcSpan
ss  ([LEpaComment] -> EpAnnComments
EpaComments ([LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
split))

            before0 :: [LEpaComment]
before0 = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
split2
            middle0 :: [LEpaComment]
middle0 = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
split2
            after0 :: [LEpaComment]
after0  = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
split
          in ([LEpaComment]
before0,[LEpaComment]
middle0,[LEpaComment]
after0)
        EpaLocation
_ -> (EpAnnComments -> [LEpaComment]
priorComments (EpAnnComments -> [LEpaComment]) -> EpAnnComments -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments SrcSpanAnnA
lf,
              [],
              EpAnnComments -> [LEpaComment]
getFollowingComments (EpAnnComments -> [LEpaComment]) -> EpAnnComments -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments SrcSpanAnnA
lf)

    lf' :: SrcSpanAnnA
lf' = SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
setCommentsEpAnn SrcSpanAnnA
lf ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
before)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsFB (before, after): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([LEpaComment], [LEpaComment]) -> String
forall a. Data a => a -> String
showAst ([LEpaComment]
before, [LEpaComment]
after)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsFB lf': " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcSpanAnnA -> String
forall a. Data a => a -> String
showAst SrcSpanAnnA
lf'
  -- let matches' = case matches of
  let matches' :: [LocatedA (Match GhcPs (LHsExpr GhcPs))]
      matches' :: [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
matches' = case [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches of
                    (L SrcSpanAnnA
lm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m':[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms') ->
                      (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn SrcSpanAnnA
lm' ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
middle )) Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m'LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms')
                    [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> String
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. HasCallStack => String -> a
error String
"balanceCommentsFB"
  matches'' <- [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
-> TransformT
     m [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
forall (m :: * -> *) a.
Monad m =>
[LocatedA a] -> TransformT m [LocatedA a]
balanceCommentsListA [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
matches'
  let (m,ms) = case reverse matches'' of
                 (L SrcSpanAnnA
lm' Match GhcPs (LHsExpr GhcPs)
m':[GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
ms') ->
                   (SrcSpanAnnA
-> Match GhcPs (LHsExpr GhcPs)
-> GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn SrcSpanAnnA
lm' ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
after)) Match GhcPs (LHsExpr GhcPs)
m',[GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
ms')
                   -- (L (addCommentsToEpAnnS lm' (EpaCommentsBalanced [] after)) m',ms')
                 [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
_ -> String
-> (GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs)),
    [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))])
forall a. HasCallStack => String -> a
error String
"balanceCommentsFB4"
  debugM $ "balanceCommentsFB: (m,ms):" ++ showAst (m,ms)
  (m',second') <- balanceCommentsA m second
  m'' <- balanceCommentsMatch m'
  let (m''',lf'') = case ms of
        [] -> GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))
-> SrcSpanAnnA
-> (GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs)),
    SrcSpanAnnA)
forall t u a.
(Data t, Data u, NoAnn t, NoAnn u) =>
LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u)
moveLeadingComments GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))
m'' SrcSpanAnnA
lf'
        [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
_  -> (GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))
m'',SrcSpanAnnA
lf')
  debugM $ "balanceCommentsFB: (lf'', m'''):" ++ showAst (lf'',m''')
  debugM $ "balanceCommentsFB done"
  let bind = SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lf'' (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
x LIdP GhcPs
n (XMG GhcPs (LHsExpr GhcPs)
-> XRec GhcPs [LMatch GhcPs (LHsExpr GhcPs)]
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
o (SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
-> GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm ([GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
-> [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
forall a. [a] -> [a]
reverse (GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))
m'''GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))
-> [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
-> [GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
forall a. a -> [a] -> [a]
:[GenLocated SrcSpanAnnA (Match GhcPs (LHsExpr GhcPs))]
ms)))))
  debugM $ "balanceCommentsFB returning:" ++ showAst bind
  balanceCommentsA (packFunBind bind) second'
balanceCommentsFB LHsBind GhcPs
f LocatedA b
s = GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> LocatedA b
-> TransformT
     m (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs), LocatedA b)
forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceCommentsA LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
f LocatedA b
s

-- | Move comments on the same line as the end of the match into the
-- GRHS, prior to the binds
balanceCommentsMatch :: (Monad m)
  => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceCommentsMatch :: forall (m :: * -> *).
Monad m =>
LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceCommentsMatch (L SrcSpanAnnA
l (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
am HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xg [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
binds))) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsMatch: (logInfo)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (EpAnnComments, SrcSpanAnnA) -> String
forall a. Data a => a -> String
showAst ((EpAnnComments, SrcSpanAnnA)
logInfo)
  LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l'' (XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext (LIdP (NoGhcTc GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (LIdP (NoGhcTc p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
am HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats (XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xg [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss' HsLocalBinds GhcPs
binds')))
  where
    simpleBreak :: (a, b) -> Bool
simpleBreak (a
r,b
_) = a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0
    an1 :: SrcSpanAnnA
an1 = SrcSpanAnnA
l
    anc1 :: EpAnnComments
anc1 = SrcSpanAnnA -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments SrcSpanAnnA
an1
    cs1f :: [LEpaComment]
cs1f = EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
anc1
    ([(Int, LEpaComment)]
move',[(Int, LEpaComment)]
stay') = ((Int, LEpaComment) -> Bool)
-> [(Int, LEpaComment)]
-> ([(Int, LEpaComment)], [(Int, LEpaComment)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int, LEpaComment) -> Bool
forall {a} {b}. (Eq a, Num a) => (a, b) -> Bool
simpleBreak (RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (LocatedA () -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA (SrcSpanAnnA -> () -> LocatedA ()
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ())) [LEpaComment]
cs1f)
    move :: [LEpaComment]
move = ((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
move'
    stay :: [LEpaComment]
stay = ((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
stay'
    (SrcSpanAnnA
l'', [GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss', HsLocalBinds GhcPs
binds', (EpAnnComments, SrcSpanAnnA)
logInfo)
      = case [GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss of
          [] -> (SrcSpanAnnA
l, [], HsLocalBinds GhcPs
binds,                 ([LEpaComment] -> EpAnnComments
EpaComments [], SrcSpanAnnA
forall e. HasAnnotation e => e
noSrcSpanA))
          (L Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lg (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ag [GuardLStmt GhcPs]
grs GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs):[GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs) ->
            let
              anc1' :: EpAnnComments
anc1' = EpAnnComments -> [LEpaComment] -> EpAnnComments
setFollowingComments EpAnnComments
anc1 [LEpaComment]
stay
              an1' :: SrcSpanAnnA
an1' = SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
setCommentsEpAnn SrcSpanAnnA
l EpAnnComments
anc1'

              -- ---------------------------------
              (Bool
moved,HsLocalBinds GhcPs
bindsm) = WithWhere
-> EpAnnComments
-> HsLocalBinds GhcPs
-> (Bool, HsLocalBinds GhcPs)
pushTrailingComments WithWhere
WithWhere ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
move) HsLocalBinds GhcPs
binds
              -- ---------------------------------

              (EpAnn EpaLocation
anc GrhsAnn
an EpAnnComments
lgc) = XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ag
              lgc' :: EpAnnComments
lgc' = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lg) EpAnnComments
lgc
              ag' :: EpAnn GrhsAnn
ag' = if Bool
moved
                      then EpaLocation -> GrhsAnn -> EpAnnComments -> EpAnn GrhsAnn
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc GrhsAnn
an EpAnnComments
lgc'
                      else EpaLocation -> GrhsAnn -> EpAnnComments -> EpAnn GrhsAnn
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc GrhsAnn
an (EpAnnComments
lgc' EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
<> ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
move))

            in (SrcSpanAnnA
an1', ([GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([GenLocated
    (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
       (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lg (XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GuardLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
ag' [GuardLStmt GhcPs]
grs GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs)GenLocated
  (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs)), HsLocalBinds GhcPs
bindsm, (EpAnnComments
anc1',SrcSpanAnnA
an1'))

pushTrailingComments :: WithWhere -> EpAnnComments -> HsLocalBinds GhcPs -> (Bool, HsLocalBinds GhcPs)
pushTrailingComments :: WithWhere
-> EpAnnComments
-> HsLocalBinds GhcPs
-> (Bool, HsLocalBinds GhcPs)
pushTrailingComments WithWhere
_ EpAnnComments
_cs b :: HsLocalBinds GhcPs
b@EmptyLocalBinds{} = (Bool
False, HsLocalBinds GhcPs
b)
pushTrailingComments WithWhere
_ EpAnnComments
_cs (HsIPBinds XHsIPBinds GhcPs GhcPs
_ HsIPBinds GhcPs
_) = String -> (Bool, HsLocalBinds GhcPs)
forall a. HasCallStack => String -> a
error String
"TODO: pushTrailingComments:HsIPBinds"
pushTrailingComments WithWhere
w EpAnnComments
cs lb :: HsLocalBinds GhcPs
lb@(HsValBinds XHsValBinds GhcPs GhcPs
an HsValBindsLR GhcPs GhcPs
_)
  = (Bool
True, XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
SrcSpanAnnL
an' HsValBindsLR GhcPs GhcPs
vb)
  where
    decls :: [LHsDecl GhcPs]
decls = HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
lb
    (SrcSpanAnnL
an', [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls') = case [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls of
      [] -> (SrcSpanAnnL -> EpAnnComments -> SrcSpanAnnL
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn XHsValBinds GhcPs GhcPs
SrcSpanAnnL
an EpAnnComments
cs, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls)
      (L SrcSpanAnnA
la HsDecl GhcPs
d:[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds) -> (XHsValBinds GhcPs GhcPs
SrcSpanAnnL
an, SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn SrcSpanAnnA
la EpAnnComments
cs) HsDecl GhcPs
dGenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds)
    (HsValBindsLR GhcPs GhcPs
vb,[String]
_ws2) = case Transform (HsLocalBinds GhcPs)
-> (HsLocalBinds GhcPs, Int, [String])
forall a. Transform a -> (a, Int, [String])
runTransform (WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> Transform (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
w HsLocalBinds GhcPs
lb ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls')) of
      ((HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
vb'), Int
_, [String]
ws2') -> (HsValBindsLR GhcPs GhcPs
vb', [String]
ws2')
      (HsLocalBinds GhcPs, Int, [String])
_ -> (XValBinds GhcPs GhcPs
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
AnnSortKey BindTag
forall tag. AnnSortKey tag
NoAnnSortKey LHsBindsLR GhcPs GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. Bag a
emptyBag [], [])


balanceCommentsListA :: (Monad m) => [LocatedA a] -> TransformT m [LocatedA a]
balanceCommentsListA :: forall (m :: * -> *) a.
Monad m =>
[LocatedA a] -> TransformT m [LocatedA a]
balanceCommentsListA [] = [LocatedA a] -> TransformT m [LocatedA a]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
balanceCommentsListA [LocatedA a
x] = [LocatedA a] -> TransformT m [LocatedA a]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return [LocatedA a
x]
balanceCommentsListA (LocatedA a
a:LocatedA a
b:[LocatedA a]
ls) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsListA entered"
  (a',b') <- LocatedA a -> LocatedA a -> TransformT m (LocatedA a, LocatedA a)
forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceCommentsA LocatedA a
a LocatedA a
b
  r <- balanceCommentsListA (b':ls)
  return (a':r)

-- |Prior to moving an AST element, make sure any trailing comments belonging to
-- it are attached to it, and not the following element. Of necessity this is a
-- heuristic process, to be tuned later. Possibly a variant should be provided
-- with a passed-in decision function.
-- The initial situation is that all comments for a given anchor appear as prior comments
-- Many of these should in fact be following comments for the previous anchor
balanceCommentsA :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceCommentsA :: forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceCommentsA LocatedA a
la1 LocatedA b
la2 = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsA: anchors=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SrcSpanAnnA, SrcSpanAnnA) -> String
forall a. Data a => a -> String
showAst (SrcSpanAnnA
an1, SrcSpanAnnA
an2)
  -- debugM $ "balanceCommentsA: (anc1)=" ++ showAst (anc1)
  -- debugM $ "balanceCommentsA: (anc2)=" ++ showAst (anc2)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsA: (cs1f)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ EpAnnComments -> String
forall a. Data a => a -> String
showAst (EpAnnComments
cs1f)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsA: (cs2p, cs2f)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(Int, LEpaComment)], [(Int, LEpaComment)]) -> String
forall a. Data a => a -> String
showAst ([(Int, LEpaComment)]
cs2p, [(Int, LEpaComment)]
cs2f)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsA: (cs1stay,cs1move)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(Int, LEpaComment)], [(Int, LEpaComment)]) -> String
forall a. Data a => a -> String
showAst ([(Int, LEpaComment)]
cs1stay,[(Int, LEpaComment)]
cs1move)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> m ()
debugM (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsA: (an1',an2')=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SrcSpanAnnA, SrcSpanAnnA) -> String
forall a. Data a => a -> String
showAst (SrcSpanAnnA
an1',SrcSpanAnnA
an2')
  (LocatedA a, LocatedA b) -> TransformT m (LocatedA a, LocatedA b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA a
la1', LocatedA b
la2')
  where
    simpleBreak :: a -> (a, b) -> Bool
simpleBreak a
n (a
r,b
_) = a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
n
    L SrcSpanAnnA
an1 a
f = LocatedA a
la1
    L SrcSpanAnnA
an2 b
s = LocatedA b
la2
    anc1 :: EpAnnComments
anc1 = SrcSpanAnnA -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments SrcSpanAnnA
an1
    anc2 :: EpAnnComments
anc2 = SrcSpanAnnA -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments SrcSpanAnnA
an2

    ([LEpaComment]
p1,[LEpaComment]
m1,[LEpaComment]
f1) = RealSrcSpan
-> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment])
splitComments (LocatedA a -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA a
la1) EpAnnComments
anc1
    cs1p :: [(Int, LEpaComment)]
cs1p = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
priorCommentsDeltas    (LocatedA a -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA a
la1) [LEpaComment]
p1

    -- Split cs1 following comments into those before any
    -- TrailingAnn's on an1, and any after
    cs1f :: EpAnnComments
cs1f = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd (LocatedA a -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
fullSpanFromLocatedA LocatedA a
la1) (EpAnnComments -> EpAnnComments) -> EpAnnComments -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ [LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
f1
    cs1fp :: [(Int, LEpaComment)]
cs1fp = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
priorCommentsDeltas    (LocatedA a -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA a
la1) (EpAnnComments -> [LEpaComment]
priorComments        EpAnnComments
cs1f)
    cs1ff :: [(Int, LEpaComment)]
cs1ff = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (LocatedA a -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA a
la1) (EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs1f)

    -- Split cs1ff into those that belong on an1 and ones that must move to an2
    ([(Int, LEpaComment)]
cs1move,[(Int, LEpaComment)]
cs1stay) = ((Int, LEpaComment) -> Bool)
-> [(Int, LEpaComment)]
-> ([(Int, LEpaComment)], [(Int, LEpaComment)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> (Int, LEpaComment) -> Bool
forall {a} {b}. Ord a => a -> (a, b) -> Bool
simpleBreak Int
1) [(Int, LEpaComment)]
cs1ff

    ([LEpaComment]
p2,[LEpaComment]
m2,[LEpaComment]
f2) = RealSrcSpan
-> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment])
splitComments (LocatedA b -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA b
la2) EpAnnComments
anc2
    cs2p :: [(Int, LEpaComment)]
cs2p = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
priorCommentsDeltas    (LocatedA b -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA b
la2) [LEpaComment]
p2
    cs2f :: [(Int, LEpaComment)]
cs2f = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (LocatedA b -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA b
la2) [LEpaComment]
f2

    ([(Int, LEpaComment)]
stay'',[(Int, LEpaComment)]
move') = ((Int, LEpaComment) -> Bool)
-> [(Int, LEpaComment)]
-> ([(Int, LEpaComment)], [(Int, LEpaComment)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> (Int, LEpaComment) -> Bool
forall {a} {b}. Ord a => a -> (a, b) -> Bool
simpleBreak Int
1) [(Int, LEpaComment)]
cs2p
    -- Need to also check for comments more closely attached to la1,
    -- ie trailing on the same line
    ([(Int, LEpaComment)]
move'',[(Int, LEpaComment)]
stay') = ((Int, LEpaComment) -> Bool)
-> [(Int, LEpaComment)]
-> ([(Int, LEpaComment)], [(Int, LEpaComment)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> (Int, LEpaComment) -> Bool
forall {a} {b}. Ord a => a -> (a, b) -> Bool
simpleBreak Int
0) (RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (LocatedA a -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA a
la1) (((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
stay''))
    move :: [LEpaComment]
move = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ ((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd ([(Int, LEpaComment)]
cs1fp [(Int, LEpaComment)]
-> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. [a] -> [a] -> [a]
++ [(Int, LEpaComment)]
cs1move [(Int, LEpaComment)]
-> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. [a] -> [a] -> [a]
++ [(Int, LEpaComment)]
move'' [(Int, LEpaComment)]
-> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. [a] -> [a] -> [a]
++ [(Int, LEpaComment)]
move')
    stay :: [LEpaComment]
stay = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
m2 [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ ((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd ([(Int, LEpaComment)]
cs1stay [(Int, LEpaComment)]
-> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. [a] -> [a] -> [a]
++ [(Int, LEpaComment)]
stay')

    an1' :: SrcSpanAnnA
an1' = SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
setCommentsEpAnn (LocatedA a -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedA a
la1) ([LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced ([LEpaComment]
m1 [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ ((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
cs1p) [LEpaComment]
move)
    an2' :: SrcSpanAnnA
an2' = SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
setCommentsEpAnn (LocatedA b -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedA b
la2) ([LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
stay (((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
cs2f))
    la1' :: LocatedA a
la1' = SrcSpanAnnA -> a -> LocatedA a
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
an1' a
f
    la2' :: LocatedA b
la2' = SrcSpanAnnA -> b -> LocatedA b
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
an2' b
s

-- | Like commentsDeltas, but calculates the delta from the end of the anchor, not the start
trailingCommentsDeltas :: RealSrcSpan -> [LEpaComment]
               -> [(Int, LEpaComment)]
trailingCommentsDeltas :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas RealSrcSpan
_ [] = []
trailingCommentsDeltas RealSrcSpan
r (la :: LEpaComment
la@(L (EpaDelta DeltaPos
dp NoComments
_) EpaComment
_):[LEpaComment]
las)
  = (DeltaPos -> Int
getDeltaLine DeltaPos
dp, LEpaComment
la)(Int, LEpaComment) -> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas RealSrcSpan
r [LEpaComment]
las
trailingCommentsDeltas RealSrcSpan
r (la :: LEpaComment
la@(L NoCommentsLocation
l EpaComment
_):[LEpaComment]
las)
  = RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
forall {a} {e}.
RealSrcSpan
-> GenLocated (EpaLocation' a) e
-> (Int, GenLocated (EpaLocation' a) e)
deltaComment RealSrcSpan
r LEpaComment
la (Int, LEpaComment) -> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (NoCommentsLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor NoCommentsLocation
l) [LEpaComment]
las
  where
    deltaComment :: RealSrcSpan
-> GenLocated (EpaLocation' a) e
-> (Int, GenLocated (EpaLocation' a) e)
deltaComment RealSrcSpan
rs' (L EpaLocation' a
loc e
c) = (Int -> Int
forall a. Num a => a -> a
abs(Int
ll Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
al), EpaLocation' a -> e -> GenLocated (EpaLocation' a) e
forall l e. l -> e -> GenLocated l e
L EpaLocation' a
loc e
c)
      where
        (Int
al,Int
_) = RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
rs'
        (Int
ll,Int
_) = RealSrcSpan -> (Int, Int)
ss2pos (EpaLocation' a -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor EpaLocation' a
loc)

priorCommentsDeltas :: RealSrcSpan -> [LEpaComment]
                    -> [(Int, LEpaComment)]
priorCommentsDeltas :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
priorCommentsDeltas RealSrcSpan
r [LEpaComment]
cs = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go RealSrcSpan
r ([LEpaComment] -> [LEpaComment]
sortEpaComments [LEpaComment]
cs)
  where
    go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
    go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go RealSrcSpan
_   [] = []
    go RealSrcSpan
_   (la :: LEpaComment
la@(L l :: NoCommentsLocation
l@(EpaDelta DeltaPos
dp NoComments
_) EpaComment
_):[LEpaComment]
las) = (DeltaPos -> Int
deltaLine DeltaPos
dp, LEpaComment
la) (Int, LEpaComment) -> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go (NoCommentsLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor NoCommentsLocation
l) [LEpaComment]
las
    go RealSrcSpan
rs' (la :: LEpaComment
la@(L NoCommentsLocation
l EpaComment
_):[LEpaComment]
las) = RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
deltaComment RealSrcSpan
rs' LEpaComment
la (Int, LEpaComment) -> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go (NoCommentsLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor NoCommentsLocation
l) [LEpaComment]
las

    deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
    deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
deltaComment RealSrcSpan
rs' (L NoCommentsLocation
loc EpaComment
c) = (Int -> Int
forall a. Num a => a -> a
abs(Int
ll Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
al), NoCommentsLocation -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L NoCommentsLocation
loc EpaComment
c)
      where
        (Int
al,Int
_) = RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
rs'
        (Int
ll,Int
_) = RealSrcSpan -> (Int, Int)
ss2pos (NoCommentsLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor NoCommentsLocation
loc)


-- ---------------------------------------------------------------------

-- | Split comments into ones occurring before the end of the reference
-- span, and those after it.
splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment])
splitComments :: RealSrcSpan
-> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment])
splitComments RealSrcSpan
p EpAnnComments
cs = ([LEpaComment]
before, [LEpaComment]
middle, [LEpaComment]
after)
  where
    cmpe :: GenLocated (EpaLocation' a) e -> Bool
cmpe (L (EpaSpan (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) e
_) = RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
l (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
p
    cmpe (L EpaLocation' a
_ e
_) = Bool
True

    cmpb :: GenLocated (EpaLocation' a) e -> Bool
cmpb (L (EpaSpan (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) e
_) = RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
l (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
p
    cmpb (L EpaLocation' a
_ e
_) = Bool
True

    ([LEpaComment]
beforeEnd, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
cmpe ((EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs) [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ (EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs))
    ([LEpaComment]
before, [LEpaComment]
middle) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
cmpb [LEpaComment]
beforeEnd


-- | Split comments into ones occurring before the end of the reference
-- span, and those after it.
splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd RealSrcSpan
p (EpaComments [LEpaComment]
cs) = EpAnnComments
cs'
  where
    cmp :: GenLocated (EpaLocation' a) e -> Bool
cmp (L (EpaSpan (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) e
_) = RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
l (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
p
    cmp (L EpaLocation' a
_ e
_) = Bool
True
    ([LEpaComment]
before, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
cmp [LEpaComment]
cs
    cs' :: EpAnnComments
cs' = case [LEpaComment]
after of
      [] -> [LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
cs
      [LEpaComment]
_ -> [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
before [LEpaComment]
after
splitCommentsEnd RealSrcSpan
p (EpaCommentsBalanced [LEpaComment]
cs [LEpaComment]
ts) = [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
cs' [LEpaComment]
ts'
  where
    cmp :: GenLocated (EpaLocation' a) e -> Bool
cmp (L (EpaSpan (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) e
_) = RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
l (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
p
    cmp (L EpaLocation' a
_ e
_) = Bool
True
    ([LEpaComment]
before, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
cmp [LEpaComment]
cs
    cs' :: [LEpaComment]
cs' = [LEpaComment]
before
    ts' :: [LEpaComment]
ts' = [LEpaComment]
after [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. Semigroup a => a -> a -> a
<> [LEpaComment]
ts

-- | Split comments into ones occurring before the start of the reference
-- span, and those after it.
splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsStart RealSrcSpan
p (EpaComments [LEpaComment]
cs) = EpAnnComments
cs'
  where
    cmp :: GenLocated (EpaLocation' a) e -> Bool
cmp (L (EpaSpan (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) e
_) = RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
l (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
p
    cmp (L EpaLocation' a
_ e
_) = Bool
True
    ([LEpaComment]
before, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
cmp [LEpaComment]
cs
    cs' :: EpAnnComments
cs' = case [LEpaComment]
after of
      [] -> [LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
cs
      [LEpaComment]
_ -> [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
before [LEpaComment]
after
splitCommentsStart RealSrcSpan
p (EpaCommentsBalanced [LEpaComment]
cs [LEpaComment]
ts) = [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
cs' [LEpaComment]
ts'
  where
    cmp :: GenLocated (EpaLocation' a) e -> Bool
cmp (L (EpaSpan (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) e
_) = RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
l (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
p
    cmp (L EpaLocation' a
_ e
_) = Bool
True
    ([LEpaComment]
before, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
cmp [LEpaComment]
cs
    cs' :: [LEpaComment]
cs' = [LEpaComment]
before
    ts' :: [LEpaComment]
ts' = [LEpaComment]
after [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. Semigroup a => a -> a -> a
<> [LEpaComment]
ts

moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u)
  => LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u)
moveLeadingComments :: forall t u a.
(Data t, Data u, NoAnn t, NoAnn u) =>
LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u)
moveLeadingComments (L EpAnn t
la a
a) EpAnn u
lb = (EpAnn t -> a -> GenLocated (EpAnn t) a
forall l e. l -> e -> GenLocated l e
L EpAnn t
la' a
a, EpAnn u
lb')
  (GenLocated (EpAnn t) a, EpAnn u)
-> String -> (GenLocated (EpAnn t) a, EpAnn u)
forall c. c -> String -> c
`debug` (String
"moveLeadingComments: (before, after, la', lb'):" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([LEpaComment], [LEpaComment], EpAnn t, EpAnn u) -> String
forall a. Data a => a -> String
showAst ([LEpaComment]
before, [LEpaComment]
after, EpAnn t
la', EpAnn u
lb'))
  where
    split :: EpAnnComments
split = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ EpAnn t -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpAnn t
la) (EpAnn t -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments EpAnn t
la)
    before :: [LEpaComment]
before = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
split
    after :: [LEpaComment]
after = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
split

    -- TODO: need to set an entry delta on lb' to zero, and move the
    -- original spacing to the first comment.

    la' :: EpAnn t
la' = EpAnn t -> EpAnnComments -> EpAnn t
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
setCommentsEpAnn EpAnn t
la ([LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [] [LEpaComment]
after)
    lb' :: EpAnn u
lb' = EpAnn u -> EpAnnComments -> EpAnn u
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn EpAnn u
lb ([LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
before [])

-- | A GHC comment includes the span of the preceding (non-comment)
-- token.  Takes an original list of comments, and converts the
-- 'Anchor's to have a have a `MovedAnchor` operation based on the
-- original locations.
commentOrigDeltas :: [LEpaComment] -> [LEpaComment]
commentOrigDeltas :: [LEpaComment] -> [LEpaComment]
commentOrigDeltas [] = []
commentOrigDeltas [LEpaComment]
lcs = (LEpaComment -> LEpaComment) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map LEpaComment -> LEpaComment
commentOrigDelta [LEpaComment]
lcs

addCommentOrigDeltas :: EpAnnComments -> EpAnnComments
addCommentOrigDeltas :: EpAnnComments -> EpAnnComments
addCommentOrigDeltas (EpaComments [LEpaComment]
cs) = [LEpaComment] -> EpAnnComments
EpaComments ([LEpaComment] -> [LEpaComment]
commentOrigDeltas [LEpaComment]
cs)
addCommentOrigDeltas (EpaCommentsBalanced [LEpaComment]
pcs [LEpaComment]
fcs)
  = [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced ([LEpaComment] -> [LEpaComment]
commentOrigDeltas [LEpaComment]
pcs) ([LEpaComment] -> [LEpaComment]
commentOrigDeltas [LEpaComment]
fcs)

addCommentOrigDeltasAnn :: (EpAnn a) -> (EpAnn a)
addCommentOrigDeltasAnn :: forall a. EpAnn a -> EpAnn a
addCommentOrigDeltasAnn (EpAnn EpaLocation
e a
a EpAnnComments
cs) = EpaLocation -> a -> EpAnnComments -> EpAnn a
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
e a
a (EpAnnComments -> EpAnnComments
addCommentOrigDeltas EpAnnComments
cs)


-- TODO: this is replicating functionality in ExactPrint. Sort out the
-- import loop`
anchorFromLocatedA :: LocatedA a -> RealSrcSpan
anchorFromLocatedA :: forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA (L (EpAnn EpaLocation
anc AnnListItem
_ EpAnnComments
_) a
_) = EpaLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor EpaLocation
anc

-- | Get the full span of interest for comments from a LocatedA.
-- This extends up to the last TrailingAnn
fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan
fullSpanFromLocatedA :: forall a. LocatedA a -> RealSrcSpan
fullSpanFromLocatedA (L (EpAnn EpaLocation
anc (AnnListItem [TrailingAnn]
tas)  EpAnnComments
_) a
_) = RealSrcSpan
rr
  where
    r :: RealSrcSpan
r = EpaLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor EpaLocation
anc
    trailing_loc :: TrailingAnn -> [RealSrcSpan]
trailing_loc TrailingAnn
ta = case TrailingAnn -> EpaLocation
ta_location TrailingAnn
ta of
        EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) -> [RealSrcSpan
s]
        EpaLocation
_ -> []
    rr :: RealSrcSpan
rr = case [RealSrcSpan] -> [RealSrcSpan]
forall a. [a] -> [a]
reverse ((TrailingAnn -> [RealSrcSpan]) -> [TrailingAnn] -> [RealSrcSpan]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TrailingAnn -> [RealSrcSpan]
trailing_loc [TrailingAnn]
tas) of
        [] -> RealSrcSpan
r
        (RealSrcSpan
s:[RealSrcSpan]
_) -> RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans RealSrcSpan
r RealSrcSpan
s

-- ---------------------------------------------------------------------

balanceSameLineComments :: (Monad m)
  => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceSameLineComments :: forall (m :: * -> *).
Monad m =>
LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceSameLineComments (L SrcSpanAnnA
la (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
anm HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
lb))) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceSameLineComments: (la)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Int, Int), (Int, Int)) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan -> ((Int, Int), (Int, Int))
ss2range (SrcSpan -> ((Int, Int), (Int, Int)))
-> SrcSpan -> ((Int, Int), (Int, Int))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
la)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceSameLineComments: [logInfo]=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(EpAnnComments, ([LEpaComment], [LEpaComment]))] -> String
forall a. Data a => a -> String
showAst [(EpAnnComments, ([LEpaComment], [LEpaComment]))]
logInfo
  LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
la' (XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext (LIdP (NoGhcTc GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (LIdP (NoGhcTc p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
anm HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt [LPat GhcPs]
pats (XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss' HsLocalBinds GhcPs
lb)))
  where
    simpleBreak :: a -> (a, b) -> Bool
simpleBreak a
n (a
r,b
_) = a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
n
    (SrcSpanAnnA
la',[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss', [(EpAnnComments, ([LEpaComment], [LEpaComment]))]
logInfo) = case [GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss of
      [] -> (SrcSpanAnnA
la,[LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss,[])
      (L EpAnnCO
lg (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ga [GuardLStmt GhcPs]
gs GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs):[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs) -> (SrcSpanAnnA
la'',[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([GenLocated
    EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (EpAnnCO
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L EpAnnCO
lg (XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GuardLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
ga' [GuardLStmt GhcPs]
gs GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs))GenLocated
  EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs,[(EpAnnComments
gac,([LEpaComment]
csp,[LEpaComment]
csf))])
        where
          anc1 :: EpAnnComments
anc1 = SrcSpanAnnA -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments SrcSpanAnnA
la
          (EpAnn EpaLocation
anc GrhsAnn
an EpAnnComments
_) = XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
ga :: EpAnn GrhsAnn
          ([LEpaComment]
csp,[LEpaComment]
csf) = case EpAnnComments
anc1 of
            EpaComments [LEpaComment]
cs -> ([],[LEpaComment]
cs)
            EpaCommentsBalanced [LEpaComment]
p [LEpaComment]
f -> ([LEpaComment]
p,[LEpaComment]
f)
          ([(Int, LEpaComment)]
move',[(Int, LEpaComment)]
stay') = ((Int, LEpaComment) -> Bool)
-> [(Int, LEpaComment)]
-> ([(Int, LEpaComment)], [(Int, LEpaComment)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> (Int, LEpaComment) -> Bool
forall {a} {b}. Ord a => a -> (a, b) -> Bool
simpleBreak Int
0) (RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (EpaLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor EpaLocation
anc) [LEpaComment]
csf)
          move :: [LEpaComment]
move = ((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
move'
          stay :: [LEpaComment]
stay = ((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
stay'
          cs1 :: EpAnnComments
cs1 = [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
csp [LEpaComment]
stay

          gac :: EpAnnComments
gac = EpAnn GrhsAnn -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
epAnnComments XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
ga
          gfc :: [LEpaComment]
gfc = EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
gac
          gac' :: EpAnnComments
gac' = EpAnnComments -> [LEpaComment] -> EpAnnComments
setFollowingComments EpAnnComments
gac ([LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
gfc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
move)
          ga' :: EpAnn GrhsAnn
ga' = (EpaLocation -> GrhsAnn -> EpAnnComments -> EpAnn GrhsAnn
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc GrhsAnn
an EpAnnComments
gac')

          la'' :: SrcSpanAnnA
la'' = SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
setCommentsEpAnn SrcSpanAnnA
la EpAnnComments
cs1

-- ---------------------------------------------------------------------

anchorEof :: ParsedSource -> ParsedSource
anchorEof :: ParsedSource -> ParsedSource
anchorEof (L SrcSpan
l m :: HsModule GhcPs
m@(HsModule (XModulePs EpAnn AnnsModule
an EpLayout
_lo Maybe (LWarningTxt GhcPs)
_ Maybe (LHsDoc GhcPs)
_) Maybe (XRec GhcPs ModuleName)
_mn Maybe (XRec GhcPs [LIE GhcPs])
_exps [LImportDecl GhcPs]
_imps [LHsDecl GhcPs]
_decls)) = SrcSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsModule GhcPs
m { hsmodExt = (hsmodExt m){ hsmodAnn = an' } })
  where
    an' :: EpAnn AnnsModule
an' = EpAnn AnnsModule -> EpAnn AnnsModule
forall a. EpAnn a -> EpAnn a
addCommentOrigDeltasAnn EpAnn AnnsModule
an

-- ---------------------------------------------------------------------

-- | Create a @SrcSpanAnn@ with a @MovedAnchor@ operation using the
-- given @DeltaPos@.
noAnnSrcSpanDP :: (NoAnn ann) => DeltaPos -> EpAnn ann
noAnnSrcSpanDP :: forall ann. NoAnn ann => DeltaPos -> EpAnn ann
noAnnSrcSpanDP DeltaPos
dp = EpaLocation -> ann -> EpAnnComments -> EpAnn ann
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta DeltaPos
dp []) ann
forall a. NoAnn a => a
noAnn EpAnnComments
emptyComments

noAnnSrcSpanDP0 :: (NoAnn ann) => EpAnn ann
noAnnSrcSpanDP0 :: forall ann. NoAnn ann => EpAnn ann
noAnnSrcSpanDP0 = DeltaPos -> EpAnn ann
forall ann. NoAnn ann => DeltaPos -> EpAnn ann
noAnnSrcSpanDP (Int -> DeltaPos
SameLine Int
0)

noAnnSrcSpanDP1 :: (NoAnn ann) => EpAnn ann
noAnnSrcSpanDP1 :: forall ann. NoAnn ann => EpAnn ann
noAnnSrcSpanDP1 = DeltaPos -> EpAnn ann
forall ann. NoAnn ann => DeltaPos -> EpAnn ann
noAnnSrcSpanDP (Int -> DeltaPos
SameLine Int
1)

noAnnSrcSpanDPn :: (NoAnn ann) => Int -> EpAnn ann
noAnnSrcSpanDPn :: forall ann. NoAnn ann => Int -> EpAnn ann
noAnnSrcSpanDPn Int
s = DeltaPos -> EpAnn ann
forall ann. NoAnn ann => DeltaPos -> EpAnn ann
noAnnSrcSpanDP (Int -> DeltaPos
SameLine Int
s)

d0 :: EpaLocation
d0 :: EpaLocation
d0 = DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) []

d1 :: EpaLocation
d1 :: EpaLocation
d1 = DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
1) []

dn :: Int -> EpaLocation
dn :: Int -> EpaLocation
dn Int
n = DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
n) []

addComma :: SrcSpanAnnA -> SrcSpanAnnA
addComma :: SrcSpanAnnA -> SrcSpanAnnA
addComma (EpAnn EpaLocation
anc (AnnListItem [TrailingAnn]
as) EpAnnComments
cs)
  = EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc ([TrailingAnn] -> AnnListItem
AnnListItem (EpaLocation -> TrailingAnn
AddCommaAnn EpaLocation
d0TrailingAnn -> [TrailingAnn] -> [TrailingAnn]
forall a. a -> [a] -> [a]
:[TrailingAnn]
as)) EpAnnComments
cs

-- ---------------------------------------------------------------------

-- | Insert a declaration into an AST element having sub-declarations
-- (@HasDecls@) according to the given location function.
insertAt :: (HasDecls ast)
              => (LHsDecl GhcPs
                  -> [LHsDecl GhcPs]
                  -> [LHsDecl GhcPs])
              -> ast
              -> LHsDecl GhcPs
              -> Transform ast
insertAt :: forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> Transform ast
insertAt LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
f ast
t LHsDecl GhcPs
decl = do
  oldDecls <- ast -> TransformT Identity [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
ast -> TransformT m [LHsDecl GhcPs]
hsDecls ast
t
  oldDeclsb <- balanceCommentsList oldDecls
  let oldDecls' = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
oldDeclsb
  replaceDecls t (f decl oldDecls')

-- |Insert a declaration at the beginning or end of the subdecls of the given
-- AST item
insertAtStart, insertAtEnd :: (HasDecls ast)
              => ast
              -> LHsDecl GhcPs
              -> Transform ast

insertAtEnd :: forall ast. HasDecls ast => ast -> LHsDecl GhcPs -> Transform ast
insertAtEnd   = (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> Transform ast
forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> Transform ast
insertAt (\LHsDecl GhcPs
x [LHsDecl GhcPs]
xs -> [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
xs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
x])

insertAtStart :: forall ast. HasDecls ast => ast -> LHsDecl GhcPs -> Transform ast
insertAtStart = (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> Transform ast
forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> Transform ast
insertAt LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {t} {a}.
(Data t, Data a) =>
LocatedAn t a -> [LocatedAn t a] -> [LocatedAn t a]
insertFirst
  where
    insertFirst :: LocatedAn t a -> [LocatedAn t a] -> [LocatedAn t a]
insertFirst LocatedAn t a
x [LocatedAn t a]
xs =
      case [LocatedAn t a]
xs of
        [] -> [LocatedAn t a
x]
        (LocatedAn t a
h:[LocatedAn t a]
t) -> LocatedAn t a
xLocatedAn t a -> [LocatedAn t a] -> [LocatedAn t a]
forall a. a -> [a] -> [a]
:LocatedAn t a -> DeltaPos -> LocatedAn t a
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedAn t a
h (Int -> Int -> DeltaPos
DifferentLine Int
2 Int
0)LocatedAn t a -> [LocatedAn t a] -> [LocatedAn t a]
forall a. a -> [a] -> [a]
:[LocatedAn t a]
t
                   [LocatedAn t a] -> String -> [LocatedAn t a]
forall c. c -> String -> c
`debug` (String
"insertAtStart:h=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LocatedAn t a -> String
forall a. Data a => a -> String
showAst LocatedAn t a
h)


-- |Insert a declaration at a specific location in the subdecls of the given
-- AST item
insertAfter, insertBefore :: (HasDecls (LocatedA ast))
                          => LocatedA old
                          -> LocatedA ast
                          -> LHsDecl GhcPs
                          -> Transform (LocatedA ast)
insertAfter :: forall ast old.
HasDecls (LocatedA ast) =>
LocatedA old
-> LocatedA ast -> LHsDecl GhcPs -> Transform (LocatedA ast)
insertAfter (LocatedA old -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA -> SrcSpan
k) = (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> LocatedA ast -> LHsDecl GhcPs -> Transform (LocatedA ast)
forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> Transform ast
insertAt LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {a} {e}.
HasLoc a =>
GenLocated a e -> [GenLocated a e] -> [GenLocated a e]
findAfter
  where
    findAfter :: GenLocated a e -> [GenLocated a e] -> [GenLocated a e]
findAfter GenLocated a e
x [GenLocated a e]
xs =
      case (GenLocated a e -> Bool)
-> [GenLocated a e] -> ([GenLocated a e], [GenLocated a e])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(L a
l e
_) -> a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
l SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= SrcSpan
k) [GenLocated a e]
xs of
        ([],[]) -> [GenLocated a e
x]
        ([GenLocated a e]
fs,[]) -> [GenLocated a e]
fs[GenLocated a e] -> [GenLocated a e] -> [GenLocated a e]
forall a. [a] -> [a] -> [a]
++[GenLocated a e
x]
        ([GenLocated a e]
fs, GenLocated a e
b:[GenLocated a e]
bs) -> [GenLocated a e]
fs [GenLocated a e] -> [GenLocated a e] -> [GenLocated a e]
forall a. [a] -> [a] -> [a]
++ (GenLocated a e
b GenLocated a e -> [GenLocated a e] -> [GenLocated a e]
forall a. a -> [a] -> [a]
: GenLocated a e
x GenLocated a e -> [GenLocated a e] -> [GenLocated a e]
forall a. a -> [a] -> [a]
: [GenLocated a e]
bs)
insertBefore :: forall ast old.
HasDecls (LocatedA ast) =>
LocatedA old
-> LocatedA ast -> LHsDecl GhcPs -> Transform (LocatedA ast)
insertBefore (LocatedA old -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA -> SrcSpan
k) = (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> LocatedA ast -> LHsDecl GhcPs -> Transform (LocatedA ast)
forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> Transform ast
insertAt LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {a} {e}.
HasLoc a =>
GenLocated a e -> [GenLocated a e] -> [GenLocated a e]
findBefore
  where
    findBefore :: GenLocated a e -> [GenLocated a e] -> [GenLocated a e]
findBefore GenLocated a e
x [GenLocated a e]
xs =
      let ([GenLocated a e]
fs, [GenLocated a e]
bs) = (GenLocated a e -> Bool)
-> [GenLocated a e] -> ([GenLocated a e], [GenLocated a e])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(L a
l e
_) -> a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
l SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= SrcSpan
k) [GenLocated a e]
xs
      in [GenLocated a e]
fs [GenLocated a e] -> [GenLocated a e] -> [GenLocated a e]
forall a. [a] -> [a] -> [a]
++ (GenLocated a e
x GenLocated a e -> [GenLocated a e] -> [GenLocated a e]
forall a. a -> [a] -> [a]
: [GenLocated a e]
bs)

-- =====================================================================
-- start of HasDecls instances
-- =====================================================================

-- |Provide a means to get and process the immediate child declarations 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 'HsDecl's that are directly enclosed in the
    -- given syntax phrase. They are always returned in the wrapped 'HsDecl'
    -- form, even if orginating in local decls. This is safe, as annotations
    -- never attach to the wrapper, only to the wrapped item.
    hsDecls :: (Monad m) => t -> TransformT m [LHsDecl GhcPs]

    -- | Replace the directly enclosed decl list by the given
    --  decl list. Runs in the 'Transform' monad to be able to update list order
    --  annotations, and rebalance comments and other layout changes as needed.
    --
    -- For example, a call on replaceDecls for a wrapped 'FunBind' having no
    -- where clause will convert
    --
    -- @
    -- -- |This is a function
    -- foo = x -- comment1
    -- @
    -- in to
    --
    -- @
    -- -- |This is a function
    -- foo = x -- comment1
    --   where
    --     nn = 2
    -- @
    replaceDecls :: (Monad m) => t -> [LHsDecl GhcPs] -> TransformT m t

-- ---------------------------------------------------------------------

instance HasDecls ParsedSource where
  hsDecls :: forall (m :: * -> *).
Monad m =>
ParsedSource -> TransformT m [LHsDecl GhcPs]
hsDecls (L SrcSpan
_ (HsModule (XModulePs EpAnn AnnsModule
_ EpLayout
_lo Maybe (LWarningTxt GhcPs)
_ Maybe (LHsDoc GhcPs)
_) Maybe (XRec GhcPs ModuleName)
_mn Maybe (XRec GhcPs [LIE GhcPs])
_exps [LImportDecl GhcPs]
_imps [LHsDecl GhcPs]
decls)) = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls

  replaceDecls :: forall (m :: * -> *).
Monad m =>
ParsedSource -> [LHsDecl GhcPs] -> TransformT m ParsedSource
replaceDecls (L SrcSpan
l (HsModule (XModulePs EpAnn AnnsModule
a EpLayout
lo Maybe (LWarningTxt GhcPs)
deps Maybe (LHsDoc GhcPs)
haddocks) Maybe (XRec GhcPs ModuleName)
mname Maybe (XRec GhcPs [LIE GhcPs])
exps [LImportDecl GhcPs]
imps [LHsDecl GhcPs]
_decls)) [LHsDecl GhcPs]
decls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LHsModule"
        ParsedSource -> TransformT m ParsedSource
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XCModule GhcPs
-> Maybe (XRec GhcPs ModuleName)
-> Maybe (XRec GhcPs [LIE GhcPs])
-> [LImportDecl GhcPs]
-> [LHsDecl GhcPs]
-> HsModule GhcPs
forall p.
XCModule p
-> Maybe (XRec p ModuleName)
-> Maybe (XRec p [LIE p])
-> [LImportDecl p]
-> [LHsDecl p]
-> HsModule p
HsModule (EpAnn AnnsModule
-> EpLayout
-> Maybe (LWarningTxt GhcPs)
-> Maybe (LHsDoc GhcPs)
-> XModulePs
XModulePs EpAnn AnnsModule
a EpLayout
lo Maybe (LWarningTxt GhcPs)
deps Maybe (LHsDoc GhcPs)
haddocks) Maybe (XRec GhcPs ModuleName)
mname Maybe (XRec GhcPs [LIE GhcPs])
exps [LImportDecl GhcPs]
imps [LHsDecl GhcPs]
decls))

-- ---------------------------------------------------------------------

instance HasDecls (LocatedA (HsDecl GhcPs)) where
  hsDecls :: forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT m [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (TyClD XTyClD GhcPs
_ c :: TyClDecl GhcPs
c@ClassDecl{}))  = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs])
-> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsClassDecl TyClDecl GhcPs
c
  hsDecls GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl = do
    String -> TransformT m [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> TransformT m [LHsDecl GhcPs])
-> String -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ String
"hsDecls:decl=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> String
forall a. Data a => a -> String
showAst GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
  replaceDecls :: forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
replaceDecls (L SrcSpanAnnA
l (TyClD XTyClD GhcPs
e dec :: TyClDecl GhcPs
dec@ClassDecl{})) [LHsDecl GhcPs]
decls = do
    let decl' :: TyClDecl GhcPs
decl' = TyClDecl GhcPs -> [LHsDecl GhcPs] -> TyClDecl GhcPs
replaceDeclsClassDecl TyClDecl GhcPs
dec [LHsDecl GhcPs]
decls
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
e TyClDecl GhcPs
decl'))
  replaceDecls GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl [LHsDecl GhcPs]
_decls = do
    String -> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. HasCallStack => String -> a
error (String -> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> String -> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ String
"replaceDecls:decl=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> String
forall a. Data a => a -> String
showAst GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl

-- ---------------------------------------------------------------------

instance HasDecls (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where
  hsDecls :: forall (m :: * -> *).
Monad m =>
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsMatchContext (LIdP (NoGhcTc GhcPs))
_ [LPat GhcPs]
_ (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
_ HsLocalBinds GhcPs
lb))) = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs])
-> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
lb

  replaceDecls :: forall (m :: * -> *).
Monad m =>
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT
     m (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
replaceDecls (L SrcSpanAnnA
l (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext (LIdP (NoGhcTc GhcPs))
c [LPat GhcPs]
p (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
binds))) []
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LMatch empty decls"
        binds'' <- WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
WithoutWhere HsLocalBinds GhcPs
binds []
        return (L l (Match xm c p (GRHSs xr rhs binds'')))

  replaceDecls m :: LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m@(L SrcSpanAnnA
l (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext (LIdP (NoGhcTc GhcPs))
c [LPat GhcPs]
p (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
binds))) [LHsDecl GhcPs]
newBinds
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LMatch nonempty decls"
        -- Need to throw in a fresh where clause if the binds were empty,
        -- in the annotations.
        (l', rhs') <- case HsLocalBinds GhcPs
binds of
          EmptyLocalBinds{} -> do
            String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"replaceDecls LMatch empty binds"

            String
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m ()
forall (m :: * -> *) a.
(Monad m, Data a) =>
String -> a -> TransformT m ()
logDataWithAnnsTr String
"Match.replaceDecls:balancing comments:m" LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m
            L l' m' <- LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceSameLineComments LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m
            logDataWithAnnsTr "Match.replaceDecls:(m1')" (L l' m')
            return (l', grhssGRHSs $ m_grhss m')
          HsLocalBinds GhcPs
_ -> (SrcSpanAnnA,
 [GenLocated
    EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> TransformT
     m
     (SrcSpanAnnA,
      [GenLocated
         EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
l, [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs)
        binds'' <- replaceDeclsValbinds WithWhere binds newBinds
        logDataWithAnnsTr "Match.replaceDecls:binds'" binds''
        return (L l' (Match xm c p (GRHSs xr rhs' binds'')))

-- ---------------------------------------------------------------------

instance HasDecls (LocatedA (HsExpr GhcPs)) where
  hsDecls :: forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (HsLet XLet GhcPs
_ HsLocalBinds GhcPs
decls LHsExpr GhcPs
_ex)) = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs])
-> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
decls
  hsDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
_                         = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

  replaceDecls :: forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls (L SrcSpanAnnA
ll (HsLet (EpToken "let"
tkLet, EpToken "in"
tkIn) HsLocalBinds GhcPs
binds LHsExpr GhcPs
ex)) [LHsDecl GhcPs]
newDecls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsLet"
        let lastAnc :: RealSrcSpan
lastAnc = SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> SrcSpan
forall (p :: Pass). HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds GhcPs
binds
        -- TODO: may be an intervening comment, take account for lastAnc
        let (EpToken "let"
tkLet', EpToken "in"
tkIn', GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex',[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls') = case (EpToken "let"
tkLet, EpToken "in"
tkIn) of
              (EpTok EpaLocation
l, EpTok EpaLocation
i) ->
                let
                  off :: LayoutStartCol
off = case EpaLocation
l of
                          (EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_)) -> Int -> LayoutStartCol
LayoutStartCol (Int -> LayoutStartCol) -> Int -> LayoutStartCol
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
r
                          (EpaSpan (UnhelpfulSpan UnhelpfulSpanReason
_)) -> Int -> LayoutStartCol
LayoutStartCol Int
0
                          (EpaDelta (SameLine Int
_) [LEpaComment]
_) -> Int -> LayoutStartCol
LayoutStartCol Int
0
                          (EpaDelta (DifferentLine Int
_ Int
c) [LEpaComment]
_) -> Int -> LayoutStartCol
LayoutStartCol Int
c
                  ex'' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex'' = LayoutStartCol
-> EpaLocation
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall t. LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t
setEntryDPFromAnchor LayoutStartCol
off EpaLocation
i LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex
                  newDecls'' :: [LHsDecl GhcPs]
newDecls'' = case [LHsDecl GhcPs]
newDecls of
                    [] -> [LHsDecl GhcPs]
newDecls
                    (LHsDecl GhcPs
d:[LHsDecl GhcPs]
ds) -> LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs
setEntryDPDecl LHsDecl GhcPs
d (Int -> DeltaPos
SameLine Int
0) GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds
                in ( EpaLocation -> EpToken "let"
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok EpaLocation
l
                   , EpaLocation -> EpToken "in"
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok (LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta LayoutStartCol
off RealSrcSpan
lastAnc EpaLocation
i)
                   , GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex''
                   , [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls'')
              (EpToken "let"
_,EpToken "in"
_) -> (EpToken "let"
tkLet, EpToken "in"
tkIn, LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex, [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls)
        binds' <- WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
WithoutWhere HsLocalBinds GhcPs
binds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls'
        return (L ll (HsLet (tkLet', tkIn') binds' ex'))

  -- TODO: does this make sense? Especially as no hsDecls for HsPar
  replaceDecls (L SrcSpanAnnA
l (HsPar XPar GhcPs
x LHsExpr GhcPs
e)) [LHsDecl GhcPs]
newDecls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsPar"
        e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
        return (L l (HsPar x e'))
  replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
old [LHsDecl GhcPs]
_new = String -> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. HasCallStack => String -> a
error (String -> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> String -> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ String
"replaceDecls (LHsExpr GhcPs) undefined for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
showGhc GenLocated SrcSpanAnnA (HsExpr GhcPs)
old

-- ---------------------------------------------------------------------

-- | Extract the immediate declarations for a 'PatBind' wrapped in a 'ValD'. This
-- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent
-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is
-- idempotent.
hsDeclsPatBindD :: LHsDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsPatBindD :: LHsDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsPatBindD (L SrcSpanAnnA
l (ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
d)) = LHsBind GhcPs -> [LHsDecl GhcPs]
hsDeclsPatBind (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
d)
hsDeclsPatBindD LHsDecl GhcPs
x = String -> [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> [LHsDecl GhcPs]) -> String -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ String
"hsDeclsPatBindD called for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> String
forall a. Outputable a => a -> String
showGhc LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
x

-- | Extract the immediate declarations for a 'PatBind'. This
-- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent
-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is
-- idempotent.
hsDeclsPatBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
hsDeclsPatBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
hsDeclsPatBind (L SrcSpanAnnA
_ (PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
_ HsMultAnn GhcPs
_ (GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [LGRHS GhcPs (LHsExpr GhcPs)]
_grhs HsLocalBinds GhcPs
lb))) = HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
lb
hsDeclsPatBind LHsBind GhcPs
x = String -> [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> [LHsDecl GhcPs]) -> String -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ String
"hsDeclsPatBind called for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs) -> String
forall a. Outputable a => a -> String
showGhc LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
x

-- -------------------------------------

-- | Replace the immediate declarations for a 'PatBind' wrapped in a 'ValD'. This
-- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent
-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is
-- idempotent.
replaceDeclsPatBindD :: (Monad m) => LHsDecl GhcPs -> [LHsDecl GhcPs]
                     -> TransformT m (LHsDecl GhcPs)
replaceDeclsPatBindD :: forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsDecl GhcPs)
replaceDeclsPatBindD (L SrcSpanAnnA
l (ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
d)) [LHsDecl GhcPs]
newDecls = do
  (L _ d') <- LHsBind GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsBind GhcPs)
forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsBind GhcPs)
replaceDeclsPatBind (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
d) [LHsDecl GhcPs]
newDecls
  return (L l (ValD x d'))
replaceDeclsPatBindD LHsDecl GhcPs
x [LHsDecl GhcPs]
_ = String -> TransformT m (LHsDecl GhcPs)
forall a. HasCallStack => String -> a
error (String -> TransformT m (LHsDecl GhcPs))
-> String -> TransformT m (LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ String
"replaceDeclsPatBindD called for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> String
forall a. Outputable a => a -> String
showGhc LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
x

-- | Replace the immediate declarations for a 'PatBind'. This
-- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent
-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is
-- idempotent.
replaceDeclsPatBind :: (Monad m) => LHsBind GhcPs -> [LHsDecl GhcPs]
                    -> TransformT m (LHsBind GhcPs)
replaceDeclsPatBind :: forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsBind GhcPs)
replaceDeclsPatBind (L SrcSpanAnnA
l (PatBind XPatBind GhcPs GhcPs
x LPat GhcPs
a HsMultAnn GhcPs
p (GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
xr [LGRHS GhcPs (LHsExpr GhcPs)]
rhss HsLocalBinds GhcPs
binds))) [LHsDecl GhcPs]
newDecls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls PatBind"
        binds'' <- WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
WithWhere HsLocalBinds GhcPs
binds [LHsDecl GhcPs]
newDecls
        return (L l (PatBind x a p (GRHSs xr rhss binds'')))
replaceDeclsPatBind LHsBind GhcPs
x [LHsDecl GhcPs]
_ = String -> TransformT m (LHsBind GhcPs)
forall a. HasCallStack => String -> a
error (String -> TransformT m (LHsBind GhcPs))
-> String -> TransformT m (LHsBind GhcPs)
forall a b. (a -> b) -> a -> b
$ String
"replaceDeclsPatBind called for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs) -> String
forall a. Outputable a => a -> String
showGhc LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
x

-- ---------------------------------------------------------------------

instance HasDecls (LocatedA (Stmt GhcPs (LocatedA (HsExpr GhcPs)))) where
  hsDecls :: forall (m :: * -> *).
Monad m =>
LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsLocalBinds GhcPs
lb))      = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs])
-> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
lb
  hsDecls (L SrcSpanAnnA
_ (LastStmt XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
e Maybe Bool
_ SyntaxExpr GhcPs
_))  = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [LHsDecl GhcPs]
hsDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
  hsDecls (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ LPat GhcPs
_pat GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)) = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [LHsDecl GhcPs]
hsDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
  hsDecls (L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))  = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [LHsDecl GhcPs]
hsDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
  hsDecls LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
_                         = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

  replaceDecls :: forall (m :: * -> *).
Monad m =>
LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
replaceDecls (L SrcSpanAnnA
l (LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x HsLocalBinds GhcPs
lb)) [LHsDecl GhcPs]
newDecls
    = do
        lb'' <- WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
WithWhere HsLocalBinds GhcPs
lb [LHsDecl GhcPs]
newDecls
        return (L l (LetStmt x lb''))
  replaceDecls (L SrcSpanAnnA
l (LastStmt XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
e Maybe Bool
d SyntaxExpr GhcPs
se)) [LHsDecl GhcPs]
newDecls
    = do
        e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
        return (L l (LastStmt x e' d se))
  replaceDecls (L SrcSpanAnnA
l (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x LPat GhcPs
pat GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)) [LHsDecl GhcPs]
newDecls
    = do
      e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
      return (L l (BindStmt x pat e'))

  replaceDecls (L SrcSpanAnnA
l (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
e SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b)) [LHsDecl GhcPs]
newDecls
    = do
      e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
      return (L l (BodyStmt x e' a b))
  replaceDecls LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x [LHsDecl GhcPs]
_newDecls = LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x

-- =====================================================================
-- end of HasDecls instances
-- =====================================================================

-- ---------------------------------------------------------------------
-- A @FunBind@ is a container for @[LMatch GhcPs]@
--
-- When being used as a Bind (or Decl), the surrounding context
-- annotations must appear at the FunBind level, so it can be
-- manipulated in the context of other Binds or Decls.
--
-- Surrounding context annotations are specifically prior comments,
-- following comments and trailing annotations.
--
-- But when we unpack the container, by calling @hsDecls@ on a
-- @FunBind@, we must make sure that the component parts fully
-- represent the relationship between them and the surrounding
-- declarations.
--
-- This means pushing the prior context annotations into the first
-- match, and the following ones into the last match when returning
-- @hsDecls@, and undoing this for @replaceDecls@.

-- |Push leading and trailing top level annotations into the @[LMatch GhcPs]@
unpackFunBind :: LHsBind GhcPs -> LHsBind GhcPs
unpackFunBind :: LHsBind GhcPs -> LHsBind GhcPs
unpackFunBind (L SrcSpanAnnA
loc (FunBind XFunBind GhcPs GhcPs
x1 LIdP GhcPs
fid (MG XMG GhcPs (LHsExpr GhcPs)
x2 (L SrcSpanAnnL
lg (L SrcSpanAnnA
lm Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches)))))
  = (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc'' (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
x1 LIdP GhcPs
fid (XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x2 (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lg ([LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
llm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
lmtchLocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms))))))
     -- `debug` ("unpackFunBind: ="
     --          ++ showAst (("loc",loc), ("loc'",loc'), ("loc''",loc''),
     --                      ("lm'",lm'), ("llm",llm), ("llm'", llm')))
  where
    (SrcSpanAnnA
loc', SrcSpanAnnA
lm') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferPriorCommentsA SrcSpanAnnA
loc SrcSpanAnnA
lm
    matches' :: [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches' = [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [LocatedA
       (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mLocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches
    (L SrcSpanAnnA
llm Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
lmtch, [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms) = case [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches' of
                      LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
mm:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0 -> (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
mm,[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0)
                      [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> String
-> (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
    [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a. HasCallStack => String -> a
error String
"unpackFunBind"

    (SrcSpanAnnA
loc'', SrcSpanAnnA
llm') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferFollowingA SrcSpanAnnA
loc' SrcSpanAnnA
llm

unpackFunBind LHsBind GhcPs
d = LHsBind GhcPs
d

-- |Pull leading and trailing annotations from the @[LMatch GhcPs]@ to
-- the top level.
packFunBind :: LHsBind GhcPs -> LHsBind GhcPs
packFunBind :: LHsBind GhcPs -> LHsBind GhcPs
packFunBind (L SrcSpanAnnA
loc (FunBind XFunBind GhcPs GhcPs
x1 LIdP GhcPs
fid (MG XMG GhcPs (LHsExpr GhcPs)
x2 (L SrcSpanAnnL
lg (L SrcSpanAnnA
lm Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches)))))
  = (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc'' (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
x1 LIdP GhcPs
fid (XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x2 (SrcSpanAnnL
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lg ([LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
llm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
lmtchLocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms))))))
     -- `debug` ("packFunBind: ="
     --          ++ showAst (("loc",loc), ("loc'",loc'), ("loc''",loc''),
     --                      ("lm'",lm'), ("llm",llm), ("llm'", llm')))
  where
    (SrcSpanAnnA
lm', SrcSpanAnnA
loc') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferPriorCommentsA SrcSpanAnnA
lm SrcSpanAnnA
loc
    matches' :: [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches' = [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [LocatedA
       (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mLocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches
    (L SrcSpanAnnA
llm Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
lmtch, [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms) = case [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches' of
                      LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
mm:[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0 -> (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
mm,[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0)
                      [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> String
-> (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
    [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a. HasCallStack => String -> a
error String
"packFunBind"
    (SrcSpanAnnA
llm', SrcSpanAnnA
loc'') = SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferFollowingA SrcSpanAnnA
llm SrcSpanAnnA
loc'
packFunBind LHsBind GhcPs
d = LHsBind GhcPs
d

packFunDecl :: LHsDecl GhcPs -> LHsDecl GhcPs
packFunDecl :: LHsDecl GhcPs -> LHsDecl GhcPs
packFunDecl (L SrcSpanAnnA
l (ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
b)) = SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
b')
  where
    L SrcSpanAnnA
l' HsBindLR GhcPs GhcPs
b' = LHsBind GhcPs -> LHsBind GhcPs
packFunBind (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
b)
packFunDecl LHsDecl GhcPs
x = LHsDecl GhcPs
x

unpackFunDecl :: LHsDecl GhcPs -> LHsDecl GhcPs
unpackFunDecl :: LHsDecl GhcPs -> LHsDecl GhcPs
unpackFunDecl (L SrcSpanAnnA
l (ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
b)) = SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
b')
  where
    L SrcSpanAnnA
l' HsBindLR GhcPs GhcPs
b' = LHsBind GhcPs -> LHsBind GhcPs
unpackFunBind (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
b)
unpackFunDecl LHsDecl GhcPs
x = LHsDecl GhcPs
x

-- ---------------------------------------------------------------------

data WithWhere = WithWhere
               | WithoutWhere
               deriving (WithWhere -> WithWhere -> Bool
(WithWhere -> WithWhere -> Bool)
-> (WithWhere -> WithWhere -> Bool) -> Eq WithWhere
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WithWhere -> WithWhere -> Bool
== :: WithWhere -> WithWhere -> Bool
$c/= :: WithWhere -> WithWhere -> Bool
/= :: WithWhere -> WithWhere -> Bool
Eq,Int -> WithWhere -> String -> String
[WithWhere] -> String -> String
WithWhere -> String
(Int -> WithWhere -> String -> String)
-> (WithWhere -> String)
-> ([WithWhere] -> String -> String)
-> Show WithWhere
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> WithWhere -> String -> String
showsPrec :: Int -> WithWhere -> String -> String
$cshow :: WithWhere -> String
show :: WithWhere -> String
$cshowList :: [WithWhere] -> String -> String
showList :: [WithWhere] -> String -> String
Show)

-- | Utility function for returning decls to 'HsLocalBinds'. Use with
-- care, as this does not manage the declaration order, the
-- ordering should be done by the calling function from the 'HsLocalBinds'
-- context in the AST.
replaceDeclsValbinds :: (Monad m)
                     => WithWhere
                     -> HsLocalBinds GhcPs -> [LHsDecl GhcPs]
                     -> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds :: forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
_ HsLocalBinds GhcPs
_ [] = do
  HsLocalBinds GhcPs -> TransformT m (HsLocalBinds GhcPs)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
NoExtField
NoExtField)
replaceDeclsValbinds WithWhere
w b :: HsLocalBinds GhcPs
b@(HsValBinds XHsValBinds GhcPs GhcPs
a HsValBindsLR GhcPs GhcPs
_) [LHsDecl GhcPs]
new
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDeclsValbinds"
        let oldSpan :: SrcSpan
oldSpan = HsLocalBinds GhcPs -> SrcSpan
forall (p :: Pass). HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds GhcPs
b
        an <- SrcSpanAnnL -> WithWhere -> RealSrcSpan -> TransformT m SrcSpanAnnL
forall (m :: * -> *).
Monad m =>
SrcSpanAnnL -> WithWhere -> RealSrcSpan -> TransformT m SrcSpanAnnL
oldWhereAnnotation XHsValBinds GhcPs GhcPs
SrcSpanAnnL
a WithWhere
w (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
oldSpan)
        let decs = [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. [a] -> Bag a
listToBag ([GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
 -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [LHsBind GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
decl2Bind [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
new
        let sigs = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> [GenLocated SrcSpanAnnA (Sig GhcPs)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [LSig GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
decl2Sig [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
new
        let sortKey = [LHsDecl GhcPs] -> AnnSortKey BindTag
captureOrderBinds [LHsDecl GhcPs]
new
        return (HsValBinds an (ValBinds sortKey decs sigs))
replaceDeclsValbinds WithWhere
_ (HsIPBinds {}) [LHsDecl GhcPs]
_new    = String -> TransformT m (HsLocalBinds GhcPs)
forall a. HasCallStack => String -> a
error String
"undefined replaceDecls HsIPBinds"
replaceDeclsValbinds WithWhere
w (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) [LHsDecl GhcPs]
new
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsLocalBinds"
        an <- WithWhere -> TransformT m SrcSpanAnnL
forall (m :: * -> *).
Monad m =>
WithWhere -> TransformT m SrcSpanAnnL
newWhereAnnotation WithWhere
w
        let newBinds = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [LHsBind GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
decl2Bind [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
new
            newSigs  = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> [GenLocated SrcSpanAnnA (Sig GhcPs)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [LSig GhcPs]
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
decl2Sig  [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
new
        let decs = [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. [a] -> Bag a
listToBag ([GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
 -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
newBinds
        let sigs = [GenLocated SrcSpanAnnA (Sig GhcPs)]
newSigs
        let sortKey = [LHsDecl GhcPs] -> AnnSortKey BindTag
captureOrderBinds [LHsDecl GhcPs]
new
        return (HsValBinds an (ValBinds sortKey decs sigs))

oldWhereAnnotation :: (Monad m)
  => EpAnn AnnList -> WithWhere -> RealSrcSpan -> TransformT m (EpAnn AnnList)
oldWhereAnnotation :: forall (m :: * -> *).
Monad m =>
SrcSpanAnnL -> WithWhere -> RealSrcSpan -> TransformT m SrcSpanAnnL
oldWhereAnnotation (EpAnn EpaLocation
anc AnnList
an EpAnnComments
cs) WithWhere
ww RealSrcSpan
_oldSpan = do
  -- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation, change the AnnList anchor to have the correct DP too
  let (AnnList Maybe EpaLocation
ancl Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
_r [TrailingAnn]
t) = AnnList
an
  let w :: [AddEpAnn]
w = case WithWhere
ww of
        WithWhere
WithWhere -> [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnWhere (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])]
        WithWhere
WithoutWhere -> []
  (anc', ancl') <- do
        case WithWhere
ww of
          WithWhere
WithWhere -> (EpaLocation, Maybe EpaLocation)
-> TransformT m (EpaLocation, Maybe EpaLocation)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpaLocation
anc, Maybe EpaLocation
ancl)
          WithWhere
WithoutWhere -> (EpaLocation, Maybe EpaLocation)
-> TransformT m (EpaLocation, Maybe EpaLocation)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpaLocation
anc, Maybe EpaLocation
ancl)
  let an' = EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc'
                  (Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe EpaLocation
ancl' Maybe AddEpAnn
o Maybe AddEpAnn
c [AddEpAnn]
w [TrailingAnn]
t)
                  EpAnnComments
cs
  return an'

newWhereAnnotation :: (Monad m) => WithWhere -> TransformT m (EpAnn AnnList)
newWhereAnnotation :: forall (m :: * -> *).
Monad m =>
WithWhere -> TransformT m SrcSpanAnnL
newWhereAnnotation WithWhere
ww = do
  let anc :: EpaLocation' [a]
anc  = DeltaPos -> [a] -> EpaLocation' [a]
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
3) []
  let anc2 :: EpaLocation' [a]
anc2 = DeltaPos -> [a] -> EpaLocation' [a]
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
5) []
  let w :: [AddEpAnn]
w = case WithWhere
ww of
        WithWhere
WithWhere -> [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnWhere (DeltaPos -> [LEpaComment] -> EpaLocation
forall a. DeltaPos -> a -> EpaLocation' a
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])]
        WithWhere
WithoutWhere -> []
  let an :: SrcSpanAnnL
an = EpaLocation -> AnnList -> EpAnnComments -> SrcSpanAnnL
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
forall {a}. EpaLocation' [a]
anc
                  (Maybe EpaLocation
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList (EpaLocation -> Maybe EpaLocation
forall a. a -> Maybe a
Just EpaLocation
forall {a}. EpaLocation' [a]
anc2) Maybe AddEpAnn
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing [AddEpAnn]
w [])
                  EpAnnComments
emptyComments
  SrcSpanAnnL -> TransformT m SrcSpanAnnL
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return SrcSpanAnnL
an

-- ---------------------------------------------------------------------

type Decl  = LHsDecl GhcPs
type PMatch = LMatch GhcPs (LHsExpr GhcPs)

-- |Modify a 'LHsBind' wrapped in a 'ValD'. For a 'PatBind' the
-- declarations are extracted and returned after modification. For a
-- 'FunBind' the supplied 'SrcSpan' is used to identify the specific
-- 'Match' to be transformed, for when there are multiple of them.
modifyValD :: forall m t. (HasTransform m)
                => SrcSpan
                -> Decl
                -> (PMatch -> [Decl] -> m ([Decl], Maybe t))
                -> m (Decl,Maybe t)
modifyValD :: forall (m :: * -> *) t.
HasTransform m =>
SrcSpan
-> LHsDecl GhcPs
-> (LMatch GhcPs (LHsExpr GhcPs)
    -> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t))
-> m (LHsDecl GhcPs, Maybe t)
modifyValD SrcSpan
p pb :: LHsDecl GhcPs
pb@(L SrcSpanAnnA
ss (ValD XValD GhcPs
_ (PatBind {} ))) LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t)
f =
  if (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
ss) SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
p
     then do
       let ds :: [LHsDecl GhcPs]
ds = LHsDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsPatBindD LHsDecl GhcPs
pb
       (ds',r) <- LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t)
f (String
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => String -> a
error String
"modifyValD.PatBind should not touch Match") [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds
       pb' <- liftT $ replaceDeclsPatBindD pb ds'
       return (pb',r)
     else (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
pb,Maybe t
forall a. Maybe a
Nothing)
modifyValD SrcSpan
p LHsDecl GhcPs
decl LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t)
f = do
  (decl',r) <- StateT (Maybe t) m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> Maybe t -> m (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (GenericM (StateT (Maybe t) m) -> GenericM (StateT (Maybe t) m)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> StateT
      (Maybe t)
      m
      (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> a -> StateT (Maybe t) m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM LMatch GhcPs (LHsExpr GhcPs)
-> StateT (Maybe t) m (LMatch GhcPs (LHsExpr GhcPs))
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> StateT
     (Maybe t)
     m
     (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
doModLocal) (LHsDecl GhcPs -> LHsDecl GhcPs
unpackFunDecl LHsDecl GhcPs
decl)) Maybe t
forall a. Maybe a
Nothing
  return (packFunDecl decl',r)
  where
    doModLocal :: PMatch -> StateT (Maybe t) m PMatch
    doModLocal :: LMatch GhcPs (LHsExpr GhcPs)
-> StateT (Maybe t) m (LMatch GhcPs (LHsExpr GhcPs))
doModLocal  (match :: LMatch GhcPs (LHsExpr GhcPs)
match@(L SrcSpanAnnA
ss Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_) :: PMatch) = do
         if (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
ss) SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
p
           then do
             ds <- m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> StateT (Maybe t) m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) a. Monad m => m a -> StateT (Maybe t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> StateT (Maybe t) m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> StateT (Maybe t) m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ TransformT Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (TransformT Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT Identity [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [LHsDecl GhcPs]
hsDecls LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match
                TransformT Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> String
-> TransformT Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall c. c -> String -> c
`debug` (String
"modifyValD: match=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> String
forall a. Data a => a -> String
showAst LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match)
             (ds',r) <- lift $ f match ds
             put r
             match' <- lift $ liftT $ replaceDecls match ds'
             return match'
           else LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> StateT
     (Maybe t)
     m
     (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> StateT (Maybe t) m a
forall (m :: * -> *) a. Monad m => a -> m a
return LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match

-- ---------------------------------------------------------------------

-- |Used to integrate a @Transform@ into other Monad stacks
class (Monad m) => (HasTransform m) where
  liftT :: Transform a -> m a

instance Monad m => HasTransform (TransformT m) where
  liftT :: forall a. Transform a -> TransformT m a
liftT = (forall x. Identity x -> m x)
-> TransformT Identity a -> TransformT m a
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform (x -> m x
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> m x) -> (Identity x -> x) -> Identity x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> x
forall a. Identity a -> a
runIdentity)

-- ---------------------------------------------------------------------

-- | Apply a transformation to the decls contained in @t@
modifyDeclsT :: (HasDecls t,HasTransform m)
             => ([LHsDecl GhcPs] -> m [LHsDecl GhcPs])
             -> t -> m t
modifyDeclsT :: forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT [LHsDecl GhcPs] -> m [LHsDecl GhcPs]
action t
t = do
  decls <- TransformT Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (TransformT Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ t -> TransformT Identity [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *). Monad m => t -> TransformT m [LHsDecl GhcPs]
hsDecls t
t
  decls' <- action decls
  liftT $ replaceDecls t decls'