{-# LANGUAGE CPP #-}
{-# 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

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

        -- *** Low level operations used in 'HasDecls'
        , balanceComments
        , balanceTrailingComments
        , moveTrailingComments

        -- ** Managing lists, pure functions
        , captureOrder
        , captureOrderAnnKey

        -- * Operations
        , isUniqueSrcSpan

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

        ) where

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

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

import qualified GHC           as GHC hiding (parseModule)
#if __GLASGOW_HASKELL__ >= 900
import qualified GHC.Data.Bag          as GHC
import qualified GHC.Data.FastString   as GHC
#else
import qualified Bag           as GHC
import qualified FastString    as GHC
#endif

import qualified Data.Generics as SYB

import Data.Data
import Data.List
import Data.Maybe

import qualified Data.Map as Map

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

-- import Debug.Trace

------------------------------------------------------------------------------
-- 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 { TransformT m a -> RWST () [String] (Anns, Int) m a
unTransformT :: RWST () [String] (Anns,Int) m a }
                deriving (Applicative (TransformT m)
a -> TransformT m a
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)
TransformT m a -> (a -> TransformT m b) -> TransformT m b
TransformT m a -> TransformT m b -> TransformT m b
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 :: a -> TransformT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> TransformT m a
>> :: 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
>>= :: 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
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (TransformT m)
Monad,Functor (TransformT m)
a -> TransformT m a
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)
TransformT m a -> TransformT m b -> TransformT m b
TransformT m a -> TransformT m b -> TransformT m a
TransformT m (a -> b) -> TransformT m a -> TransformT m b
(a -> b -> c) -> TransformT m a -> TransformT m b -> TransformT m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> TransformT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> TransformT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (TransformT m)
Applicative,a -> TransformT m b -> TransformT m a
(a -> b) -> TransformT m a -> TransformT m b
(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
<$ :: a -> TransformT m b -> TransformT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> TransformT m b -> TransformT m a
fmap :: (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)
                         ,m a -> TransformT m a
(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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 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 :: 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) => (SYB.Data a) => String -> a -> TransformT m ()
logDataWithAnnsTr :: String -> a -> TransformT m ()
logDataWithAnnsTr String
str a
ast = do
  Anns
anns <- TransformT m Anns
forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT
  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]
++ Anns -> Int -> a -> String
forall a. Data a => Anns -> Int -> a -> String
showAnnData Anns
anns Int
0 a
ast

-- |Access the 'Anns' being modified in this transformation
getAnnsT :: (Monad m) => TransformT m Anns
getAnnsT :: 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 :: 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 :: (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 'GHC.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 'GHC.SrcSpan' for this.
uniqueSrcSpanT :: (Monad m) => TransformT m GHC.SrcSpan
uniqueSrcSpanT :: 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
GHC.mkSrcLoc (String -> FastString
GHC.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
GHC.mkSrcSpan SrcLoc
pos SrcLoc
pos

-- |Test whether a given 'GHC.SrcSpan' was generated by 'uniqueSrcSpanT'
isUniqueSrcSpan :: GHC.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

-- ---------------------------------------------------------------------
-- |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, [(GHC.SrcSpan, GHC.SrcSpan)])
cloneT :: 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))
-> a -> WriterT [(SrcSpan, SrcSpan)] (TransformT m) a
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
SYB.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
`SYB.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)
                    => (GHC.GenLocated loc a) -> WriterT [(GHC.SrcSpan, GHC.SrcSpan)] (TransformT m) (GHC.GenLocated loc a)
    replaceLocated :: GenLocated loc a
-> WriterT [(SrcSpan, SrcSpan)] (TransformT m) (GenLocated loc a)
replaceLocated (GHC.L loc
l a
t) = do
      case loc -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast loc
l :: Maybe GHC.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. Constraints a => a -> AnnKey
mkAnnKey (SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
GHC.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. Constraints a => a -> AnnKey
mkAnnKey (SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
GHC.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
GHC.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
GHC.L loc
l a
t)

-- ---------------------------------------------------------------------
-- |Slightly more general form of cloneT
graftT :: (Data a,Monad m) => Anns -> a -> TransformT m a
graftT :: Anns -> a -> TransformT m a
graftT Anns
origAnns = GenericM (TransformT m) -> GenericM (TransformT m)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
SYB.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
`SYB.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)
                    => GHC.GenLocated loc a -> TransformT m (GHC.GenLocated loc a)
    replaceLocated :: GenLocated loc a -> TransformT m (GenLocated loc a)
replaceLocated (GHC.L loc
l a
t) = do
      case loc -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast loc
l :: Maybe GHC.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. Constraints a => a -> AnnKey
mkAnnKey (SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
GHC.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. Constraints a => a -> AnnKey
mkAnnKey (SrcSpan -> a -> GenLocated SrcSpan a
forall l e. l -> e -> GenLocated l e
GHC.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
GHC.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
GHC.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 first
-- parameter.
captureOrder :: (Data a) => GHC.Located a -> [GHC.Located b] -> Anns -> Anns
captureOrder :: Located a -> [Located b] -> Anns -> Anns
captureOrder Located a
parent [Located b]
ls Anns
ans = AnnKey -> [Located b] -> Anns -> Anns
forall b. AnnKey -> [Located b] -> Anns -> Anns
captureOrderAnnKey (Located a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located a
parent) [Located b]
ls Anns
ans

-- |If a list has been re-ordered or had items added, capture the new order in
-- the appropriate 'annSortKey' item of the supplied 'AnnKey'
captureOrderAnnKey :: AnnKey -> [GHC.Located b] -> Anns -> Anns
captureOrderAnnKey :: AnnKey -> [Located b] -> Anns -> Anns
captureOrderAnnKey AnnKey
parentKey [Located b]
ls Anns
ans = Anns
ans'
  where
    newList :: [SrcSpan]
newList = (Located b -> SrcSpan) -> [Located b] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> SrcSpan
rs (SrcSpan -> SrcSpan)
-> (Located b -> SrcSpan) -> Located b -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located b -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc) [Located b]
ls
    reList :: Anns -> Anns
reList = (Annotation -> Annotation) -> AnnKey -> Anns -> Anns
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\Annotation
an -> Annotation
an {annSortKey :: Maybe [SrcSpan]
annSortKey = [SrcSpan] -> Maybe [SrcSpan]
forall a. a -> Maybe a
Just [SrcSpan]
newList }) AnnKey
parentKey
    ans' :: Anns
ans' = Anns -> Anns
reList Anns
ans

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

-- |Pure function to convert a 'GHC.LHsDecl' to a 'GHC.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 :: GHC.LHsDecl name -> [GHC.LHsBind name]
#if __GLASGOW_HASKELL__ > 804
decl2Bind :: LHsDecl name -> [LHsBind name]
decl2Bind (GHC.L SrcSpan
l (GHC.ValD XValD name
_ HsBind name
s)) = [SrcSpan -> HsBind name -> LHsBind name
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l HsBind name
s]
#else
decl2Bind (GHC.L l (GHC.ValD s)) = [GHC.L l s]
#endif
decl2Bind LHsDecl name
_                      = []

-- |Pure function to convert a 'GHC.LSig' to a 'GHC.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 :: GHC.LHsDecl name -> [GHC.LSig name]
#if __GLASGOW_HASKELL__ > 804
decl2Sig :: LHsDecl name -> [LSig name]
decl2Sig (GHC.L SrcSpan
l (GHC.SigD XSigD name
_ Sig name
s)) = [SrcSpan -> Sig name -> LSig name
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l Sig name
s]
#else
decl2Sig (GHC.L l (GHC.SigD s)) = [GHC.L l s]
#endif
decl2Sig LHsDecl name
_                      = []

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

-- |Convert a 'GHC.LSig' into a 'GHC.LHsDecl'
wrapSig :: GHC.LSig GhcPs -> GHC.LHsDecl GhcPs
#if __GLASGOW_HASKELL__ > 808
wrapSig :: LSig GhcPs -> LHsDecl GhcPs
wrapSig (GHC.L SrcSpan
l Sig GhcPs
s) = SrcSpan -> HsDecl GhcPs -> LHsDecl GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
GHC.SigD NoExtField
XSigD GhcPs
GHC.NoExtField Sig GhcPs
s)
#elif __GLASGOW_HASKELL__ > 804
wrapSig (GHC.L l s) = GHC.L l (GHC.SigD GHC.noExt s)
#else
wrapSig (GHC.L l s) = GHC.L l (GHC.SigD s)
#endif

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

-- |Convert a 'GHC.LHsBind' into a 'GHC.LHsDecl'
wrapDecl :: GHC.LHsBind GhcPs -> GHC.LHsDecl GhcPs
#if __GLASGOW_HASKELL__ > 808
wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs
wrapDecl (GHC.L SrcSpan
l HsBindLR GhcPs GhcPs
s) = SrcSpan -> HsDecl GhcPs -> LHsDecl GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
GHC.ValD NoExtField
XValD GhcPs
GHC.NoExtField HsBindLR GhcPs GhcPs
s)
#elif __GLASGOW_HASKELL__ > 804
wrapDecl (GHC.L l s) = GHC.L l (GHC.ValD GHC.noExt s)
#else
wrapDecl (GHC.L l s) = GHC.L l (GHC.ValD s)
#endif

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

-- |Create a simple 'Annotation' without comments, and attach it to the first
-- parameter.
addSimpleAnnT :: (Constraints a,Monad m)
#if (__GLASGOW_HASKELL__ >= 808) && (__GLASGOW_HASKELL__ < 900)
              => a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
#else
              => GHC.Located a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
#endif
addSimpleAnnT :: a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT 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 (a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey a
ast) Annotation
ann)

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

-- |Add a trailing comma annotation, unless there is already one
addTrailingCommaT :: (Data a,Monad m) => GHC.Located a -> TransformT m ()
addTrailingCommaT :: 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, Int) -> DeltaPos
DP (Int
0,Int
0)))

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

-- |Remove a trailing comma annotation, if there is one one
removeTrailingCommaT :: (Data a,Monad m) => GHC.Located a -> TransformT m ()
removeTrailingCommaT :: 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'
#if (__GLASGOW_HASKELL__ >= 808) && (__GLASGOW_HASKELL__ < 900)
getEntryDPT :: (Constraints a,Monad m) => a -> TransformT m DeltaPos
#else
getEntryDPT :: (Data a,Monad m) => GHC.Located a -> TransformT m DeltaPos
#endif
getEntryDPT :: a -> TransformT m DeltaPos
getEntryDPT 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 -> a -> DeltaPos
forall a. Constraints a => Anns -> a -> DeltaPos
getEntryDP Anns
anns a
ast)

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

-- |'Transform' monad version of 'getEntryDP'
#if (__GLASGOW_HASKELL__ >= 808) && (__GLASGOW_HASKELL__ < 900)
setEntryDPT :: (Constraints a,Monad m) => a -> DeltaPos -> TransformT m ()
#else
setEntryDPT :: (Data a,Monad m) => GHC.Located a -> DeltaPos -> TransformT m ()
#endif
setEntryDPT :: a -> DeltaPos -> TransformT m ()
setEntryDPT a
ast DeltaPos
dp = do
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (a -> DeltaPos -> Anns -> Anns
forall a. Constraints a => a -> DeltaPos -> Anns -> Anns
setEntryDP a
ast DeltaPos
dp)

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

-- |'Transform' monad version of 'transferEntryDP'
transferEntryDPT :: (Data a,Data b,Monad m) => GHC.Located a -> GHC.Located b -> TransformT m ()
transferEntryDPT :: Located a -> Located b -> TransformT m ()
transferEntryDPT Located a
a Located b
b =
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (Located a -> Located b -> Anns -> Anns
forall a b.
(Data a, Data b) =>
Located a -> Located b -> Anns -> Anns
transferEntryDP Located a
a Located b
b)

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

-- |'Transform' monad version of 'setPrecedingLinesDecl'
setPrecedingLinesDeclT :: (Monad m) => GHC.LHsDecl GhcPs -> Int -> Int -> TransformT m ()
setPrecedingLinesDeclT :: 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 ::  (SYB.Data a,Monad m) => GHC.Located a -> Int -> Int -> TransformT m ()
setPrecedingLinesT :: Located a -> Int -> Int -> TransformT m ()
setPrecedingLinesT Located a
ld Int
n Int
c =
  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (Located a -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines Located 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 :: GHC.LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
setPrecedingLinesDecl :: LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
setPrecedingLinesDecl LHsDecl GhcPs
ld Int
n Int
c Anns
ans = LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines LHsDecl GhcPs
ld Int
n Int
c Anns
ans

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

-- | Adjust the entry annotations to provide an `n` line preceding gap
setPrecedingLines :: (SYB.Data a) => GHC.Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines :: Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines Located a
ast Int
n Int
c Anns
anne = Located a -> DeltaPos -> Anns -> Anns
forall a. Constraints a => a -> DeltaPos -> Anns -> Anns
setEntryDP Located a
ast ((Int, Int) -> DeltaPos
DP (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.
#if (__GLASGOW_HASKELL__ >= 808) && (__GLASGOW_HASKELL__ < 900)
getEntryDP :: (Constraints a) => Anns -> a -> DeltaPos
#else
getEntryDP :: (Data a) => Anns -> GHC.Located a -> DeltaPos
#endif
getEntryDP :: Anns -> a -> DeltaPos
getEntryDP Anns
anns a
ast =
  case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey a
ast) Anns
anns of
    Maybe Annotation
Nothing  -> (Int, Int) -> DeltaPos
DP (Int
0,Int
0)
    Just Annotation
ann -> Annotation -> DeltaPos
annTrueEntryDelta Annotation
ann

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

-- |Set the true entry 'DeltaPos' from the annotation for a given AST
-- element. This is the 'DeltaPos' ignoring any comments.
#if (__GLASGOW_HASKELL__ >= 808) && (__GLASGOW_HASKELL__ < 900)
setEntryDP :: (Constraints a) => a -> DeltaPos -> Anns -> Anns
#else
setEntryDP :: (Data a) => GHC.Located a -> DeltaPos -> Anns -> Anns
#endif
setEntryDP :: a -> DeltaPos -> Anns -> Anns
setEntryDP a
ast DeltaPos
dp Anns
anns =
  case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey a
ast) Anns
anns of
    Maybe Annotation
Nothing  -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey a
ast) (Annotation
annNone { annEntryDelta :: DeltaPos
annEntryDelta = DeltaPos
dp}) Anns
anns
    Just Annotation
ann -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey a
ast) (Annotation
ann'    { annEntryDelta :: DeltaPos
annEntryDelta = Annotation -> DeltaPos -> DeltaPos
annCommentEntryDelta Annotation
ann' DeltaPos
dp}) Anns
anns
      where
        ann' :: Annotation
ann' = Annotation -> DeltaPos -> Annotation
setCommentEntryDP Annotation
ann DeltaPos
dp

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

-- |When setting an entryDP, the leading comment needs to be adjusted too
setCommentEntryDP :: Annotation -> DeltaPos -> Annotation
-- setCommentEntryDP ann dp = error $ "setCommentEntryDP:ann'=" ++ show ann'
setCommentEntryDP :: Annotation -> DeltaPos -> Annotation
setCommentEntryDP Annotation
ann DeltaPos
dp = Annotation
ann'
  where
    ann' :: Annotation
ann' = case (Annotation -> [(Comment, DeltaPos)]
annPriorComments Annotation
ann) of
      [] -> Annotation
ann
      [(Comment
pc,DeltaPos
_)]     -> Annotation
ann { annPriorComments :: [(Comment, DeltaPos)]
annPriorComments = [(Comment
pc,DeltaPos
dp)] }
      ((Comment
pc,DeltaPos
_):[(Comment, DeltaPos)]
pcs) -> Annotation
ann { annPriorComments :: [(Comment, DeltaPos)]
annPriorComments = ((Comment
pc,DeltaPos
dp)(Comment, DeltaPos)
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. a -> [a] -> [a]
:[(Comment, DeltaPos)]
pcs) }

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

-- |Take the annEntryDelta associated with the first item and associate it with the second.
-- Also transfer any comments occuring before it.
transferEntryDP :: (SYB.Data a, SYB.Data b) => GHC.Located a -> GHC.Located b -> Anns -> Anns
transferEntryDP :: Located a -> Located b -> Anns -> Anns
transferEntryDP Located a
a Located b
b Anns
anns = (Anns -> Anns -> Anns
forall a b. a -> b -> a
const Anns
anns2) Anns
anns
  where
    maybeAnns :: Maybe (Anns, DeltaPos)
maybeAnns = do -- Maybe monad
      Annotation
anA <- AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Located a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located a
a) Anns
anns
      Annotation
anB <- AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Located b -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located b
b) Anns
anns
      let anB' :: Annotation
anB'  = Ann :: DeltaPos
-> [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> [(KeywordId, DeltaPos)]
-> Maybe [SrcSpan]
-> Maybe AnnKey
-> Annotation
Ann
            { annEntryDelta :: DeltaPos
annEntryDelta        = (Int, Int) -> DeltaPos
DP (Int
0,Int
0) -- Need to adjust for comments after
            , annPriorComments :: [(Comment, DeltaPos)]
annPriorComments     = Annotation -> [(Comment, DeltaPos)]
annPriorComments     Annotation
anB
            , annFollowingComments :: [(Comment, DeltaPos)]
annFollowingComments = Annotation -> [(Comment, DeltaPos)]
annFollowingComments Annotation
anB
            , annsDP :: [(KeywordId, DeltaPos)]
annsDP               = Annotation -> [(KeywordId, DeltaPos)]
annsDP          Annotation
anB
            , annSortKey :: Maybe [SrcSpan]
annSortKey           = Annotation -> Maybe [SrcSpan]
annSortKey      Annotation
anB
            , annCapturedSpan :: Maybe AnnKey
annCapturedSpan      = Annotation -> Maybe AnnKey
annCapturedSpan Annotation
anB
            }
      (Anns, DeltaPos) -> Maybe (Anns, DeltaPos)
forall (m :: * -> *) a. Monad m => a -> m a
return ((AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Located b -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located b
b) Annotation
anB' Anns
anns),Annotation -> DeltaPos
annLeadingCommentEntryDelta Annotation
anA)
    (Anns
anns',DeltaPos
dp) = (Anns, DeltaPos) -> Maybe (Anns, DeltaPos) -> (Anns, DeltaPos)
forall a. a -> Maybe a -> a
fromMaybe
                  (String -> (Anns, DeltaPos)
forall a. HasCallStack => String -> a
error (String -> (Anns, DeltaPos)) -> String -> (Anns, DeltaPos)
forall a b. (a -> b) -> a -> b
$ String
"transferEntryDP: lookup failed (a,b)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (AnnKey, AnnKey) -> String
forall a. Show a => a -> String
show (Located a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located a
a,Located b -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located b
b))
                  Maybe (Anns, DeltaPos)
maybeAnns
    anns2 :: Anns
anns2 = Located b -> DeltaPos -> Anns -> Anns
forall a. Constraints a => a -> DeltaPos -> Anns -> Anns
setEntryDP Located b
b DeltaPos
dp Anns
anns'

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

addTrailingComma :: (SYB.Data a) => GHC.Located a -> DeltaPos -> Anns -> Anns
addTrailingComma :: 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. Constraints a => 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. Constraints a => 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
GHC.AnnComma,DeltaPos
dp)]}) Anns
anns
        Just (KeywordId, DeltaPos)
_  -> Anns
anns
      where
        isAnnComma :: (KeywordId, b) -> Bool
isAnnComma (G AnnKeywordId
GHC.AnnComma,b
_) = Bool
True
        isAnnComma (KeywordId, b)
_                  = Bool
False

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

removeTrailingComma :: (SYB.Data a) => GHC.Located a -> Anns -> Anns
removeTrailingComma :: 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. Constraints a => 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. Constraints a => 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
GHC.AnnComma,b
_) = Bool
True
        isAnnComma (KeywordId, b)
_                  = Bool
False

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

-- |The relatavise phase puts all comments appearing between the end of one AST
-- item and the beginning of the next as 'annPriorComments' for the second one.
-- This function takes two adjacent AST items and moves any 'annPriorComments'
-- from the second one to the 'annFollowingComments' of the first if they belong
-- to it instead. This is typically required before deleting or duplicating
-- either of the AST elements.
balanceComments :: (Data a,Data b,Monad m) => GHC.Located a -> GHC.Located b -> TransformT m ()
balanceComments :: Located a -> Located b -> TransformT m ()
balanceComments Located a
first Located b
second = do
  -- ++AZ++ : replace the nested casts with appropriate SYB.gmapM
  -- logTr $ "balanceComments entered"
  -- logDataWithAnnsTr "first" first
  case Located a -> Maybe (LHsDecl GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located a
first :: Maybe (GHC.LHsDecl GhcPs) of
#if __GLASGOW_HASKELL__ > 804
    Just (GHC.L SrcSpan
l (GHC.ValD XValD GhcPs
_ fb :: HsBindLR GhcPs GhcPs
fb@(GHC.FunBind{}))) -> do
#else
    Just (GHC.L l (GHC.ValD   fb@(GHC.FunBind{}))) -> do
#endif
      LHsBind GhcPs -> Located b -> TransformT m ()
forall b (m :: * -> *).
(Data b, Monad m) =>
LHsBind GhcPs -> Located b -> TransformT m ()
balanceCommentsFB (SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l HsBindLR GhcPs GhcPs
fb) Located b
second
    Maybe (LHsDecl GhcPs)
_ -> case Located a -> Maybe (LHsBind GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located a
first :: Maybe (GHC.LHsBind GhcPs) of
      Just fb' :: LHsBind GhcPs
fb'@(GHC.L SrcSpan
_ (GHC.FunBind{})) -> do
        LHsBind GhcPs -> Located b -> TransformT m ()
forall b (m :: * -> *).
(Data b, Monad m) =>
LHsBind GhcPs -> Located b -> TransformT m ()
balanceCommentsFB LHsBind GhcPs
fb' Located b
second
      Maybe (LHsBind GhcPs)
_ -> Located a -> Located b -> TransformT m ()
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
Located a -> Located b -> TransformT m ()
balanceComments' Located a
first Located b
second

-- |Prior to moving an AST element, make sure any trailing comments belonging to
-- it are attached to it, and not the following element. Of necessity this is a
-- heuristic process, to be tuned later. Possibly a variant should be provided
-- with a passed-in decision function.
balanceComments' :: (Data a,Data b,Monad m) => GHC.Located a -> GHC.Located b -> TransformT m ()
balanceComments' :: Located a -> Located b -> TransformT m ()
balanceComments' Located a
first Located b
second = do
  let
    k1 :: AnnKey
k1 = Located a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located a
first
    k2 :: AnnKey
k2 = Located b -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located b
second
    moveComments :: ((Comment, DeltaPos) -> Bool) -> Anns -> Anns
moveComments (Comment, DeltaPos) -> Bool
p Anns
ans = Anns
ans'
      where
        an1 :: Annotation
an1 = String -> Maybe Annotation -> Annotation
forall a. String -> Maybe a -> a
gfromJust String
"balanceComments' 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
"balanceComments' 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
        cs2b :: [(Comment, DeltaPos)]
cs2b = Annotation -> [(Comment, DeltaPos)]
annPriorComments Annotation
an2
        ([(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)]
cs2b
        an1' :: Annotation
an1' = Annotation
an1 { annFollowingComments :: [(Comment, DeltaPos)]
annFollowingComments = [(Comment, DeltaPos)]
cs1f [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ [(Comment, DeltaPos)]
move}
        an2' :: Annotation
an2' = Annotation
an2 { annPriorComments :: [(Comment, DeltaPos)]
annPriorComments = [(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
_,DP (Int
r,Int
_c)) = Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

  (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (((Comment, DeltaPos) -> Bool) -> Anns -> Anns
moveComments (Comment, DeltaPos) -> Bool
forall a. (a, DeltaPos) -> Bool
simpleBreak)

-- |Once 'balanceComments' has been called to move trailing comments to a
-- 'GHC.FunBind', these need to be pushed down from the top level to the last
-- 'GHC.Match' if that 'GHC.Match' needs to be manipulated.
balanceCommentsFB :: (Data b,Monad m) => GHC.LHsBind GhcPs -> GHC.Located b -> TransformT m ()
#if __GLASGOW_HASKELL__ >= 900
balanceCommentsFB (GHC.L _ (GHC.FunBind _ _ (GHC.MG _ (GHC.L _ matches) _) _)) second = do
#elif __GLASGOW_HASKELL__ > 808
balanceCommentsFB :: LHsBind GhcPs -> Located b -> TransformT m ()
balanceCommentsFB (GHC.L SrcSpan
_ (GHC.FunBind XFunBind GhcPs GhcPs
_ Located (IdP GhcPs)
_ (GHC.MG XMG GhcPs (LHsExpr GhcPs)
_ (GHC.L SrcSpan
_ [LMatch GhcPs (LHsExpr GhcPs)]
matches) Origin
_) HsWrapper
_ [Tickish Id]
_)) Located b
second = do
#elif __GLASGOW_HASKELL__ > 804
balanceCommentsFB (GHC.L _ (GHC.FunBind _ _ (GHC.MG _ (GHC.L _ matches) _) _ _)) second = do
#elif __GLASGOW_HASKELL__ > 710
balanceCommentsFB (GHC.L _ (GHC.FunBind _ (GHC.MG (GHC.L _ matches) _ _ _) _ _ _)) second = do
#else
balanceCommentsFB (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) second = do
#endif
  -- logTr $ "balanceCommentsFB entered"
  LMatch GhcPs (LHsExpr GhcPs) -> Located b -> TransformT m ()
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
Located a -> Located b -> TransformT m ()
balanceComments' ([LMatch GhcPs (LHsExpr GhcPs)] -> LMatch GhcPs (LHsExpr GhcPs)
forall a. [a] -> a
last [LMatch GhcPs (LHsExpr GhcPs)]
matches) Located b
second
balanceCommentsFB LHsBind GhcPs
f Located b
s = LHsBind GhcPs -> Located b -> TransformT m ()
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
Located a -> Located b -> TransformT m ()
balanceComments' LHsBind GhcPs
f Located b
s

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


-- |After moving an AST element, make sure any comments that may belong
-- with the following element in fact do. Of necessity this is a heuristic
-- process, to be tuned later. Possibly a variant should be provided with a
-- passed-in decision function.
balanceTrailingComments :: (Monad m) => (Data a,Data b) => GHC.Located a -> GHC.Located b
                        -> TransformT m [(Comment, DeltaPos)]
balanceTrailingComments :: 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. Constraints a => a -> AnnKey
mkAnnKey Located a
first
    k2 :: AnnKey
k2 = Located b -> AnnKey
forall a. Constraints a => 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
_,DP (Int
r,Int
_c)) = Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

  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)
                     => GHC.Located a -> GHC.Located b -> Transform ()
moveTrailingComments :: Located a -> Located b -> Transform ()
moveTrailingComments Located a
first Located b
second = do
  let
    k1 :: AnnKey
k1 = Located a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located a
first
    k2 :: AnnKey
k2 = Located b -> AnnKey
forall a. Constraints a => 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

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

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

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

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

-- |Insert a declaration at a specific location in the subdecls of the given
-- AST item
insertAfter, insertBefore :: (HasDecls (GHC.Located ast))
                          => GHC.Located old
                          -> GHC.Located ast
                          -> GHC.LHsDecl GhcPs
                          -> Transform (GHC.Located ast)
insertAfter :: Located old
-> Located ast -> LHsDecl GhcPs -> Transform (Located ast)
insertAfter (Located old -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc -> SrcSpan
k) = (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> Located ast -> LHsDecl GhcPs -> Transform (Located ast)
forall ast.
HasDecls (Located ast) =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> Located ast -> LHsDecl GhcPs -> Transform (Located ast)
insertAt LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
forall e.
GenLocated SrcSpan e
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
findAfter
  where
    findAfter :: GenLocated SrcSpan e
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
findAfter GenLocated SrcSpan e
x [GenLocated SrcSpan e]
xs =
      let ([GenLocated SrcSpan e]
fs, GenLocated SrcSpan e
b:[GenLocated SrcSpan e]
bs) = (GenLocated SrcSpan e -> Bool)
-> [GenLocated SrcSpan e]
-> ([GenLocated SrcSpan e], [GenLocated SrcSpan e])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(GHC.L SrcSpan
l e
_) -> SrcSpan
l SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= SrcSpan
k) [GenLocated SrcSpan e]
xs
      in [GenLocated SrcSpan e]
fs [GenLocated SrcSpan e]
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpan e
b GenLocated SrcSpan e
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
forall a. a -> [a] -> [a]
: GenLocated SrcSpan e
x GenLocated SrcSpan e
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpan e]
bs)
insertBefore :: Located old
-> Located ast -> LHsDecl GhcPs -> Transform (Located ast)
insertBefore (Located old -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc -> SrcSpan
k) = (LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> Located ast -> LHsDecl GhcPs -> Transform (Located ast)
forall ast.
HasDecls (Located ast) =>
(LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> Located ast -> LHsDecl GhcPs -> Transform (Located ast)
insertAt LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
forall e.
GenLocated SrcSpan e
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
findBefore
  where
    findBefore :: GenLocated SrcSpan e
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
findBefore GenLocated SrcSpan e
x [GenLocated SrcSpan e]
xs =
      let ([GenLocated SrcSpan e]
fs, [GenLocated SrcSpan e]
bs) = (GenLocated SrcSpan e -> Bool)
-> [GenLocated SrcSpan e]
-> ([GenLocated SrcSpan e], [GenLocated SrcSpan e])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(GHC.L SrcSpan
l e
_) -> SrcSpan
l SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= SrcSpan
k) [GenLocated SrcSpan e]
xs
      in [GenLocated SrcSpan e]
fs [GenLocated SrcSpan e]
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpan e
x GenLocated SrcSpan e
-> [GenLocated SrcSpan e] -> [GenLocated SrcSpan e]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpan 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 'GHC.HsDecl's that are directly enclosed in the
    -- given syntax phrase. They are always returned in the wrapped 'GHC.HsDecl'
    -- form, even if orginating in local decls. This is safe, as annotations
    -- never attach to the wrapper, only to the wrapped item.
    hsDecls :: (Monad m) => t -> TransformT m [GHC.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 'GHC.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 -> [GHC.LHsDecl GhcPs] -> TransformT m t

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

instance HasDecls GHC.ParsedSource where
#if __GLASGOW_HASKELL__ >= 900
  hsDecls (GHC.L _ (GHC.HsModule _lo _mn _exps _imps decls _ _)) = return decls
  replaceDecls m@(GHC.L l (GHC.HsModule lo mn exps imps _decls deps haddocks)) decls
    = do
        logTr "replaceDecls LHsModule"
        modifyAnnsT (captureOrder m decls)
        return (GHC.L l (GHC.HsModule lo mn exps imps decls deps haddocks))
#else
  hsDecls :: ParsedSource -> TransformT m [LHsDecl GhcPs]
hsDecls (GHC.L SrcSpan
_ (GHC.HsModule Maybe (Located ModuleName)
_mn Maybe (Located [LIE GhcPs])
_exps [LImportDecl GhcPs]
_imps [LHsDecl GhcPs]
decls Maybe (Located WarningTxt)
_ Maybe LHsDocString
_)) = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return [LHsDecl GhcPs]
decls
  replaceDecls :: ParsedSource -> [LHsDecl GhcPs] -> TransformT m ParsedSource
replaceDecls m :: ParsedSource
m@(GHC.L SrcSpan
l (GHC.HsModule Maybe (Located ModuleName)
mn Maybe (Located [LIE GhcPs])
exps [LImportDecl GhcPs]
imps [LHsDecl GhcPs]
_decls Maybe (Located WarningTxt)
deps Maybe LHsDocString
haddocks)) [LHsDecl GhcPs]
decls
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LHsModule"
        (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (ParsedSource -> [LHsDecl GhcPs] -> Anns -> Anns
forall a b. Data a => Located a -> [Located b] -> Anns -> Anns
captureOrder ParsedSource
m [LHsDecl GhcPs]
decls)
        ParsedSource -> TransformT m ParsedSource
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (Maybe (Located ModuleName)
-> Maybe (Located [LIE GhcPs])
-> [LImportDecl GhcPs]
-> [LHsDecl GhcPs]
-> Maybe (Located WarningTxt)
-> Maybe LHsDocString
-> HsModule GhcPs
forall pass.
Maybe (Located ModuleName)
-> Maybe (Located [LIE pass])
-> [LImportDecl pass]
-> [LHsDecl pass]
-> Maybe (Located WarningTxt)
-> Maybe LHsDocString
-> HsModule pass
GHC.HsModule Maybe (Located ModuleName)
mn Maybe (Located [LIE GhcPs])
exps [LImportDecl GhcPs]
imps [LHsDecl GhcPs]
decls Maybe (Located WarningTxt)
deps Maybe LHsDocString
haddocks))
#endif

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

instance HasDecls (GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)) where
#if __GLASGOW_HASKELL__ > 804
  hsDecls :: LMatch GhcPs (LHsExpr GhcPs) -> TransformT m [LHsDecl GhcPs]
hsDecls d :: LMatch GhcPs (LHsExpr GhcPs)
d@(GHC.L SrcSpan
_ (GHC.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
_ [LPat GhcPs]
_ (GHC.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [LGRHS GhcPs (LHsExpr GhcPs)]
_ (GHC.L SrcSpan
_ HsLocalBinds GhcPs
lb)))) = do
#elif __GLASGOW_HASKELL__ >= 804
  hsDecls d@(GHC.L _ (GHC.Match _ _ (GHC.GRHSs _ (GHC.L _ lb)))) = do
#elif __GLASGOW_HASKELL__ >= 800
  hsDecls d@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ (GHC.L _ lb)))) = do
#elif __GLASGOW_HASKELL__ >= 710
  hsDecls d@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ lb))) = do
#else
  hsDecls d@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ lb))) = do
#endif
    [LHsDecl GhcPs]
decls <- HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
lb
    LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
orderedDecls LMatch GhcPs (LHsExpr GhcPs)
d [LHsDecl GhcPs]
decls
#if __GLASGOW_HASKELL__ > 804
  hsDecls (GHC.L SrcSpan
_ (GHC.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
_ [LPat GhcPs]
_ (GHC.XGRHSs XXGRHSs GhcPs (LHsExpr GhcPs)
_))) = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  hsDecls (GHC.L SrcSpan
_ (GHC.XMatch XXMatch GhcPs (LHsExpr GhcPs)
_))                   = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []
#endif


#if __GLASGOW_HASKELL__ > 804
  replaceDecls :: LMatch GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
replaceDecls m :: LMatch GhcPs (LHsExpr GhcPs)
m@(GHC.L SrcSpan
l (GHC.Match XCMatch GhcPs (LHsExpr GhcPs)
xm HsMatchContext (NameOrRdrName (IdP GhcPs))
c [LPat GhcPs]
p (GHC.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
xr [LGRHS GhcPs (LHsExpr GhcPs)]
rhs GenLocated SrcSpan (HsLocalBinds GhcPs)
binds))) []
#elif __GLASGOW_HASKELL__ >= 804
  replaceDecls m@(GHC.L l (GHC.Match c p (GHC.GRHSs rhs binds))) []
#else
  replaceDecls m@(GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds))) []
#endif
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LMatch"
        let
          noWhere :: (KeywordId, b) -> Bool
noWhere (G AnnKeywordId
GHC.AnnWhere,b
_) = Bool
False
          noWhere (KeywordId, b)
_                  = Bool
True

          removeWhere :: Anns -> Anns
removeWhere Anns
mkds =
            case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (LMatch GhcPs (LHsExpr GhcPs) -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LMatch GhcPs (LHsExpr GhcPs)
m) Anns
mkds of
              Maybe Annotation
Nothing -> String -> Anns
forall a. HasCallStack => String -> a
error String
"wtf"
              Just Annotation
ann -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (LMatch GhcPs (LHsExpr GhcPs) -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LMatch GhcPs (LHsExpr GhcPs)
m) Annotation
ann1 Anns
mkds
                where
                  ann1 :: Annotation
ann1 = Annotation
ann { annsDP :: [(KeywordId, DeltaPos)]
annsDP = ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. (a -> Bool) -> [a] -> [a]
filter (KeywordId, DeltaPos) -> Bool
forall b. (KeywordId, b) -> Bool
noWhere (Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
ann)
                                 }
        (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT Anns -> Anns
removeWhere

#if __GLASGOW_HASKELL__ <= 710
        binds' <- replaceDeclsValbinds binds []
#else
        HsLocalBinds GhcPs
binds'' <- HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds (GenLocated SrcSpan (HsLocalBinds GhcPs)
-> SrcSpanLess (GenLocated SrcSpan (HsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
binds) []
        let binds' :: GenLocated SrcSpan (HsLocalBinds GhcPs)
binds' = SrcSpan
-> HsLocalBinds GhcPs -> GenLocated SrcSpan (HsLocalBinds GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L (GenLocated SrcSpan (HsLocalBinds GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
binds) HsLocalBinds GhcPs
binds''
#endif
#if __GLASGOW_HASKELL__ > 804
        LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XCMatch GhcPs (LHsExpr GhcPs)
-> HsMatchContext (NameOrRdrName (IdP GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> Match GhcPs (LHsExpr GhcPs)
forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
GHC.Match XCMatch GhcPs (LHsExpr GhcPs)
xm HsMatchContext (NameOrRdrName (IdP GhcPs))
c [LPat GhcPs]
p (XCGRHSs GhcPs (LHsExpr GhcPs)
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> GenLocated SrcSpan (HsLocalBinds GhcPs)
-> GRHSs GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GHC.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
xr [LGRHS GhcPs (LHsExpr GhcPs)]
rhs GenLocated SrcSpan (HsLocalBinds GhcPs)
binds')))
#elif __GLASGOW_HASKELL__ >= 804
        return (GHC.L l (GHC.Match c p (GHC.GRHSs rhs binds')))
#else
        return (GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds')))
#endif

#if __GLASGOW_HASKELL__ > 804
  replaceDecls m :: LMatch GhcPs (LHsExpr GhcPs)
m@(GHC.L SrcSpan
l (GHC.Match XCMatch GhcPs (LHsExpr GhcPs)
xm HsMatchContext (NameOrRdrName (IdP GhcPs))
c [LPat GhcPs]
p (GHC.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
xr [LGRHS GhcPs (LHsExpr GhcPs)]
rhs GenLocated SrcSpan (HsLocalBinds GhcPs)
binds))) [LHsDecl GhcPs]
newBinds
#elif __GLASGOW_HASKELL__ >= 804
  replaceDecls m@(GHC.L l (GHC.Match c p (GHC.GRHSs rhs binds))) newBinds
#else
  replaceDecls m@(GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds))) newBinds
#endif
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls LMatch"
        -- Need to throw in a fresh where clause if the binds were empty,
        -- in the annotations.
#if __GLASGOW_HASKELL__ <= 710
        case binds of
#else
        case GenLocated SrcSpan (HsLocalBinds GhcPs)
-> SrcSpanLess (GenLocated SrcSpan (HsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
binds of
#endif
#if __GLASGOW_HASKELL__ > 804
          GHC.EmptyLocalBinds{} -> do
#else
          GHC.EmptyLocalBinds -> do
#endif
            let
              addWhere :: Anns -> Anns
addWhere Anns
mkds =
                case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (LMatch GhcPs (LHsExpr GhcPs) -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LMatch GhcPs (LHsExpr GhcPs)
m) Anns
mkds of
                  Maybe Annotation
Nothing -> String -> Anns
forall a. HasCallStack => String -> a
error String
"wtf"
                  Just Annotation
ann -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (LMatch GhcPs (LHsExpr GhcPs) -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LMatch GhcPs (LHsExpr GhcPs)
m) Annotation
ann1 Anns
mkds
                    where
                      ann1 :: Annotation
ann1 = Annotation
ann { annsDP :: [(KeywordId, DeltaPos)]
annsDP = Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
ann [(KeywordId, DeltaPos)]
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ [(AnnKeywordId -> KeywordId
G AnnKeywordId
GHC.AnnWhere,(Int, Int) -> DeltaPos
DP (Int
1,Int
2))]
                                 }
            (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT Anns -> Anns
addWhere
            (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines (String -> [LHsDecl GhcPs] -> LHsDecl GhcPs
forall a. String -> [a] -> a
ghead String
"LMatch.replaceDecls" [LHsDecl GhcPs]
newBinds) Int
1 Int
4)

            -- only move the comment if the original where clause was empty.
            [(Comment, DeltaPos)]
toMove <- LMatch GhcPs (LHsExpr GhcPs)
-> LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m [(Comment, DeltaPos)]
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
Located a -> Located b -> TransformT m [(Comment, DeltaPos)]
balanceTrailingComments LMatch GhcPs (LHsExpr GhcPs)
m LMatch GhcPs (LHsExpr GhcPs)
m
            AnnKey
-> [(Comment, DeltaPos)]
-> ((KeywordId, DeltaPos) -> Bool)
-> TransformT m ()
forall (m :: * -> *).
Monad m =>
AnnKey
-> [(Comment, DeltaPos)]
-> ((KeywordId, DeltaPos) -> Bool)
-> TransformT m ()
insertCommentBefore (LMatch GhcPs (LHsExpr GhcPs) -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LMatch GhcPs (LHsExpr GhcPs)
m) [(Comment, DeltaPos)]
toMove (AnnKeywordId -> (KeywordId, DeltaPos) -> Bool
matchApiAnn AnnKeywordId
GHC.AnnWhere)
          SrcSpanLess (GenLocated SrcSpan (HsLocalBinds GhcPs))
_ -> () -> TransformT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (AnnKey -> [LHsDecl GhcPs] -> Anns -> Anns
forall b. AnnKey -> [Located b] -> Anns -> Anns
captureOrderAnnKey (LMatch GhcPs (LHsExpr GhcPs) -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LMatch GhcPs (LHsExpr GhcPs)
m) [LHsDecl GhcPs]
newBinds)
#if __GLASGOW_HASKELL__ <= 710
        binds' <- replaceDeclsValbinds binds newBinds
#else
        HsLocalBinds GhcPs
binds'' <- HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds (GenLocated SrcSpan (HsLocalBinds GhcPs)
-> SrcSpanLess (GenLocated SrcSpan (HsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
binds) [LHsDecl GhcPs]
newBinds
        let binds' :: GenLocated SrcSpan (HsLocalBinds GhcPs)
binds' = SrcSpan
-> HsLocalBinds GhcPs -> GenLocated SrcSpan (HsLocalBinds GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L (GenLocated SrcSpan (HsLocalBinds GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
binds) HsLocalBinds GhcPs
binds''
#endif
        -- logDataWithAnnsTr "Match.replaceDecls:binds'" binds'
#if __GLASGOW_HASKELL__ > 804
        LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XCMatch GhcPs (LHsExpr GhcPs)
-> HsMatchContext (NameOrRdrName (IdP GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> Match GhcPs (LHsExpr GhcPs)
forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
GHC.Match XCMatch GhcPs (LHsExpr GhcPs)
xm HsMatchContext (NameOrRdrName (IdP GhcPs))
c [LPat GhcPs]
p (XCGRHSs GhcPs (LHsExpr GhcPs)
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> GenLocated SrcSpan (HsLocalBinds GhcPs)
-> GRHSs GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GHC.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
xr [LGRHS GhcPs (LHsExpr GhcPs)]
rhs GenLocated SrcSpan (HsLocalBinds GhcPs)
binds')))
#elif __GLASGOW_HASKELL__ >= 804
        return (GHC.L l (GHC.Match c p (GHC.GRHSs rhs binds')))
#else
        return (GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds')))
#endif
#if __GLASGOW_HASKELL__ > 804
  replaceDecls (GHC.L SrcSpan
_ (GHC.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
_ [LPat GhcPs]
_ (GHC.XGRHSs XXGRHSs GhcPs (LHsExpr GhcPs)
_))) [LHsDecl GhcPs]
_ = String -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
forall a. HasCallStack => String -> a
error String
"replaceDecls"
  replaceDecls (GHC.L SrcSpan
_ (GHC.XMatch XXMatch GhcPs (LHsExpr GhcPs)
_)) [LHsDecl GhcPs]
_                   = String -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
forall a. HasCallStack => String -> a
error String
"replaceDecls"
#endif

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

instance HasDecls (GHC.LHsExpr GhcPs) where
#if __GLASGOW_HASKELL__ > 804
  hsDecls :: LHsExpr GhcPs -> TransformT m [LHsDecl GhcPs]
hsDecls ls :: LHsExpr GhcPs
ls@(GHC.L SrcSpan
_ (GHC.HsLet XLet GhcPs
_ (GHC.L SrcSpan
_ HsLocalBinds GhcPs
decls) LHsExpr GhcPs
_ex)) = do
#elif __GLASGOW_HASKELL__ > 710
  hsDecls ls@(GHC.L _ (GHC.HsLet (GHC.L _ decls) _ex)) = do
#else
  hsDecls ls@(GHC.L _ (GHC.HsLet decls _ex)) = do
#endif
    [LHsDecl GhcPs]
ds <- HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
decls
    LHsExpr GhcPs -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
orderedDecls LHsExpr GhcPs
ls [LHsDecl GhcPs]
ds
  hsDecls LHsExpr GhcPs
_                               = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []

#if __GLASGOW_HASKELL__ > 804
  replaceDecls :: LHsExpr GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsExpr GhcPs)
replaceDecls e :: LHsExpr GhcPs
e@(GHC.L SrcSpan
l (GHC.HsLet XLet GhcPs
x GenLocated SrcSpan (HsLocalBinds GhcPs)
decls LHsExpr GhcPs
ex)) [LHsDecl GhcPs]
newDecls
#else
  replaceDecls e@(GHC.L l (GHC.HsLet decls ex)) newDecls
#endif
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsLet"
        (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (LHsExpr GhcPs -> [LHsDecl GhcPs] -> Anns -> Anns
forall a b. Data a => Located a -> [Located b] -> Anns -> Anns
captureOrder LHsExpr GhcPs
e [LHsDecl GhcPs]
newDecls)
#if __GLASGOW_HASKELL__ <= 710
        decls' <- replaceDeclsValbinds decls newDecls
#else
        HsLocalBinds GhcPs
decls'' <- HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds (GenLocated SrcSpan (HsLocalBinds GhcPs)
-> SrcSpanLess (GenLocated SrcSpan (HsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
decls) [LHsDecl GhcPs]
newDecls
        let decls' :: GenLocated SrcSpan (HsLocalBinds GhcPs)
decls' = SrcSpan
-> HsLocalBinds GhcPs -> GenLocated SrcSpan (HsLocalBinds GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L (GenLocated SrcSpan (HsLocalBinds GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
decls) HsLocalBinds GhcPs
decls''
#endif
#if __GLASGOW_HASKELL__ > 804
        LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XLet GhcPs
-> GenLocated SrcSpan (HsLocalBinds GhcPs)
-> LHsExpr GhcPs
-> HsExpr GhcPs
forall p. XLet p -> LHsLocalBinds p -> LHsExpr p -> HsExpr p
GHC.HsLet XLet GhcPs
x GenLocated SrcSpan (HsLocalBinds GhcPs)
decls' LHsExpr GhcPs
ex))
#else
        return (GHC.L l (GHC.HsLet decls' ex))
#endif

#if __GLASGOW_HASKELL__ > 804
  replaceDecls (GHC.L SrcSpan
l (GHC.HsPar XPar GhcPs
x LHsExpr GhcPs
e)) [LHsDecl GhcPs]
newDecls
#else
  replaceDecls (GHC.L l (GHC.HsPar e)) newDecls
#endif
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsPar"
        LHsExpr GhcPs
e' <- LHsExpr GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsExpr GhcPs)
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
replaceDecls LHsExpr GhcPs
e [LHsDecl GhcPs]
newDecls
#if __GLASGOW_HASKELL__ > 804
        LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
GHC.HsPar XPar GhcPs
x LHsExpr GhcPs
e'))
#else
        return (GHC.L l (GHC.HsPar e'))
#endif
  replaceDecls LHsExpr GhcPs
old [LHsDecl GhcPs]
_new = String -> TransformT m (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error (String -> TransformT m (LHsExpr GhcPs))
-> String -> TransformT m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ String
"replaceDecls (GHC.LHsExpr GhcPs) undefined for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LHsExpr GhcPs -> String
forall a. Outputable a => a -> String
showGhc LHsExpr GhcPs
old

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

-- | Extract the immediate declarations for a 'GHC.PatBind' wrapped in a 'GHC.ValD'. This
-- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is
-- idempotent.
hsDeclsPatBindD :: (Monad m) => GHC.LHsDecl GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
#if __GLASGOW_HASKELL__ > 804
hsDeclsPatBindD :: LHsDecl GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBindD (GHC.L SrcSpan
l (GHC.ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
d)) = LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBind (SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l HsBindLR GhcPs GhcPs
d)
#else
hsDeclsPatBindD (GHC.L l (GHC.ValD d)) = hsDeclsPatBind (GHC.L l d)
#endif
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]
++ LHsDecl GhcPs -> String
forall a. Outputable a => a -> String
showGhc LHsDecl GhcPs
x

-- | Extract the immediate declarations for a 'GHC.PatBind'. This
-- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is
-- idempotent.
hsDeclsPatBind :: (Monad m) => GHC.LHsBind GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
#if __GLASGOW_HASKELL__ > 804
hsDeclsPatBind :: LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsPatBind d :: LHsBind GhcPs
d@(GHC.L SrcSpan
_ (GHC.PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
_ (GHC.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [LGRHS GhcPs (LHsExpr GhcPs)]
_grhs (GHC.L SrcSpan
_ HsLocalBinds GhcPs
lb)) ([Tickish Id], [[Tickish Id]])
_)) = do
#elif __GLASGOW_HASKELL__ > 710
hsDeclsPatBind d@(GHC.L _ (GHC.PatBind _ (GHC.GRHSs _grhs (GHC.L _ lb)) _ _ _)) = do
#else
hsDeclsPatBind d@(GHC.L _ (GHC.PatBind _ (GHC.GRHSs _grhs lb) _ _ _)) = do
#endif
  [LHsDecl GhcPs]
decls <- HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
lb
  LHsBind GhcPs -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
orderedDecls LHsBind GhcPs
d [LHsDecl GhcPs]
decls
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]
++ LHsBind GhcPs -> String
forall a. Outputable a => a -> String
showGhc LHsBind GhcPs
x

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

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

-- | Replace the immediate declarations for a 'GHC.PatBind'. This
-- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
-- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is
-- idempotent.
replaceDeclsPatBind :: (Monad m) => GHC.LHsBind GhcPs -> [GHC.LHsDecl GhcPs]
                    -> TransformT m (GHC.LHsBind GhcPs)
#if __GLASGOW_HASKELL__ > 804
replaceDeclsPatBind :: LHsBind GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsBind GhcPs)
replaceDeclsPatBind p :: LHsBind GhcPs
p@(GHC.L SrcSpan
l (GHC.PatBind XPatBind GhcPs GhcPs
x LPat GhcPs
a (GHC.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
xr [LGRHS GhcPs (LHsExpr GhcPs)]
rhss GenLocated SrcSpan (HsLocalBinds GhcPs)
binds) ([Tickish Id], [[Tickish Id]])
b)) [LHsDecl GhcPs]
newDecls
#else
replaceDeclsPatBind p@(GHC.L l (GHC.PatBind a (GHC.GRHSs rhss binds) b c d)) newDecls
#endif
    = 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.
#if __GLASGOW_HASKELL__ <= 710
        case binds of
#else
        case GenLocated SrcSpan (HsLocalBinds GhcPs)
-> SrcSpanLess (GenLocated SrcSpan (HsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
binds of
#endif
#if __GLASGOW_HASKELL__ > 804
          GHC.EmptyLocalBinds{} -> do
#else
          GHC.EmptyLocalBinds -> do
#endif
            let
              addWhere :: Anns -> Anns
addWhere Anns
mkds =
                case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (LHsBind GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsBind GhcPs
p) Anns
mkds of
                  Maybe Annotation
Nothing -> String -> Anns
forall a. HasCallStack => String -> a
error String
"wtf"
                  Just Annotation
ann -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (LHsBind GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsBind GhcPs
p) Annotation
ann1 Anns
mkds
                    where
                      ann1 :: Annotation
ann1 = Annotation
ann { annsDP :: [(KeywordId, DeltaPos)]
annsDP = Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
ann [(KeywordId, DeltaPos)]
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ [(AnnKeywordId -> KeywordId
G AnnKeywordId
GHC.AnnWhere,(Int, Int) -> DeltaPos
DP (Int
1,Int
2))]
                                 }
            (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT Anns -> Anns
addWhere
            (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines (String -> [LHsDecl GhcPs] -> LHsDecl GhcPs
forall a. String -> [a] -> a
ghead String
"LMatch.replaceDecls" [LHsDecl GhcPs]
newDecls) Int
1 Int
4)

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

        (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (AnnKey -> [LHsDecl GhcPs] -> Anns -> Anns
forall b. AnnKey -> [Located b] -> Anns -> Anns
captureOrderAnnKey (LHsBind GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsBind GhcPs
p) [LHsDecl GhcPs]
newDecls)
#if __GLASGOW_HASKELL__ <= 710
        binds' <- replaceDeclsValbinds binds newDecls
#else
        HsLocalBinds GhcPs
binds'' <- HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds (GenLocated SrcSpan (HsLocalBinds GhcPs)
-> SrcSpanLess (GenLocated SrcSpan (HsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
binds) [LHsDecl GhcPs]
newDecls
        let binds' :: GenLocated SrcSpan (HsLocalBinds GhcPs)
binds' = SrcSpan
-> HsLocalBinds GhcPs -> GenLocated SrcSpan (HsLocalBinds GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L (GenLocated SrcSpan (HsLocalBinds GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
binds) HsLocalBinds GhcPs
binds''
#endif
#if __GLASGOW_HASKELL__ > 804
        LHsBind GhcPs -> TransformT m (LHsBind GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XPatBind GhcPs GhcPs
-> LPat GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
-> ([Tickish Id], [[Tickish Id]])
-> HsBindLR GhcPs GhcPs
forall idL idR.
XPatBind idL idR
-> LPat idL
-> GRHSs idR (LHsExpr idR)
-> ([Tickish Id], [[Tickish Id]])
-> HsBindLR idL idR
GHC.PatBind XPatBind GhcPs GhcPs
x LPat GhcPs
a (XCGRHSs GhcPs (LHsExpr GhcPs)
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> GenLocated SrcSpan (HsLocalBinds GhcPs)
-> GRHSs GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GHC.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
xr [LGRHS GhcPs (LHsExpr GhcPs)]
rhss GenLocated SrcSpan (HsLocalBinds GhcPs)
binds') ([Tickish Id], [[Tickish Id]])
b))
#else
        return (GHC.L l (GHC.PatBind a (GHC.GRHSs rhss binds') b c d))
#endif
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]
++ LHsBind GhcPs -> String
forall a. Outputable a => a -> String
showGhc LHsBind GhcPs
x

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

instance HasDecls (GHC.LStmt GhcPs (GHC.LHsExpr GhcPs)) where
#if __GLASGOW_HASKELL__ > 804
  hsDecls :: LStmt GhcPs (LHsExpr GhcPs) -> TransformT m [LHsDecl GhcPs]
hsDecls ls :: LStmt GhcPs (LHsExpr GhcPs)
ls@(GHC.L SrcSpan
_ (GHC.LetStmt XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (GHC.L SrcSpan
_ HsLocalBinds GhcPs
lb))) = do
#elif __GLASGOW_HASKELL__ > 710
  hsDecls ls@(GHC.L _ (GHC.LetStmt (GHC.L _ lb))) = do
#else
  hsDecls ls@(GHC.L _ (GHC.LetStmt lb))       = do
#endif
    [LHsDecl GhcPs]
decls <- HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
lb
    LStmt GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
orderedDecls LStmt GhcPs (LHsExpr GhcPs)
ls [LHsDecl GhcPs]
decls
#if __GLASGOW_HASKELL__ > 804
  hsDecls (GHC.L SrcSpan
_ (GHC.LastStmt XLastStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr GhcPs
e Bool
_ SyntaxExpr GhcPs
_))    = LHsExpr GhcPs -> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls LHsExpr GhcPs
e
#elif __GLASGOW_HASKELL__ >= 804
  hsDecls (GHC.L _ (GHC.LastStmt e _ _))      = hsDecls e
#elif __GLASGOW_HASKELL__ > 800
  hsDecls (GHC.L _ (GHC.LastStmt e _ _))      = hsDecls e
#elif __GLASGOW_HASKELL__ > 710
  hsDecls (GHC.L _ (GHC.LastStmt e _ _))      = hsDecls e
#else
  hsDecls (GHC.L _ (GHC.LastStmt e _))        = hsDecls e
#endif
#if __GLASGOW_HASKELL__ >= 900
  hsDecls (GHC.L _ (GHC.BindStmt _ _pat e))     = hsDecls e
#elif __GLASGOW_HASKELL__ > 804
  hsDecls (GHC.L SrcSpan
_ (GHC.BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LPat GhcPs
_pat LHsExpr GhcPs
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) = LHsExpr GhcPs -> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls LHsExpr GhcPs
e
#elif __GLASGOW_HASKELL__ > 710
  hsDecls (GHC.L _ (GHC.BindStmt _pat e _ _ _)) = hsDecls e
#else
  hsDecls (GHC.L _ (GHC.BindStmt _pat e _ _)) = hsDecls e
#endif
#if __GLASGOW_HASKELL__ > 804
  hsDecls (GHC.L SrcSpan
_ (GHC.BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr GhcPs
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))    = LHsExpr GhcPs -> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls LHsExpr GhcPs
e
#else
  hsDecls (GHC.L _ (GHC.BodyStmt e _ _ _))    = hsDecls e
#endif
  hsDecls LStmt GhcPs (LHsExpr GhcPs)
_                                   = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []

#if __GLASGOW_HASKELL__ > 804
  replaceDecls :: LStmt GhcPs (LHsExpr GhcPs)
-> [LHsDecl GhcPs] -> TransformT m (LStmt GhcPs (LHsExpr GhcPs))
replaceDecls s :: LStmt GhcPs (LHsExpr GhcPs)
s@(GHC.L SrcSpan
l (GHC.LetStmt XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
x GenLocated SrcSpan (HsLocalBinds GhcPs)
lb)) [LHsDecl GhcPs]
newDecls
#else
  replaceDecls s@(GHC.L l (GHC.LetStmt lb)) newDecls
#endif
    = do
        (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (LStmt GhcPs (LHsExpr GhcPs) -> [LHsDecl GhcPs] -> Anns -> Anns
forall a b. Data a => Located a -> [Located b] -> Anns -> Anns
captureOrder LStmt GhcPs (LHsExpr GhcPs)
s [LHsDecl GhcPs]
newDecls)
#if __GLASGOW_HASKELL__ <= 710
        lb' <- replaceDeclsValbinds lb newDecls
#else
        HsLocalBinds GhcPs
lb'' <- HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
forall (m :: * -> *).
Monad m =>
HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds (GenLocated SrcSpan (HsLocalBinds GhcPs)
-> SrcSpanLess (GenLocated SrcSpan (HsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
lb) [LHsDecl GhcPs]
newDecls
        let lb' :: GenLocated SrcSpan (HsLocalBinds GhcPs)
lb' = SrcSpan
-> HsLocalBinds GhcPs -> GenLocated SrcSpan (HsLocalBinds GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L (GenLocated SrcSpan (HsLocalBinds GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc GenLocated SrcSpan (HsLocalBinds GhcPs)
lb) HsLocalBinds GhcPs
lb''
#endif
#if __GLASGOW_HASKELL__ > 804
        LStmt GhcPs (LHsExpr GhcPs)
-> TransformT m (LStmt GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-> LStmt GhcPs (LHsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
-> GenLocated SrcSpan (HsLocalBinds GhcPs)
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
GHC.LetStmt XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
x GenLocated SrcSpan (HsLocalBinds GhcPs)
lb'))
#else
        return (GHC.L l (GHC.LetStmt   lb'))
#endif
#if __GLASGOW_HASKELL__ > 804
  replaceDecls (GHC.L SrcSpan
l (GHC.LastStmt XLastStmt GhcPs GhcPs (LHsExpr GhcPs)
x LHsExpr GhcPs
e Bool
d SyntaxExpr GhcPs
se)) [LHsDecl GhcPs]
newDecls
    = do
        LHsExpr GhcPs
e' <- LHsExpr GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsExpr GhcPs)
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
replaceDecls LHsExpr GhcPs
e [LHsDecl GhcPs]
newDecls
        LStmt GhcPs (LHsExpr GhcPs)
-> TransformT m (LStmt GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-> LStmt GhcPs (LHsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XLastStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> Bool
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XLastStmt idL idR body
-> body -> Bool -> SyntaxExpr idR -> StmtLR idL idR body
GHC.LastStmt XLastStmt GhcPs GhcPs (LHsExpr GhcPs)
x LHsExpr GhcPs
e' Bool
d SyntaxExpr GhcPs
se))
#elif __GLASGOW_HASKELL__ > 710
  replaceDecls (GHC.L l (GHC.LastStmt e d se)) newDecls
    = do
        e' <- replaceDecls e newDecls
        return (GHC.L l (GHC.LastStmt e' d se))
#else
  replaceDecls (GHC.L l (GHC.LastStmt e se)) newDecls
    = do
        e' <- replaceDecls e newDecls
        return (GHC.L l (GHC.LastStmt e' se))
#endif
#if __GLASGOW_HASKELL__ >= 900
  replaceDecls (GHC.L l (GHC.BindStmt x pat e)) newDecls
    = do
      e' <- replaceDecls e newDecls
      return (GHC.L l (GHC.BindStmt x pat e'))
#elif __GLASGOW_HASKELL__ > 804
  replaceDecls (GHC.L SrcSpan
l (GHC.BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
x LPat GhcPs
pat LHsExpr GhcPs
e SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b)) [LHsDecl GhcPs]
newDecls
    = do
      LHsExpr GhcPs
e' <- LHsExpr GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsExpr GhcPs)
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
replaceDecls LHsExpr GhcPs
e [LHsDecl GhcPs]
newDecls
      LStmt GhcPs (LHsExpr GhcPs)
-> TransformT m (LStmt GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-> LStmt GhcPs (LHsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LPat GhcPs
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
GHC.BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
x LPat GhcPs
pat LHsExpr GhcPs
e' SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b))
#elif __GLASGOW_HASKELL__ > 710
  replaceDecls (GHC.L l (GHC.BindStmt pat e a b c)) newDecls
    = do
      e' <- replaceDecls e newDecls
      return (GHC.L l (GHC.BindStmt pat e' a b c))
#else
  replaceDecls (GHC.L l (GHC.BindStmt pat e a b)) newDecls
    = do
      e' <- replaceDecls e newDecls
      return (GHC.L l (GHC.BindStmt pat e' a b))
#endif

#if __GLASGOW_HASKELL__ > 804
  replaceDecls (GHC.L SrcSpan
l (GHC.BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
x LHsExpr GhcPs
e SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b)) [LHsDecl GhcPs]
newDecls
    = do
      LHsExpr GhcPs
e' <- LHsExpr GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsExpr GhcPs)
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
replaceDecls LHsExpr GhcPs
e [LHsDecl GhcPs]
newDecls
      LStmt GhcPs (LHsExpr GhcPs)
-> TransformT m (LStmt GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-> LStmt GhcPs (LHsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
GHC.BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
x LHsExpr GhcPs
e' SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b))
#else
  replaceDecls (GHC.L l (GHC.BodyStmt e a b c)) newDecls
    = do
      e' <- replaceDecls e newDecls
      return (GHC.L l (GHC.BodyStmt e' a b c))
#endif
  replaceDecls LStmt GhcPs (LHsExpr GhcPs)
x [LHsDecl GhcPs]
_newDecls = LStmt GhcPs (LHsExpr GhcPs)
-> TransformT m (LStmt GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return LStmt GhcPs (LHsExpr 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 'GHC.LHsBind'. This is required
-- because a 'GHC.FunBind' may have multiple 'GHC.Match' items, so we cannot
-- gurantee that 'replaceDecls' after 'hsDecls' is idempotent.
hasDeclsSybTransform :: (SYB.Data t2,Monad m)
       => (forall t. HasDecls t => t -> m t)
             -- ^Worker function for the general case
       -> (GHC.LHsBind GhcPs -> m (GHC.LHsBind GhcPs))
             -- ^Worker function for FunBind/PatBind
       -> t2 -- ^Item to be updated
       -> m t2
hasDeclsSybTransform :: (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
SYB.mkM   ParsedSource -> m ParsedSource
parsedSource
         (t2 -> m t2)
-> (LMatch GhcPs (LHsExpr GhcPs)
    -> m (LMatch GhcPs (LHsExpr GhcPs)))
-> t2
-> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`SYB.extM` LMatch GhcPs (LHsExpr GhcPs) -> m (LMatch GhcPs (LHsExpr GhcPs))
lmatch
         (t2 -> m t2) -> (LHsExpr GhcPs -> m (LHsExpr GhcPs)) -> t2 -> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`SYB.extM` LHsExpr GhcPs -> m (LHsExpr GhcPs)
lexpr
         (t2 -> m t2)
-> (LStmt GhcPs (LHsExpr GhcPs) -> m (LStmt GhcPs (LHsExpr GhcPs)))
-> t2
-> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`SYB.extM` LStmt GhcPs (LHsExpr GhcPs) -> m (LStmt GhcPs (LHsExpr GhcPs))
lstmt
         (t2 -> m t2) -> (LHsBind GhcPs -> m (LHsBind GhcPs)) -> t2 -> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`SYB.extM` LHsBind GhcPs -> m (LHsBind GhcPs)
lhsbind
         (t2 -> m t2) -> (LHsDecl GhcPs -> m (LHsDecl GhcPs)) -> t2 -> m t2
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`SYB.extM` LHsDecl GhcPs -> m (LHsDecl GhcPs)
lvald

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

    lmatch :: LMatch GhcPs (LHsExpr GhcPs) -> m (LMatch GhcPs (LHsExpr GhcPs))
lmatch (LMatch GhcPs (LHsExpr GhcPs)
lm::GHC.LMatch GhcPs (GHC.LHsExpr GhcPs))
      = LMatch GhcPs (LHsExpr GhcPs) -> m (LMatch GhcPs (LHsExpr GhcPs))
forall t. HasDecls t => t -> m t
workerHasDecls LMatch GhcPs (LHsExpr GhcPs)
lm

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

    lstmt :: LStmt GhcPs (LHsExpr GhcPs) -> m (LStmt GhcPs (LHsExpr GhcPs))
lstmt (LStmt GhcPs (LHsExpr GhcPs)
d::GHC.LStmt GhcPs (GHC.LHsExpr GhcPs))
      = LStmt GhcPs (LHsExpr GhcPs) -> m (LStmt GhcPs (LHsExpr GhcPs))
forall t. HasDecls t => t -> m t
workerHasDecls LStmt GhcPs (LHsExpr GhcPs)
d

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

#if __GLASGOW_HASKELL__ > 804
    lvald :: LHsDecl GhcPs -> m (LHsDecl GhcPs)
lvald (GHC.L SrcSpan
l (GHC.ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
d)) = do
      (GHC.L SrcSpan
_ HsBindLR GhcPs GhcPs
d') <- LHsBind GhcPs -> m (LHsBind GhcPs)
lhsbind (SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l HsBindLR GhcPs GhcPs
d)
      LHsDecl GhcPs -> m (LHsDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsDecl GhcPs -> LHsDecl GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
GHC.ValD XValD GhcPs
x HsBindLR GhcPs GhcPs
d'))
#else
    lvald (GHC.L l (GHC.ValD d)) = do
      (GHC.L _ d') <- lhsbind (GHC.L l d)
      return (GHC.L l (GHC.ValD d'))
#endif
    lvald LHsDecl GhcPs
x = LHsDecl GhcPs -> m (LHsDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsDecl GhcPs
x

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

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

    parsedSource :: ParsedSource -> TransformT m [LHsDecl GhcPs]
parsedSource (ParsedSource
p::GHC.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::GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)) = LMatch GhcPs (LHsExpr GhcPs) -> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls LMatch GhcPs (LHsExpr GhcPs)
lm

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

    lstmt :: LStmt GhcPs (LHsExpr GhcPs) -> TransformT m [LHsDecl GhcPs]
lstmt (LStmt GhcPs (LHsExpr GhcPs)
d::GHC.LStmt GhcPs (GHC.LHsExpr GhcPs)) = LStmt GhcPs (LHsExpr GhcPs) -> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls LStmt GhcPs (LHsExpr GhcPs)
d

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

    lhsbind :: (Monad m) => GHC.LHsBind GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
#if __GLASGOW_HASKELL__ >= 900
    lhsbind (GHC.L _ (GHC.FunBind _ _ (GHC.MG _ (GHC.L _ matches) _) _)) = do
#elif __GLASGOW_HASKELL__ > 808
    lhsbind :: LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
lhsbind (GHC.L SrcSpan
_ (GHC.FunBind XFunBind GhcPs GhcPs
_ Located (IdP GhcPs)
_ (GHC.MG XMG GhcPs (LHsExpr GhcPs)
_ (GHC.L SrcSpan
_ [LMatch GhcPs (LHsExpr GhcPs)]
matches) Origin
_) HsWrapper
_ [Tickish Id]
_)) = do
#elif __GLASGOW_HASKELL__ > 804
    lhsbind (GHC.L _ (GHC.FunBind _ _ (GHC.MG _ (GHC.L _ matches) _) _ _)) = do
#elif __GLASGOW_HASKELL__ > 710
    lhsbind (GHC.L _ (GHC.FunBind _ (GHC.MG (GHC.L _ matches) _ _ _) _ _ _)) = do
#else
    lhsbind (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) = do
#endif
        [[LHsDecl GhcPs]]
dss <- (LMatch GhcPs (LHsExpr GhcPs) -> TransformT m [LHsDecl GhcPs])
-> [LMatch GhcPs (LHsExpr GhcPs)] -> TransformT m [[LHsDecl GhcPs]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcPs (LHsExpr GhcPs) -> TransformT m [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls [LMatch GhcPs (LHsExpr GhcPs)]
matches
        [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[LHsDecl GhcPs]] -> [LHsDecl GhcPs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LHsDecl GhcPs]]
dss)
    lhsbind p :: LHsBind GhcPs
p@(GHC.L SrcSpan
_ (GHC.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
_ = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []

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

#if __GLASGOW_HASKELL__ > 804
    lhsbindd :: LHsDecl GhcPs -> TransformT m [LHsDecl GhcPs]
lhsbindd (GHC.L SrcSpan
l (GHC.ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
d)) = LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *).
Monad m =>
LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
lhsbind (SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l HsBindLR GhcPs GhcPs
d)
#else
    lhsbindd (GHC.L l (GHC.ValD d)) = lhsbind (GHC.L l d)
#endif
    lhsbindd LHsDecl GhcPs
_ = [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []

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

    llocalbinds :: (Monad m) => GHC.Located (GHC.HsLocalBinds GhcPs) -> TransformT m [GHC.LHsDecl GhcPs]
    llocalbinds :: GenLocated SrcSpan (HsLocalBinds GhcPs)
-> TransformT m [LHsDecl GhcPs]
llocalbinds (GHC.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) => GHC.HsLocalBinds GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
    localbinds :: 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
orderedDecls :: (Data a,Monad m) => GHC.Located a -> [GHC.LHsDecl GhcPs] -> TransformT m [GHC.LHsDecl GhcPs]
orderedDecls :: Located a -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
orderedDecls Located a
parent [LHsDecl GhcPs]
decls = do
  Anns
ans <- TransformT m Anns
forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT
  case Located a -> Anns -> Maybe Annotation
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Anns -> Maybe Annotation
getAnnotationEP Located a
parent Anns
ans of
    Maybe Annotation
Nothing -> 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
"orderedDecls:no annotation for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Anns -> Int -> Located a -> String
forall a. Data a => Anns -> Int -> a -> String
showAnnData Anns
emptyAnns Int
0 Located a
parent
    Just Annotation
ann -> case Annotation -> Maybe [SrcSpan]
annSortKey Annotation
ann of
      Maybe [SrcSpan]
Nothing -> do
        [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return [LHsDecl GhcPs]
decls
      Just [SrcSpan]
keys -> do
        let ds :: [(SrcSpan, LHsDecl GhcPs)]
ds = (LHsDecl GhcPs -> (SrcSpan, LHsDecl GhcPs))
-> [LHsDecl GhcPs] -> [(SrcSpan, LHsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (\LHsDecl GhcPs
s -> (SrcSpan -> SrcSpan
rs (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc LHsDecl GhcPs
s,LHsDecl GhcPs
s)) [LHsDecl GhcPs]
decls
            ordered :: [LHsDecl GhcPs]
ordered = ((SrcSpan, LHsDecl GhcPs) -> LHsDecl GhcPs)
-> [(SrcSpan, LHsDecl GhcPs)] -> [LHsDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan, LHsDecl GhcPs) -> LHsDecl GhcPs
forall a b. (a, b) -> b
snd ([(SrcSpan, LHsDecl GhcPs)] -> [LHsDecl GhcPs])
-> [(SrcSpan, LHsDecl GhcPs)] -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ [(SrcSpan, LHsDecl GhcPs)]
-> [SrcSpan] -> [(SrcSpan, LHsDecl GhcPs)]
forall o a. Eq o => [(o, a)] -> [o] -> [(o, a)]
orderByKey [(SrcSpan, LHsDecl GhcPs)]
ds [SrcSpan]
keys
        [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return [LHsDecl GhcPs]
ordered

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

-- | Utility function for extracting decls from 'GHC.HsLocalBinds'. Use with
-- care, as this does not necessarily return the declarations in order, the
-- ordering should be done by the calling function from the 'GHC.HsLocalBinds'
-- context in the AST.
hsDeclsValBinds :: (Monad m) => GHC.HsLocalBinds GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
hsDeclsValBinds :: HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
hsDeclsValBinds HsLocalBinds GhcPs
lb = case HsLocalBinds GhcPs
lb of
#if __GLASGOW_HASKELL__ > 804
    GHC.HsValBinds XHsValBinds GhcPs GhcPs
_ (GHC.ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bs [LSig GhcPs]
sigs) -> do
      let
        bds :: [LHsDecl GhcPs]
bds = (LHsBind GhcPs -> LHsDecl GhcPs)
-> [LHsBind GhcPs] -> [LHsDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LHsBind GhcPs -> LHsDecl GhcPs
wrapDecl (LHsBindsLR GhcPs GhcPs -> [LHsBind GhcPs]
forall a. Bag a -> [a]
GHC.bagToList LHsBindsLR GhcPs GhcPs
bs)
        sds :: [LHsDecl GhcPs]
sds = (LSig GhcPs -> LHsDecl GhcPs) -> [LSig GhcPs] -> [LHsDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LSig GhcPs -> LHsDecl GhcPs
wrapSig [LSig GhcPs]
sigs
      [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl GhcPs]
bds [LHsDecl GhcPs] -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcPs]
sds)
    GHC.HsValBinds XHsValBinds GhcPs GhcPs
_ (GHC.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"
    GHC.HsIPBinds {}       -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    GHC.EmptyLocalBinds {} -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    GHC.XHsLocalBindsLR {} -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *) a. Monad m => a -> m a
return []
#else
    GHC.HsValBinds (GHC.ValBindsIn bs sigs) -> do
      let
        bds = map wrapDecl (GHC.bagToList bs)
        sds = map wrapSig sigs
      return (bds ++ sds)
    GHC.HsValBinds (GHC.ValBindsOut _ _) -> error $ "hsDecls.ValbindsOut not valid"
    GHC.HsIPBinds _     -> return []
    GHC.EmptyLocalBinds -> return []
#endif

-- | Utility function for returning decls to 'GHC.HsLocalBinds'. Use with
-- care, as this does not manage the declaration order, the
-- ordering should be done by the calling function from the 'GHC.HsLocalBinds'
-- context in the AST.
replaceDeclsValbinds :: (Monad m)
                     => GHC.HsLocalBinds GhcPs -> [GHC.LHsDecl GhcPs]
                     -> TransformT m (GHC.HsLocalBinds GhcPs)
replaceDeclsValbinds :: HsLocalBinds GhcPs
-> [LHsDecl GhcPs] -> TransformT m (HsLocalBinds GhcPs)
replaceDeclsValbinds HsLocalBinds GhcPs
_ [] = do
#if __GLASGOW_HASKELL__ > 808
  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
GHC.EmptyLocalBinds NoExtField
XEmptyLocalBinds GhcPs GhcPs
GHC.NoExtField)
#elif __GLASGOW_HASKELL__ > 804
  return (GHC.EmptyLocalBinds GHC.noExt)
#else
  return (GHC.EmptyLocalBinds)
#endif
#if __GLASGOW_HASKELL__ > 804
replaceDeclsValbinds (GHC.HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
_b) [LHsDecl GhcPs]
new
#else
replaceDeclsValbinds (GHC.HsValBinds _b) new
#endif
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsLocalBinds"
        let decs :: LHsBindsLR GhcPs GhcPs
decs = [LHsBind GhcPs] -> LHsBindsLR GhcPs GhcPs
forall a. [a] -> Bag a
GHC.listToBag ([LHsBind GhcPs] -> LHsBindsLR GhcPs GhcPs)
-> [LHsBind GhcPs] -> LHsBindsLR GhcPs GhcPs
forall a b. (a -> b) -> a -> b
$ (LHsDecl GhcPs -> [LHsBind GhcPs])
-> [LHsDecl GhcPs] -> [LHsBind GhcPs]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [LHsBind GhcPs]
forall name. LHsDecl name -> [LHsBind name]
decl2Bind [LHsDecl GhcPs]
new
        let sigs :: [LSig GhcPs]
sigs = (LHsDecl GhcPs -> [LSig GhcPs]) -> [LHsDecl GhcPs] -> [LSig GhcPs]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [LSig GhcPs]
forall name. LHsDecl name -> [LSig name]
decl2Sig [LHsDecl GhcPs]
new
#if __GLASGOW_HASKELL__ > 808
        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
GHC.HsValBinds NoExtField
XHsValBinds GhcPs GhcPs
GHC.NoExtField (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
GHC.ValBinds NoExtField
XValBinds GhcPs GhcPs
GHC.NoExtField LHsBindsLR GhcPs GhcPs
decs [LSig GhcPs]
sigs))
#elif __GLASGOW_HASKELL__ > 804
        return (GHC.HsValBinds GHC.noExt (GHC.ValBinds GHC.noExt decs sigs))
#else
        return (GHC.HsValBinds (GHC.ValBindsIn decs sigs))
#endif
replaceDeclsValbinds (GHC.HsIPBinds {}) [LHsDecl GhcPs]
_new    = String -> TransformT m (HsLocalBinds GhcPs)
forall a. HasCallStack => String -> a
error String
"undefined replaceDecls HsIPBinds"
#if __GLASGOW_HASKELL__ > 804
replaceDeclsValbinds (GHC.EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) [LHsDecl GhcPs]
new
#else
replaceDeclsValbinds (GHC.EmptyLocalBinds) new
#endif
    = do
        String -> TransformT m ()
forall (m :: * -> *). Monad m => String -> TransformT m ()
logTr String
"replaceDecls HsLocalBinds"
        let newBinds :: [[LHsBind GhcPs]]
newBinds = (LHsDecl GhcPs -> [LHsBind GhcPs])
-> [LHsDecl GhcPs] -> [[LHsBind GhcPs]]
forall a b. (a -> b) -> [a] -> [b]
map LHsDecl GhcPs -> [LHsBind GhcPs]
forall name. LHsDecl name -> [LHsBind name]
decl2Bind [LHsDecl GhcPs]
new
            newSigs :: [[LSig GhcPs]]
newSigs  = (LHsDecl GhcPs -> [LSig GhcPs])
-> [LHsDecl GhcPs] -> [[LSig GhcPs]]
forall a b. (a -> b) -> [a] -> [b]
map LHsDecl GhcPs -> [LSig GhcPs]
forall name. LHsDecl name -> [LSig name]
decl2Sig  [LHsDecl GhcPs]
new
        let decs :: LHsBindsLR GhcPs GhcPs
decs = [LHsBind GhcPs] -> LHsBindsLR GhcPs GhcPs
forall a. [a] -> Bag a
GHC.listToBag ([LHsBind GhcPs] -> LHsBindsLR GhcPs GhcPs)
-> [LHsBind GhcPs] -> LHsBindsLR GhcPs GhcPs
forall a b. (a -> b) -> a -> b
$ [[LHsBind GhcPs]] -> [LHsBind GhcPs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LHsBind GhcPs]]
newBinds
        let sigs :: [LSig GhcPs]
sigs = [[LSig GhcPs]] -> [LSig GhcPs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LSig GhcPs]]
newSigs
#if __GLASGOW_HASKELL__ > 808
        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
GHC.HsValBinds NoExtField
XHsValBinds GhcPs GhcPs
GHC.NoExtField (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
GHC.ValBinds NoExtField
XValBinds GhcPs GhcPs
GHC.NoExtField LHsBindsLR GhcPs GhcPs
decs [LSig GhcPs]
sigs))
#elif __GLASGOW_HASKELL__ > 804
        return (GHC.HsValBinds GHC.noExt (GHC.ValBinds GHC.noExt decs sigs))
#else
        return (GHC.HsValBinds (GHC.ValBindsIn decs sigs))
#endif
#if __GLASGOW_HASKELL__ > 804
replaceDeclsValbinds (GHC.XHsLocalBindsLR XXHsLocalBindsLR GhcPs GhcPs
_) [LHsDecl GhcPs]
_ = String -> TransformT m (HsLocalBinds GhcPs)
forall a. HasCallStack => String -> a
error String
"replaceDeclsValbinds. XHsLocalBindsLR"
#endif

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

type Decl  = GHC.LHsDecl GhcPs
type Match = GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)

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

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

matchApiAnn :: GHC.AnnKeywordId -> (KeywordId,DeltaPos) -> Bool
matchApiAnn :: AnnKeywordId -> (KeywordId, DeltaPos) -> Bool
matchApiAnn AnnKeywordId
mkw (KeywordId
kw,DeltaPos
_)
  = case KeywordId
kw of
     (G AnnKeywordId
akw) -> AnnKeywordId
mkw AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
akw
     KeywordId
_       -> Bool
False


-- We comments extracted from annPriorComments or annFollowingComments, which
-- need to move to just before the item identified by the predicate, if it
-- fires, else at the end of the annotations.
insertCommentBefore :: (Monad m) => AnnKey -> [(Comment, DeltaPos)]
                    -> ((KeywordId, DeltaPos) -> Bool) -> TransformT m ()
insertCommentBefore :: AnnKey
-> [(Comment, DeltaPos)]
-> ((KeywordId, DeltaPos) -> Bool)
-> TransformT m ()
insertCommentBefore AnnKey
key [(Comment, DeltaPos)]
toMove (KeywordId, DeltaPos) -> Bool
p = do
  let
    doInsert :: Anns -> Anns
doInsert Anns
ans =
      case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
key Anns
ans of
        Maybe Annotation
Nothing -> String -> Anns
forall a. HasCallStack => String -> a
error (String -> Anns) -> String -> Anns
forall a b. (a -> b) -> a -> b
$ String
"insertCommentBefore:no AnnKey for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnnKey -> String
forall a. Outputable a => a -> String
showGhc AnnKey
key
        Just Annotation
ann -> AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
key Annotation
ann' Anns
ans
          where
            ([(KeywordId, DeltaPos)]
before,[(KeywordId, DeltaPos)]
after) = ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)]
-> ([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (KeywordId, DeltaPos) -> Bool
p (Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
ann)
            ann' :: Annotation
ann' = Annotation
ann { annsDP :: [(KeywordId, DeltaPos)]
annsDP = [(KeywordId, DeltaPos)]
before [(KeywordId, DeltaPos)]
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ (((Comment, DeltaPos) -> (KeywordId, DeltaPos))
-> [(Comment, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> [a] -> [b]
map (Comment, DeltaPos) -> (KeywordId, DeltaPos)
comment2dp [(Comment, DeltaPos)]
toMove) [(KeywordId, DeltaPos)]
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ [(KeywordId, DeltaPos)]
after}

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