{-# LANGUAGE DataKinds #-}
{-# 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.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.
-- This should no longer be needed, we use an @EpaDelta@ location instead.
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 SrcSpanAnnLW
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 (SrcSpanAnnLW
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnLW
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnLW
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 EpUniToken "::" "\8759"
NoEpUniTok Maybe (EpToken "pattern")
mp Maybe (EpToken "default")
md) [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 (EpUniToken "::" "\8759"
-> Maybe (EpToken "pattern") -> Maybe (EpToken "default") -> AnnSig
AnnSig EpUniToken "::" "\8759"
forall (tok :: Symbol) (utok :: Symbol). EpUniToken tok utok
NoEpUniTok Maybe (EpToken "pattern")
mp Maybe (EpToken "default")
md) [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))))
captureTypeSigSpacing (L SrcSpanAnnA
l (SigD XSigD GhcPs
x (TypeSig (AnnSig (EpUniTok EpaLocation
dca IsUnicodeSyntax
u) Maybe (EpToken "pattern")
mp Maybe (EpToken "default")
md) [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 (EpUniToken "::" "\8759"
-> Maybe (EpToken "pattern") -> Maybe (EpToken "default") -> AnnSig
AnnSig (EpaLocation -> IsUnicodeSyntax -> EpUniToken "::" "\8759"
forall (tok :: Symbol) (utok :: Symbol).
EpaLocation -> IsUnicodeSyntax -> EpUniToken tok utok
EpUniTok EpaLocation
dca' IsUnicodeSyntax
u) Maybe (EpToken "pattern")
mp Maybe (EpToken "default")
md) [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
    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
epaLocationRealSrcSpan EpaLocation
anc'
    dca' :: EpaLocation
dca' = case EpaLocation
dca of
          EpaSpan ss :: SrcSpan
ss@(RealSrcSpan RealSrcSpan
r Maybe BufSpan
_) -> (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss ((Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
rd) RealSrcSpan
r) [])
          EpaLocation
_                            -> 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 SrcSpan
_ DeltaPos
_ [LEpaComment]
_ -> EpaLocation
anc0
                EpaLocation
_ -> case EpaLocation
dca of
                  EpaSpan SrcSpan
ss -> SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss (Int -> DeltaPos
SameLine Int
1) []
                  EpaDelta SrcSpan
ss DeltaPos
_ [LEpaComment]
cs0 -> SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss (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 SrcSpanAnnLW
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 (SrcSpanAnnLW
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnLW
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnLW
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 ss :: SrcSpan
ss@(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 (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss DeltaPos
dp []) t
an EpAnnComments
cs) a
a
setEntryDP (L (EpAnn (EpaSpan SrcSpan
ss) 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 (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss DeltaPos
dp []) t
an ([LEpaComment] -> EpAnnComments
EpaComments [])) a
a
setEntryDP (L (EpAnn (EpaDelta SrcSpan
ss 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 (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss DeltaPos
d' [LEpaComment]
csd') t
an EpAnnComments
cs') a
a
  where
    -- I suspect we should assume the comments are already in the
    -- right place, and just set the entry DP for this case. This
    -- avoids suprises from the caller.
    (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]
csd, [LEpaComment] -> EpAnnComments
EpaComments (LEpaComment
c'LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
t))
      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 SrcSpan
ss0 DeltaPos
_ NoComments
c0) e
c) = (DeltaPos
d,  NoCommentsLocation -> e -> GenLocated NoCommentsLocation e
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> DeltaPos -> NoComments -> NoCommentsLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss0 DeltaPos
dp NoComments
c0) e
c)
    go (L (EpaSpan SrcSpan
ss0)       e
c) = (DeltaPos
d,  NoCommentsLocation -> e -> GenLocated NoCommentsLocation e
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> DeltaPos -> NoComments -> NoCommentsLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss0 DeltaPos
dp NoComments
NoComments) e
c)
setEntryDP (L (EpAnn (EpaSpan ss :: SrcSpan
ss@(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 (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss 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 (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss 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 (SrcSpan -> DeltaPos -> NoComments -> NoCommentsLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss 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 SrcSpan
_ 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
epaLocationRealSrcSpan (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 SrcSpan
_ 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 SrcSpan
ss DeltaPos
d [LEpaComment]
cs) = SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss DeltaPos
d [LEpaComment]
cs
addEpaLocationDelta LayoutStartCol
_off RealSrcSpan
_anc (EpaSpan ss :: SrcSpan
ss@(UnhelpfulSpan UnhelpfulSpanReason
_)) = SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss (Int -> DeltaPos
SameLine Int
0) []
addEpaLocationDelta  LayoutStartCol
off  RealSrcSpan
anc (EpaSpan ss :: SrcSpan
ss@(RealSrcSpan RealSrcSpan
r Maybe BufSpan
_))
  = SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss (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 SrcSpan
_ 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 SrcSpan
_ 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 :: (Typeable t1, Typeable t2)
  => LocatedAn t1 a -> LocatedAn t2 b -> (LocatedAn t2 b)
transferEntryDP :: forall t1 t2 a b.
(Typeable t1, Typeable t2) =>
LocatedAn t1 a -> LocatedAn t2 b -> LocatedAn t2 b
transferEntryDP (L (EpAnn EpaLocation
anc1 t1
an1 EpAnnComments
cs1) a
_) (L (EpAnn EpaLocation
anc2 t2
an2 EpAnnComments
cs2) b
b) =
  -- Note: the EpaDelta version of an EpaLocation contains the original
  -- SrcSpan. We must preserve that.
  let anc1' :: EpaLocation
anc1' = case (EpaLocation
anc1,EpaLocation
anc2) of
          (EpaDelta SrcSpan
_ DeltaPos
dp [LEpaComment]
cs, EpaDelta SrcSpan
ss2 DeltaPos
_ [LEpaComment]
_) -> SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss2 DeltaPos
dp [LEpaComment]
cs
          (EpaLocation
_, EpaLocation
_) -> EpaLocation
anc1
  -- Problem: if the original had preceding comments, blindly
  -- transferring the location is not correct
  in case EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs1 of
    [] -> (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
_ EpaComment
_:[LEpaComment]
_) -> (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' :: LHsDecl GhcPs -> LHsDecl GhcPs -> (LHsDecl GhcPs)
transferEntryDP' :: LHsDecl GhcPs -> LHsDecl GhcPs -> LHsDecl GhcPs
transferEntryDP' LHsDecl GhcPs
la LHsDecl GhcPs
lb =
  let
    (L SrcSpanAnnA
l2 HsDecl GhcPs
b) = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall t1 t2 a b.
(Typeable t1, Typeable t2) =>
LocatedAn t1 a -> LocatedAn t2 b -> LocatedAn t2 b
transferEntryDP LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
la LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
lb
  in (SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l2 (HsDecl GhcPs -> DeltaPos -> HsDecl GhcPs
pushDeclDP HsDecl GhcPs
b (Int -> DeltaPos
SameLine Int
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 SrcSpanAnnLW
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 (SrcSpanAnnLW
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnLW
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnLW
d' [LMatch GhcPs (LHsExpr GhcPs)]
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms')))
    where
      L SrcSpanAnnLW
d' [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ = GenLocated
  SrcSpanAnnLW
  [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> DeltaPos
-> GenLocated
     SrcSpanAnnLW
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall t a. LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (SrcSpanAnnLW
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnLW
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnLW
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, the haddock processing inserts
-- DocDecls to carry the Haddock Documentation. We ignore these in
-- exact printing, as all the comments are also available in their
-- normal location, and the haddock processing is lossy, in that it
-- does not preserve all haddock-like comments. When we balance
-- comments in a list, we migrate some to preceding or following
-- declarations in the list. We must make sure we do not move any to
-- these DocDecls, which are not printed.
balanceCommentsList :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
balanceCommentsList :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
balanceCommentsList [LHsDecl GhcPs]
decls = [LHsDecl GhcPs] -> [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' :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
balanceCommentsList' :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
balanceCommentsList' [] = []
balanceCommentsList' [LHsDecl GhcPs
x] = [LHsDecl GhcPs
x]
balanceCommentsList' (LHsDecl GhcPs
a:LHsDecl GhcPs
b:[LHsDecl GhcPs]
ls) = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
a'GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
r)
  where
    (LHsDecl GhcPs
a',LHsDecl GhcPs
b') = LHsDecl GhcPs -> LHsDecl GhcPs -> (LHsDecl GhcPs, LHsDecl GhcPs)
balanceComments LHsDecl GhcPs
a LHsDecl GhcPs
b
    r :: [LHsDecl GhcPs]
r = [LHsDecl GhcPs] -> [LHsDecl GhcPs]
balanceCommentsList' (GenLocated SrcSpanAnnA (HsDecl GhcPs)
b'GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:[LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ls)

-- |The GHC parser puts all comments appearing between the end of one AST
-- item and the beginning of the next as 'annPriorComments' for the second one.
-- 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 :: LHsDecl GhcPs -> LHsDecl GhcPs
                -> (LHsDecl GhcPs, LHsDecl GhcPs)
balanceComments :: LHsDecl GhcPs -> LHsDecl GhcPs -> (LHsDecl GhcPs, LHsDecl GhcPs)
balanceComments LHsDecl GhcPs
first LHsDecl GhcPs
second =
  case LHsDecl GhcPs
first of
    (L SrcSpanAnnA
l (ValD XValD GhcPs
x fb :: HsBindLR GhcPs GhcPs
fb@(FunBind{}))) ->
      let
        (L SrcSpanAnnA
l' HsBindLR GhcPs GhcPs
fb',GenLocated SrcSpanAnnA (HsDecl GhcPs)
second') = LHsBind GhcPs
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> (LHsBind GhcPs, GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall b.
LHsBind GhcPs -> LocatedA b -> (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
      in (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
fb'), LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
second')
    LHsDecl GhcPs
_ -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs),
    GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. LocatedA a -> LocatedA b -> (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 :: LHsBind GhcPs -> LocatedA b -> (LHsBind GhcPs, LocatedA b)
balanceCommentsFB :: forall b.
LHsBind GhcPs -> LocatedA b -> (LHsBind GhcPs, LocatedA b)
balanceCommentsFB (L SrcSpanAnnA
lf (FunBind XFunBind GhcPs GhcPs
x LIdP GhcPs
n (MG XMG GhcPs (LHsExpr GhcPs)
o (L SrcSpanAnnLW
lm [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches)))) LocatedA b
second
  = GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> LocatedA b
-> (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs), LocatedA b)
forall a b. LocatedA a -> LocatedA b -> (LocatedA a, LocatedA b)
balanceCommentsA (LHsBind GhcPs -> LHsBind GhcPs
packFunBind LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
bind) LocatedA b
second'
  -- There are comments on lf.  We need to
  -- + Keep the prior ones here
  -- + move the interior ones to the first match,
  -- + move the trailing ones to the last match.
  where
    ([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)
    matches' :: [LocatedA (Match GhcPs (LHsExpr GhcPs))]
    matches' :: [LocatedA (Match GhcPs (LHsExpr GhcPs))]
matches' = case [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches of
                  (L SrcSpanAnnA
lm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m0:[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))
m0LocatedA (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'' :: [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches'' = [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall e. [LocatedA e] -> [LocatedA e]
balanceCommentsListA [LocatedA (Match GhcPs (LHsExpr GhcPs))]
[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches'
    (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m,[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms) = case [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)))]
matches'' of
               (L SrcSpanAnnA
lm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m0:[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] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
after)) Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m0,[LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms')
               [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
"balanceCommentsFB4"
    (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m',LocatedA b
second') = LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedA b
-> (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
    LocatedA b)
forall a b. LocatedA a -> LocatedA b -> (LocatedA a, LocatedA b)
balanceCommentsA LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m LocatedA b
second
    m'' :: LMatch GhcPs (LHsExpr GhcPs)
m'' = LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
balanceCommentsMatch LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m'
    (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m''',SrcSpanAnnA
lf'') = case [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms of
      [] -> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpanAnnA
-> (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m'' SrcSpanAnnA
lf'
      [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_  -> (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m'',SrcSpanAnnA
lf')
    bind :: GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
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 (SrcSpanAnnLW
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnLW
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnLW
lm ([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)))
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)))))
balanceCommentsFB LHsBind GhcPs
f LocatedA b
s = GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> LocatedA b
-> (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs), LocatedA b)
forall a b. LocatedA a -> LocatedA b -> (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 :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs))
balanceCommentsMatch :: LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
balanceCommentsMatch (L SrcSpanAnnA
l (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
am HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt XRec GhcPs [LPat GhcPs]
pats (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xg [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
binds)))
  = (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))
-> XRec 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))
-> XRec p [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
am HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt XRec GhcPs [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
SrcSpanAnnLW
an' HsValBindsLR GhcPs GhcPs
vb)
  where
    decls :: [LHsDecl GhcPs]
decls = HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
lb
    (SrcSpanAnnLW
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
      [] -> (SrcSpanAnnLW -> EpAnnComments -> SrcSpanAnnLW
forall ann. NoAnn ann => EpAnn ann -> EpAnnComments -> EpAnn ann
addCommentsToEpAnn XHsValBinds GhcPs GhcPs
SrcSpanAnnLW
an EpAnnComments
cs, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls)
      (L SrcSpanAnnA
la HsDecl GhcPs
d:[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds) -> (XHsValBinds GhcPs GhcPs
SrcSpanAnnLW
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)
    vb :: HsValBindsLR GhcPs GhcPs
vb = case WithWhere
-> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> 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') -> HsValBindsLR GhcPs GhcPs
vb'
      HsLocalBinds GhcPs
_ -> 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 [] []


balanceCommentsListA :: [LocatedA a] -> [LocatedA a]
balanceCommentsListA :: forall e. [LocatedA e] -> [LocatedA e]
balanceCommentsListA [] = []
balanceCommentsListA [LocatedA a
x] = [LocatedA a
x]
balanceCommentsListA (LocatedA a
a:LocatedA a
b:[LocatedA a]
ls) = (LocatedA a
a'LocatedA a -> [LocatedA a] -> [LocatedA a]
forall a. a -> [a] -> [a]
:[LocatedA a]
r)
  where
    (LocatedA a
a',LocatedA a
b') = LocatedA a -> LocatedA a -> (LocatedA a, LocatedA a)
forall a b. LocatedA a -> LocatedA b -> (LocatedA a, LocatedA b)
balanceCommentsA LocatedA a
a LocatedA a
b
    r :: [LocatedA a]
r = [LocatedA a] -> [LocatedA a]
forall e. [LocatedA e] -> [LocatedA e]
balanceCommentsListA (LocatedA a
b'LocatedA a -> [LocatedA a] -> [LocatedA a]
forall a. a -> [a] -> [a]
:[LocatedA a]
ls)

-- |Prior to moving an AST element, make sure any trailing comments belonging to
-- it are attached to it, and not the following element. Of necessity this is a
-- 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 :: LocatedA a -> LocatedA b -> (LocatedA a, LocatedA b)
balanceCommentsA :: forall a b. LocatedA a -> LocatedA b -> (LocatedA a, LocatedA b)
balanceCommentsA LocatedA a
la1 LocatedA b
la2 = (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 SrcSpan
_ 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
epaLocationRealSrcSpan 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
epaLocationRealSrcSpan 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 SrcSpan
_ 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)]
go (NoCommentsLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan 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
epaLocationRealSrcSpan 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
epaLocationRealSrcSpan 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
epaLocationRealSrcSpan 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
epaLocationRealSrcSpan 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 :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs))
balanceSameLineComments :: LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
balanceSameLineComments (L SrcSpanAnnA
la (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
anm HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt XRec GhcPs [LPat GhcPs]
pats (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
lb)))
  = (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))
-> XRec 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))
-> XRec p [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
anm HsMatchContext (LIdP (NoGhcTc GhcPs))
mctxt XRec GhcPs [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
epaLocationRealSrcSpan 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 (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan 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 = SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan (Int -> DeltaPos
SameLine Int
0) []

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

dn :: Int -> EpaLocation
dn :: Int -> EpaLocation
dn Int
n = SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan (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 (EpToken "," -> TrailingAnn
AddCommaAnn (EpaLocation -> EpToken ","
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok EpaLocation
d0)TrailingAnn -> [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
         -> ast
insertAt :: forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> ast
insertAt LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
f ast
t LHsDecl GhcPs
decl = ast -> [LHsDecl GhcPs] -> ast
forall t. HasDecls t => t -> [LHsDecl GhcPs] -> t
replaceDecls ast
t (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
f LHsDecl GhcPs
decl [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
oldDecls')
  where
    oldDecls :: [LHsDecl GhcPs]
oldDecls = ast -> [LHsDecl GhcPs]
forall t. HasDecls t => t -> [LHsDecl GhcPs]
hsDecls ast
t
    oldDeclsb :: [LHsDecl GhcPs]
oldDeclsb = [LHsDecl GhcPs] -> [LHsDecl GhcPs]
balanceCommentsList [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
oldDecls
    oldDecls' :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
oldDecls' = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
oldDeclsb

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

insertAtEnd :: forall ast. HasDecls ast => ast -> LHsDecl GhcPs -> ast
insertAtEnd   = (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> ast
forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> 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 -> ast
insertAtStart = (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> ast
forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> 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
                          -> LocatedA ast
insertAfter :: forall ast old.
HasDecls (LocatedA ast) =>
LocatedA old -> LocatedA ast -> LHsDecl GhcPs -> 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 -> LocatedA ast
forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> 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 -> 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 -> LocatedA ast
forall ast.
HasDecls ast =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> ast -> LHsDecl GhcPs -> 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 :: t -> [LHsDecl GhcPs]

    -- | Replace the directly enclosed decl list by the given
    --  decl list. As part of replacing it will update list order
    --  annotations, and rebalance comments and other layout changes as needed.
    --
    -- For example, a call on replaceDecls for a wrapped 'FunBind' having no
    -- where clause will convert
    --
    -- @
    -- -- |This is a function
    -- foo = x -- comment1
    -- @
    -- in to
    --
    -- @
    -- -- |This is a function
    -- foo = x -- comment1
    --   where
    --     nn = 2
    -- @
    replaceDecls :: t -> [LHsDecl GhcPs] -> t

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

instance HasDecls ParsedSource where
  hsDecls :: ParsedSource -> [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)) = [LHsDecl GhcPs]
decls

  replaceDecls :: ParsedSource -> [LHsDecl GhcPs] -> 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
    = (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 :: GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (TyClD XTyClD GhcPs
_ c :: TyClDecl GhcPs
c@ClassDecl{}))  = TyClDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsClassDecl TyClDecl GhcPs
c
  hsDecls GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl = String -> [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> [LHsDecl GhcPs]) -> String -> [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 :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [LHsDecl GhcPs] -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
replaceDecls (L SrcSpanAnnA
l (TyClD XTyClD GhcPs
e dec :: TyClDecl GhcPs
dec@ClassDecl{})) [LHsDecl GhcPs]
decls =
    let
        decl' :: TyClDecl GhcPs
decl' = TyClDecl GhcPs -> [LHsDecl GhcPs] -> TyClDecl GhcPs
replaceDeclsClassDecl TyClDecl GhcPs
dec [LHsDecl GhcPs]
decls
    in (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
      = String -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a. HasCallStack => String -> a
error (String -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> String -> 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 :: LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsMatchContext (LIdP (NoGhcTc GhcPs))
_ XRec GhcPs [LPat GhcPs]
_ (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
_ HsLocalBinds GhcPs
lb))) = HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
lb

  replaceDecls :: LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
replaceDecls (L SrcSpanAnnA
l (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext (LIdP (NoGhcTc GhcPs))
c XRec GhcPs [LPat GhcPs]
p (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
binds))) []
    = let
        binds'' :: HsLocalBinds GhcPs
binds'' = WithWhere
-> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> HsLocalBinds GhcPs
replaceDeclsValbinds WithWhere
WithoutWhere HsLocalBinds GhcPs
binds []
      in (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))
-> XRec 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))
-> XRec p [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext (LIdP (NoGhcTc GhcPs))
c XRec GhcPs [LPat GhcPs]
p (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))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
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 XRec GhcPs [LPat GhcPs]
p (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
binds))) [LHsDecl GhcPs]
newBinds
    = let
        -- Need to throw in a fresh where clause if the binds were empty,
        -- in the annotations.
        (SrcSpanAnnA
l', [GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs') = case HsLocalBinds GhcPs
binds of
          EmptyLocalBinds{} ->
            let
              L SrcSpanAnnA
l0 Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m' = LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
balanceSameLineComments LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m
            in (SrcSpanAnnA
l0, GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m')
          HsLocalBinds GhcPs
_ -> (SrcSpanAnnA
l, [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs)
        binds'' :: HsLocalBinds GhcPs
binds'' = WithWhere
-> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> HsLocalBinds GhcPs
replaceDeclsValbinds WithWhere
WithWhere HsLocalBinds GhcPs
binds [LHsDecl GhcPs]
newBinds
      in (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))
-> XRec 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))
-> XRec p [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext (LIdP (NoGhcTc GhcPs))
c XRec GhcPs [LPat GhcPs]
p (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))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs' HsLocalBinds GhcPs
binds'')))

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

instance HasDecls (LocatedA (HsExpr GhcPs)) where
  hsDecls :: GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (HsLet XLet GhcPs
_ HsLocalBinds GhcPs
decls LHsExpr GhcPs
_ex)) = HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
decls
  hsDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
_                         = []

  replaceDecls :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs] -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
replaceDecls (L SrcSpanAnnA
ll (HsLet (EpToken "let"
tkLet, EpToken "in"
tkIn) HsLocalBinds GhcPs
binds LHsExpr GhcPs
ex)) [LHsDecl GhcPs]
newDecls
    = 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
        (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 SrcSpan
_ (SameLine Int
_) [LEpaComment]
_) -> Int -> LayoutStartCol
LayoutStartCol Int
0
                      (EpaDelta SrcSpan
_ (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' :: HsLocalBinds GhcPs
binds' = WithWhere
-> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> HsLocalBinds GhcPs
replaceDeclsValbinds WithWhere
WithoutWhere HsLocalBinds GhcPs
binds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls'
      in (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ll (XLet GhcPs -> HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet (EpToken "let"
tkLet', EpToken "in"
tkIn') HsLocalBinds GhcPs
binds' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
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
    = let
        e' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs] -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall t. HasDecls t => t -> [LHsDecl GhcPs] -> t
replaceDecls LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
      in (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcPs
x LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e'))
  replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
old [LHsDecl GhcPs]
_new = String -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. HasCallStack => String -> a
error (String -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> String -> 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 :: LHsDecl GhcPs -> [LHsDecl GhcPs] -> (LHsDecl GhcPs)
replaceDeclsPatBindD :: LHsDecl GhcPs -> [LHsDecl GhcPs] -> LHsDecl GhcPs
replaceDeclsPatBindD (L SrcSpanAnnA
l (ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
d)) [LHsDecl GhcPs]
newDecls =
  let
    (L SrcSpanAnnA
_ HsBindLR GhcPs GhcPs
d') = LHsBind GhcPs -> [LHsDecl GhcPs] -> 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
  in (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
d'))
replaceDeclsPatBindD LHsDecl GhcPs
x [LHsDecl GhcPs]
_ = String -> LHsDecl GhcPs
forall a. HasCallStack => String -> a
error (String -> LHsDecl GhcPs) -> String -> 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 :: LHsBind GhcPs -> [LHsDecl GhcPs] -> (LHsBind GhcPs)
replaceDeclsPatBind :: LHsBind GhcPs -> [LHsDecl GhcPs] -> 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
  =  (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XPatBind GhcPs GhcPs
-> LPat GhcPs
-> HsMultAnn GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XPatBind idL idR
-> LPat idL
-> HsMultAnn idL
-> GRHSs idR (LHsExpr idR)
-> HsBindLR idL idR
PatBind XPatBind GhcPs GhcPs
x LPat GhcPs
a HsMultAnn GhcPs
p (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 (LHsExpr GhcPs)
XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (LHsExpr GhcPs)]
[LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhss HsLocalBinds GhcPs
binds'')))
  where
    binds'' :: HsLocalBinds GhcPs
binds'' = WithWhere
-> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> HsLocalBinds GhcPs
replaceDeclsValbinds WithWhere
WithWhere HsLocalBinds GhcPs
binds [LHsDecl GhcPs]
newDecls
replaceDeclsPatBind LHsBind GhcPs
x [LHsDecl GhcPs]
_ = String -> LHsBind GhcPs
forall a. HasCallStack => String -> a
error (String -> LHsBind GhcPs) -> String -> 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 :: LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsLocalBinds GhcPs
lb))      = 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) -> [LHsDecl GhcPs]
forall t. HasDecls t => t -> [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) -> [LHsDecl GhcPs]
forall t. HasDecls t => t -> [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) -> [LHsDecl GhcPs]
forall t. HasDecls t => t -> [LHsDecl GhcPs]
hsDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
  hsDecls LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
_                         = []

  replaceDecls :: LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> 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
    = let
        lb'' :: HsLocalBinds GhcPs
lb'' = WithWhere
-> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> HsLocalBinds GhcPs
replaceDeclsValbinds WithWhere
WithWhere HsLocalBinds GhcPs
lb [LHsDecl GhcPs]
newDecls
      in (SrcSpanAnnA
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsLocalBinds GhcPs
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x HsLocalBinds GhcPs
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
    = let
        e' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs] -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall t. HasDecls t => t -> [LHsDecl GhcPs] -> t
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
      in (SrcSpanAnnA
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe Bool
-> SyntaxExpr GhcPs
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' Maybe Bool
d SyntaxExpr GhcPs
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
    = let
        e' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs] -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall t. HasDecls t => t -> [LHsDecl GhcPs] -> t
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
      in (SrcSpanAnnA
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LPat GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x LPat GhcPs
pat GenLocated SrcSpanAnnA (HsExpr GhcPs)
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
    = let
        e' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs] -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall t. HasDecls t => t -> [LHsDecl GhcPs] -> t
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
      in (SrcSpanAnnA
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b))
  replaceDecls LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x [LHsDecl GhcPs]
_newDecls = 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 SrcSpanAnnLW
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 (SrcSpanAnnLW
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnLW
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnLW
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 SrcSpanAnnLW
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 (SrcSpanAnnLW
-> [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnLW
     [LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnLW
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 :: WithWhere
                     -> HsLocalBinds GhcPs -> [LHsDecl GhcPs]
                     -> HsLocalBinds GhcPs
replaceDeclsValbinds :: WithWhere
-> HsLocalBinds GhcPs -> [LHsDecl GhcPs] -> HsLocalBinds GhcPs
replaceDeclsValbinds WithWhere
_ HsLocalBinds GhcPs
_ [] = 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
    = let
        oldSpan :: SrcSpan
oldSpan = HsLocalBinds GhcPs -> SrcSpan
forall (p :: Pass). HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds GhcPs
b
        an :: SrcSpanAnnLW
an = SrcSpanAnnLW -> WithWhere -> RealSrcSpan -> SrcSpanAnnLW
oldWhereAnnotation XHsValBinds GhcPs GhcPs
SrcSpanAnnLW
a WithWhere
w (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
oldSpan)
        decs :: [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
decs = (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 -> LHsBindsLR GhcPs GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
decl2Bind [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
new
        sigs :: [GenLocated SrcSpanAnnA (Sig GhcPs)]
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
        sortKey :: AnnSortKey BindTag
sortKey = [LHsDecl GhcPs] -> AnnSortKey BindTag
captureOrderBinds [LHsDecl GhcPs]
new
      in (XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
SrcSpanAnnLW
an (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
sortKey LHsBindsLR GhcPs GhcPs
[GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
decs [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs))
replaceDeclsValbinds WithWhere
_ (HsIPBinds {}) [LHsDecl GhcPs]
_new    = String -> HsLocalBinds GhcPs
forall a. HasCallStack => String -> a
error String
"undefined replaceDecls HsIPBinds"
replaceDeclsValbinds WithWhere
w (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) [LHsDecl GhcPs]
new
    = let
        an :: SrcSpanAnnLW
an = WithWhere -> SrcSpanAnnLW
newWhereAnnotation WithWhere
w
        decs :: [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
decs = (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 -> LHsBindsLR GhcPs GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
decl2Bind [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
new
        sigs :: [GenLocated SrcSpanAnnA (Sig GhcPs)]
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
        sortKey :: AnnSortKey BindTag
sortKey = [LHsDecl GhcPs] -> AnnSortKey BindTag
captureOrderBinds [LHsDecl GhcPs]
new
      in (XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
SrcSpanAnnLW
an (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
sortKey LHsBindsLR GhcPs GhcPs
[GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
decs [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs))

oldWhereAnnotation :: EpAnn (AnnList (EpToken "where"))
  -> WithWhere -> RealSrcSpan -> (EpAnn (AnnList (EpToken "where")))
oldWhereAnnotation :: SrcSpanAnnLW -> WithWhere -> RealSrcSpan -> SrcSpanAnnLW
oldWhereAnnotation (EpAnn EpaLocation
anc AnnList (EpToken "where")
an EpAnnComments
cs) WithWhere
ww RealSrcSpan
_oldSpan = SrcSpanAnnLW
forall {tok :: Symbol}. EpAnn (AnnList (EpToken tok))
an'
  -- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation,
  -- change the AnnList anchor to have the correct DP too
  where
    (AnnList Maybe EpaLocation
ancl AnnListBrackets
p [EpToken ";"]
s EpToken "where"
_r [TrailingAnn]
t) = AnnList (EpToken "where")
an
    w :: EpToken tok
w = case WithWhere
ww of
      WithWhere
WithWhere -> EpaLocation -> EpToken tok
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan (Int -> DeltaPos
SameLine Int
0) [])
      WithWhere
WithoutWhere -> EpToken tok
forall (tok :: Symbol). EpToken tok
NoEpTok
    (EpaLocation
anc', Maybe EpaLocation
ancl') =
          case WithWhere
ww of
            WithWhere
WithWhere -> (EpaLocation
anc, Maybe EpaLocation
ancl)
            WithWhere
WithoutWhere -> (EpaLocation
anc, Maybe EpaLocation
ancl)
    an' :: EpAnn (AnnList (EpToken tok))
an' = EpaLocation
-> AnnList (EpToken tok)
-> EpAnnComments
-> EpAnn (AnnList (EpToken tok))
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc'
                (Maybe EpaLocation
-> AnnListBrackets
-> [EpToken ";"]
-> EpToken tok
-> [TrailingAnn]
-> AnnList (EpToken tok)
forall a.
Maybe EpaLocation
-> AnnListBrackets
-> [EpToken ";"]
-> a
-> [TrailingAnn]
-> AnnList a
AnnList Maybe EpaLocation
ancl' AnnListBrackets
p [EpToken ";"]
s EpToken tok
forall (tok :: Symbol). EpToken tok
w [TrailingAnn]
t)
                EpAnnComments
cs

newWhereAnnotation :: WithWhere -> (EpAnn (AnnList (EpToken "where")))
newWhereAnnotation :: WithWhere -> SrcSpanAnnLW
newWhereAnnotation WithWhere
ww = SrcSpanAnnLW
forall {tok :: Symbol}. EpAnn (AnnList (EpToken tok))
an
  where
  anc :: EpaLocation' [a]
anc  = SrcSpan -> DeltaPos -> [a] -> EpaLocation' [a]
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
3) []
  anc2 :: EpaLocation' [a]
anc2 = SrcSpan -> DeltaPos -> [a] -> EpaLocation' [a]
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
5) []
  w :: EpToken tok
w = case WithWhere
ww of
    WithWhere
WithWhere -> EpaLocation -> EpToken tok
forall (tok :: Symbol). EpaLocation -> EpToken tok
EpTok (SrcSpan -> DeltaPos -> [LEpaComment] -> EpaLocation
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan (Int -> DeltaPos
SameLine Int
0) [])
    WithWhere
WithoutWhere -> EpToken tok
forall (tok :: Symbol). EpToken tok
NoEpTok
  an :: EpAnn (AnnList (EpToken tok))
an = EpaLocation
-> AnnList (EpToken tok)
-> EpAnnComments
-> EpAnn (AnnList (EpToken tok))
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
forall {a}. EpaLocation' [a]
anc
              (Maybe EpaLocation
-> AnnListBrackets
-> [EpToken ";"]
-> EpToken tok
-> [TrailingAnn]
-> AnnList (EpToken tok)
forall a.
Maybe EpaLocation
-> AnnListBrackets
-> [EpToken ";"]
-> a
-> [TrailingAnn]
-> AnnList a
AnnList (EpaLocation -> Maybe EpaLocation
forall a. a -> Maybe a
Just EpaLocation
forall {a}. EpaLocation' [a]
anc2) AnnListBrackets
ListNone [] EpToken tok
forall (tok :: Symbol). EpToken tok
w [])
              EpAnnComments
emptyComments

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

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 t.
                   SrcSpan
                -> Decl
                -> (PMatch -> [Decl] -> ([Decl], Maybe t))
                -> (Decl,Maybe t)
modifyValD :: forall t.
SrcSpan
-> LHsDecl GhcPs
-> (LMatch GhcPs (LHsExpr GhcPs)
    -> [LHsDecl GhcPs] -> ([LHsDecl GhcPs], Maybe t))
-> (LHsDecl GhcPs, Maybe t)
modifyValD SrcSpan
p pb :: LHsDecl GhcPs
pb@(L SrcSpanAnnA
ss (ValD XValD GhcPs
_ (PatBind {} ))) LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> ([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
       let
           ds :: [LHsDecl GhcPs]
ds = LHsDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsPatBindD LHsDecl GhcPs
pb
           ([LHsDecl GhcPs]
ds',Maybe t
r) = LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> ([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' :: LHsDecl GhcPs
pb' = LHsDecl GhcPs -> [LHsDecl GhcPs] -> LHsDecl GhcPs
replaceDeclsPatBindD LHsDecl GhcPs
pb [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds'
       in (LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
pb',Maybe t
r)
     else (LHsDecl GhcPs
pb,Maybe t
forall a. Maybe a
Nothing)
modifyValD SrcSpan
p LHsDecl GhcPs
decl LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> ([LHsDecl GhcPs], Maybe t)
f = (LHsDecl GhcPs -> LHsDecl GhcPs
packFunDecl LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl', Maybe t
r)
  where
    (GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl',Maybe t
r) = State (Maybe t) (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> Maybe t -> (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
forall s a. State s a -> s -> (a, s)
runState (GenericM (StateT (Maybe t) Identity)
-> GenericM (StateT (Maybe t) Identity)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> StateT
      (Maybe t)
      Identity
      (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> a -> StateT (Maybe t) Identity a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM LMatch GhcPs (LHsExpr GhcPs)
-> State (Maybe t) (LMatch GhcPs (LHsExpr GhcPs))
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> StateT
     (Maybe t)
     Identity
     (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
doModLocal) (LHsDecl GhcPs -> LHsDecl GhcPs
unpackFunDecl LHsDecl GhcPs
decl)) Maybe t
forall a. Maybe a
Nothing
    doModLocal :: PMatch -> State (Maybe t) PMatch
    doModLocal :: LMatch GhcPs (LHsExpr GhcPs)
-> State (Maybe t) (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
             let
               ds :: [LHsDecl GhcPs]
ds = LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
forall t. HasDecls t => t -> [LHsDecl GhcPs]
hsDecls LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match
               ([LHsDecl GhcPs]
ds',Maybe t
r0) = LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> ([LHsDecl GhcPs], Maybe t)
f LMatch GhcPs (LHsExpr GhcPs)
match [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds
             Maybe t -> StateT (Maybe t) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Maybe t
r0
             let match' :: LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match' = LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall t. HasDecls t => t -> [LHsDecl GhcPs] -> t
replaceDecls LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds'
             LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> StateT
     (Maybe t)
     Identity
     (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> StateT (Maybe t) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match'
           else LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> StateT
     (Maybe t)
     Identity
     (LocatedA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> StateT (Maybe t) Identity 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
  let decls :: [LHsDecl GhcPs]
decls = t -> [LHsDecl GhcPs]
forall t. HasDecls t => t -> [LHsDecl GhcPs]
hsDecls t
t
  decls' <- [LHsDecl GhcPs] -> m [LHsDecl GhcPs]
action [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
  return $ replaceDecls t decls'