{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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
        , getAnnsT, putAnnsT, modifyAnnsT
        , uniqueSrcSpanT

        , cloneT
        , graftT

        , getEntryDPT
        , setEntryDPT
        , transferEntryDPT
        , setPrecedingLinesDeclT
        , setPrecedingLinesT
        , addSimpleAnnT
        , addTrailingCommaT
        , removeTrailingCommaT

        -- ** Managing declarations, in Transform monad
        , HasTransform (..)
        , HasDecls (..)
        , hasDeclsSybTransform
        , hsDeclsGeneric
        , 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'
        , balanceTrailingComments
        , moveTrailingComments
        , anchorEof

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

        -- * Operations
        , isUniqueSrcSpan

        -- * Pure functions
        , mergeAnns
        , mergeAnnList
        , setPrecedingLinesDecl
        , setPrecedingLines
        , getEntryDP
        , setEntryDP
        , setEntryDP'
        , transferEntryDP
        , transferEntryDP'
        , addTrailingComma
        , wrapSig, wrapDecl
        , decl2Sig, decl2Bind
        , deltaAnchor
        ) where

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

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

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

import Data.Generics
-- import Data.Data
import Data.List (sort, sortBy, find)
import Data.Maybe

import qualified Data.Map as Map

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


------------------------------------------------------------------------------
-- 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] (Anns, Int) m a
unTransformT :: RWST () [String] (Anns,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
return :: forall a. a -> TransformT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> TransformT m a
>> :: 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 b
>>= :: forall a b.
TransformT m a -> (a -> TransformT m b) -> TransformT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> (a -> TransformT m b) -> TransformT m b
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
<* :: forall a b. TransformT m a -> TransformT m b -> TransformT m a
$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 b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
TransformT m a -> TransformT m b -> TransformT m b
liftA2 :: forall a b c.
(a -> b -> c) -> TransformT m a -> TransformT m b -> TransformT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TransformT m a -> TransformT m b -> TransformT m c
<*> :: forall a b.
TransformT m (a -> b) -> TransformT m a -> TransformT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
TransformT m (a -> b) -> TransformT m a -> TransformT m b
pure :: forall a. a -> TransformT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> 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
<$ :: forall a b. a -> TransformT m b -> TransformT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> TransformT m b -> TransformT m a
fmap :: forall a b. (a -> b) -> TransformT m a -> TransformT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TransformT m a -> TransformT m b
Functor
                         ,MonadReader ()
                         ,MonadWriter [String]
                         ,MonadState (Anns,Int)
                         ,(forall (m :: * -> *) a. Monad m => m a -> TransformT m a)
-> MonadTrans TransformT
forall (m :: * -> *) a. Monad m => m a -> TransformT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> TransformT m a
$clift :: 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] (Anns, Int) m a -> TransformT m a
forall (m :: * -> *) a.
RWST () [String] (Anns, Int) m a -> TransformT m a
TransformT (RWST () [String] (Anns, Int) m a -> TransformT m a)
-> RWST () [String] (Anns, Int) m a -> TransformT m a
forall a b. (a -> b) -> a -> b
$ (() -> (Anns, Int) -> m (a, (Anns, Int), [String]))
-> RWST () [String] (Anns, Int) m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((() -> (Anns, Int) -> m (a, (Anns, Int), [String]))
 -> RWST () [String] (Anns, Int) m a)
-> (() -> (Anns, Int) -> m (a, (Anns, Int), [String]))
-> RWST () [String] (Anns, Int) m a
forall a b. (a -> b) -> a -> b
$ \()
_ (Anns, Int)
_ -> String -> m (a, (Anns, Int), [String])
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 :: Anns -> Transform a -> (a,(Anns,Int),[String])
runTransform :: forall a. Anns -> Transform a -> (a, (Anns, Int), [String])
runTransform Anns
ans Transform a
f = Int -> Anns -> Transform a -> (a, (Anns, Int), [String])
forall a. Int -> Anns -> Transform a -> (a, (Anns, Int), [String])
runTransformFrom Int
0 Anns
ans Transform a
f

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

-- |Run a monad transformer stack for the 'TransformT' monad transformer
runTransformFromT :: Int -> Anns -> TransformT m a -> m (a,(Anns,Int),[String])
runTransformFromT :: forall (m :: * -> *) a.
Int -> Anns -> TransformT m a -> m (a, (Anns, Int), [String])
runTransformFromT Int
seed Anns
ans TransformT m a
f = RWST () [String] (Anns, Int) m a
-> () -> (Anns, Int) -> m (a, (Anns, 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] (Anns, Int) m a
forall (m :: * -> *) a.
TransformT m a -> RWST () [String] (Anns, Int) m a
unTransformT TransformT m a
f) () (Anns
ans,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] (Anns, Int) m a
m) = RWST () [String] (Anns, Int) n a -> TransformT n a
forall (m :: * -> *) a.
RWST () [String] (Anns, Int) m a -> TransformT m a
TransformT ((m (a, (Anns, Int), [String]) -> n (a, (Anns, Int), [String]))
-> RWST () [String] (Anns, Int) m a
-> RWST () [String] (Anns, 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, (Anns, Int), [String]) -> n (a, (Anns, Int), [String])
forall x. m x -> n x
nt RWST () [String] (Anns, 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

-- |Access the 'Anns' being modified in this transformation
getAnnsT :: (Monad m) => TransformT m Anns
getAnnsT :: forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT = ((Anns, Int) -> Anns) -> TransformT m Anns
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Anns, Int) -> Anns
forall a b. (a, b) -> a
fst

-- |Replace the 'Anns' after any changes
putAnnsT :: (Monad m) => Anns -> TransformT m ()
putAnnsT :: forall (m :: * -> *). Monad m => Anns -> TransformT m ()
putAnnsT Anns
ans = do
  (Anns
_,Int
col) <- TransformT m (Anns, Int)
forall s (m :: * -> *). MonadState s m => m s
get
  (Anns, Int) -> TransformT m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Anns
ans,Int
col)

-- |Change the stored 'Anns'
modifyAnnsT :: (Monad m) => (Anns -> Anns) -> TransformT m ()
modifyAnnsT :: forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT Anns -> Anns
f = do
  Anns
ans <- TransformT m Anns
forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT
  Anns -> TransformT m ()
forall (m :: * -> *). Monad m => Anns -> TransformT m ()
putAnnsT (Anns -> Anns
f Anns
ans)

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

-- |Once we have 'Anns', a 'SrcSpan' is used purely as part of an 'AnnKey'
-- to index into the 'Anns'. 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
  (Anns
an,Int
col) <- TransformT m (Anns, Int)
forall s (m :: * -> *). MonadState s m => m s
get
  (Anns, Int) -> TransformT m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Anns
an,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 (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

-- ---------------------------------------------------------------------
-- |Make a copy of an AST element, replacing the existing SrcSpans with new
-- ones, and duplicating the matching annotations.
cloneT :: (Data a,Monad m) => a -> TransformT m (a, [(SrcSpan, SrcSpan)])
cloneT :: forall a (m :: * -> *).
(Data a, Monad m) =>
a -> TransformT m (a, [(SrcSpan, SrcSpan)])
cloneT a
ast = do
  WriterT [(SrcSpan, SrcSpan)] (TransformT m) a
-> TransformT m (a, [(SrcSpan, SrcSpan)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [(SrcSpan, SrcSpan)] (TransformT m) a
 -> TransformT m (a, [(SrcSpan, SrcSpan)]))
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) a
-> TransformT m (a, [(SrcSpan, SrcSpan)])
forall a b. (a -> b) -> a -> b
$ GenericM (WriterT [(SrcSpan, SrcSpan)] (TransformT m))
-> GenericM (WriterT [(SrcSpan, SrcSpan)] (TransformT m))
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM (GenericM (WriterT [(SrcSpan, SrcSpan)] (TransformT m))
forall (m :: * -> *) a. Monad m => a -> m a
return GenericM (WriterT [(SrcSpan, SrcSpan)] (TransformT m))
-> (forall d1 d2.
    (Data d1, Data d2) =>
    GenLocated d1 d2
    -> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated d1 d2))
-> a
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) a
forall (m :: * -> *) d (t :: * -> * -> *).
(Monad m, Data d, Typeable t) =>
(forall e. Data e => e -> m e)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> m (t d1 d2))
-> d
-> m d
`ext2M` forall d1 d2.
(Data d1, Data d2) =>
GenLocated d1 d2
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated d1 d2)
forall loc a (m :: * -> *).
(Typeable loc, Data a, Monad m) =>
GenLocated loc a
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a)
replaceLocated) a
ast
  where
    replaceLocated :: forall loc a m. (Typeable loc,Data a,Monad m)
                    => (GenLocated loc a) -> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a)
    replaceLocated :: forall loc a (m :: * -> *).
(Typeable loc, Data a, Monad m) =>
GenLocated loc a
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a)
replaceLocated (L loc
l a
t) = do
      case loc -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast loc
l :: Maybe SrcSpan of
        Just SrcSpan
ss -> do
          SrcSpan
newSpan <- TransformT m SrcSpan
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) SrcSpan
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
          TransformT m () -> WriterT [(SrcSpan, SrcSpan)] (TransformT m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m () -> WriterT [(SrcSpan, SrcSpan)] (TransformT m) ())
-> TransformT m ()
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) ()
forall a b. (a -> b) -> a -> b
$ (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (\Anns
anns -> case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (GenLocated SrcSpan a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey (SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
L SrcSpan
ss a
t)) Anns
anns of
                                  Maybe Annotation
Nothing -> Anns
anns
                                  Just Annotation
an -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (GenLocated SrcSpan a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey (SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
L SrcSpan
newSpan a
t)) Annotation
an Anns
anns)
          [(SrcSpan, SrcSpan)]
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(SrcSpan
ss, SrcSpan
newSpan)]
          GenLocated loc a
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated loc a
 -> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a))
-> GenLocated loc a
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a)
forall a b. (a -> b) -> a -> b
$ Maybe (GenLocated loc a) -> GenLocated loc a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (GenLocated loc a) -> GenLocated loc a)
-> (GenLocated SrcSpan a -> Maybe (GenLocated loc a))
-> GenLocated SrcSpan a
-> GenLocated loc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan a -> Maybe (GenLocated loc a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast  (GenLocated SrcSpan a -> GenLocated loc a)
-> GenLocated SrcSpan a -> GenLocated loc a
forall a b. (a -> b) -> a -> b
$ SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
L SrcSpan
newSpan a
t
        Maybe SrcSpan
Nothing -> GenLocated loc a
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (loc -> a -> GenLocated loc a
forall l e. l -> e -> GenLocated l e
L loc
l a
t)

-- ---------------------------------------------------------------------
-- |Slightly more general form of cloneT
graftT :: (Data a,Monad m) => Anns -> a -> TransformT m a
graftT :: forall a (m :: * -> *).
(Data a, Monad m) =>
Anns -> a -> TransformT m a
graftT Anns
origAnns = GenericM (TransformT m) -> GenericM (TransformT m)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM (GenericM (TransformT m)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericM (TransformT m)
-> (forall d1 d2.
    (Data d1, Data d2) =>
    GenLocated d1 d2 -> TransformT m (GenLocated d1 d2))
-> a
-> TransformT m a
forall (m :: * -> *) d (t :: * -> * -> *).
(Monad m, Data d, Typeable t) =>
(forall e. Data e => e -> m e)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> m (t d1 d2))
-> d
-> m d
`ext2M` forall d1 d2.
(Data d1, Data d2) =>
GenLocated d1 d2 -> TransformT m (GenLocated d1 d2)
forall loc a (m :: * -> *).
(Typeable loc, Data a, Monad m) =>
GenLocated loc a -> TransformT m (GenLocated loc a)
replaceLocated)
  where
    replaceLocated :: forall loc a m. (Typeable loc, Data a, Monad m)
                    => GenLocated loc a -> TransformT m (GenLocated loc a)
    replaceLocated :: forall loc a (m :: * -> *).
(Typeable loc, Data a, Monad m) =>
GenLocated loc a -> TransformT m (GenLocated loc a)
replaceLocated (L loc
l a
t) = do
      case loc -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast loc
l :: Maybe SrcSpan of
        Just SrcSpan
ss -> do
          SrcSpan
newSpan <- TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
          (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (\Anns
anns -> case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (GenLocated SrcSpan a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey (SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
L SrcSpan
ss a
t)) Anns
origAnns of
                                  Maybe Annotation
Nothing -> Anns
anns
                                  Just Annotation
an -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (GenLocated SrcSpan a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey (SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
L SrcSpan
newSpan a
t)) Annotation
an Anns
anns)
          GenLocated loc a -> TransformT m (GenLocated loc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated loc a -> TransformT m (GenLocated loc a))
-> GenLocated loc a -> TransformT m (GenLocated loc a)
forall a b. (a -> b) -> a -> b
$ Maybe (GenLocated loc a) -> GenLocated loc a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (GenLocated loc a) -> GenLocated loc a)
-> Maybe (GenLocated loc a) -> GenLocated loc a
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan a -> Maybe (GenLocated loc a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (GenLocated SrcSpan a -> Maybe (GenLocated loc a))
-> GenLocated SrcSpan a -> Maybe (GenLocated loc a)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
L SrcSpan
newSpan a
t
        Maybe SrcSpan
Nothing -> GenLocated loc a -> TransformT m (GenLocated loc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (loc -> a -> GenLocated loc a
forall l e. l -> e -> GenLocated l e
L loc
l a
t)

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

-- |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 ) Origin
e) [CoreTickish]
f)))
                       = 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)
-> [CoreTickish]
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL
-> MatchGroup idR (LHsExpr idR)
-> [CoreTickish]
-> 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))]
-> Origin
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> 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') Origin
e) [CoreTickish]
f))
    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. Monoid 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 :: Monoid t
                   => [LocatedAn t e] -> [GenLocated (SrcSpanAnn' (EpAnn t)) e]
captureLineSpacing :: forall t e. Monoid 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. Monoid 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. Monoid 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. [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?
    -- DP (line, col) = ss2delta (ss2pos $ anchor $ getLoc lc) r
    dc' :: AddEpAnn
dc' = case EpaLocation
dca of
      EpaSpan RealSrcSpan
r -> AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
kw (DeltaPos -> EpaLocation
EpaDelta (DeltaPos -> EpaLocation) -> DeltaPos -> EpaLocation
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
rd) RealSrcSpan
r)
      EpaDelta DeltaPos
_ -> 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 -> DeltaPos -> AnchorOperation
MovedAnchor ((Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
r) (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
ll))
               EpaDelta DeltaPos
_ -> 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 -> DeltaPos -> AnchorOperation
MovedAnchor ((Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2posEnd RealSrcSpan
dcr) RealSrcSpan
r)
                  EpaDelta DeltaPos
_ -> 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)

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

-- |Create a simple 'Annotation' without comments, and attach it to the first
-- parameter.
addSimpleAnnT :: (Data a,Monad m)
              => Located a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT :: forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT Located a
ast DeltaPos
dp [(KeywordId, DeltaPos)]
kds = do
  let ann :: Annotation
ann = Annotation
annNone { annEntryDelta :: DeltaPos
annEntryDelta = DeltaPos
dp
                    , annsDP :: [(KeywordId, DeltaPos)]
annsDP = [(KeywordId, DeltaPos)]
kds
                    }
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
ast) Annotation
ann)

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

-- |Add a trailing comma annotation, unless there is already one
addTrailingCommaT :: (Data a,Monad m) => Located a -> TransformT m ()
addTrailingCommaT :: forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT Located a
ast = do
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (Located a -> DeltaPos -> Anns -> Anns
forall a. Data a => Located a -> DeltaPos -> Anns -> Anns
addTrailingComma Located a
ast (Int -> DeltaPos
SameLine Int
0))

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

-- |Remove a trailing comma annotation, if there is one one
removeTrailingCommaT :: (Data a,Monad m) => Located a -> TransformT m ()
removeTrailingCommaT :: forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
removeTrailingCommaT Located a
ast = do
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (Located a -> Anns -> Anns
forall a. Data a => Located a -> Anns -> Anns
removeTrailingComma Located a
ast)

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

-- |'Transform' monad version of 'getEntryDP'
getEntryDPT :: (Data a,Monad m) => Located a -> TransformT m DeltaPos
getEntryDPT :: forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m DeltaPos
getEntryDPT Located a
ast = do
  Anns
anns <- TransformT m Anns
forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT
  DeltaPos -> TransformT m DeltaPos
forall (m :: * -> *) a. Monad m => a -> m a
return (Anns -> Located a -> DeltaPos
forall a. Data a => Anns -> Located a -> DeltaPos
getEntryDP Anns
anns Located a
ast)

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

-- |'Transform' monad version of 'getEntryDP'
setEntryDPT :: (Monad m) => LocatedA a -> DeltaPos -> TransformT m ()
setEntryDPT :: forall (m :: * -> *) a.
Monad m =>
LocatedA a -> DeltaPos -> TransformT m ()
setEntryDPT LocatedA a
ast DeltaPos
dp = do
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (LocatedA a -> DeltaPos -> Anns -> Anns
forall a. LocatedA a -> DeltaPos -> Anns -> Anns
setEntryDP LocatedA a
ast DeltaPos
dp)

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

-- |'Transform' monad version of 'transferEntryDP'
transferEntryDPT :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA b)
transferEntryDPT :: forall (m :: * -> *) a b.
Monad m =>
LocatedA a -> LocatedA b -> TransformT m (LocatedA b)
transferEntryDPT LocatedA a
_a LocatedA b
b = do
  LocatedA b -> TransformT m (LocatedA b)
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA b
b
  -- modifyAnnsT (transferEntryDP a b)

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

-- |'Transform' monad version of 'setPrecedingLinesDecl'
setPrecedingLinesDeclT :: (Monad m) => LHsDecl GhcPs -> Int -> Int -> TransformT m ()
setPrecedingLinesDeclT :: forall (m :: * -> *).
Monad m =>
LHsDecl GhcPs -> Int -> Int -> TransformT m ()
setPrecedingLinesDeclT LHsDecl GhcPs
ld Int
n Int
c =
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
setPrecedingLinesDecl LHsDecl GhcPs
ld Int
n Int
c)

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

-- |'Transform' monad version of 'setPrecedingLines'
setPrecedingLinesT ::  (Monad m) => LocatedA a -> Int -> Int -> TransformT m ()
setPrecedingLinesT :: forall (m :: * -> *) a.
Monad m =>
LocatedA a -> Int -> Int -> TransformT m ()
setPrecedingLinesT LocatedA a
ld Int
n Int
c =
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (LocatedA a -> Int -> Int -> Anns -> Anns
forall a. LocatedA a -> Int -> Int -> Anns -> Anns
setPrecedingLines LocatedA a
ld Int
n Int
c)

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

-- | Left bias pair union
mergeAnns :: Anns -> Anns -> Anns
mergeAnns :: Anns -> Anns -> Anns
mergeAnns
  = Anns -> Anns -> Anns
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union

-- |Combine a list of annotations
mergeAnnList :: [Anns] -> Anns
mergeAnnList :: [Anns] -> Anns
mergeAnnList [] = String -> Anns
forall a. HasCallStack => String -> a
error String
"mergeAnnList must have at lease one entry"
mergeAnnList (Anns
x:[Anns]
xs) = (Anns -> Anns -> Anns) -> Anns -> [Anns] -> Anns
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Anns -> Anns -> Anns
mergeAnns Anns
x [Anns]
xs

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

-- |Unwrap a HsDecl and call setPrecedingLines on it
-- ++AZ++ TODO: get rid of this, it is a synonym only
setPrecedingLinesDecl :: LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
setPrecedingLinesDecl :: LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
setPrecedingLinesDecl LHsDecl GhcPs
ld Int
n Int
c Anns
ans = GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Int -> Int -> Anns -> Anns
forall a. LocatedA a -> Int -> Int -> Anns -> Anns
setPrecedingLines LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
ld Int
n Int
c Anns
ans

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

-- | Adjust the entry annotations to provide an `n` line preceding gap
setPrecedingLines :: LocatedA a -> Int -> Int -> Anns -> Anns
setPrecedingLines :: forall a. LocatedA a -> Int -> Int -> Anns -> Anns
setPrecedingLines LocatedA a
ast Int
n Int
c Anns
anne = LocatedA a -> DeltaPos -> Anns -> Anns
forall a. LocatedA a -> DeltaPos -> Anns -> Anns
setEntryDP LocatedA a
ast (Int -> Int -> DeltaPos
deltaPos Int
n Int
c) Anns
anne

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

-- |Return the true entry 'DeltaPos' from the annotation for a given AST
-- element. This is the 'DeltaPos' ignoring any comments.
getEntryDP :: (Data a) => Anns -> Located a -> DeltaPos
getEntryDP :: forall a. Data a => Anns -> Located a -> DeltaPos
getEntryDP Anns
anns Located a
ast =
  case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
ast) Anns
anns of
    Maybe Annotation
Nothing  -> Int -> DeltaPos
SameLine Int
0
    Just Annotation
ann -> Annotation -> DeltaPos
annTrueEntryDelta Annotation
ann

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

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 ) Origin
e) [CoreTickish]
f))) 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)
-> [CoreTickish]
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL
-> MatchGroup idR (LHsExpr idR)
-> [CoreTickish]
-> 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))]
-> Origin
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> 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') Origin
e) [CoreTickish]
f))
    where
      L SrcSpanAnnA
l' HsDecl GhcPs
_ = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DeltaPos -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall t a. Monoid 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. Monoid 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. Monoid 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' :: (Data a) => LocatedA a -> DeltaPos -> LocatedA a
setEntryDP' :: (Monoid t) => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP' :: forall t a. Monoid 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. Monoid a => a
mempty 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 AnchorOperation
_) t
an EpAnnComments
cs) SrcSpan
l) a
a) DeltaPos
dp
  = case [LEpaComment] -> [LEpaComment]
forall a. Ord a => [a] -> [a]
sort (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. [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 = (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
                -- TODO: this adjustment by 1 happens all over the place. Generalise it
                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))

-- |Set the true entry 'DeltaPos' from the annotation for a given AST
-- element. This is the 'DeltaPos' ignoring any comments.
setEntryDP :: LocatedA a -> DeltaPos -> Anns -> Anns
setEntryDP :: forall a. LocatedA a -> DeltaPos -> Anns -> Anns
setEntryDP LocatedA a
_ast DeltaPos
_dp Anns
anns = Anns
anns

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

addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta LayoutStartCol
_off RealSrcSpan
_anc (EpaDelta DeltaPos
d) = DeltaPos -> EpaLocation
EpaDelta DeltaPos
d
addEpaLocationDelta  LayoutStartCol
off  RealSrcSpan
anc (EpaSpan RealSrcSpan
r)
  = DeltaPos -> EpaLocation
EpaDelta (Int -> LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset Int
0 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
_) (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) ll :: GenLocated SrcSpanAnnA t
ll@(L SrcSpanAnnA
la t
_) = GenLocated SrcSpanAnnA t -> DeltaPos -> GenLocated SrcSpanAnnA t
forall t a. Monoid 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' = Int -> LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset Int
0 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 t) => LocatedAn t a -> LocatedAn t b -> TransformT m (LocatedAn t b)
transferEntryDP :: forall (m :: * -> *) t a b.
(Monad m, Monoid t) =>
LocatedAn t a -> LocatedAn t b -> TransformT m (LocatedAn t b)
transferEntryDP (L (SrcSpanAnn EpAnn t
EpAnnNotUsed SrcSpan
l1) a
_) (L (SrcSpanAnn EpAnn t
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 t) b -> TransformT m (GenLocated (SrcAnn t) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t -> b -> GenLocated (SrcAnn t) b
forall l e. l -> e -> GenLocated l e
L (EpAnn t -> SrcSpan -> SrcAnn t
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn t
forall ann. EpAnn ann
EpAnnNotUsed SrcSpan
l1) b
b)
transferEntryDP (L (SrcSpanAnn (EpAnn Anchor
anc t
_an EpAnnComments
cs) SrcSpan
_l1) a
_) (L (SrcSpanAnn EpAnn t
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 t) b -> TransformT m (GenLocated (SrcAnn t) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t -> b -> GenLocated (SrcAnn t) b
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 Anchor
anc t
forall a. Monoid a => a
mempty EpAnnComments
cs) SrcSpan
l2) b
b)
transferEntryDP (L (SrcSpanAnn (EpAnn Anchor
anc1 t
_an1 EpAnnComments
cs1) SrcSpan
_l1) a
_) (L (SrcSpanAnn (EpAnn Anchor
_anc2 t
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 t) b -> TransformT m (GenLocated (SrcAnn t) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t -> b -> GenLocated (SrcAnn t) b
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 Anchor
anc1 t
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 t) b -> TransformT m (GenLocated (SrcAnn t) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t -> b -> GenLocated (SrcAnn t) b
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 Anchor
anc t
an2 EpAnnComments
cs2) SrcSpan
l2) b
b)
transferEntryDP (L (SrcSpanAnn EpAnn t
EpAnnNotUsed SrcSpan
_l1) a
_) (L (SrcSpanAnn (EpAnn Anchor
anc2 t
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 t) b -> TransformT m (GenLocated (SrcAnn t) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn t -> b -> GenLocated (SrcAnn t) b
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 Anchor
anc2' t
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

-- |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 :: * -> *) t a b.
(Monad m, Monoid t) =>
LocatedAn t a -> LocatedAn t b -> TransformT m (LocatedAn t 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 (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 ) Origin
e) [CoreTickish]
f)) 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)
-> [CoreTickish]
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL
-> MatchGroup idR (LHsExpr idR)
-> [CoreTickish]
-> 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))]
-> Origin
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> 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') Origin
e) [CoreTickish]
f)
    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. Monoid 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. Monoid 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

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

addTrailingComma :: (Data a) => Located a -> DeltaPos -> Anns -> Anns
addTrailingComma :: forall a. Data a => Located a -> DeltaPos -> Anns -> Anns
addTrailingComma Located a
a DeltaPos
dp Anns
anns =
  case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
a) Anns
anns of
    Maybe Annotation
Nothing -> Anns
anns
    Just Annotation
an ->
      case ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)] -> Maybe (KeywordId, DeltaPos)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (KeywordId, DeltaPos) -> Bool
forall {b}. (KeywordId, b) -> Bool
isAnnComma (Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
an) of
        Maybe (KeywordId, DeltaPos)
Nothing -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
a) (Annotation
an { annsDP :: [(KeywordId, DeltaPos)]
annsDP = Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
an [(KeywordId, DeltaPos)]
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnComma,DeltaPos
dp)]}) Anns
anns
        Just (KeywordId, DeltaPos)
_  -> Anns
anns
      where
        isAnnComma :: (KeywordId, b) -> Bool
isAnnComma (G AnnKeywordId
AnnComma,b
_) = Bool
True
        isAnnComma (KeywordId, b)
_              = Bool
False

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

removeTrailingComma :: (Data a) => Located a -> Anns -> Anns
removeTrailingComma :: forall a. Data a => Located a -> Anns -> Anns
removeTrailingComma Located a
a Anns
anns =
  case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
a) Anns
anns of
    Maybe Annotation
Nothing -> Anns
anns
    Just Annotation
an ->
      case ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)] -> Maybe (KeywordId, DeltaPos)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (KeywordId, DeltaPos) -> Bool
forall {b}. (KeywordId, b) -> Bool
isAnnComma (Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
an) of
        Maybe (KeywordId, DeltaPos)
Nothing -> Anns
anns
        Just (KeywordId, DeltaPos)
_  -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
a) (Annotation
an { annsDP :: [(KeywordId, DeltaPos)]
annsDP = ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool)
-> ((KeywordId, DeltaPos) -> Bool) -> (KeywordId, DeltaPos) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(KeywordId, DeltaPos) -> Bool
forall {b}. (KeywordId, b) -> Bool
isAnnComma) (Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
an) }) Anns
anns
      where
        isAnnComma :: (KeywordId, b) -> Bool
isAnnComma (G AnnKeywordId
AnnComma,b
_) = Bool
True
        isAnnComma (KeywordId, b)
_              = Bool
False

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

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 (m :: * -> *) a. Monad m => a -> m a
return []
balanceCommentsList [LHsDecl GhcPs
x] = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
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 (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 relatavise phase puts all comments appearing between the end of one AST
-- item and the beginning of the next as 'annPriorComments' for the second one.
-- This function takes two adjacent AST items and moves any 'annPriorComments'
-- from the second one to the 'annFollowingComments' of the first if they belong
-- to it instead. This is typically required before deleting or duplicating
-- either of the AST elements.
balanceComments :: (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
  -- ++AZ++ : replace the nested casts with appropriate gmapM
  -- logTr $ "balanceComments entered"
  -- logDataWithAnnsTr "first" first
  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 (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)
mx (L SrcSpanAnnL
lm [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches) Origin
o) [CoreTickish]
t)) 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)
  [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
                 (LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
m':[LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ms') -> (LocatedAn
  AnnListItem (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'
  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. 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
lf (XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> [CoreTickish]
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL
-> MatchGroup idR (LHsExpr idR)
-> [CoreTickish]
-> 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))]
-> Origin
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mx (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))) Origin
o) [CoreTickish]
t), 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 (NoGhcTc GhcPs)
mctxt [LPat GhcPs]
pats (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xg [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
binds))) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceCommentsMatch: (loc1)=" 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 (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l))
  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: (move',stay')=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(Int, LEpaComment)], [(Int, LEpaComment)]) -> String
forall a. Data a => a -> String
showAst ([(Int, LEpaComment)]
move',[(Int, LEpaComment)]
stay')
  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)
  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: (loc1)=" 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 (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l))
  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: (anc1,cs1f)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (EpAnnComments, [LEpaComment]) -> String
forall a. Data a => a -> String
showAst (EpAnnComments
anc1,[LEpaComment]
cs1f)
  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: (l'', grhss')=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SrcSpanAnnA,
 [GenLocated
    SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> String
forall a. Data a => a -> String
showAst (SrcSpanAnnA
l'', [GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss')
  LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m
     (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
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 (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
am HsMatchContext (NoGhcTc GhcPs)
mctxt [LPat GhcPs]
pats (XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xg [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   SrcSpan (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
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss', HsLocalBinds GhcPs
binds', (EpAnnComments, SrcSpanAnnA)
logInfo)
      = case [GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   SrcSpan (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 SrcSpan
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
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
gs) -> (SrcSpanAnnA
l, [GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse (SrcSpan
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpan
lg GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
gGenLocated
  SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   SrcSpan (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 SrcSpan
lg (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ag [GuardLStmt GhcPs]
grs GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs):[GenLocated
   SrcSpan (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
splitComments (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
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
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([GenLocated
    SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (SrcSpan
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpan
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
  SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   SrcSpan (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, (Anns, Int)
_, [String]
_ws1) = Anns
-> Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], (Anns, Int), [String])
forall a. Anns -> Transform a -> (a, (Anns, Int), [String])
runTransform Anns
forall a. Monoid a => a
mempty (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).
Data (HsLocalBinds (GhcPass p)) =>
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 Anns
-> Transform (HsLocalBinds GhcPs)
-> (HsLocalBinds GhcPs, (Anns, Int), [String])
forall a. Anns -> Transform a -> (a, (Anns, Int), [String])
runTransform Anns
forall a. Monoid a => a
mempty (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 [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls') of
      ((HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
vb'), (Anns, Int)
_, [String]
ws2') -> (HsValBindsLR GhcPs GhcPs
vb', [String]
ws2')
      (HsLocalBinds GhcPs, (Anns, 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
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 (m :: * -> *) a. Monad m => a -> m a
return []
balanceCommentsList' [LocatedA a
x] = [LocatedA a] -> TransformT m [LocatedA 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 (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': (anchorFromLocatedA la1)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RealSrcSpan -> String
forall a. Outputable a => a -> String
showGhc (LocatedA a -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA a
la1)
  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': (sort cs2b)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [LEpaComment] -> String
forall a. Data a => a -> String
showAst ([LEpaComment] -> [LEpaComment]
forall a. Ord a => [a] -> [a]
sort [LEpaComment]
cs2b)
  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': (move',stay')=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(Int, LEpaComment)], [(Int, LEpaComment)]) -> String
forall a. Data a => a -> String
showAst ([(Int, LEpaComment)]
move',[(Int, LEpaComment)]
stay')
  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': (move'',stay'')=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(Int, LEpaComment)], [(Int, LEpaComment)]) -> String
forall a. Data a => a -> String
showAst ([(Int, LEpaComment)]
move'',[(Int, LEpaComment)]
stay'')
  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': (move,stay)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([LEpaComment], [LEpaComment]) -> String
forall a. Data a => a -> String
showAst ([LEpaComment]
move,[LEpaComment]
stay)
  (LocatedA a, LocatedA b) -> TransformT m (LocatedA a, LocatedA b)
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
    cs1f :: [LEpaComment]
cs1f = EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
anc1
    cs2b :: [LEpaComment]
cs2b = EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
anc2
    ([(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) (RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
priorCommentsDeltas (LocatedA b -> RealSrcSpan
forall a. LocatedA a -> RealSrcSpan
anchorFromLocatedA LocatedA b
la2) [LEpaComment]
cs2b)
    -- 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 = ((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'' [(Int, LEpaComment)]
-> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. [a] -> [a] -> [a]
++ [(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 = EpAnnComments -> [LEpaComment] -> EpAnnComments
setFollowingComments EpAnnComments
anc1 ([LEpaComment] -> [LEpaComment]
forall a. Ord a => [a] -> [a]
sort ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
cs1f [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
move)
    cs2 :: EpAnnComments
cs2 = EpAnnComments -> [LEpaComment] -> EpAnnComments
setPriorComments EpAnnComments
anc2 [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) EpAnnComments
cs1
    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) EpAnnComments
cs2
    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]
forall a. Ord a => [a] -> [a]
sort [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.
splitComments :: RealSrcSpan -> EpAnnComments -> EpAnnComments
splitComments :: RealSrcSpan -> EpAnnComments -> EpAnnComments
splitComments 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
splitComments 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

-- | 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 c@(L (GHC.Anchor _ (GHC.MovedAnchor _)) _) = c
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))
  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)
               else DeltaPos -> AnchorOperation
MovedAnchor ((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'

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

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 (NoGhcTc GhcPs)
mctxt [LPat GhcPs]
pats (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
lb))) = do
  String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr (String -> TransformT m ()) -> String -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ String
"balanceSameLineComments: (la)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Int, Int), (Int, Int)) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan -> ((Int, Int), (Int, Int))
ss2range (SrcSpan -> ((Int, Int), (Int, Int)))
-> SrcSpan -> ((Int, Int), (Int, Int))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. 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 (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 (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
anm HsMatchContext (NoGhcTc GhcPs)
mctxt [LPat GhcPs]
pats (XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   SrcSpan (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
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss', [(EpAnnComments, ([LEpaComment], [LEpaComment]))]
logInfo) = case [GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss of
      [] -> (SrcSpanAnnA
la,[LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grhss,[])
      (L SrcSpan
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
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs) -> (SrcSpanAnnA
la,[GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([GenLocated
    SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (SrcSpan
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpan
lg GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
g)GenLocated
  SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs,[])
      (L SrcSpan
lg (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ga [GuardLStmt GhcPs]
gs GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs):[GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
grs) -> (SrcSpanAnnA
la'',[GenLocated
   SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
reverse ([GenLocated
    SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (SrcSpan
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpan
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
  SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[GenLocated
   SrcSpan (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]
forall a. Ord a => [a] -> [a]
sort ([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'

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


-- |After moving an AST element, make sure any comments that may belong
-- with the following element in fact do. Of necessity this is a heuristic
-- process, to be tuned later. Possibly a variant should be provided with a
-- passed-in decision function.
balanceTrailingComments :: (Monad m) => (Data a,Data b) => Located a -> Located b
                        -> TransformT m [(Comment, DeltaPos)]
balanceTrailingComments :: forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
Located a -> Located b -> TransformT m [(Comment, DeltaPos)]
balanceTrailingComments Located a
first Located b
second = do
  let
    k1 :: AnnKey
k1 = Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
first
    k2 :: AnnKey
k2 = Located b -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located b
second
    moveComments :: ((Comment, DeltaPos) -> Bool)
-> Anns -> (Anns, [(Comment, DeltaPos)])
moveComments (Comment, DeltaPos) -> Bool
p Anns
ans = (Anns
ans',[(Comment, DeltaPos)]
move)
      where
        an1 :: Annotation
an1 = String -> Maybe Annotation -> Annotation
forall a. String -> Maybe a -> a
gfromJust String
"balanceTrailingComments k1" (Maybe Annotation -> Annotation) -> Maybe Annotation -> Annotation
forall a b. (a -> b) -> a -> b
$ AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
k1 Anns
ans
        an2 :: Annotation
an2 = String -> Maybe Annotation -> Annotation
forall a. String -> Maybe a -> a
gfromJust String
"balanceTrailingComments k2" (Maybe Annotation -> Annotation) -> Maybe Annotation -> Annotation
forall a b. (a -> b) -> a -> b
$ AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
k2 Anns
ans
        cs1f :: [(Comment, DeltaPos)]
cs1f = Annotation -> [(Comment, DeltaPos)]
annFollowingComments Annotation
an1
        ([(Comment, DeltaPos)]
move,[(Comment, DeltaPos)]
stay) = ((Comment, DeltaPos) -> Bool)
-> [(Comment, DeltaPos)]
-> ([(Comment, DeltaPos)], [(Comment, DeltaPos)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Comment, DeltaPos) -> Bool
p [(Comment, DeltaPos)]
cs1f
        an1' :: Annotation
an1' = Annotation
an1 { annFollowingComments :: [(Comment, DeltaPos)]
annFollowingComments = [(Comment, DeltaPos)]
stay }
        ans' :: Anns
ans' = AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
k1 Annotation
an1' (Anns -> Anns) -> Anns -> Anns
forall a b. (a -> b) -> a -> b
$ AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
k2 Annotation
an2 Anns
ans

    simpleBreak :: (a, DeltaPos) -> Bool
simpleBreak (a
_,SameLine Int
_) = Bool
False
    simpleBreak (a
_,DifferentLine Int
_ Int
_) = Bool
True

  Anns
ans <- TransformT m Anns
forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT
  let (Anns
ans',[(Comment, DeltaPos)]
mov) = ((Comment, DeltaPos) -> Bool)
-> Anns -> (Anns, [(Comment, DeltaPos)])
moveComments (Comment, DeltaPos) -> Bool
forall {a}. (a, DeltaPos) -> Bool
simpleBreak Anns
ans
  Anns -> TransformT m ()
forall (m :: * -> *). Monad m => Anns -> TransformT m ()
putAnnsT Anns
ans'
  [(Comment, DeltaPos)] -> TransformT m [(Comment, DeltaPos)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Comment, DeltaPos)]
mov

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

-- ++AZ++ TODO: This needs to be renamed/reworked, based on what it actually gets used for
-- |Move any 'annFollowingComments' values from the 'Annotation' associated to
-- the first parameter to that of the second.
moveTrailingComments :: (Data a,Data b)
                     => Located a -> Located b -> Transform ()
moveTrailingComments :: forall a b.
(Data a, Data b) =>
Located a -> Located b -> Transform ()
moveTrailingComments Located a
first Located b
second = do
  let
    k1 :: AnnKey
k1 = Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
first
    k2 :: AnnKey
k2 = Located b -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKey Located b
second
    moveComments :: Anns -> Anns
moveComments Anns
ans = Anns
ans'
      where
        an1 :: Annotation
an1 = String -> Maybe Annotation -> Annotation
forall a. String -> Maybe a -> a
gfromJust String
"moveTrailingComments k1" (Maybe Annotation -> Annotation) -> Maybe Annotation -> Annotation
forall a b. (a -> b) -> a -> b
$ AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
k1 Anns
ans
        an2 :: Annotation
an2 = String -> Maybe Annotation -> Annotation
forall a. String -> Maybe a -> a
gfromJust String
"moveTrailingComments k2" (Maybe Annotation -> Annotation) -> Maybe Annotation -> Annotation
forall a b. (a -> b) -> a -> b
$ AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
k2 Anns
ans
        cs1f :: [(Comment, DeltaPos)]
cs1f = Annotation -> [(Comment, DeltaPos)]
annFollowingComments Annotation
an1
        cs2f :: [(Comment, DeltaPos)]
cs2f = Annotation -> [(Comment, DeltaPos)]
annFollowingComments Annotation
an2
        an1' :: Annotation
an1' = Annotation
an1 { annFollowingComments :: [(Comment, DeltaPos)]
annFollowingComments = [] }
        an2' :: Annotation
an2' = Annotation
an2 { annFollowingComments :: [(Comment, DeltaPos)]
annFollowingComments = [(Comment, DeltaPos)]
cs1f [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ [(Comment, DeltaPos)]
cs2f }
        ans' :: Anns
ans' = AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
k1 Annotation
an1' (Anns -> Anns) -> Anns -> Anns
forall a b. (a -> b) -> a -> b
$ AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
k2 Annotation
an2' Anns
ans

  (Anns -> Anns) -> Transform ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT Anns -> Anns
moveComments

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

anchorEof :: ParsedSource -> ParsedSource
anchorEof :: ParsedSource -> ParsedSource
anchorEof (L SrcSpan
l m :: HsModule
m@(HsModule EpAnn AnnsModule
an LayoutInfo
_lo Maybe (Located ModuleName)
_mn Maybe (LocatedL [LIE GhcPs])
_exps [LImportDecl GhcPs]
_imps [LHsDecl GhcPs]
_decls Maybe (LocatedP WarningTxt)
_ Maybe LHsDocString
_)) = SrcSpan -> HsModule -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsModule
m { hsmodAnn :: EpAnn AnnsModule
hsmodAnn = EpAnn AnnsModule
an' })
  where
    an' :: EpAnn AnnsModule
an' = EpAnn AnnsModule -> EpAnn AnnsModule
forall a. EpAnn a -> EpAnn a
addCommentOrigDeltasAnn EpAnn AnnsModule
an

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

-- | Take an anchor and a preceding location, and generate an
-- equivalent one with a 'MovedAnchor' delta.
deltaAnchor :: Anchor -> RealSrcSpan -> Anchor
deltaAnchor :: Anchor -> RealSrcSpan -> Anchor
deltaAnchor (Anchor RealSrcSpan
anc AnchorOperation
_) RealSrcSpan
ss = RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
anc (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)
  where
    dp :: DeltaPos
dp = (Int, Int) -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
anc) RealSrcSpan
ss

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

-- | 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 -> EpaLocation
EpaDelta (DeltaPos -> EpaLocation) -> DeltaPos -> EpaLocation
forall a b. (a -> b) -> a -> b
$ Int -> DeltaPos
SameLine Int
0

d1 :: EpaLocation
d1 :: EpaLocation
d1 = DeltaPos -> EpaLocation
EpaDelta (DeltaPos -> EpaLocation) -> DeltaPos -> EpaLocation
forall a b. (a -> b) -> a -> b
$ Int -> DeltaPos
SameLine Int
1

dn :: Int -> EpaLocation
dn :: Int -> EpaLocation
dn Int
n = DeltaPos -> EpaLocation
EpaDelta (DeltaPos -> EpaLocation) -> DeltaPos -> EpaLocation
forall a b. (a -> b) -> a -> b
$ 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]
hsDecls ast
t
  ast -> [LHsDecl GhcPs] -> Transform ast
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
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]
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]
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 EpAnn AnnsModule
_ LayoutInfo
_lo Maybe (Located ModuleName)
_mn Maybe (LocatedL [LIE GhcPs])
_exps [LImportDecl GhcPs]
_imps [LHsDecl GhcPs]
decls Maybe (LocatedP WarningTxt)
_ Maybe LHsDocString
_)) = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
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 EpAnn AnnsModule
a LayoutInfo
lo Maybe (Located ModuleName)
mname Maybe (LocatedL [LIE GhcPs])
exps [LImportDecl GhcPs]
imps [LHsDecl GhcPs]
_decls Maybe (LocatedP WarningTxt)
deps Maybe LHsDocString
haddocks)) [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 (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsModule -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (EpAnn AnnsModule
-> LayoutInfo
-> Maybe (Located ModuleName)
-> Maybe (LocatedL [LIE GhcPs])
-> [LImportDecl GhcPs]
-> [LHsDecl GhcPs]
-> Maybe (LocatedP WarningTxt)
-> Maybe LHsDocString
-> HsModule
HsModule EpAnn AnnsModule
a LayoutInfo
lo Maybe (Located ModuleName)
mname Maybe (LocatedL [LIE GhcPs])
exps [LImportDecl GhcPs]
imps [LHsDecl GhcPs]
decls Maybe (LocatedP WarningTxt)
deps Maybe LHsDocString
haddocks))

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

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 (NoGhcTc 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 (NoGhcTc GhcPs)
c [LPat GhcPs]
p (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
binds))) []
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LMatch empty decls"
        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 (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 (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext (NoGhcTc 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 (NoGhcTc GhcPs)
c [LPat GhcPs]
p (GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xr [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
rhs HsLocalBinds GhcPs
binds))) [LHsDecl GhcPs]
newBinds
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LMatch nonempty decls"
        -- Need to throw in a fresh where clause if the binds were empty,
        -- in the annotations.
        (SrcSpanAnnA
l', [GenLocated
   SrcSpan (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"
            (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Int -> Int -> Anns -> Anns
forall a. LocatedA a -> Int -> Int -> Anns -> Anns
setPrecedingLines (String
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a. String -> [a] -> a
ghead String
"LMatch.replaceDecls" [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newBinds) Int
1 Int
4)

            -- only move the comment if the original where clause was empty.
            -- toMove <- balanceTrailingComments m m
            -- insertCommentBefore (mkAnnKey m) toMove (matchEpAnn AnnWhere)
            -- TODO: move trailing comments on the same line to before the 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
    SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> TransformT
     m
     (SrcSpanAnnA,
      [GenLocated
         SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
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
    SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> TransformT
     m
     (SrcSpanAnnA,
      [GenLocated
         SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
l, [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   SrcSpan (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 (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 (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
xm HsMatchContext (NoGhcTc 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
   SrcSpan (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
_ HsLocalBinds GhcPs
decls 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 (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 HsLocalBinds GhcPs
binds LHsExpr GhcPs
ex)) [LHsDecl GhcPs]
newDecls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsLet"
        let lastAnc :: RealSrcSpan
lastAnc = SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> SrcSpan
forall (p :: Pass).
Data (HsLocalBinds (GhcPass p)) =>
HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds GhcPs
binds
        -- TODO: may be an intervening comment, take account for lastAnc
        let (EpAnn AnnsLet
x', GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex',[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls') = case XLet GhcPs
x of
              XLet GhcPs
EpAnn AnnsLet
EpAnnNotUsed -> (XLet GhcPs
EpAnn AnnsLet
x, LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex, [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls)
              (EpAnn Anchor
a (AnnsLet EpaLocation
l EpaLocation
i) EpAnnComments
cs) ->
                let
                  off :: LayoutStartCol
off = case EpaLocation
l of
                          (EpaSpan RealSrcSpan
r) -> 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
_)) -> Int -> LayoutStartCol
LayoutStartCol Int
0
                          (EpaDelta (DifferentLine Int
_ Int
c)) -> 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 ( Anchor -> AnnsLet -> EpAnnComments -> EpAnn AnnsLet
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
a (EpaLocation -> EpaLocation -> AnnsLet
AnnsLet EpaLocation
l (LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta LayoutStartCol
off RealSrcSpan
lastAnc EpaLocation
i)) EpAnnComments
cs
                   , GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex''
                   , [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 (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 -> HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet XLet GhcPs
EpAnn AnnsLet
x' HsLocalBinds GhcPs
binds' LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
ex'))

  -- TODO: does this make sense? Especially as no hsDecls for HsPar
  replaceDecls (L SrcSpanAnnA
l (HsPar XPar GhcPs
x LHsExpr GhcPs
e)) [LHsDecl GhcPs]
newDecls
    = 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
replaceDecls LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e [LHsDecl GhcPs]
newDecls
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
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 -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcPs
x LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e'))
  replaceDecls GenLocated SrcSpanAnnA (HsExpr GhcPs)
old [LHsDecl GhcPs]
_new = String -> 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) ([CoreTickish], [[CoreTickish]])
_)) = 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 (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) ([CoreTickish], [[CoreTickish]])
b)) [LHsDecl GhcPs]
newDecls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls PatBind"
        -- Need to throw in a fresh where clause if the binds were empty,
        -- in the annotations.
        case HsLocalBinds GhcPs
binds of
          EmptyLocalBinds{} -> do
            let
              addWhere :: p -> a
addWhere p
_mkds =
                String -> a
forall a. HasCallStack => String -> a
error String
"TBD"
            (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT Anns -> Anns
forall {p} {a}. p -> a
addWhere
            (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Int -> Int -> Anns -> Anns
forall a. LocatedA a -> Int -> Int -> Anns -> Anns
setPrecedingLines (String
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a. String -> [a] -> a
ghead String
"LMatch.replaceDecls" [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls) Int
1 Int
4)

          HsLocalBinds GhcPs
_ -> () -> TransformT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        -- modifyAnnsT (captureOrderAnnKey (mkAnnKey p) 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
WithWhere HsLocalBinds GhcPs
binds [LHsDecl GhcPs]
newDecls
        -- let binds' = L (getLoc binds) binds''
        GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> TransformT m (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
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)
-> ([CoreTickish], [[CoreTickish]])
-> HsBindLR GhcPs GhcPs
forall idL idR.
XPatBind idL idR
-> LPat idL
-> GRHSs idR (LHsExpr idR)
-> ([CoreTickish], [[CoreTickish]])
-> 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'') ([CoreTickish], [[CoreTickish]])
b))
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]
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]
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]
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 (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
        -- modifyAnnsT (captureOrder s newDecls)
        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
        -- let lb' = L (getLoc lb) lb''
        LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT
     m (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
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
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 (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
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 (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
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 (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 (m :: * -> *) a. Monad m => a -> m a
return LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x

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

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

-- |Do a transformation on an AST fragment by providing a function to process
-- the general case and one specific for a 'LHsBind'. This is required
-- because a 'FunBind' may have multiple 'Match' items, so we cannot
-- gurantee that 'replaceDecls' after 'hsDecls' is idempotent.
hasDeclsSybTransform :: (Data t2,Monad m)
       => (forall t. HasDecls t => t -> m t)
             -- ^Worker function for the general case
       -> (LHsBind GhcPs -> m (LHsBind GhcPs))
             -- ^Worker function for FunBind/PatBind
       -> t2 -- ^Item to be updated
       -> m t2
hasDeclsSybTransform :: forall t2 (m :: * -> *).
(Data t2, Monad m) =>
(forall t. HasDecls t => t -> m t)
-> (LHsBind GhcPs -> m (LHsBind GhcPs)) -> t2 -> m t2
hasDeclsSybTransform forall t. HasDecls t => t -> m t
workerHasDecls LHsBind GhcPs -> m (LHsBind GhcPs)
workerBind t2
t = t2 -> m t2
trf t2
t
  where
    trf :: t2 -> m t2
trf = (ParsedSource -> m ParsedSource) -> t2 -> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM   ParsedSource -> m ParsedSource
parsedSource
         (t2 -> m t2)
-> (LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> m (LocatedAn
            AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> t2
-> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
lmatch
         (t2 -> m t2)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> m (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> t2
-> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
lexpr
         (t2 -> m t2)
-> (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> m (LocatedA
            (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> t2
-> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (LocatedA
        (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
lstmt
         (t2 -> m t2)
-> (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
    -> m (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)))
-> t2
-> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> m (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
lhsbind
         (t2 -> m t2)
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> m (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> t2
-> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
lvald

    parsedSource :: ParsedSource -> m ParsedSource
parsedSource (ParsedSource
p::ParsedSource) = ParsedSource -> m ParsedSource
forall t. HasDecls t => t -> m t
workerHasDecls ParsedSource
p

    lmatch :: LMatch GhcPs (LHsExpr GhcPs)
-> m (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
lmatch (LMatch GhcPs (LHsExpr GhcPs)
lm::LMatch GhcPs (LHsExpr GhcPs))
      = LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall t. HasDecls t => t -> m t
workerHasDecls LMatch GhcPs (LHsExpr GhcPs)
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lm

    lexpr :: LHsExpr GhcPs -> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
lexpr (LHsExpr GhcPs
le::LHsExpr GhcPs)
      = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall t. HasDecls t => t -> m t
workerHasDecls LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
le

    lstmt :: GuardLStmt GhcPs
-> m (LocatedA
        (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
lstmt (GuardLStmt GhcPs
d::LStmt GhcPs (LHsExpr GhcPs))
      = LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> m (LocatedA
        (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall t. HasDecls t => t -> m t
workerHasDecls GuardLStmt GhcPs
LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
d

    lhsbind :: LHsBind GhcPs -> m (LHsBind GhcPs)
lhsbind (b :: LHsBind GhcPs
b@(L SrcSpanAnnA
_ FunBind{}):: LHsBind GhcPs)
      = LHsBind GhcPs -> m (LHsBind GhcPs)
workerBind LHsBind GhcPs
b
    lhsbind b :: LHsBind GhcPs
b@(L SrcSpanAnnA
_ PatBind{})
      = LHsBind GhcPs -> m (LHsBind GhcPs)
workerBind LHsBind GhcPs
b
    lhsbind LHsBind GhcPs
x = GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> m (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsBind GhcPs
GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
x

    lvald :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
lvald (L SrcSpanAnnA
l (ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
d)) = do
      (L SrcSpanAnnA
_ HsBindLR GhcPs GhcPs
d') <- GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> m (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
lhsbind (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
d)
      GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
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'))
    lvald GenLocated SrcSpanAnnA (HsDecl GhcPs)
x = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> m (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnA (HsDecl GhcPs)
x

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

-- |A 'FunBind' wraps up one or more 'Match' items. 'hsDecls' cannot
-- return anything for these as there is not meaningful 'replaceDecls' for it.
-- This function provides a version of 'hsDecls' that returns the 'FunBind'
-- decls too, where they are needed for analysis only.
hsDeclsGeneric :: (Data t,Monad m) => t -> TransformT m [LHsDecl GhcPs]
hsDeclsGeneric :: forall t (m :: * -> *).
(Data t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDeclsGeneric t
t = t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
q t
t
  where
    q :: t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
q = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> (ParsedSource
    -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> t
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ`  ParsedSource
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {m :: * -> *}.
Monad m =>
ParsedSource
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
parsedSource
        (t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> t
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {m :: * -> *}.
Monad m =>
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
lmatch
        (t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> t
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {m :: * -> *}.
Monad m =>
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
lexpr
        (t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> t
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {m :: * -> *}.
Monad m =>
LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
lstmt
        (t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
    -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> t
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
lhsbind
        (t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> t
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {m :: * -> *}.
Monad m =>
GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
lhsbindd
        (t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (Located (HsLocalBinds GhcPs)
    -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> t
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Located (HsLocalBinds GhcPs)
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *).
Monad m =>
Located (HsLocalBinds GhcPs) -> TransformT m [LHsDecl GhcPs]
llocalbinds
        (t -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (HsLocalBinds GhcPs
    -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> t
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsLocalBinds GhcPs
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
localbinds

    parsedSource :: ParsedSource -> TransformT m [LHsDecl GhcPs]
parsedSource (ParsedSource
p::ParsedSource) = ParsedSource -> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls ParsedSource
p

    lmatch :: LMatch GhcPs (LHsExpr GhcPs) -> TransformT m [LHsDecl GhcPs]
lmatch (LMatch GhcPs (LHsExpr GhcPs)
lm::LMatch GhcPs (LHsExpr GhcPs)) = LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls LMatch GhcPs (LHsExpr GhcPs)
LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
lm

    lexpr :: LHsExpr GhcPs -> TransformT m [LHsDecl GhcPs]
lexpr (LHsExpr GhcPs
le::LHsExpr GhcPs) = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
le

    lstmt :: GuardLStmt GhcPs -> TransformT m [LHsDecl GhcPs]
lstmt (GuardLStmt GhcPs
d::LStmt GhcPs (LHsExpr GhcPs)) = LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls GuardLStmt GhcPs
LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
d

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

    lhsbind :: (Monad m) => LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
    lhsbind :: forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
lhsbind (L SrcSpanAnnA
_ (FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpanAnnL
_ [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches) Origin
_) [CoreTickish]
_)) = do
        [[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
dss <- (LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> [LocatedAn
      AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> TransformT m [[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls [LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches
        [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
dss)
    lhsbind p :: LHsBind GhcPs
p@(L SrcSpanAnnA
_ (PatBind{})) = do
      LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBind LHsBind GhcPs
p
    lhsbind LHsBind GhcPs
_ = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

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

    lhsbindd :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT m [LHsDecl GhcPs]
lhsbindd (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]
lhsbind (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
d)
    lhsbindd GenLocated SrcSpanAnnA (HsDecl GhcPs)
_ = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

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

    llocalbinds :: (Monad m) => Located (HsLocalBinds GhcPs) -> TransformT m [LHsDecl GhcPs]
    llocalbinds :: forall (m :: * -> *).
Monad m =>
Located (HsLocalBinds GhcPs) -> TransformT m [LHsDecl GhcPs]
llocalbinds (L SrcSpan
_ HsLocalBinds GhcPs
ds) = HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
localbinds HsLocalBinds GhcPs
ds

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

    localbinds :: (Monad m) => HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
    localbinds :: forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
localbinds HsLocalBinds GhcPs
d = HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
d

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

-- |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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return []
    EmptyLocalBinds {} -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
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
/= :: WithWhere -> WithWhere -> Bool
$c/= :: WithWhere -> WithWhere -> Bool
== :: WithWhere -> WithWhere -> Bool
$c== :: 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
showList :: [WithWhere] -> String -> String
$cshowList :: [WithWhere] -> String -> String
show :: WithWhere -> String
$cshow :: WithWhere -> String
showsPrec :: Int -> WithWhere -> String -> String
$cshowsPrec :: Int -> 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 (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).
Data (HsLocalBinds (GhcPass p)) =>
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 (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 (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 -> 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 (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 (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 -> 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 (m :: * -> *) a. Monad m => a -> m a
return (Anchor
anc, Maybe Anchor
ancl)
          WithWhere
WithoutWhere -> (Anchor, Maybe Anchor) -> TransformT m (Anchor, Maybe Anchor)
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 (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
3))
  let anc2 :: Anchor
anc2 = RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
rs SrcSpan
newSpan) (DeltaPos -> AnchorOperation
MovedAnchor (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
5))
  let w :: [AddEpAnn]
w = case WithWhere
ww of
        WithWhere
WithWhere -> [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnWhere (DeltaPos -> 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 (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 (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 (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 (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 (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 (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 (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 (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]
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 (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 (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 (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
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 (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 (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 (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 (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]
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 (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
replaceDecls t
t [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls'

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