{-# 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
        , m0, m1, mn
        , addComma

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

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

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

        -- * Operations
        , isUniqueSrcSpan

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

import Language.Haskell.GHC.ExactPrint.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Utils
-- import Language.Haskell.GHC.ExactPrint.Orphans (Default(..))

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

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

import Data.Data
import Data.Default
import Data.Maybe
import Data.Generics
import Data.List (sortBy)

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

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

-- | Monad type for updating the AST and managing the annotations at the same
-- time. The W state is used to generate logging information if required.
type Transform = TransformT Identity

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

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

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

runTransformT :: TransformT m a -> m (a,Int,[String])
runTransformT :: forall (m :: * -> *) a. TransformT m a -> m (a, Int, [String])
runTransformT TransformT m a
f = Int -> TransformT m a -> m (a, Int, [String])
forall (m :: * -> *) a.
Int -> TransformT m a -> m (a, Int, [String])
runTransformFromT Int
0 TransformT m a
f

-- | Run a transformation in the 'Transform' monad, returning the updated
-- annotations and any logging generated via 'logTr', allocating any new
-- SrcSpans from the provided initial value.
runTransformFrom :: Int -> Transform a -> (a,Int,[String])
runTransformFrom :: forall a. Int -> Transform a -> (a, Int, [String])
runTransformFrom Int
seed Transform a
f = RWS () [String] Int a -> () -> Int -> (a, Int, [String])
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS (Transform a -> RWS () [String] Int a
forall (m :: * -> *) a. TransformT m a -> RWST () [String] Int m a
unTransformT Transform a
f) () Int
seed

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

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

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

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

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

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

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

-- |If a list has been re-ordered or had items added, capture the new order in
-- the appropriate 'AnnSortKey' attached to the 'Annotation' for the list.
captureOrder :: [LocatedA b] -> AnnSortKey
captureOrder :: forall b. [LocatedA b] -> AnnSortKey
captureOrder [LocatedA b]
ls = [RealSrcSpan] -> AnnSortKey
AnnSortKey ([RealSrcSpan] -> AnnSortKey) -> [RealSrcSpan] -> AnnSortKey
forall a b. (a -> b) -> a -> b
$ (LocatedA b -> RealSrcSpan) -> [LocatedA b] -> [RealSrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> RealSrcSpan
rs (SrcSpan -> RealSrcSpan)
-> (LocatedA b -> SrcSpan) -> LocatedA b -> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA b -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [LocatedA b]
ls

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

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

captureLineSpacing :: Default t
                   => [LocatedAn t e] -> [LocatedAn t e]
captureLineSpacing :: forall t e. Default t => [LocatedAn t e] -> [LocatedAn t e]
captureLineSpacing [] = []
captureLineSpacing [LocatedAn t e
d] = [LocatedAn t e
d]
captureLineSpacing (LocatedAn t e
de1:LocatedAn t e
d2:[LocatedAn t e]
ds) = LocatedAn t e
de1LocatedAn t e -> [LocatedAn t e] -> [LocatedAn t e]
forall a. a -> [a] -> [a]
:[LocatedAn t e] -> [LocatedAn t e]
forall t e. Default t => [LocatedAn t e] -> [LocatedAn t e]
captureLineSpacing (LocatedAn t e
d2'LocatedAn t e -> [LocatedAn t e] -> [LocatedAn t e]
forall a. a -> [a] -> [a]
:[LocatedAn t e]
ds)
  where
    (Int
l1,Int
_) = RealSrcSpan -> (Int, Int)
ss2pos (RealSrcSpan -> (Int, Int)) -> RealSrcSpan -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RealSrcSpan
rs (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LocatedAn t e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn t e
de1
    (Int
l2,Int
_) = RealSrcSpan -> (Int, Int)
ss2pos (RealSrcSpan -> (Int, Int)) -> RealSrcSpan -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RealSrcSpan
rs (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LocatedAn t e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn t e
d2
    d2' :: LocatedAn t e
d2' = LocatedAn t e -> DeltaPos -> LocatedAn t e
forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedAn t e
d2 (Int -> Int -> DeltaPos
deltaPos (Int
l2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l1) Int
0)

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

captureTypeSigSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs
captureTypeSigSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs
captureTypeSigSpacing (L SrcSpanAnnA
l (SigD XSigD GhcPs
x (TypeSig (EpAnn Anchor
anc (AnnSig AddEpAnn
dc [AddEpAnn]
rs') EpAnnComments
cs) [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 (Anchor -> AnnSig -> EpAnnComments -> EpAnn AnnSig
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc (AddEpAnn -> [AddEpAnn] -> AnnSig
AnnSig AddEpAnn
dc' [AddEpAnn]
rs') EpAnnComments
cs) [LIdP GhcPs]
ns (XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC XHsWC GhcPs (LHsSigType GhcPs)
XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
xw LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'))))
  where
    -- we want DPs for the distance from the end of the ns to the
    -- AnnDColon, and to the start of the ty
    AddEpAnn AnnKeywordId
kw EpaLocation
dca = AddEpAnn
dc
    rd :: RealSrcSpan
rd = case [GenLocated (SrcSpanAnn' (EpAnn NameAnn)) (IdP GhcPs)]
-> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) (IdP GhcPs)
forall a. HasCallStack => [a] -> a
last [LIdP GhcPs]
[GenLocated (SrcSpanAnn' (EpAnn NameAnn)) (IdP GhcPs)]
ns of
      L (SrcSpanAnn EpAnn NameAnn
EpAnnNotUsed   SrcSpan
ll) IdP GhcPs
_ -> SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
ll
      L (SrcSpanAnn (EpAnn Anchor
anc' NameAnn
_ EpAnnComments
_) SrcSpan
_) IdP GhcPs
_ -> Anchor -> RealSrcSpan
anchor Anchor
anc' -- TODO MovedAnchor?
    dc' :: AddEpAnn
dc' = case EpaLocation
dca of
      EpaSpan RealSrcSpan
r Maybe BufSpan
_ -> AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kw (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta ((Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
rd) RealSrcSpan
r) [])
      EpaDelta DeltaPos
_ [LEpaComment]
_ -> AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kw EpaLocation
dca

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

    ty' :: LHsSigType GhcPs
    ty' :: LHsSigType GhcPs
ty' = case LHsSigType GhcPs
ty of
      (L (SrcSpanAnn EpAnn AnnListItem
EpAnnNotUsed    SrcSpan
ll) HsSigType GhcPs
b)
        -> let
             op :: AnchorOperation
op = case EpaLocation
dca of
               EpaSpan RealSrcSpan
r Maybe BufSpan
_ -> DeltaPos -> AnchorOperation
MovedAnchor ((Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
r) (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
ll))
               EpaDelta DeltaPos
_ [LEpaComment]
_ -> DeltaPos -> AnchorOperation
MovedAnchor (Int -> DeltaPos
SameLine Int
1)
           in (SrcSpanAnnA
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnListItem -> EpAnnComments -> EpAnn AnnListItem
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
ll) AnchorOperation
op) AnnListItem
forall a. Monoid a => a
mempty EpAnnComments
emptyComments) SrcSpan
ll) HsSigType GhcPs
b)
      (L (SrcSpanAnn (EpAnn (Anchor RealSrcSpan
r AnchorOperation
op) AnnListItem
a EpAnnComments
c) SrcSpan
ll) HsSigType GhcPs
b)
        -> let
              op' :: AnchorOperation
op' = case AnchorOperation
op of
                MovedAnchor DeltaPos
_ -> AnchorOperation
op
                AnchorOperation
_ -> case EpaLocation
dca of
                  EpaSpan RealSrcSpan
dcr Maybe BufSpan
_ -> DeltaPos -> AnchorOperation
MovedAnchor ((Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
dcr) RealSrcSpan
r)
                  EpaDelta DeltaPos
_ [LEpaComment]
_ -> DeltaPos -> AnchorOperation
MovedAnchor (Int -> DeltaPos
SameLine Int
1)
           in (SrcSpanAnnA
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnListItem -> EpAnnComments -> EpAnn AnnListItem
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
r AnchorOperation
op') AnnListItem
a EpAnnComments
c) SrcSpan
ll) HsSigType GhcPs
b)

captureTypeSigSpacing LHsDecl GhcPs
s = LHsDecl GhcPs
s

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

-- |Pure function to convert a 'LHsDecl' to a 'LHsBind'. This does
-- nothing to any annotations that may be attached to either of the elements.
-- It is used as a utility function in 'replaceDecls'
decl2Bind :: LHsDecl GhcPs -> [LHsBind GhcPs]
decl2Bind :: LHsDecl GhcPs -> [LHsBind GhcPs]
decl2Bind (L SrcSpanAnnA
l (ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
s)) = [SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
s]
decl2Bind LHsDecl GhcPs
_                      = []

-- |Pure function to convert a 'LSig' to a 'LHsBind'. This does
-- nothing to any annotations that may be attached to either of the elements.
-- It is used as a utility function in 'replaceDecls'
decl2Sig :: LHsDecl GhcPs -> [LSig GhcPs]
decl2Sig :: LHsDecl GhcPs -> [LSig GhcPs]
decl2Sig (L SrcSpanAnnA
l (SigD XSigD GhcPs
_ Sig GhcPs
s)) = [SrcSpanAnnA -> Sig GhcPs -> GenLocated SrcSpanAnnA (Sig GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Sig GhcPs
s]
decl2Sig LHsDecl GhcPs
_                = []

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

-- |Convert a 'LSig' into a 'LHsDecl'
wrapSig :: LSig GhcPs -> LHsDecl GhcPs
wrapSig :: LSig GhcPs -> LHsDecl GhcPs
wrapSig (L SrcSpanAnnA
l Sig GhcPs
s) = 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
NoExtField
NoExtField Sig GhcPs
s)

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

-- |Convert a 'LHsBind' into a 'LHsDecl'
wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs
wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs
wrapDecl (L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
s) = 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
NoExtField
NoExtField HsBindLR GhcPs GhcPs
s)

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

setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs
setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs
setEntryDPDecl decl :: LHsDecl GhcPs
decl@(L SrcSpanAnnA
_  (ValD XValD GhcPs
x (FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (MG XMG GhcPs (LHsExpr GhcPs)
c (L SrcSpanAnnL
d [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms ))))) DeltaPos
dp
                   = SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
x (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
c (SrcSpanAnnL
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
d [LMatch GhcPs (LHsExpr GhcPs)]
[LocatedAn
   AnnListItem (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. Default t => 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 [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms of
        [] -> []
        (LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m0':[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0) -> LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> DeltaPos
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m0' DeltaPos
dp LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
: [LocatedAn
   AnnListItem (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. Default t => 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 :: Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP :: forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (L (SrcSpanAnn EpAnn t
EpAnnNotUsed SrcSpan
l) a
a) DeltaPos
dp
  = SrcAnn t -> a -> GenLocated (SrcAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpAnn t -> SrcSpan -> SrcAnn t
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn
           (Anchor -> t -> EpAnnComments -> EpAnn t
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)) t
forall a. Default a => a
def EpAnnComments
emptyComments)
           SrcSpan
l) a
a
setEntryDP (L (SrcSpanAnn (EpAnn (Anchor RealSrcSpan
r AnchorOperation
_) t
an (EpaComments [])) SrcSpan
l) a
a) DeltaPos
dp
  = SrcAnn t -> a -> GenLocated (SrcAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpAnn t -> SrcSpan -> SrcAnn t
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn
           (Anchor -> t -> EpAnnComments -> EpAnn t
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
r (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)) t
an ([LEpaComment] -> EpAnnComments
EpaComments []))
           SrcSpan
l) a
a
setEntryDP (L (SrcSpanAnn (EpAnn (Anchor RealSrcSpan
r (MovedAnchor DeltaPos
d)) t
an EpAnnComments
cs) SrcSpan
l) a
a) DeltaPos
dp
  = SrcAnn t -> a -> GenLocated (SrcAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpAnn t -> SrcSpan -> SrcAnn t
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn
           (Anchor -> t -> EpAnnComments -> EpAnn t
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
r (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
d')) t
an EpAnnComments
cs')
           SrcSpan
l) a
a
  where
    (DeltaPos
d',EpAnnComments
cs') = case EpAnnComments
cs of
      EpaComments (LEpaComment
h:[LEpaComment]
t) ->
        let
          (DeltaPos
dp0,LEpaComment
c') = LEpaComment -> (DeltaPos, LEpaComment)
forall {e}. GenLocated Anchor e -> (DeltaPos, GenLocated Anchor e)
go LEpaComment
h
        in
          (DeltaPos
dp0, [LEpaComment] -> EpAnnComments
EpaComments (LEpaComment
c'LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
t))
      EpaCommentsBalanced (LEpaComment
h:[LEpaComment]
t) [LEpaComment]
ts ->
        let
          (DeltaPos
dp0,LEpaComment
c') = LEpaComment -> (DeltaPos, LEpaComment)
forall {e}. GenLocated Anchor e -> (DeltaPos, GenLocated Anchor e)
go LEpaComment
h
        in
          (DeltaPos
dp0, [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced (LEpaComment
c'LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
t) [LEpaComment]
ts)
      EpAnnComments
_ -> (DeltaPos
dp, EpAnnComments
cs)
    go :: GenLocated Anchor e -> (DeltaPos, GenLocated Anchor e)
go (L (Anchor RealSrcSpan
rr (MovedAnchor DeltaPos
ma)) e
c) = (DeltaPos
d,  Anchor -> e -> GenLocated Anchor e
forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
rr (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
ma)) e
c)
    go (L (Anchor RealSrcSpan
rr                AnchorOperation
_) e
c) = (DeltaPos
d,  Anchor -> e -> GenLocated Anchor e
forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
rr (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)) e
c)
setEntryDP (L (SrcSpanAnn (EpAnn (Anchor RealSrcSpan
r AnchorOperation
_) t
an EpAnnComments
cs) SrcSpan
l) a
a) DeltaPos
dp
  = case [LEpaComment] -> [LEpaComment]
sortEpaComments (EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs) of
      [] ->
        SrcAnn t -> a -> GenLocated (SrcAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpAnn t -> SrcSpan -> SrcAnn t
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn
               (Anchor -> t -> EpAnnComments -> EpAnn t
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
r (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)) t
an EpAnnComments
cs)
               SrcSpan
l) a
a
      (L Anchor
ca EpaComment
c:[LEpaComment]
cs') ->
        SrcAnn t -> a -> GenLocated (SrcAnn t) a
forall l e. l -> e -> GenLocated l e
L (EpAnn t -> SrcSpan -> SrcAnn t
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn
               (Anchor -> t -> EpAnnComments -> EpAnn t
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
r (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
edp)) t
an EpAnnComments
cs'')
               SrcSpan
l) a
a
              where
                cs'' :: EpAnnComments
cs'' = EpAnnComments -> [LEpaComment] -> EpAnnComments
setPriorComments EpAnnComments
cs (Anchor -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> AnchorOperation -> Anchor
Anchor (Anchor -> RealSrcSpan
anchor Anchor
ca) (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)) EpaComment
cLEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
cs')
                lc :: LEpaComment
lc = [LEpaComment] -> LEpaComment
forall a. HasCallStack => [a] -> a
head ([LEpaComment] -> LEpaComment) -> [LEpaComment] -> LEpaComment
forall a b. (a -> b) -> a -> b
$ [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a]
reverse ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ (Anchor -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L Anchor
ca EpaComment
cLEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
:[LEpaComment]
cs')
                delta :: DeltaPos
delta = DeltaPos -> DeltaPos
tweakDelta (DeltaPos -> DeltaPos) -> DeltaPos -> DeltaPos
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2pos (RealSrcSpan -> (Int, Int)) -> RealSrcSpan -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor (Anchor -> RealSrcSpan) -> Anchor -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> Anchor
forall l e. GenLocated l e -> l
getLoc LEpaComment
lc) RealSrcSpan
r
                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
$ Anchor -> RealSrcSpan
anchor (Anchor -> RealSrcSpan) -> Anchor -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> Anchor
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 (SrcSpanAnn (EpAnn (Anchor RealSrcSpan
_ (MovedAnchor DeltaPos
dp)) t
_ EpAnnComments
_) SrcSpan
_) a
_) = DeltaPos
dp
getEntryDP GenLocated (SrcAnn t) a
_ = Int -> DeltaPos
SameLine Int
1

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

addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta LayoutStartCol
_off RealSrcSpan
_anc (EpaDelta DeltaPos
d [LEpaComment]
cs) = DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta DeltaPos
d [LEpaComment]
cs
addEpaLocationDelta  LayoutStartCol
off  RealSrcSpan
anc (EpaSpan RealSrcSpan
r Maybe BufSpan
_)
  = DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset LayoutStartCol
off (RealSrcSpan -> RealSrcSpan -> DeltaPos
ss2deltaEnd RealSrcSpan
anc RealSrcSpan
r)) []

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

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

-- |Take the annEntryDelta associated with the first item and associate it with the second.
-- Also transfer any comments occuring before it.
transferEntryDP :: (Monad m, Monoid t2, Typeable t1, Typeable t2)
  => LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP :: forall (m :: * -> *) t2 t1 a b.
(Monad m, Monoid t2, Typeable t1, Typeable t2) =>
LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP (L (SrcSpanAnn EpAnn t1
EpAnnNotUsed SrcSpan
l1) a
_) (L (SrcSpanAnn EpAnn t2
EpAnnNotUsed SrcSpan
_) b
b) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"transferEntryDP': EpAnnNotUsed,EpAnnNotUsed"
  GenLocated (SrcAnn t2) b -> TransformT m (GenLocated (SrcAnn t2) b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t2 -> b -> GenLocated (SrcAnn t2) b
forall l e. l -> e -> GenLocated l e
L (EpAnn t2 -> SrcSpan -> SrcAnn t2
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn t2
forall ann. EpAnn ann
EpAnnNotUsed SrcSpan
l1) b
b)
transferEntryDP (L (SrcSpanAnn (EpAnn Anchor
anc t1
_an EpAnnComments
cs) SrcSpan
_l1) a
_) (L (SrcSpanAnn EpAnn t2
EpAnnNotUsed SrcSpan
l2) b
b) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"transferEntryDP': EpAnn,EpAnnNotUsed"
  GenLocated (SrcAnn t2) b -> TransformT m (GenLocated (SrcAnn t2) b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t2 -> b -> GenLocated (SrcAnn t2) b
forall l e. l -> e -> GenLocated l e
L (EpAnn t2 -> SrcSpan -> SrcAnn t2
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> t2 -> EpAnnComments -> EpAnn t2
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc t2
forall a. Monoid a => a
mempty EpAnnComments
cs) SrcSpan
l2) b
b)
transferEntryDP (L (SrcSpanAnn (EpAnn Anchor
anc1 t1
an1 EpAnnComments
cs1) SrcSpan
_l1) a
_) (L (SrcSpanAnn (EpAnn Anchor
_anc2 t2
an2 EpAnnComments
cs2) SrcSpan
l2) b
b) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"transferEntryDP': EpAnn,EpAnn"
  -- Problem: if the original had preceding comments, blindly
  -- transferring the location is not correct
  case EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cs1 of
    [] -> GenLocated (SrcAnn t2) b -> TransformT m (GenLocated (SrcAnn t2) b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t2 -> b -> GenLocated (SrcAnn t2) b
forall l e. l -> e -> GenLocated l e
L (EpAnn t2 -> SrcSpan -> SrcAnn t2
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> t2 -> EpAnnComments -> EpAnn t2
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc1 (t1 -> t2 -> t2
forall a b. (Typeable a, Typeable b) => a -> b -> b
combine t1
an1 t2
an2) EpAnnComments
cs2) SrcSpan
l2) b
b)
    -- TODO: what happens if the receiving side already has comments?
    (L Anchor
anc EpaComment
_:[LEpaComment]
_) -> do
      String -> Anchor -> TransformT m ()
forall (m :: * -> *) a.
(Monad m, Data a) =>
String -> a -> TransformT m ()
logDataWithAnnsTr String
"transferEntryDP':priorComments anc=" Anchor
anc
      GenLocated (SrcAnn t2) b -> TransformT m (GenLocated (SrcAnn t2) b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t2 -> b -> GenLocated (SrcAnn t2) b
forall l e. l -> e -> GenLocated l e
L (EpAnn t2 -> SrcSpan -> SrcAnn t2
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> t2 -> EpAnnComments -> EpAnn t2
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
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)) SrcSpan
l2) b
b)
transferEntryDP (L (SrcSpanAnn EpAnn t1
EpAnnNotUsed SrcSpan
_l1) a
_) (L (SrcSpanAnn (EpAnn Anchor
anc2 t2
an2 EpAnnComments
cs2) SrcSpan
l2) b
b) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"transferEntryDP': EpAnnNotUsed,EpAnn"
  GenLocated (SrcAnn t2) b -> TransformT m (GenLocated (SrcAnn t2) b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t2 -> b -> GenLocated (SrcAnn t2) b
forall l e. l -> e -> GenLocated l e
L (EpAnn t2 -> SrcSpan -> SrcAnn t2
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> t2 -> EpAnnComments -> EpAnn t2
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc2' t2
an2 EpAnnComments
cs2) SrcSpan
l2) b
b)
    where
      anc2' :: Anchor
anc2' = case Anchor
anc2 of
        Anchor RealSrcSpan
_a AnchorOperation
op   -> RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l2) AnchorOperation
op


-- |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 occuring before it.
-- TODO: call transferEntryDP, and use pushDeclDP
transferEntryDP' :: (Monad m) => LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs)
transferEntryDP' :: forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs)
transferEntryDP' LHsDecl GhcPs
la LHsDecl GhcPs
lb = do
  (L SrcSpanAnnA
l2 HsDecl GhcPs
b) <- GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) t2 t1 a b.
(Monad m, Monoid t2, Typeable t1, Typeable t2) =>
LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
la LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
lb
  GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
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 SrcSpanAnnL
d  [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms )))) DeltaPos
dp
          = XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
x (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
a LIdP GhcPs
b (XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
c (SrcSpanAnnL
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
d' [LMatch GhcPs (LHsExpr GhcPs)]
[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms')))
    where
      L SrcSpanAnnL
d' [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ = GenLocated
  SrcSpanAnnL
  [LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> DeltaPos
-> GenLocated
     SrcSpanAnnL
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (SrcSpanAnnL
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
d [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms) DeltaPos
dp
      ms' :: [LMatch GhcPs (LHsExpr GhcPs)]
      ms' :: [LMatch GhcPs (LHsExpr GhcPs)]
ms' = case [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms of
        [] -> []
        (LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m0':[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0) -> LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> DeltaPos
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m0' DeltaPos
dp LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
: [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms0
pushDeclDP HsDecl GhcPs
d DeltaPos
_dp = HsDecl GhcPs
d

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

balanceCommentsList :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
balanceCommentsList :: forall (m :: * -> *).
Monad m =>
[LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
balanceCommentsList [LHsDecl GhcPs]
ds = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
[LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
balanceCommentsList'' [LHsDecl GhcPs]
ds

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

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

-- |Once 'balanceComments' has been called to move trailing comments to a
-- 'FunBind', these need to be pushed down from the top level to the last
-- 'Match' if that 'Match' needs to be manipulated.
balanceCommentsFB :: (Monad m)
  => LHsBind GhcPs -> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b)
balanceCommentsFB :: forall (m :: * -> *) b.
Monad m =>
LHsBind GhcPs
-> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b)
balanceCommentsFB (L SrcSpanAnnA
lf (FunBind XFunBind GhcPs GhcPs
x LIdP GhcPs
n (MG XMG GhcPs (LHsExpr GhcPs)
o (L SrcSpanAnnL
lm [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches)))) LocatedA b
second = 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
"balanceCommentsFB entered: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Int, Int), (Int, Int)) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan -> ((Int, Int), (Int, Int))
ss2range (SrcSpan -> ((Int, Int), (Int, Int)))
-> SrcSpan -> ((Int, Int), (Int, Int))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
lf)
  -- There are comments on lf.  We need to
  -- + Keep the prior ones here
  -- + move the interior ones to the first match,
  -- + move the trailing ones to the last match.
  let
    split :: EpAnnComments
split = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
lf) (EpAnn AnnListItem -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments (EpAnn AnnListItem -> EpAnnComments)
-> EpAnn AnnListItem -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> EpAnn AnnListItem
forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnA
lf)
    split2 :: EpAnnComments
split2 = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsStart (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
lf)  ([LEpaComment] -> EpAnnComments
EpaComments ([LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
split))

    before :: [LEpaComment]
before = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
split2
    middle :: [LEpaComment]
middle = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
split2
    after :: [LEpaComment]
after  = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
split

    lf' :: SrcSpanAnnA
lf' = SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
setCommentsSrcAnn SrcSpanAnnA
lf ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
before)
  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
"balanceCommentsFB (before, after): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([LEpaComment], [LEpaComment]) -> String
forall a. Data a => a -> String
showAst ([LEpaComment]
before, [LEpaComment]
after)
  let matches' :: [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches' = case [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches of
                    (L SrcSpanAnnA
lm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m':[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms') ->
                      (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
lm' ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
middle )) Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m'LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms')
                    [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> String
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. HasCallStack => String -> a
error String
"balanceCommentsFB"
  [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches'' <- [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> TransformT
     m
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall (m :: * -> *) a.
Monad m =>
[LocatedA a] -> TransformT m [LocatedA a]
balanceCommentsList' [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches'
  let (LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m,[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms) = case [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches'' of
                 (L SrcSpanAnnA
lm' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m':[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms') ->
                   (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
lm' ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
after)) Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m',[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms')
                 [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ -> String
-> (LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
    [LocatedAn
       AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a. HasCallStack => String -> a
error String
"balanceCommentsFB"
  (LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m',LocatedA b
second') <- LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedA b
-> TransformT
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
      LocatedA b)
forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceComments' LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m LocatedA b
second
  LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m'' <- LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceCommentsMatch LMatch GhcPs (LHsExpr GhcPs)
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m'
  let (LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m''',SrcSpanAnnA
lf'') = case [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms of
        [] -> LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpanAnnA
-> (LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
    SrcSpanAnnA)
forall t u a.
(Data t, Data u, Monoid t, Monoid u) =>
LocatedAn t a -> SrcAnn u -> (LocatedAn t a, SrcAnn u)
moveLeadingComments LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m'' SrcSpanAnnA
lf'
        [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_  -> (LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m'',SrcSpanAnnA
lf')
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsMatch done"
  GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> LocatedA b
-> TransformT
     m (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs), LocatedA b)
forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceComments' (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 (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))
o (SrcSpanAnnL
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lm ([LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse (LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m'''LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms)))))) LocatedA b
second'
balanceCommentsFB LHsBind GhcPs
f LocatedA b
s = GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> LocatedA b
-> TransformT
     m (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs), LocatedA b)
forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceComments' LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
f LocatedA b
s

-- | Move comments on the same line as the end of the match into the
-- GRHS, prior to the binds
balanceCommentsMatch :: (Monad m)
  => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceCommentsMatch :: forall (m :: * -> *).
Monad m =>
LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceCommentsMatch (L SrcSpanAnnA
l (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
am HsMatchContext GhcPs
mctxt [LPat GhcPs]
pats (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xg [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
binds))) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsMatch: (logInfo)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (EpAnnComments, SrcSpanAnnA) -> String
forall a. Data a => a -> String
showAst ((EpAnnComments, SrcSpanAnnA)
logInfo)
  LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l'' (XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext GhcPs
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
am HsMatchContext GhcPs
mctxt [LPat GhcPs]
pats (XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xg [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (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
    (SrcSpanAnn EpAnn AnnListItem
an1 SrcSpan
_loc1) = SrcSpanAnnA
l
    anc1 :: EpAnnComments
anc1 = EpAnnComments -> EpAnnComments
addCommentOrigDeltas (EpAnnComments -> EpAnnComments) -> EpAnnComments -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ EpAnn AnnListItem -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments EpAnn AnnListItem
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
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss', HsLocalBinds GhcPs
binds', (EpAnnComments, SrcSpanAnnA)
logInfo)
      = case [GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss of
          [] -> (SrcSpanAnnA
l, [], HsLocalBinds GhcPs
binds,                 ([LEpaComment] -> EpAnnComments
EpaComments [], EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnListItem
forall ann. EpAnn ann
EpAnnNotUsed SrcSpan
noSrcSpan))
          (L SrcSpanAnn' (EpAnn NoEpAnns)
lg g :: GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g@(GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
EpAnnNotUsed [GuardLStmt GhcPs]
_grs GenLocated SrcSpanAnnA (HsExpr GhcPs)
_rhs):[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs)
            -> (SrcSpanAnnA
l, [GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse (SrcSpanAnn' (EpAnn NoEpAnns)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     (SrcSpanAnn' (EpAnn NoEpAnns))
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn NoEpAnns)
lg GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
gGenLocated
  (SrcSpanAnn' (EpAnn NoEpAnns))
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs), HsLocalBinds GhcPs
binds, ([LEpaComment] -> EpAnnComments
EpaComments [], EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnListItem
forall ann. EpAnn ann
EpAnnNotUsed SrcSpan
noSrcSpan))
          (L SrcSpanAnn' (EpAnn NoEpAnns)
lg (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ag [GuardLStmt GhcPs]
grs GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs):[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (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. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
setCommentsSrcAnn 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 Anchor
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
$ SrcSpanAnn' (EpAnn NoEpAnns) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn NoEpAnns)
lg) (EpAnnComments -> EpAnnComments) -> EpAnnComments -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> EpAnnComments
addCommentOrigDeltas EpAnnComments
lgc
              ag' :: EpAnn GrhsAnn
ag' = if Bool
moved
                      then Anchor -> GrhsAnn -> EpAnnComments -> EpAnn GrhsAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc GrhsAnn
an EpAnnComments
lgc'
                      else Anchor -> GrhsAnn -> EpAnnComments -> EpAnn GrhsAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc GrhsAnn
an (EpAnnComments
lgc' EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
<> ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [] [LEpaComment]
move))
              -- ag' = EpAnn anc an lgc'

            in (SrcSpanAnnA
an1', ([GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([GenLocated
    (SrcSpanAnn' (EpAnn NoEpAnns))
    (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       (SrcSpanAnn' (EpAnn NoEpAnns))
       (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (SrcSpanAnn' (EpAnn NoEpAnns)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     (SrcSpanAnn' (EpAnn NoEpAnns))
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn NoEpAnns)
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
  (SrcSpanAnn' (EpAnn NoEpAnns))
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (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
EpAnn AnnList
an' HsValBindsLR GhcPs GhcPs
vb)
  where
    ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls, Int
_, [String]
_ws1) = Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], Int, [String])
forall a. Transform a -> (a, Int, [String])
runTransform (HsLocalBinds GhcPs -> TransformT Identity [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
lb)
    (EpAnn AnnList
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
      [] -> (SrcSpan -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList
forall a.
Monoid a =>
SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
addCommentsToEpAnn (HsLocalBinds GhcPs -> SrcSpan
forall (p :: Pass). HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds GhcPs
lb) XHsValBinds GhcPs GhcPs
EpAnn AnnList
an EpAnnComments
cs, [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls)
      (L SrcSpanAnnA
la HsDecl GhcPs
d:[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds) -> (XHsValBinds GhcPs GhcPs
EpAnn AnnList
an, SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
la EpAnnComments
cs) HsDecl GhcPs
dGenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds)
    (HsValBindsLR GhcPs GhcPs
vb,[String]
_ws2) = case Transform (HsLocalBinds GhcPs)
-> (HsLocalBinds GhcPs, Int, [String])
forall a. Transform a -> (a, Int, [String])
runTransform (WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> Transform (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
w HsLocalBinds GhcPs
lb ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls')) of
      ((HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
vb'), Int
_, [String]
ws2') -> (HsValBindsLR GhcPs GhcPs
vb', [String]
ws2')
      (HsLocalBinds GhcPs, Int, [String])
_ -> (XValBinds GhcPs GhcPs
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
AnnSortKey
NoAnnSortKey LHsBindsLR GhcPs GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. Bag a
emptyBag [], [])


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

-- |Prior to moving an AST element, make sure any trailing comments belonging to
-- it are attached to it, and not the following element. Of necessity this is a
-- heuristic process, to be tuned later. Possibly a variant should be provided
-- with a passed-in decision function.
-- The initial situation is that all comments for a given anchor appear as prior comments
-- Many of these should in fact be following comments for the previous anchor
balanceComments' :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceComments' :: forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)
balanceComments' LocatedA a
la1 LocatedA b
la2 = 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
"balanceComments': (loc1,loc2)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (((Int, Int), (Int, Int)), ((Int, Int), (Int, Int))) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan -> ((Int, Int), (Int, Int))
ss2range SrcSpan
loc1,SrcSpan -> ((Int, Int), (Int, Int))
ss2range SrcSpan
loc2)
  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
"balanceComments': (anc1)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ EpAnnComments -> String
forall a. Data a => a -> String
showAst (EpAnnComments
anc1)
  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
"balanceComments': (cs1s)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ EpAnnComments -> String
forall a. Data a => a -> String
showAst (EpAnnComments
cs1s)
  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
"balanceComments': (cs1stay,cs1move)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(Int, LEpaComment)], [(Int, LEpaComment)]) -> String
forall a. Data a => a -> String
showAst ([(Int, LEpaComment)]
cs1stay,[(Int, LEpaComment)]
cs1move)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceComments': (an1',an2')=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SrcSpanAnnA, SrcSpanAnnA) -> String
forall a. Data a => a -> String
showAst (SrcSpanAnnA
an1',SrcSpanAnnA
an2')
  (LocatedA a, LocatedA b) -> TransformT m (LocatedA a, LocatedA b)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedA a
la1', LocatedA b
la2')
  where
    simpleBreak :: a -> (a, b) -> Bool
simpleBreak a
n (a
r,b
_) = a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
n
    L (SrcSpanAnn EpAnn AnnListItem
an1 SrcSpan
loc1) a
f = LocatedA a
la1
    L (SrcSpanAnn EpAnn AnnListItem
an2 SrcSpan
loc2) b
s = LocatedA b
la2
    anc1 :: EpAnnComments
anc1 = EpAnnComments -> EpAnnComments
addCommentOrigDeltas (EpAnnComments -> EpAnnComments) -> EpAnnComments -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ EpAnn AnnListItem -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments EpAnn AnnListItem
an1
    anc2 :: EpAnnComments
anc2 = EpAnnComments -> EpAnnComments
addCommentOrigDeltas (EpAnnComments -> EpAnnComments) -> EpAnnComments -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ EpAnn AnnListItem -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments EpAnn AnnListItem
an2

    cs1s :: EpAnnComments
cs1s = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd (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) (EpAnnComments -> [LEpaComment]
priorComments        EpAnnComments
cs1s)
    cs1f :: [(Int, LEpaComment)]
cs1f = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (LocatedA a -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA a
la1) (EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs1s)

    cs2s :: EpAnnComments
cs2s = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd (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) (EpAnnComments -> [LEpaComment]
priorComments        EpAnnComments
cs2s)
    cs2f :: [(Int, LEpaComment)]
cs2f = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (LocatedA b -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA b
la2) (EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cs2s)

    -- Split cs1f 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)]
cs1f

    ([(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)]
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
$ ((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. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
setCommentsSrcAnn (LocatedA a -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedA a
la1) ([LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced (((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. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
setCommentsSrcAnn (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
anc (la :: LEpaComment
la@(L Anchor
l EpaComment
_):[LEpaComment]
las)
  = RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
forall {e}.
RealSrcSpan -> GenLocated Anchor e -> (Int, GenLocated Anchor e)
deltaComment RealSrcSpan
anc LEpaComment
la (Int, LEpaComment) -> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
trailingCommentsDeltas (Anchor -> RealSrcSpan
anchor Anchor
l) [LEpaComment]
las
  where
    deltaComment :: RealSrcSpan -> GenLocated Anchor e -> (Int, GenLocated Anchor e)
deltaComment RealSrcSpan
anc' (L Anchor
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), Anchor -> e -> GenLocated Anchor e
forall l e. l -> e -> GenLocated l e
L Anchor
loc e
c)
      where
        (Int
al,Int
_) = RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
anc'
        (Int
ll,Int
_) = RealSrcSpan -> (Int, Int)
ss2pos (Anchor -> RealSrcSpan
anchor Anchor
loc)

-- AZ:TODO: this is identical to commentsDeltas
priorCommentsDeltas :: RealSrcSpan -> [LEpaComment]
                    -> [(Int, LEpaComment)]
priorCommentsDeltas :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
priorCommentsDeltas RealSrcSpan
anc [LEpaComment]
cs = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go RealSrcSpan
anc ([LEpaComment] -> [LEpaComment]
forall a. [a] -> [a]
reverse ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment] -> [LEpaComment]
sortEpaComments [LEpaComment]
cs)
  where
    go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
    go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go RealSrcSpan
_ [] = []
    go RealSrcSpan
anc' (la :: LEpaComment
la@(L Anchor
l EpaComment
_):[LEpaComment]
las) = RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
deltaComment RealSrcSpan
anc' LEpaComment
la (Int, LEpaComment) -> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go (Anchor -> RealSrcSpan
anchor Anchor
l) [LEpaComment]
las

    deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
    deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
deltaComment RealSrcSpan
anc' (L Anchor
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), Anchor -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L Anchor
loc EpaComment
c)
      where
        (Int
al,Int
_) = RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
anc'
        (Int
ll,Int
_) = RealSrcSpan -> (Int, Int)
ss2pos (Anchor -> RealSrcSpan
anchor Anchor
loc)


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

-- | Split comments into ones occuring 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 Anchor e -> Bool
cmp (L (Anchor RealSrcSpan
l AnchorOperation
_) 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
    ([LEpaComment]
before, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {e}. GenLocated Anchor 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 Anchor e -> Bool
cmp (L (Anchor RealSrcSpan
l AnchorOperation
_) 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
    ([LEpaComment]
before, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {e}. GenLocated Anchor 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 occuring 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 Anchor e -> Bool
cmp (L (Anchor RealSrcSpan
l AnchorOperation
_) 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
    ([LEpaComment]
before, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {e}. GenLocated Anchor 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 Anchor e -> Bool
cmp (L (Anchor RealSrcSpan
l AnchorOperation
_) 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
    ([LEpaComment]
before, [LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LEpaComment -> Bool
forall {e}. GenLocated Anchor 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, Monoid t, Monoid u)
  => LocatedAn t a -> SrcAnn u -> (LocatedAn t a, SrcAnn u)
moveLeadingComments :: forall t u a.
(Data t, Data u, Monoid t, Monoid u) =>
LocatedAn t a -> SrcAnn u -> (LocatedAn t a, SrcAnn u)
moveLeadingComments from :: LocatedAn t a
from@(L (SrcSpanAnn EpAnn t
EpAnnNotUsed SrcSpan
_) a
_) SrcAnn u
to = (LocatedAn t a
from, SrcAnn u
to)
moveLeadingComments (L SrcAnn t
la a
a) SrcAnn u
lb = (SrcAnn t -> a -> LocatedAn t a
forall l e. l -> e -> GenLocated l e
L SrcAnn t
la' a
a, SrcAnn u
lb')
  (LocatedAn t a, SrcAnn u) -> String -> (LocatedAn t a, SrcAnn u)
forall c. c -> String -> c
`debug` (String
"moveLeadingComments: (before, after, la', lb'):" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([LEpaComment], [LEpaComment], SrcAnn t, SrcAnn u) -> String
forall a. Data a => a -> String
showAst ([LEpaComment]
before, [LEpaComment]
after, SrcAnn t
la', SrcAnn u
lb'))
  where
    split :: EpAnnComments
split = RealSrcSpan -> EpAnnComments -> EpAnnComments
splitCommentsEnd (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcAnn t -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn t
la) (EpAnn t -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments (EpAnn t -> EpAnnComments) -> EpAnn t -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ SrcAnn t -> EpAnn t
forall a. SrcSpanAnn' a -> a
ann SrcAnn 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' :: SrcAnn t
la' = SrcAnn t -> EpAnnComments -> SrcAnn t
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
setCommentsSrcAnn SrcAnn t
la ([LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
after)
    lb' :: SrcAnn u
lb' = SrcAnn u -> EpAnnComments -> SrcAnn u
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcAnn 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 a
EpAnnNotUsed   = EpAnn a
forall ann. EpAnn ann
EpAnnNotUsed
addCommentOrigDeltasAnn (EpAnn Anchor
e a
a EpAnnComments
cs) = Anchor -> a -> EpAnnComments -> EpAnn a
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
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 (SrcSpanAnn EpAnn AnnListItem
an SrcSpan
loc) a
_)
  = case EpAnn AnnListItem
an of
      EpAnn AnnListItem
EpAnnNotUsed    -> SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
loc
      (EpAnn Anchor
anc AnnListItem
_ EpAnnComments
_) -> Anchor -> RealSrcSpan
anchor Anchor
anc

-- | A GHC comment includes the span of the preceding token.  Take an
-- original comment, and convert the 'Anchor to have a have a
-- `MovedAnchor` operation based on the original location, only if it
-- does not already have one.
commentOrigDelta :: LEpaComment -> LEpaComment
commentOrigDelta :: LEpaComment -> LEpaComment
commentOrigDelta (L (GHC.Anchor RealSrcSpan
la AnchorOperation
_) (GHC.EpaComment EpaCommentTok
t RealSrcSpan
pp))
  = (Anchor -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> AnchorOperation -> Anchor
GHC.Anchor RealSrcSpan
la AnchorOperation
op) (EpaCommentTok -> RealSrcSpan -> EpaComment
GHC.EpaComment EpaCommentTok
t RealSrcSpan
pp))
                  LEpaComment -> String -> LEpaComment
forall c. c -> String -> c
`debug` (String
"commentOrigDelta: (la, pp, r,c, op)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (RealSrcSpan, RealSrcSpan, Int, Int, AnchorOperation) -> String
forall a. Data a => a -> String
showAst (RealSrcSpan
la, RealSrcSpan
pp, Int
r,Int
c, AnchorOperation
op))
  where
        (Int
r,Int
c) = RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
pp

        op' :: AnchorOperation
op' = if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
               then DeltaPos -> AnchorOperation
MovedAnchor ((Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (Int
r,Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RealSrcSpan
la)
               -- then MovedAnchor (ss2delta (r,c+0) la)
               -- else MovedAnchor (ss2delta (r,c)   la)
               else DeltaPos -> AnchorOperation
MovedAnchor (DeltaPos -> DeltaPos
tweakDelta (DeltaPos -> DeltaPos) -> DeltaPos -> DeltaPos
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (Int
r,Int
c)   RealSrcSpan
la)
        op :: AnchorOperation
op = if EpaCommentTok
t EpaCommentTok -> EpaCommentTok -> Bool
forall a. Eq a => a -> a -> Bool
== EpaCommentTok
EpaEofComment Bool -> Bool -> Bool
&& AnchorOperation
op' AnchorOperation -> AnchorOperation -> Bool
forall a. Eq a => a -> a -> Bool
== DeltaPos -> AnchorOperation
MovedAnchor (Int -> DeltaPos
SameLine Int
0)
               then DeltaPos -> AnchorOperation
MovedAnchor (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
0)
               else AnchorOperation
op'

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


-- | For comment-related deltas starting on a new line we have an
-- off-by-one problem. Adjust
tweakDelta :: DeltaPos  -> DeltaPos
tweakDelta :: DeltaPos -> DeltaPos
tweakDelta (SameLine Int
d) = Int -> DeltaPos
SameLine Int
d
tweakDelta (DifferentLine Int
l Int
d) = Int -> Int -> DeltaPos
DifferentLine Int
l (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

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

balanceSameLineComments :: (Monad m)
  => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceSameLineComments :: forall (m :: * -> *).
Monad m =>
LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceSameLineComments (L SrcSpanAnnA
la (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
anm HsMatchContext GhcPs
mctxt [LPat GhcPs]
pats (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
lb))) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceSameLineComments: (la)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Int, Int), (Int, Int)) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan -> ((Int, Int), (Int, Int))
ss2range (SrcSpan -> ((Int, Int), (Int, Int)))
-> SrcSpan -> ((Int, Int), (Int, Int))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
la)
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceSameLineComments: [logInfo]=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(EpAnnComments, ([LEpaComment], [LEpaComment]))] -> String
forall a. Data a => a -> String
showAst [(EpAnnComments, ([LEpaComment], [LEpaComment]))]
logInfo
  LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
la' (XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext GhcPs
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
anm HsMatchContext GhcPs
mctxt [LPat GhcPs]
pats (XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (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
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss', [(EpAnnComments, ([LEpaComment], [LEpaComment]))]
logInfo) = case [GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss of
      [] -> (SrcSpanAnnA
la,[LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss,[])
      (L SrcSpanAnn' (EpAnn NoEpAnns)
lg g :: GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g@(GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
EpAnnNotUsed [GuardLStmt GhcPs]
_gs GenLocated SrcSpanAnnA (HsExpr GhcPs)
_rhs):[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs) -> (SrcSpanAnnA
la,[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([GenLocated
    (SrcSpanAnn' (EpAnn NoEpAnns))
    (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       (SrcSpanAnn' (EpAnn NoEpAnns))
       (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (SrcSpanAnn' (EpAnn NoEpAnns)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     (SrcSpanAnn' (EpAnn NoEpAnns))
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn NoEpAnns)
lg GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g)GenLocated
  (SrcSpanAnn' (EpAnn NoEpAnns))
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs,[])
      (L SrcSpanAnn' (EpAnn NoEpAnns)
lg (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ga [GuardLStmt GhcPs]
gs GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs):[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs) -> (SrcSpanAnnA
la'',[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([GenLocated
    (SrcSpanAnn' (EpAnn NoEpAnns))
    (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       (SrcSpanAnn' (EpAnn NoEpAnns))
       (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (SrcSpanAnn' (EpAnn NoEpAnns)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     (SrcSpanAnn' (EpAnn NoEpAnns))
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn NoEpAnns)
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
  (SrcSpanAnn' (EpAnn NoEpAnns))
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (SrcSpanAnn' (EpAnn NoEpAnns))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs,[(EpAnnComments
gac,([LEpaComment]
csp,[LEpaComment]
csf))])
        where
          (SrcSpanAnn EpAnn AnnListItem
an1 SrcSpan
_loc1) = SrcSpanAnnA
la
          anc1 :: EpAnnComments
anc1 = EpAnnComments -> EpAnnComments
addCommentOrigDeltas (EpAnnComments -> EpAnnComments) -> EpAnnComments -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ EpAnn AnnListItem -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments EpAnn AnnListItem
an1
          (EpAnn Anchor
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 (Anchor -> RealSrcSpan
anchor Anchor
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 = EpAnnComments -> EpAnnComments
addCommentOrigDeltas (EpAnnComments -> EpAnnComments) -> EpAnnComments -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ EpAnn GrhsAnn -> EpAnnComments
forall an. EpAnn an -> 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' = (Anchor -> GrhsAnn -> EpAnnComments -> EpAnn GrhsAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc GrhsAnn
an EpAnnComments
gac')

          an1' :: SrcSpanAnnA
an1' = SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
setCommentsSrcAnn SrcSpanAnnA
la EpAnnComments
cs1
          la'' :: SrcSpanAnnA
la'' = SrcSpanAnnA
an1'

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

anchorEof :: ParsedSource -> ParsedSource
anchorEof :: ParsedSource -> ParsedSource
anchorEof (L SrcSpan
l m :: HsModule GhcPs
m@(HsModule (XModulePs EpAnn AnnsModule
an LayoutInfo GhcPs
_lo Maybe (LocatedP (WarningTxt 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

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

commentsOrigDeltasDecl :: LHsDecl GhcPs -> LHsDecl GhcPs
commentsOrigDeltasDecl :: LHsDecl GhcPs -> LHsDecl GhcPs
commentsOrigDeltasDecl (L (SrcSpanAnn EpAnn AnnListItem
an SrcSpan
l) HsDecl GhcPs
d) = SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnListItem
an' SrcSpan
l) HsDecl GhcPs
d
  where
    an' :: EpAnn AnnListItem
an' = EpAnn AnnListItem -> EpAnn AnnListItem
forall a. EpAnn a -> EpAnn a
addCommentOrigDeltasAnn EpAnn AnnListItem
an

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

-- | Create a @SrcSpanAnn@ with a @MovedAnchor@ operation using the
-- given @DeltaPos@.
noAnnSrcSpanDP :: (Monoid ann) => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP :: forall ann.
Monoid ann =>
SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP SrcSpan
l DeltaPos
dp
  = EpAnn ann -> SrcSpan -> SrcSpanAnn' (EpAnn ann)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> ann -> EpAnnComments -> EpAnn ann
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)) ann
forall a. Monoid a => a
mempty EpAnnComments
emptyComments) SrcSpan
l

noAnnSrcSpanDP0 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP0 :: forall ann. Monoid ann => SrcSpan -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP0 SrcSpan
l = SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
forall ann.
Monoid ann =>
SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP SrcSpan
l (Int -> DeltaPos
SameLine Int
0)

noAnnSrcSpanDP1 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP1 :: forall ann. Monoid ann => SrcSpan -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP1 SrcSpan
l = SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
forall ann.
Monoid ann =>
SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP SrcSpan
l (Int -> DeltaPos
SameLine Int
1)

noAnnSrcSpanDPn :: (Monoid ann) => SrcSpan -> Int -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDPn :: forall ann. Monoid ann => SrcSpan -> Int -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDPn SrcSpan
l Int
s = SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
forall ann.
Monoid ann =>
SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP SrcSpan
l (Int -> DeltaPos
SameLine Int
s)

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

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

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

m0 :: AnchorOperation
m0 :: AnchorOperation
m0 = DeltaPos -> AnchorOperation
MovedAnchor (DeltaPos -> AnchorOperation) -> DeltaPos -> AnchorOperation
forall a b. (a -> b) -> a -> b
$ Int -> DeltaPos
SameLine Int
0

m1 :: AnchorOperation
m1 :: AnchorOperation
m1 = DeltaPos -> AnchorOperation
MovedAnchor (DeltaPos -> AnchorOperation) -> DeltaPos -> AnchorOperation
forall a b. (a -> b) -> a -> b
$ Int -> DeltaPos
SameLine Int
1

mn :: Int -> AnchorOperation
mn :: Int -> AnchorOperation
mn Int
n = DeltaPos -> AnchorOperation
MovedAnchor (DeltaPos -> AnchorOperation) -> DeltaPos -> AnchorOperation
forall a b. (a -> b) -> a -> b
$ Int -> DeltaPos
SameLine Int
n

addComma :: SrcSpanAnnA -> SrcSpanAnnA
addComma :: SrcSpanAnnA -> SrcSpanAnnA
addComma (SrcSpanAnn EpAnn AnnListItem
EpAnnNotUsed SrcSpan
l)
  = (EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnListItem -> EpAnnComments -> EpAnn AnnListItem
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
l) ([TrailingAnn] -> AnnListItem
AnnListItem [EpaLocation -> TrailingAnn
AddCommaAnn EpaLocation
d0]) EpAnnComments
emptyComments) SrcSpan
l)
addComma (SrcSpanAnn (EpAnn Anchor
anc (AnnListItem [TrailingAnn]
as) EpAnnComments
cs) SrcSpan
l)
  = (EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnListItem -> EpAnnComments -> EpAnn AnnListItem
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc ([TrailingAnn] -> AnnListItem
AnnListItem (EpaLocation -> TrailingAnn
AddCommaAnn EpaLocation
d0TrailingAnn -> [TrailingAnn] -> [TrailingAnn]
forall a. a -> [a] -> [a]
:[TrailingAnn]
as)) EpAnnComments
cs) SrcSpan
l)

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

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

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

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

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

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

-- |Provide a means to get and process the immediate child declartions of a
-- given AST element.
class (Data t) => HasDecls t where
-- ++AZ++: TODO: add tests to confirm that hsDecls followed by replaceDecls is idempotent

    -- | Return the 'HsDecl's that are directly enclosed in the
    -- given syntax phrase. They are always returned in the wrapped 'HsDecl'
    -- form, even if orginating in local decls. This is safe, as annotations
    -- never attach to the wrapper, only to the wrapped item.
    hsDecls :: (Monad m) => t -> TransformT m [LHsDecl GhcPs]

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

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

instance HasDecls ParsedSource where
  hsDecls :: forall (m :: * -> *).
Monad m =>
ParsedSource -> TransformT m [LHsDecl GhcPs]
hsDecls (L SrcSpan
_ (HsModule (XModulePs EpAnn AnnsModule
_ LayoutInfo GhcPs
_lo Maybe (LocatedP (WarningTxt GhcPs))
_ Maybe (LHsDoc GhcPs)
_) Maybe (XRec GhcPs ModuleName)
_mn Maybe (XRec GhcPs [LIE GhcPs])
_exps [LImportDecl GhcPs]
_imps [LHsDecl GhcPs]
decls)) = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
  replaceDecls :: forall (m :: * -> *).
Monad m =>
ParsedSource -> [LHsDecl GhcPs] -> TransformT m ParsedSource
replaceDecls (L SrcSpan
l (HsModule (XModulePs EpAnn AnnsModule
a LayoutInfo GhcPs
lo Maybe (LocatedP (WarningTxt GhcPs))
deps Maybe (LHsDoc GhcPs)
haddocks) Maybe (XRec GhcPs ModuleName)
mname Maybe (XRec GhcPs [LIE GhcPs])
exps [LImportDecl GhcPs]
imps [LHsDecl GhcPs]
_decls)) [LHsDecl GhcPs]
decls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LHsModule"
        -- modifyAnnsT (captureOrder m decls)
        ParsedSource -> TransformT m ParsedSource
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XCModule GhcPs
-> Maybe (XRec GhcPs ModuleName)
-> Maybe (XRec GhcPs [LIE GhcPs])
-> [LImportDecl GhcPs]
-> [LHsDecl GhcPs]
-> HsModule GhcPs
forall p.
XCModule p
-> Maybe (XRec p ModuleName)
-> Maybe (XRec p [LIE p])
-> [LImportDecl p]
-> [LHsDecl p]
-> HsModule p
HsModule (EpAnn AnnsModule
-> LayoutInfo GhcPs
-> Maybe (LocatedP (WarningTxt GhcPs))
-> Maybe (LHsDoc GhcPs)
-> XModulePs
XModulePs EpAnn AnnsModule
a LayoutInfo GhcPs
lo Maybe (LocatedP (WarningTxt 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 (Match GhcPs (LocatedA (HsExpr GhcPs)))) where
  hsDecls :: forall (m :: * -> *).
Monad m =>
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [LHsDecl GhcPs]
hsDecls (L SrcSpanAnnA
_ (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsMatchContext GhcPs
_ [LPat GhcPs]
_ (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
_ HsLocalBinds GhcPs
lb))) = HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
lb

  replaceDecls :: forall (m :: * -> *).
Monad m =>
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
replaceDecls (L SrcSpanAnnA
l (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext GhcPs
c [LPat GhcPs]
p (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
binds))) []
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LMatch empty decls"
        HsLocalBinds GhcPs
binds'' <- WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
WithoutWhere HsLocalBinds GhcPs
binds []
        LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext GhcPs
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext GhcPs
c [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 :: LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m@(L SrcSpanAnnA
l (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext GhcPs
c [LPat GhcPs]
p (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
binds))) [LHsDecl GhcPs]
newBinds
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LMatch nonempty decls"
        -- Need to throw in a fresh where clause if the binds were empty,
        -- in the annotations.
        (SrcSpanAnnA
l', [GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs') <- case HsLocalBinds GhcPs
binds of
          EmptyLocalBinds{} -> do
            String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"replaceDecls LMatch empty binds"

            String
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m ()
forall (m :: * -> *) a.
(Monad m, Data a) =>
String -> a -> TransformT m ()
logDataWithAnnsTr String
"Match.replaceDecls:balancing comments:m" LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m
            L SrcSpanAnnA
l' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m' <- LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
balanceSameLineComments LMatch GhcPs (LHsExpr GhcPs)
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m
            String
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m ()
forall (m :: * -> *) a.
(Monad m, Data a) =>
String -> a -> TransformT m ()
logDataWithAnnsTr String
"Match.replaceDecls:(m1')" (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m')
            (SrcSpanAnnA,
 [GenLocated
    (SrcSpanAnn' (EpAnn NoEpAnns))
    (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> TransformT
     m
     (SrcSpanAnnA,
      [GenLocated
         (SrcSpanAnn' (EpAnn NoEpAnns))
         (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
l', 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,
 [GenLocated
    (SrcSpanAnn' (EpAnn NoEpAnns))
    (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> TransformT
     m
     (SrcSpanAnnA,
      [GenLocated
         (SrcSpanAnn' (EpAnn NoEpAnns))
         (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
l, [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs)
        HsLocalBinds GhcPs
binds'' <- WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
WithWhere HsLocalBinds GhcPs
binds [LHsDecl GhcPs]
newBinds
        String -> HsLocalBinds GhcPs -> TransformT m ()
forall (m :: * -> *) a.
(Monad m, Data a) =>
String -> a -> TransformT m ()
logDataWithAnnsTr String
"Match.replaceDecls:binds'" HsLocalBinds GhcPs
binds''
        LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' (XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext GhcPs
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext GhcPs
c [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
   (SrcSpanAnn' (EpAnn NoEpAnns))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rhs' HsLocalBinds GhcPs
binds'')))

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

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

  replaceDecls :: forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls (L SrcSpanAnnA
ll (HsLet XLet GhcPs
x LHsToken "let" GhcPs
tkLet HsLocalBinds GhcPs
binds LHsToken "in" GhcPs
tkIn LHsExpr GhcPs
ex)) [LHsDecl GhcPs]
newDecls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsLet"
        let lastAnc :: RealSrcSpan
lastAnc = SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> SrcSpan
forall (p :: Pass). HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds GhcPs
binds
        -- TODO: may be an intervening comment, take account for lastAnc
        let (GenLocated TokenLocation (HsToken "let")
tkLet', GenLocated TokenLocation (HsToken "in")
tkIn', GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex',[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls') = case (LHsToken "let" GhcPs
GenLocated TokenLocation (HsToken "let")
tkLet, LHsToken "in" GhcPs
GenLocated TokenLocation (HsToken "in")
tkIn) of
              (L (TokenLoc EpaLocation
l) HsToken "let"
ls, L (TokenLoc EpaLocation
i) HsToken "in"
is) ->
                let
                  off :: LayoutStartCol
off = case EpaLocation
l of
                          (EpaSpan 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
                          (EpaDelta (SameLine Int
_) [LEpaComment]
_) -> Int -> LayoutStartCol
LayoutStartCol Int
0
                          (EpaDelta (DifferentLine Int
_ Int
c) [LEpaComment]
_) -> Int -> LayoutStartCol
LayoutStartCol Int
c
                  ex'' :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex'' = LayoutStartCol
-> EpaLocation
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall t. LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t
setEntryDPFromAnchor LayoutStartCol
off EpaLocation
i LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex
                  newDecls'' :: [LHsDecl GhcPs]
newDecls'' = case [LHsDecl GhcPs]
newDecls of
                    [] -> [LHsDecl GhcPs]
newDecls
                    (LHsDecl GhcPs
d:[LHsDecl GhcPs]
ds) -> LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs
setEntryDPDecl LHsDecl GhcPs
d (Int -> DeltaPos
SameLine Int
0) GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds
                -- in ( EpAnn a (AnnsLet l (addEpaLocationDelta off lastAnc i)) cs
                in ( TokenLocation
-> HsToken "let" -> GenLocated TokenLocation (HsToken "let")
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc EpaLocation
l) HsToken "let"
ls
                   , TokenLocation
-> HsToken "in" -> GenLocated TokenLocation (HsToken "in")
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta LayoutStartCol
off RealSrcSpan
lastAnc EpaLocation
i)) HsToken "in"
is
                   , GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex''
                   , [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls'')
              (GenLocated TokenLocation (HsToken "let")
_,GenLocated TokenLocation (HsToken "in")
_) -> (LHsToken "let" GhcPs
GenLocated TokenLocation (HsToken "let")
tkLet, LHsToken "in" GhcPs
GenLocated TokenLocation (HsToken "in")
tkIn, LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex, [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls)
        HsLocalBinds GhcPs
binds' <- WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
WithoutWhere HsLocalBinds GhcPs
binds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls'
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ll (XLet GhcPs
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LHsToken "in" GhcPs
-> LHsExpr GhcPs
-> HsExpr GhcPs
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet XLet GhcPs
x LHsToken "let" GhcPs
GenLocated TokenLocation (HsToken "let")
tkLet' HsLocalBinds GhcPs
binds' LHsToken "in" GhcPs
GenLocated TokenLocation (HsToken "in")
tkIn' 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 LHsToken "(" GhcPs
lpar LHsExpr GhcPs
e LHsToken ")" GhcPs
rpar)) [LHsDecl GhcPs]
newDecls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsPar"
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XPar GhcPs
-> LHsToken "(" GhcPs
-> LHsExpr GhcPs
-> LHsToken ")" GhcPs
-> HsExpr GhcPs
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcPs
x LHsToken "(" GhcPs
lpar LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' LHsToken ")" GhcPs
rpar))
  replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
old [LHsDecl GhcPs]
_new = String -> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. HasCallStack => String -> a
error (String -> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> String -> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ String
"replaceDecls (LHsExpr GhcPs) undefined for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
showGhc GenLocated SrcSpanAnnA (HsExpr GhcPs)
old

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

-- | Extract the immediate declarations for a 'PatBind' wrapped in a 'ValD'. This
-- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent
-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is
-- idempotent.
hsDeclsPatBindD :: (Monad m) => LHsDecl GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBindD :: forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBindD (L SrcSpanAnnA
l (ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
d)) = LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> TransformT m [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 -> TransformT m [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> TransformT m [LHsDecl GhcPs])
-> String -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ String
"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 :: (Monad m) => LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBind :: forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBind (L SrcSpanAnnA
_ (PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
_ (GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [LGRHS GhcPs (LHsExpr GhcPs)]
_grhs HsLocalBinds GhcPs
lb))) = HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
lb
hsDeclsPatBind LHsBind GhcPs
x = String -> TransformT m [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> TransformT m [LHsDecl GhcPs])
-> String -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ String
"hsDeclsPatBind called for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs) -> String
forall a. Outputable a => a -> String
showGhc LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
x

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

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

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

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

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

  replaceDecls :: forall (m :: * -> *).
Monad m =>
LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
replaceDecls (L SrcSpanAnnA
l (LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x HsLocalBinds GhcPs
lb)) [LHsDecl GhcPs]
newDecls
    = do
        HsLocalBinds GhcPs
lb'' <- WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
WithWhere
-> HsLocalBinds GhcPs
-> [LHsDecl GhcPs]
-> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds WithWhere
WithWhere HsLocalBinds GhcPs
lb [LHsDecl GhcPs]
newDecls
        LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
    = do
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
        LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
    = do
      GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
      LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
    = do
      GenLocated SrcSpanAnnA (HsExpr GhcPs)
e' <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [LHsDecl GhcPs]
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
      LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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)))
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x

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

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

-- |Look up the annotated order and sort the decls accordingly
-- TODO:AZ: this should be pure
orderedDecls :: (Monad m)
             => AnnSortKey -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
orderedDecls :: forall (m :: * -> *).
Monad m =>
AnnSortKey -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
orderedDecls AnnSortKey
sortKey [LHsDecl GhcPs]
decls = do
  case AnnSortKey
sortKey of
    AnnSortKey
NoAnnSortKey -> do
      -- return decls
      [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs])
-> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\GenLocated SrcSpanAnnA (HsDecl GhcPs)
a GenLocated SrcSpanAnnA (HsDecl GhcPs)
b -> RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsDecl GhcPs)
a) (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsDecl GhcPs)
b)) [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
    AnnSortKey [RealSrcSpan]
keys -> do
      let ds :: [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
ds = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> (RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (\GenLocated SrcSpanAnnA (HsDecl GhcPs)
s -> (SrcSpan -> RealSrcSpan
rs (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsDecl GhcPs)
s,GenLocated SrcSpanAnnA (HsDecl GhcPs)
s)) [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
          ordered :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ordered = ((RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a, b) -> b
snd ([(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [RealSrcSpan]
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. [(RealSrcSpan, a)] -> [RealSrcSpan] -> [(RealSrcSpan, a)]
orderByKey [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
ds [RealSrcSpan]
keys
      [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ordered

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

hsDeclsValBinds :: (Monad m) => HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds :: forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
lb = case HsLocalBinds GhcPs
lb of
    HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
sortKey LHsBindsLR GhcPs GhcPs
bs [LSig GhcPs]
sigs) -> do
      let
        bds :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bds = (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LHsBind GhcPs -> LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
wrapDecl (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
bs)
        sds :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
sds = (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LSig GhcPs -> LHsDecl GhcPs
GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
wrapSig [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs
      AnnSortKey -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
AnnSortKey -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
orderedDecls XValBinds GhcPs GhcPs
AnnSortKey
sortKey ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bds [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
sds)
    HsValBinds XHsValBinds GhcPs GhcPs
_ (XValBindsLR XXValBindsLR GhcPs GhcPs
_) -> String -> TransformT m [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> TransformT m [LHsDecl GhcPs])
-> String -> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ String
"hsDecls.XValBindsLR not valid"
    HsIPBinds {}       -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    EmptyLocalBinds {} -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

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

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

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

newWhereAnnotation :: (Monad m) => WithWhere -> TransformT m (EpAnn AnnList)
newWhereAnnotation :: forall (m :: * -> *).
Monad m =>
WithWhere -> TransformT m (EpAnn AnnList)
newWhereAnnotation WithWhere
ww = do
  SrcSpan
newSpan <- TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
  let anc :: Anchor
anc  = RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
rs SrcSpan
newSpan) (DeltaPos -> AnchorOperation
MovedAnchor (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
2))
  let anc2 :: Anchor
anc2 = RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
rs SrcSpan
newSpan) (DeltaPos -> AnchorOperation
MovedAnchor (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
4))
  let w :: [AddEpAnn]
w = case WithWhere
ww of
        WithWhere
WithWhere -> [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnWhere (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])]
        WithWhere
WithoutWhere -> []
  let an :: EpAnn AnnList
an = Anchor -> AnnList -> EpAnnComments -> EpAnn AnnList
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc
                  (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just Anchor
anc2) Maybe AddEpAnn
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing [AddEpAnn]
w [])
                  EpAnnComments
emptyComments
  EpAnn AnnList -> TransformT m (EpAnn AnnList)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return EpAnn AnnList
an

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

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

-- |Modify a 'LHsBind' wrapped in a 'ValD'. For a 'PatBind' the
-- declarations are extracted and returned after modification. For a
-- 'FunBind' the supplied 'SrcSpan' is used to identify the specific
-- 'Match' to be transformed, for when there are multiple of them.
modifyValD :: forall m t. (HasTransform m)
                => SrcSpan
                -> Decl
                -> (PMatch -> [Decl] -> m ([Decl], Maybe t))
                -> m (Decl,Maybe t)
modifyValD :: forall (m :: * -> *) t.
HasTransform m =>
SrcSpan
-> LHsDecl GhcPs
-> (LMatch GhcPs (LHsExpr GhcPs)
    -> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t))
-> m (LHsDecl GhcPs, Maybe t)
modifyValD SrcSpan
p pb :: LHsDecl GhcPs
pb@(L SrcSpanAnnA
ss (ValD XValD GhcPs
_ (PatBind {} ))) LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t)
f =
  if (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
ss) SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
p
     then do
       [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds <- Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> TransformT Identity [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBindD LHsDecl GhcPs
pb
       ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds',Maybe t
r) <- LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t)
f (String
-> LocatedAn
     AnnListItem (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
       GenLocated SrcSpanAnnA (HsDecl GhcPs)
pb' <- Transform (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (Transform (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> m (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> Transform (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs
-> [LHsDecl GhcPs] -> TransformT Identity (LHsDecl GhcPs)
forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsDecl GhcPs)
replaceDeclsPatBindD LHsDecl GhcPs
pb [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds'
       (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsDecl GhcPs)
pb',Maybe t
r)
     else (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
pb,Maybe t
forall a. Maybe a
Nothing)
modifyValD SrcSpan
p LHsDecl GhcPs
ast LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t)
f = do
  (GenLocated SrcSpanAnnA (HsDecl GhcPs)
ast',Maybe t
r) <- StateT (Maybe t) m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> Maybe t -> m (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (GenericM (StateT (Maybe t) m) -> GenericM (StateT (Maybe t) m)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> StateT
      (Maybe t)
      m
      (LocatedAn
         AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> a -> StateT (Maybe t) m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM LMatch GhcPs (LHsExpr GhcPs)
-> StateT (Maybe t) m (LMatch GhcPs (LHsExpr GhcPs))
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> StateT
     (Maybe t)
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
doModLocal) LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
ast) Maybe t
forall a. Maybe a
Nothing
  (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs), Maybe t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsDecl GhcPs)
ast',Maybe t
r)
  where
    doModLocal :: PMatch -> StateT (Maybe t) m PMatch
    doModLocal :: LMatch GhcPs (LHsExpr GhcPs)
-> StateT (Maybe t) m (LMatch GhcPs (LHsExpr GhcPs))
doModLocal  (match :: LMatch GhcPs (LHsExpr GhcPs)
match@(L SrcSpanAnnA
ss Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_) :: PMatch) = do
         if (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
ss) SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
p
           then do
             [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds <- m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> StateT (Maybe t) m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) a. Monad m => m a -> StateT (Maybe t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> StateT (Maybe t) m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> StateT (Maybe t) m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT Identity [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [LHsDecl GhcPs]
hsDecls LMatch GhcPs (LHsExpr GhcPs)
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match
             ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds',Maybe t
r) <- m ([LHsDecl GhcPs], Maybe t)
-> StateT (Maybe t) m ([LHsDecl GhcPs], Maybe t)
forall (m :: * -> *) a. Monad m => m a -> StateT (Maybe t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([LHsDecl GhcPs], Maybe t)
 -> StateT (Maybe t) m ([LHsDecl GhcPs], Maybe t))
-> m ([LHsDecl GhcPs], Maybe t)
-> StateT (Maybe t) m ([LHsDecl GhcPs], Maybe t)
forall a b. (a -> b) -> a -> b
$ LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], Maybe t)
f LMatch GhcPs (LHsExpr GhcPs)
match [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds
             Maybe t -> StateT (Maybe t) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Maybe t
r
             LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match' <- m (LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> StateT
     (Maybe t)
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall (m :: * -> *) a. Monad m => m a -> StateT (Maybe t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
 -> StateT
      (Maybe t)
      m
      (LocatedAn
         AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> m (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> StateT
     (Maybe t)
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ Transform
  (LocatedAn
     AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> m (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (Transform
   (LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
 -> m (LocatedAn
         AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> Transform
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> m (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> Transform
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
replaceDecls LMatch GhcPs (LHsExpr GhcPs)
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ds'
             LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> StateT
     (Maybe t)
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> StateT (Maybe t) m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match'
           else LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> StateT
     (Maybe t)
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> StateT (Maybe t) m a
forall (m :: * -> *) a. Monad m => a -> m a
return LMatch GhcPs (LHsExpr GhcPs)
LocatedAn
  AnnListItem (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
  [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls <- Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ t -> TransformT Identity [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *). Monad m => t -> TransformT m [LHsDecl GhcPs]
hsDecls t
t
  [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls' <- [LHsDecl GhcPs] -> m [LHsDecl GhcPs]
action [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
  Transform t -> m t
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (Transform t -> m t) -> Transform t -> m t
forall a b. (a -> b) -> a -> b
$ t -> [LHsDecl GhcPs] -> Transform t
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
t -> [LHsDecl GhcPs] -> TransformT m t
replaceDecls t
t [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls'