{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
module Development.IDE.GHC.ExactPrint
( Graft(..),
graftDecls,
graftDeclsWithM,
annotate,
annotateDecl,
hoistGraft,
graftWithM,
graftExprWithM,
genericGraftWithSmallestM,
genericGraftWithLargestM,
graftSmallestDeclsWithM,
transform,
transformM,
ExactPrint(..),
#if MIN_VERSION_ghc(9,2,1)
modifySmallestDeclWithM,
modifyMgMatchesT,
modifyMgMatchesT',
modifySigWithM,
genAnchor1,
#endif
#if !MIN_VERSION_ghc(9,2,0)
Anns,
Annotate,
setPrecedingLinesT,
#else
setPrecedingLines,
addParens,
addParensToCtxt,
modifyAnns,
removeComma,
eqSrcSpan,
epl,
epAnn,
removeTrailingComma,
#endif
annotateParsedSource,
getAnnotatedParsedSourceRule,
GetAnnotatedParsedSource(..),
ASTElement (..),
ExceptStringT (..),
TransformT,
Log(..),
)
where
import Control.Applicative (Alternative)
import Control.Arrow (right, (***))
import Control.DeepSeq
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Zip
import Data.Bifunctor
import Data.Bool (bool)
import Data.Default (Default)
import qualified Data.DList as DL
import Data.Either.Extra (mapLeft)
import Data.Foldable (Foldable (fold))
import Data.Functor.Classes
import Data.Functor.Contravariant
import Data.Monoid (All (All), getAll)
import qualified Data.Text as T
import Data.Traversable (for)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service (runAction)
import Development.IDE.Core.Shake hiding (Log)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.GHC.Compat hiding (parseImport,
parsePattern,
parseType)
import Development.IDE.GHC.Compat.ExactPrint
import Development.IDE.Graph (RuleResult, Rules)
import Development.IDE.Graph.Classes
import Development.IDE.Types.Location
import Development.IDE.Types.Logger (Pretty (pretty),
Recorder,
WithPriority,
cmapWithPrio)
import Generics.SYB
import Generics.SYB.GHC
import qualified GHC.Generics as GHC
import Ide.PluginUtils
import Language.Haskell.GHC.ExactPrint.Parsers
import Language.LSP.Types
import Language.LSP.Types.Capabilities (ClientCapabilities)
import Retrie.ExactPrint hiding (parseDecl,
parseExpr,
parsePattern,
parseType)
#if MIN_VERSION_ghc(9,9,0)
import GHC.Plugins (showSDoc)
import GHC.Utils.Outputable (Outputable (ppr))
#elif MIN_VERSION_ghc(9,2,0)
import GHC (EpAnn (..),
NameAdornment (NameParens),
NameAnn (..),
SrcSpanAnn' (SrcSpanAnn),
SrcSpanAnnA,
TrailingAnn (AddCommaAnn),
emptyComments,
spanAsAnchor)
import GHC.Parser.Annotation (AnnContext (..),
DeltaPos (SameLine),
EpaLocation (EpaDelta),
deltaPos)
#endif
#if MIN_VERSION_ghc(9,2,1)
import Data.List (partition)
import GHC (Anchor(..), realSrcSpan, AnchorOperation, DeltaPos(..), SrcSpanAnnN)
import GHC.Types.SrcLoc (generatedSrcSpan)
import Control.Lens ((&), _last)
import Control.Lens.Operators ((%~))
#endif
#if MIN_VERSION_ghc(9,2,0)
setPrecedingLines :: Default t => LocatedAn t a -> Int -> Int -> LocatedAn t a
setPrecedingLines :: forall t a.
Default t =>
LocatedAn t a -> Int -> Int -> LocatedAn t a
setPrecedingLines LocatedAn t a
ast Int
n Int
c = forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedAn t a
ast (Int -> Int -> DeltaPos
deltaPos Int
n Int
c)
#endif
data Log = LogShake Shake.Log deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show
instance Pretty Log where
pretty :: forall ann. Log -> Doc ann
pretty = \case
LogShake Log
shakeLog -> forall a ann. Pretty a => a -> Doc ann
pretty Log
shakeLog
instance Show (Annotated ParsedSource) where
show :: Annotated ParsedSource -> String
show Annotated ParsedSource
_ = String
"<Annotated ParsedSource>"
instance NFData (Annotated ParsedSource) where
rnf :: Annotated ParsedSource -> ()
rnf = forall a. a -> ()
rwhnf
data GetAnnotatedParsedSource = GetAnnotatedParsedSource
deriving (GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
$c/= :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
== :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
$c== :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
Eq, Int -> GetAnnotatedParsedSource -> ShowS
[GetAnnotatedParsedSource] -> ShowS
GetAnnotatedParsedSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAnnotatedParsedSource] -> ShowS
$cshowList :: [GetAnnotatedParsedSource] -> ShowS
show :: GetAnnotatedParsedSource -> String
$cshow :: GetAnnotatedParsedSource -> String
showsPrec :: Int -> GetAnnotatedParsedSource -> ShowS
$cshowsPrec :: Int -> GetAnnotatedParsedSource -> ShowS
Show, Typeable, forall x.
Rep GetAnnotatedParsedSource x -> GetAnnotatedParsedSource
forall x.
GetAnnotatedParsedSource -> Rep GetAnnotatedParsedSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAnnotatedParsedSource x -> GetAnnotatedParsedSource
$cfrom :: forall x.
GetAnnotatedParsedSource -> Rep GetAnnotatedParsedSource x
GHC.Generic)
instance Hashable GetAnnotatedParsedSource
instance NFData GetAnnotatedParsedSource
type instance RuleResult GetAnnotatedParsedSource = Annotated ParsedSource
getAnnotatedParsedSourceRule :: Recorder (WithPriority Log) -> Rules ()
getAnnotatedParsedSourceRule :: Recorder (WithPriority Log) -> Rules ()
getAnnotatedParsedSourceRule Recorder (WithPriority Log)
recorder = forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$ \GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp -> do
Maybe ParsedModule
pm <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModuleWithComments
GetParsedModuleWithComments NormalizedFilePath
nfp
forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedModule -> Annotated ParsedSource
annotateParsedSource Maybe ParsedModule
pm)
#if MIN_VERSION_ghc(9,2,0)
annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource (ParsedModule ModSummary
_ ParsedSource
ps [String]
_ ()
_) = forall ast. ast -> Int -> Annotated ast
unsafeMkA (forall ast. ExactPrint ast => ast -> ast
makeDeltaAst ParsedSource
ps) Int
0
#else
annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource = fixAnns
#endif
newtype Graft m a = Graft
{ forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft :: DynFlags -> a -> TransformT m a
}
hoistGraft :: (forall x. m x -> n x) -> Graft m a -> Graft n a
hoistGraft :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> Graft m a -> Graft n a
hoistGraft forall x. m x -> n x
h (Graft DynFlags -> a -> TransformT m a
f) = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform forall x. m x -> n x
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> a -> TransformT m a
f)
newtype ExceptStringT m a = ExceptStringT {forall (m :: * -> *) a. ExceptStringT m a -> ExceptT String m a
runExceptString :: ExceptT String m a}
deriving newtype
( forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
MonadTrans
, forall a. a -> ExceptStringT m a
forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
forall a b.
ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
forall {m :: * -> *}. Monad m => Applicative (ExceptStringT m)
forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ExceptStringT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
>> :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
>>= :: forall a b.
ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
Monad
, forall a b. a -> ExceptStringT m b -> ExceptStringT m a
forall a b. (a -> b) -> ExceptStringT m a -> ExceptStringT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ExceptStringT m b -> ExceptStringT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExceptStringT m a -> ExceptStringT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ExceptStringT m b -> ExceptStringT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ExceptStringT m b -> ExceptStringT m a
fmap :: forall a b. (a -> b) -> ExceptStringT m a -> ExceptStringT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExceptStringT m a -> ExceptStringT m b
Functor
, forall a. a -> ExceptStringT m a
forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a
forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
forall a b.
ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
forall a b c.
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
forall {m :: * -> *}. Monad m => Functor (ExceptStringT m)
forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a
forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a
*> :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
<*> :: forall a b.
ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
pure :: forall a. a -> ExceptStringT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
Applicative
, forall a. ExceptStringT m a
forall a. ExceptStringT m a -> ExceptStringT m [a]
forall a.
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall {m :: * -> *}. Monad m => Applicative (ExceptStringT m)
forall (m :: * -> *) a. Monad m => ExceptStringT m a
forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. ExceptStringT m a -> ExceptStringT m [a]
$cmany :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
some :: forall a. ExceptStringT m a -> ExceptStringT m [a]
$csome :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
<|> :: forall a.
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$c<|> :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
empty :: forall a. ExceptStringT m a
$cempty :: forall (m :: * -> *) a. Monad m => ExceptStringT m a
Alternative
, forall a. Eq a => a -> ExceptStringT m a -> Bool
forall a. Num a => ExceptStringT m a -> a
forall a. Ord a => ExceptStringT m a -> a
forall m. Monoid m => ExceptStringT m m -> m
forall a. ExceptStringT m a -> Bool
forall a. ExceptStringT m a -> Int
forall a. ExceptStringT m a -> [a]
forall a. (a -> a -> a) -> ExceptStringT m a -> a
forall m a. Monoid m => (a -> m) -> ExceptStringT m a -> m
forall b a. (b -> a -> b) -> b -> ExceptStringT m a -> b
forall a b. (a -> b -> b) -> b -> ExceptStringT m a -> b
forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> ExceptStringT m a -> Bool
forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
forall (m :: * -> *) m.
(Foldable m, Monoid m) =>
ExceptStringT m m -> m
forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Bool
forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Int
forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> [a]
forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ExceptStringT m a -> m
forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ExceptStringT m a -> b
forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ExceptStringT m a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => ExceptStringT m a -> a
$cproduct :: forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
sum :: forall a. Num a => ExceptStringT m a -> a
$csum :: forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
minimum :: forall a. Ord a => ExceptStringT m a -> a
$cminimum :: forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
maximum :: forall a. Ord a => ExceptStringT m a -> a
$cmaximum :: forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
elem :: forall a. Eq a => a -> ExceptStringT m a -> Bool
$celem :: forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> ExceptStringT m a -> Bool
length :: forall a. ExceptStringT m a -> Int
$clength :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Int
null :: forall a. ExceptStringT m a -> Bool
$cnull :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Bool
toList :: forall a. ExceptStringT m a -> [a]
$ctoList :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ExceptStringT m a -> a
$cfoldl1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
foldr1 :: forall a. (a -> a -> a) -> ExceptStringT m a -> a
$cfoldr1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ExceptStringT m a -> b
$cfoldl' :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ExceptStringT m a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ExceptStringT m a -> b
$cfoldl :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ExceptStringT m a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ExceptStringT m a -> b
$cfoldr' :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ExceptStringT m a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ExceptStringT m a -> b
$cfoldr :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ExceptStringT m a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ExceptStringT m a -> m
$cfoldMap' :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ExceptStringT m a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ExceptStringT m a -> m
$cfoldMap :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ExceptStringT m a -> m
fold :: forall m. Monoid m => ExceptStringT m m -> m
$cfold :: forall (m :: * -> *) m.
(Foldable m, Monoid m) =>
ExceptStringT m m -> m
Foldable
, forall b a. b -> ExceptStringT m b -> ExceptStringT m a
forall a' a. (a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
forall (m :: * -> *) b a.
Contravariant m =>
b -> ExceptStringT m b -> ExceptStringT m a
forall (m :: * -> *) a' a.
Contravariant m =>
(a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: forall b a. b -> ExceptStringT m b -> ExceptStringT m a
$c>$ :: forall (m :: * -> *) b a.
Contravariant m =>
b -> ExceptStringT m b -> ExceptStringT m a
contramap :: forall a' a. (a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
$ccontramap :: forall (m :: * -> *) a' a.
Contravariant m =>
(a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
Contravariant
, forall a. IO a -> ExceptStringT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (ExceptStringT m)
forall (m :: * -> *) a. MonadIO m => IO a -> ExceptStringT m a
liftIO :: forall a. IO a -> ExceptStringT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ExceptStringT m a
MonadIO
, forall a b.
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
forall (m :: * -> *) a b.
Eq1 m =>
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
forall (f :: * -> *).
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
liftEq :: forall a b.
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
$cliftEq :: forall (m :: * -> *) a b.
Eq1 m =>
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
Eq1
, forall a b.
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
forall {m :: * -> *}. Ord1 m => Eq1 (ExceptStringT m)
forall (m :: * -> *) a b.
Ord1 m =>
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
forall (f :: * -> *).
Eq1 f
-> (forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering)
-> Ord1 f
liftCompare :: forall a b.
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
$cliftCompare :: forall (m :: * -> *) a b.
Ord1 m =>
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
Ord1
, forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
forall (f :: * -> *).
(forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
liftShowList :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
$cliftShowList :: forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
$cliftShowsPrec :: forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
Show1
, forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
forall (f :: * -> *).
(forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a))
-> (forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [f a])
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a))
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [f a])
-> Read1 f
liftReadListPrec :: forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
$cliftReadListPrec :: forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
liftReadPrec :: forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
$cliftReadPrec :: forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
liftReadList :: forall a.
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
$cliftReadList :: forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
$cliftReadsPrec :: forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
Read1
, forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
forall a b.
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
forall a b c.
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
forall (m :: * -> *).
Monad m
-> (forall a b. m a -> m b -> m (a, b))
-> (forall a b c. (a -> b -> c) -> m a -> m b -> m c)
-> (forall a b. m (a, b) -> (m a, m b))
-> MonadZip m
forall {m :: * -> *}. MonadZip m => Monad (ExceptStringT m)
forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
munzip :: forall a b.
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
$cmunzip :: forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
mzipWith :: forall a b c.
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
$cmzipWith :: forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
mzip :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
$cmzip :: forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
MonadZip
, forall a. ExceptStringT m a
forall a.
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall (m :: * -> *). Monad m => Monad (ExceptStringT m)
forall (m :: * -> *). Monad m => Alternative (ExceptStringT m)
forall (m :: * -> *) a. Monad m => ExceptStringT m a
forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a.
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$cmplus :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
mzero :: forall a. ExceptStringT m a
$cmzero :: forall (m :: * -> *) a. Monad m => ExceptStringT m a
MonadPlus
, ExceptStringT m a -> ExceptStringT m a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *) a.
(Eq1 m, Eq a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
/= :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c/= :: forall (m :: * -> *) a.
(Eq1 m, Eq a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
== :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c== :: forall (m :: * -> *) a.
(Eq1 m, Eq a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
Eq
, ExceptStringT m a -> ExceptStringT m a -> Bool
ExceptStringT m a -> ExceptStringT m a -> Ordering
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {m :: * -> *} {a}. (Ord1 m, Ord a) => Eq (ExceptStringT m a)
forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Ordering
forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
min :: ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$cmin :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
max :: ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$cmax :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
>= :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c>= :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
> :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c> :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
<= :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c<= :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
< :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c< :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
compare :: ExceptStringT m a -> ExceptStringT m a -> Ordering
$ccompare :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Ordering
Ord
, Int -> ExceptStringT m a -> ShowS
[ExceptStringT m a] -> ShowS
ExceptStringT m a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) a.
(Show1 m, Show a) =>
Int -> ExceptStringT m a -> ShowS
forall (m :: * -> *) a.
(Show1 m, Show a) =>
[ExceptStringT m a] -> ShowS
forall (m :: * -> *) a.
(Show1 m, Show a) =>
ExceptStringT m a -> String
showList :: [ExceptStringT m a] -> ShowS
$cshowList :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
[ExceptStringT m a] -> ShowS
show :: ExceptStringT m a -> String
$cshow :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
ExceptStringT m a -> String
showsPrec :: Int -> ExceptStringT m a -> ShowS
$cshowsPrec :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
Int -> ExceptStringT m a -> ShowS
Show
, ReadPrec [ExceptStringT m a]
ReadPrec (ExceptStringT m a)
Int -> ReadS (ExceptStringT m a)
ReadS [ExceptStringT m a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadPrec [ExceptStringT m a]
forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadPrec (ExceptStringT m a)
forall (m :: * -> *) a.
(Read1 m, Read a) =>
Int -> ReadS (ExceptStringT m a)
forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadS [ExceptStringT m a]
readListPrec :: ReadPrec [ExceptStringT m a]
$creadListPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadPrec [ExceptStringT m a]
readPrec :: ReadPrec (ExceptStringT m a)
$creadPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadPrec (ExceptStringT m a)
readList :: ReadS [ExceptStringT m a]
$creadList :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadS [ExceptStringT m a]
readsPrec :: Int -> ReadS (ExceptStringT m a)
$creadsPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
Int -> ReadS (ExceptStringT m a)
Read
)
instance Monad m => Fail.MonadFail (ExceptStringT m) where
fail :: forall a. String -> ExceptStringT m a
fail = forall (m :: * -> *) a. ExceptT String m a -> ExceptStringT m a
ExceptStringT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
instance Monad m => Semigroup (Graft m a) where
Graft DynFlags -> a -> TransformT m a
a <> :: Graft m a -> Graft m a -> Graft m a
<> Graft DynFlags -> a -> TransformT m a
b = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags -> DynFlags -> a -> TransformT m a
a DynFlags
dflags forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> DynFlags -> a -> TransformT m a
b DynFlags
dflags
instance Monad m => Monoid (Graft m a) where
mempty :: Graft m a
mempty = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure
transform ::
DynFlags ->
ClientCapabilities ->
Uri ->
Graft (Either String) ParsedSource ->
Annotated ParsedSource ->
Either String WorkspaceEdit
transform :: DynFlags
-> ClientCapabilities
-> Uri
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform DynFlags
dflags ClientCapabilities
ccs Uri
uri Graft (Either String) ParsedSource
f Annotated ParsedSource
a = do
let src :: String
src = forall ast. (Data ast, ExactPrint ast) => Annotated ast -> String
printA Annotated ParsedSource
a
Annotated ParsedSource
a' <- forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ParsedSource
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft Graft (Either String) ParsedSource
f DynFlags
dflags
let res :: String
res = forall ast. (Data ast, ExactPrint ast) => Annotated ast -> String
printA Annotated ParsedSource
a'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
ccs (Uri
uri, String -> Text
T.pack String
src) (String -> Text
T.pack String
res) WithDeletions
IncludeDeletions
transformM ::
Monad m =>
DynFlags ->
ClientCapabilities ->
Uri ->
Graft (ExceptStringT m) ParsedSource ->
Annotated ParsedSource ->
m (Either String WorkspaceEdit)
transformM :: forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
ccs Uri
uri Graft (ExceptStringT m) ParsedSource
f Annotated ParsedSource
a = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. ExceptStringT m a -> ExceptT String m a
runExceptString forall a b. (a -> b) -> a -> b
$ do
let src :: String
src = forall ast. (Data ast, ExactPrint ast) => Annotated ast -> String
printA Annotated ParsedSource
a
Annotated ParsedSource
a' <- forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ParsedSource
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft Graft (ExceptStringT m) ParsedSource
f DynFlags
dflags
let res :: String
res = forall ast. (Data ast, ExactPrint ast) => Annotated ast -> String
printA Annotated ParsedSource
a'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
ccs (Uri
uri, String -> Text
T.pack String
src) (String -> Text
T.pack String
res) WithDeletions
IncludeDeletions
needsParensSpace ::
HsExpr GhcPs ->
(All, All)
needsParensSpace :: HsExpr GhcPs -> (All, All)
needsParensSpace HsLam{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace HsLamCase{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
True)
needsParensSpace HsApp{} = forall a. Monoid a => a
mempty
needsParensSpace HsAppType{} = forall a. Monoid a => a
mempty
needsParensSpace OpApp{} = forall a. Monoid a => a
mempty
needsParensSpace HsPar{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace SectionL{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace SectionR{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace ExplicitTuple{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace ExplicitSum{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace HsCase{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
True)
needsParensSpace HsIf{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace HsMultiIf{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace HsLet{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
True)
needsParensSpace HsDo{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace ExplicitList{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace RecordCon{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
True)
needsParensSpace RecordUpd{} = forall a. Monoid a => a
mempty
needsParensSpace HsExpr GhcPs
_ = forall a. Monoid a => a
mempty
graft' ::
forall ast a l.
(Data a, Typeable l, ASTElement l ast) =>
Bool ->
SrcSpan ->
LocatedAn l ast ->
Graft (Either String) a
graft' :: forall ast a l.
(Data a, Typeable l, ASTElement l ast) =>
Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
needs_space SrcSpan
dst LocatedAn l ast
val = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
#if MIN_VERSION_ghc(9,2,0)
LocatedAn l ast
val' <- forall l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate DynFlags
dflags Bool
needs_space LocatedAn l ast
val
#else
(anns, val') <- annotate dflags needs_space val
modifyAnnsT $ mappend anns
#endif
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
(forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere'
( forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT forall a b. (a -> b) -> a -> b
$
\case
(L SrcAnn l
src ast
_ :: LocatedAn l ast)
| forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn l
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst -> LocatedAn l ast
val'
LocatedAn l ast
l -> LocatedAn l ast
l
)
a
a
graftExpr ::
forall a.
(Data a) =>
SrcSpan ->
LHsExpr GhcPs ->
Graft (Either String) a
graftExpr :: forall a.
Data a =>
SrcSpan -> LHsExpr GhcPs -> Graft (Either String) a
graftExpr SrcSpan
dst LHsExpr GhcPs
val = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
let (Bool
needs_space, LocatedAn AnnListItem (HsExpr GhcPs)
-> LocatedAn AnnListItem (HsExpr GhcPs)
mk_parens) = forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a
forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft
(forall ast a l.
(Data a, Typeable l, ASTElement l ast) =>
Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
needs_space SrcSpan
dst forall a b. (a -> b) -> a -> b
$ LocatedAn AnnListItem (HsExpr GhcPs)
-> LocatedAn AnnListItem (HsExpr GhcPs)
mk_parens LHsExpr GhcPs
val)
DynFlags
dflags
a
a
getNeedsSpaceAndParenthesize ::
(ASTElement l ast, Data a) =>
SrcSpan ->
a ->
(Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize :: forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a =
let (Maybe All
needs_parens, Maybe All
needs_space) =
forall s r.
s -> (r -> r -> r) -> GenericQ (s -> (r, s)) -> GenericQ r
everythingWithContext (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing) forall a. Semigroup a => a -> a -> a
(<>)
( forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ (forall a. Monoid a => a
mempty, ) forall a b. (a -> b) -> a -> b
$ \LocatedAn AnnListItem (HsExpr GhcPs)
x (Maybe All, Maybe All)
s -> case LocatedAn AnnListItem (HsExpr GhcPs)
x of
(L SrcSpanAnnA
src HsExpr GhcPs
_ :: LHsExpr GhcPs) | forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst ->
((Maybe All, Maybe All)
s, (Maybe All, Maybe All)
s)
L SrcSpanAnnA
_ HsExpr GhcPs
x' -> (forall a. Monoid a => a
mempty, forall a. a -> Maybe a
Just forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> (All, All)
needsParensSpace HsExpr GhcPs
x')
) a
a
in ( forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True All -> Bool
getAll Maybe All
needs_space
, forall a. a -> a -> Bool -> a
bool forall a. a -> a
id forall l ast.
ASTElement l ast =>
LocatedAn l ast -> LocatedAn l ast
maybeParensAST forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False All -> Bool
getAll Maybe All
needs_parens
)
graftExprWithM ::
forall m a.
(Fail.MonadFail m, Data a) =>
SrcSpan ->
(LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))) ->
Graft m a
graftExprWithM :: forall (m :: * -> *) a.
(MonadFail m, Data a) =>
SrcSpan
-> (LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs)))
-> Graft m a
graftExprWithM SrcSpan
dst LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))
trans = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
let (Bool
needs_space, LocatedAn AnnListItem (HsExpr GhcPs)
-> LocatedAn AnnListItem (HsExpr GhcPs)
mk_parens) = forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM'
( forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM forall a b. (a -> b) -> a -> b
$
\case
val :: LocatedAn AnnListItem (HsExpr GhcPs)
val@(L SrcSpanAnnA
src HsExpr GhcPs
_ :: LHsExpr GhcPs)
| forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst -> do
Maybe (LocatedAn AnnListItem (HsExpr GhcPs))
mval <- LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))
trans LocatedAn AnnListItem (HsExpr GhcPs)
val
case Maybe (LocatedAn AnnListItem (HsExpr GhcPs))
mval of
Just LocatedAn AnnListItem (HsExpr GhcPs)
val' -> do
#if MIN_VERSION_ghc(9,2,0)
LocatedAn AnnListItem (HsExpr GhcPs)
val'' <-
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail forall (f :: * -> *) a. Applicative f => a -> f a
pure)
(forall l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate @AnnListItem @(HsExpr GhcPs) DynFlags
dflags Bool
needs_space (LocatedAn AnnListItem (HsExpr GhcPs)
-> LocatedAn AnnListItem (HsExpr GhcPs)
mk_parens LocatedAn AnnListItem (HsExpr GhcPs)
val'))
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn AnnListItem (HsExpr GhcPs)
val''
#else
(anns, val'') <-
hoistTransform (either Fail.fail pure)
(annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val'))
modifyAnnsT $ mappend anns
pure val''
#endif
Maybe (LocatedAn AnnListItem (HsExpr GhcPs))
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn AnnListItem (HsExpr GhcPs)
val
LocatedAn AnnListItem (HsExpr GhcPs)
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn AnnListItem (HsExpr GhcPs)
l
)
a
a
graftWithM ::
forall ast m a l.
(Fail.MonadFail m, Data a, Typeable l, ASTElement l ast) =>
SrcSpan ->
(LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))) ->
Graft m a
graftWithM :: forall ast (m :: * -> *) a l.
(MonadFail m, Data a, Typeable l, ASTElement l ast) =>
SrcSpan
-> (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast)))
-> Graft m a
graftWithM SrcSpan
dst LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))
trans = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM'
( forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM forall a b. (a -> b) -> a -> b
$
\case
val :: LocatedAn l ast
val@(L SrcAnn l
src ast
_ :: LocatedAn l ast)
| forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn l
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst -> do
Maybe (LocatedAn l ast)
mval <- LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))
trans LocatedAn l ast
val
case Maybe (LocatedAn l ast)
mval of
Just LocatedAn l ast
val' -> do
#if MIN_VERSION_ghc(9,2,0)
LocatedAn l ast
val'' <-
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall a b. (a -> b) -> a -> b
$
forall l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate DynFlags
dflags Bool
False forall a b. (a -> b) -> a -> b
$ forall l ast.
ASTElement l ast =>
LocatedAn l ast -> LocatedAn l ast
maybeParensAST LocatedAn l ast
val'
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
val''
#else
(anns, val'') <-
hoistTransform (either Fail.fail pure) $
annotate dflags True $ maybeParensAST val'
modifyAnnsT $ mappend anns
pure val''
#endif
Maybe (LocatedAn l ast)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
val
LocatedAn l ast
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
l
)
a
a
genericGraftWithSmallestM ::
forall m a ast.
(Monad m, Data a, Typeable ast) =>
Proxy (Located ast) ->
SrcSpan ->
(DynFlags -> ast -> GenericM (TransformT m)) ->
Graft m a
genericGraftWithSmallestM :: forall (m :: * -> *) a ast.
(Monad m, Data a, Typeable ast) =>
Proxy (Located ast)
-> SrcSpan
-> (DynFlags -> ast -> GenericM (TransformT m))
-> Graft m a
genericGraftWithSmallestM Proxy (Located ast)
proxy SrcSpan
dst DynFlags -> ast -> GenericM (TransformT m)
trans = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
forall (m :: * -> *) a.
Monad m =>
GenericQ (Maybe (Bool, a)) -> (a -> GenericM m) -> GenericM m
smallestM (forall ast.
Typeable ast =>
Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe (Bool, ast))
genericIsSubspan Proxy (Located ast)
proxy SrcSpan
dst) (DynFlags -> ast -> GenericM (TransformT m)
trans DynFlags
dflags)
genericGraftWithLargestM ::
forall m a ast.
(Monad m, Data a, Typeable ast) =>
Proxy (Located ast) ->
SrcSpan ->
(DynFlags -> ast -> GenericM (TransformT m)) ->
Graft m a
genericGraftWithLargestM :: forall (m :: * -> *) a ast.
(Monad m, Data a, Typeable ast) =>
Proxy (Located ast)
-> SrcSpan
-> (DynFlags -> ast -> GenericM (TransformT m))
-> Graft m a
genericGraftWithLargestM Proxy (Located ast)
proxy SrcSpan
dst DynFlags -> ast -> GenericM (TransformT m)
trans = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
forall (m :: * -> *) a.
Monad m =>
GenericQ (Maybe (Bool, a)) -> (a -> GenericM m) -> GenericM m
largestM (forall ast.
Typeable ast =>
Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe (Bool, ast))
genericIsSubspan Proxy (Located ast)
proxy SrcSpan
dst) (DynFlags -> ast -> GenericM (TransformT m)
trans DynFlags
dflags)
graftDecls ::
forall a.
(HasDecls a) =>
SrcSpan ->
[LHsDecl GhcPs] ->
Graft (Either String) a
graftDecls :: forall a.
HasDecls a =>
SrcSpan -> [LHsDecl GhcPs] -> Graft (Either String) a
graftDecls SrcSpan
dst [LHsDecl GhcPs]
decs0 = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LHsDecl GhcPs]
decs0 forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl -> do
DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
let go :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
go [] = forall a. DList a
DL.empty
go (L SrcSpanAnnA
src HsDecl GhcPs
e : [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest)
| forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst = forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
| Bool
otherwise = forall a. a -> DList a
DL.singleton (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
src HsDecl GhcPs
e) forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
go [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DL.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
go) a
a
#if MIN_VERSION_ghc(9,2,1)
modifySmallestDeclWithM ::
forall a m r.
(HasDecls a, Monad m) =>
(SrcSpan -> m Bool) ->
(LHsDecl GhcPs -> TransformT m ([LHsDecl GhcPs], r)) ->
a ->
TransformT m (a, Maybe r)
modifySmallestDeclWithM :: forall a (m :: * -> *) r.
(HasDecls a, Monad m) =>
(SrcSpan -> m Bool)
-> (LHsDecl GhcPs -> TransformT m ([LHsDecl GhcPs], r))
-> a
-> TransformT m (a, Maybe r)
modifySmallestDeclWithM SrcSpan -> m Bool
validSpan LHsDecl GhcPs -> TransformT m ([LHsDecl GhcPs], r)
f a
a = do
let modifyMatchingDecl :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
modifyMatchingDecl [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. DList a
DL.empty, forall a. Maybe a
Nothing)
modifyMatchingDecl (ldecl :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl@(L SrcSpanAnnA
src HsDecl GhcPs
_) : [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest) =
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ SrcSpan -> m Bool
validSpan forall a b. (a -> b) -> a -> b
$ forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs', r
r) <- LHsDecl GhcPs -> TransformT m ([LHsDecl GhcPs], r)
f GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs' forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest, forall a. a -> Maybe a
Just r
r)
Bool
False -> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
modifyMatchingDecl [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
forall t (m :: * -> *) r.
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r)) -> t -> m (t, r)
modifyDeclsT' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. DList a -> [a]
DL.toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
modifyMatchingDecl) a
a
generatedAnchor :: AnchorOperation -> Anchor
generatedAnchor :: AnchorOperation -> Anchor
generatedAnchor AnchorOperation
anchorOp = RealSrcSpan -> AnchorOperation -> Anchor
GHC.Anchor (SrcSpan -> RealSrcSpan
GHC.realSrcSpan SrcSpan
generatedSrcSpan) AnchorOperation
anchorOp
setAnchor :: Anchor -> SrcSpanAnnN -> SrcSpanAnnN
setAnchor :: Anchor -> SrcSpanAnnN -> SrcSpanAnnN
setAnchor Anchor
anc (SrcSpanAnn (EpAnn Anchor
_ NameAnn
nameAnn EpAnnComments
comments) SrcSpan
span) =
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc NameAnn
nameAnn EpAnnComments
comments) SrcSpan
span
setAnchor Anchor
_ SrcSpanAnnN
spanAnnN = SrcSpanAnnN
spanAnnN
removeTrailingAnns :: SrcSpanAnnN -> SrcSpanAnnN
removeTrailingAnns :: SrcSpanAnnN -> SrcSpanAnnN
removeTrailingAnns (SrcSpanAnn (EpAnn Anchor
anc NameAnn
nameAnn EpAnnComments
comments) SrcSpan
span) =
let nameAnnSansTrailings :: NameAnn
nameAnnSansTrailings = NameAnn
nameAnn {nann_trailing :: [TrailingAnn]
nann_trailing = []}
in forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc NameAnn
nameAnnSansTrailings EpAnnComments
comments) SrcSpan
span
removeTrailingAnns SrcSpanAnnN
spanAnnN = SrcSpanAnnN
spanAnnN
modifySigWithM ::
forall a m.
(HasDecls a, Monad m) =>
IdP GhcPs ->
(LHsSigType GhcPs -> LHsSigType GhcPs) ->
a ->
TransformT m a
modifySigWithM :: forall a (m :: * -> *).
(HasDecls a, Monad m) =>
IdP GhcPs
-> (LHsSigType GhcPs -> LHsSigType GhcPs) -> a -> TransformT m a
modifySigWithM IdP GhcPs
queryId LHsSigType GhcPs -> LHsSigType GhcPs
f a
a = do
let modifyMatchingSigD :: [LHsDecl GhcPs] -> TransformT m (DL.DList (LHsDecl GhcPs))
modifyMatchingSigD :: [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
modifyMatchingSigD [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. DList a
DL.empty)
modifyMatchingSigD (ldecl :: LHsDecl GhcPs
ldecl@(L SrcSpanAnnA
annSigD (SigD XSigD GhcPs
xsig (TypeSig XTypeSig GhcPs
xTypeSig [LIdP GhcPs]
ids (HsWC XHsWC GhcPs (LHsSigType GhcPs)
xHsWc LHsSigType GhcPs
lHsSig)))) : [LHsDecl GhcPs]
rest)
| IdP GhcPs
queryId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIdP GhcPs]
ids) = do
let newSig :: LHsSigType GhcPs
newSig = LHsSigType GhcPs -> LHsSigType GhcPs
f LHsSigType GhcPs
lHsSig
if LHsSigType GhcPs
newSig forall a. Data a => a -> a -> Bool
`geq` LHsSigType GhcPs
lHsSig
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> DList a
DL.singleton LHsDecl GhcPs
ldecl forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
rest
else case forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== IdP GhcPs
queryId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LIdP GhcPs]
ids of
([L SrcSpanAnnN
annMatchedId RdrName
matchedId], [GenLocated SrcSpanAnnN RdrName]
otherIds) ->
let matchedId' :: GenLocated SrcSpanAnnN RdrName
matchedId' = forall l e. l -> e -> GenLocated l e
L (Anchor -> SrcSpanAnnN -> SrcSpanAnnN
setAnchor Anchor
genAnchor0 forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> SrcSpanAnnN
removeTrailingAnns SrcSpanAnnN
annMatchedId) RdrName
matchedId
matchedIdSig :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
matchedIdSig =
let sig' :: HsDecl GhcPs
sig' = forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
xsig (forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
xTypeSig [GenLocated SrcSpanAnnN RdrName
matchedId'] (forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC XHsWC GhcPs (LHsSigType GhcPs)
xHsWc LHsSigType GhcPs
newSig))
epAnn :: SrcSpanAnnA
epAnn = forall a. a -> a -> Bool -> a
bool (forall ann.
Monoid ann =>
SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP SrcSpan
generatedSrcSpan (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
0)) SrcSpanAnnA
annSigD (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnN RdrName]
otherIds)
in forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
epAnn HsDecl GhcPs
sig'
otherSig :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
otherSig = case [GenLocated SrcSpanAnnN RdrName]
otherIds of
[] -> []
(L (SrcSpanAnn EpAnn NameAnn
epAnn SrcSpan
span) RdrName
id1:[GenLocated SrcSpanAnnN RdrName]
ids) -> [
let epAnn' :: EpAnn NameAnn
epAnn' = case EpAnn NameAnn
epAnn of
EpAnn Anchor
_ NameAnn
nameAnn EpAnnComments
commentsId1 -> forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
genAnchor0 NameAnn
nameAnn EpAnnComments
commentsId1
EpAnn NameAnn
EpAnnNotUsed -> forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
genAnchor0 forall a. Monoid a => a
mempty EpAnnComments
emptyComments
ids' :: [GenLocated SrcSpanAnnN RdrName]
ids' = forall l e. l -> e -> GenLocated l e
L (forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn NameAnn
epAnn' SrcSpan
span) RdrName
id1forall a. a -> [a] -> [a]
:[GenLocated SrcSpanAnnN RdrName]
ids
ids'' :: [GenLocated SrcSpanAnnN RdrName]
ids'' = [GenLocated SrcSpanAnnN RdrName]
ids' forall a b. a -> (a -> b) -> b
& forall s a. Snoc s s a a => Traversal' s a
_last forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SrcSpanAnnN -> SrcSpanAnnN
removeTrailingAnns
in forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
annSigD (forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
xsig (forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
xTypeSig [GenLocated SrcSpanAnnN RdrName]
ids'' (forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC XHsWC GhcPs (LHsSigType GhcPs)
xHsWc LHsSigType GhcPs
lHsSig)))
]
in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
otherSig forall a. Semigroup a => a -> a -> a
<> forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
matchedIdSig forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
rest
([GenLocated SrcSpanAnnN RdrName],
[GenLocated SrcSpanAnnN RdrName])
_ -> forall a. HasCallStack => String -> a
error String
"multiple ids matched"
modifyMatchingSigD (LHsDecl GhcPs
ldecl : [LHsDecl GhcPs]
rest) = (forall a. a -> DList a
DL.singleton LHsDecl GhcPs
ldecl forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
modifyMatchingSigD [LHsDecl GhcPs]
rest
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. DList a -> [a]
DL.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
modifyMatchingSigD) a
a
genAnchor0 :: Anchor
genAnchor0 :: Anchor
genAnchor0 = AnchorOperation -> Anchor
generatedAnchor AnchorOperation
m0
genAnchor1 :: Anchor
genAnchor1 :: Anchor
genAnchor1 = AnchorOperation -> Anchor
generatedAnchor AnchorOperation
m1
modifyDeclsT' :: (HasDecls t, HasTransform m)
=> ([LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r))
-> t -> m (t, r)
modifyDeclsT' :: forall t (m :: * -> *) r.
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r)) -> t -> m (t, r)
modifyDeclsT' [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r)
action t
t = do
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls <- forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls t
t
([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls', r
r) <- [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r)
action [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
t
t' <- forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
replaceDecls t
t [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls'
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
t', r
r)
modifyMgMatchesT ::
Monad m =>
MatchGroup GhcPs (LHsExpr GhcPs) ->
(LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))) ->
TransformT m (MatchGroup GhcPs (LHsExpr GhcPs))
modifyMgMatchesT :: forall (m :: * -> *).
Monad m =>
MatchGroup GhcPs (LHsExpr GhcPs)
-> (LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs)))
-> TransformT m (MatchGroup GhcPs (LHsExpr GhcPs))
modifyMgMatchesT MatchGroup GhcPs (LHsExpr GhcPs)
mg LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
f = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r.
Monad m =>
MatchGroup GhcPs (LHsExpr GhcPs)
-> (LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs), r))
-> r
-> (r -> r -> m r)
-> TransformT m (MatchGroup GhcPs (LHsExpr GhcPs), r)
modifyMgMatchesT' MatchGroup GhcPs (LHsExpr GhcPs)
mg (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
f) () (forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const)
modifyMgMatchesT' ::
Monad m =>
MatchGroup GhcPs (LHsExpr GhcPs) ->
(LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs), r)) ->
r ->
(r -> r -> m r) ->
TransformT m (MatchGroup GhcPs (LHsExpr GhcPs), r)
#if MIN_VERSION_ghc(9,5,0)
modifyMgMatchesT' (MG xMg (L locMatches matches)) f def combineResults = do
(unzip -> (matches', rs)) <- mapM f matches
r' <- TransformT $ lift $ foldM combineResults def rs
pure $ (MG xMg (L locMatches matches'), r')
#else
modifyMgMatchesT' :: forall (m :: * -> *) r.
Monad m =>
MatchGroup GhcPs (LHsExpr GhcPs)
-> (LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs), r))
-> r
-> (r -> r -> m r)
-> TransformT m (MatchGroup GhcPs (LHsExpr GhcPs), r)
modifyMgMatchesT' (MG XMG GhcPs (LHsExpr GhcPs)
xMg (L SrcSpanAnnL
locMatches [GenLocated
SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches) Origin
originMg) LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs), r)
f r
def r -> r -> m r
combineResults = do
(forall a b. [(a, b)] -> ([a], [b])
unzip -> ([GenLocated
SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches', [r]
rs)) <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs), r)
f [GenLocated
SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches
r
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM r -> r -> m r
combineResults r
def [r]
rs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
xMg (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
locMatches [GenLocated
SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches') Origin
originMg, r
r')
#endif
#endif
graftSmallestDeclsWithM ::
forall a.
(HasDecls a) =>
SrcSpan ->
(LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])) ->
Graft (Either String) a
graftSmallestDeclsWithM :: forall a.
HasDecls a =>
SrcSpan
-> (LHsDecl GhcPs
-> TransformT (Either String) (Maybe [LHsDecl GhcPs]))
-> Graft (Either String) a
graftSmallestDeclsWithM SrcSpan
dst LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])
toDecls = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
let go :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
(Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. DList a
DL.empty
go (e :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
e@(L SrcSpanAnnA
src HsDecl GhcPs
_) : [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest)
| SrcSpan
dst SrcSpan -> SrcSpan -> Bool
`isSubspanOf` forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src = LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])
toDecls GenLocated SrcSpanAnnA (HsDecl GhcPs)
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs0 -> do
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs0 forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl ->
DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
Nothing -> (forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
e forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
(Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
go [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
| Bool
otherwise = (forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
e forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
(Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
go [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. DList a -> [a]
DL.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
(Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
go) a
a
graftDeclsWithM ::
forall a m.
(HasDecls a, Fail.MonadFail m) =>
SrcSpan ->
(LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs])) ->
Graft m a
graftDeclsWithM :: forall a (m :: * -> *).
(HasDecls a, MonadFail m) =>
SrcSpan
-> (LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs]))
-> Graft m a
graftDeclsWithM SrcSpan
dst LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs])
toDecls = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
let go :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. DList a
DL.empty
go (e :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
e@(L SrcSpanAnnA
src HsDecl GhcPs
_) : [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest)
| forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst = LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs])
toDecls GenLocated SrcSpanAnnA (HsDecl GhcPs)
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs0 -> do
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs0 forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl ->
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall a b. (a -> b) -> a -> b
$
DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
Nothing -> (forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
e forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
go [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
| Bool
otherwise = (forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
e forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
go [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. DList a -> [a]
DL.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
go) a
a
class
( Data ast
, Typeable l
, Outputable l
, Outputable ast
#if MIN_VERSION_ghc(9,2,0)
, Default l
#endif
) => ASTElement l ast | ast -> l where
parseAST :: Parser (LocatedAn l ast)
maybeParensAST :: LocatedAn l ast -> LocatedAn l ast
graft ::
forall a.
(Data a) =>
SrcSpan ->
LocatedAn l ast ->
Graft (Either String) a
graft SrcSpan
dst = forall ast a l.
(Data a, Typeable l, ASTElement l ast) =>
Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
True SrcSpan
dst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l ast.
ASTElement l ast =>
LocatedAn l ast -> LocatedAn l ast
maybeParensAST
instance p ~ GhcPs => ASTElement AnnListItem (HsExpr p) where
parseAST :: Parser (LocatedAn AnnListItem (HsExpr p))
parseAST = Parser (LHsExpr GhcPs)
parseExpr
maybeParensAST :: LocatedAn AnnListItem (HsExpr p)
-> LocatedAn AnnListItem (HsExpr p)
maybeParensAST = LHsExpr GhcPs -> LHsExpr GhcPs
parenthesize
graft :: forall a.
Data a =>
SrcSpan
-> LocatedAn AnnListItem (HsExpr p) -> Graft (Either String) a
graft = forall a.
Data a =>
SrcSpan -> LHsExpr GhcPs -> Graft (Either String) a
graftExpr
instance p ~ GhcPs => ASTElement AnnListItem (Pat p) where
parseAST :: Parser (LocatedAn AnnListItem (Pat p))
parseAST = Parser (LPat GhcPs)
parsePattern
maybeParensAST :: LocatedAn AnnListItem (Pat p) -> LocatedAn AnnListItem (Pat p)
maybeParensAST = forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec
instance p ~ GhcPs => ASTElement AnnListItem (HsType p) where
parseAST :: Parser (LocatedAn AnnListItem (HsType p))
parseAST = Parser (LHsType GhcPs)
parseType
maybeParensAST :: LocatedAn AnnListItem (HsType p)
-> LocatedAn AnnListItem (HsType p)
maybeParensAST = forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec
instance p ~ GhcPs => ASTElement AnnListItem (HsDecl p) where
parseAST :: Parser (LocatedAn AnnListItem (HsDecl p))
parseAST = Parser (LHsDecl GhcPs)
parseDecl
maybeParensAST :: LocatedAn AnnListItem (HsDecl p)
-> LocatedAn AnnListItem (HsDecl p)
maybeParensAST = forall a. a -> a
id
instance p ~ GhcPs => ASTElement AnnListItem (ImportDecl p) where
parseAST :: Parser (LocatedAn AnnListItem (ImportDecl p))
parseAST = Parser (LImportDecl GhcPs)
parseImport
maybeParensAST :: LocatedAn AnnListItem (ImportDecl p)
-> LocatedAn AnnListItem (ImportDecl p)
maybeParensAST = forall a. a -> a
id
instance ASTElement NameAnn RdrName where
parseAST :: Parser (GenLocated SrcSpanAnnN RdrName)
parseAST DynFlags
df String
fp = forall w. DynFlags -> String -> P w -> String -> ParseResult w
parseWith DynFlags
df String
fp P (GenLocated SrcSpanAnnN RdrName)
parseIdentifier
maybeParensAST :: GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
maybeParensAST = forall a. a -> a
id
#if !MIN_VERSION_ghc(9,2,0)
fixAnns :: ParsedModule -> Annotated ParsedSource
fixAnns ParsedModule {..} =
let ranns = relativiseApiAnns pm_parsed_source pm_annotations
in unsafeMkA pm_parsed_source ranns 0
#endif
annotate :: (ASTElement l ast, Outputable l)
#if MIN_VERSION_ghc(9,2,0)
=> DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
#else
=> DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (Anns, LocatedAn l ast)
#endif
annotate :: forall l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate DynFlags
dflags Bool
needs_space LocatedAn l ast
ast = do
String
uniq <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
let rendered :: String
rendered = forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags LocatedAn l ast
ast
#if MIN_VERSION_ghc(9,4,0)
expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered
pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space)
#elif MIN_VERSION_ghc(9,2,0)
LocatedAn l ast
expr' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall l ast. ASTElement l ast => Parser (LocatedAn l ast)
parseAST DynFlags
dflags String
uniq String
rendered
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t a.
Default t =>
LocatedAn t a -> Int -> Int -> LocatedAn t a
setPrecedingLines LocatedAn l ast
expr' Int
0 (forall a. a -> a -> Bool -> a
bool Int
0 Int
1 Bool
needs_space)
#else
(anns, expr') <- lift $ mapLeft show $ parseAST dflags uniq rendered
let anns' = setPrecedingLines expr' 0 (bool 0 1 needs_space) anns
pure (anns',expr')
#endif
annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
#if !MIN_VERSION_ghc(9,2,0)
annotateDecl dflags
(L src (
ValD ext fb@FunBind
{ fun_matches = mg@MG { mg_alts = L alt_src alts@(_:_)}
})) = do
let set_matches matches =
ValD ext fb { fun_matches = mg { mg_alts = L alt_src matches }}
(anns', alts') <- fmap unzip $ for alts $ \alt -> do
uniq <- show <$> uniqueSrcSpanT
let rendered = render dflags $ set_matches [alt]
lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case
(ann, L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}}))
-> pure (setPrecedingLines alt' 1 0 ann, alt')
_ -> lift $ Left "annotateDecl: didn't parse a single FunBind match"
modifyAnnsT $ mappend $ fold anns'
pure $ L src $ set_matches alts'
#endif
annotateDecl :: DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
ast = do
String
uniq <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
let rendered :: String
rendered = forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags LHsDecl GhcPs
ast
#if MIN_VERSION_ghc(9,4,0)
expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered
pure $ setPrecedingLines expr' 1 0
#elif MIN_VERSION_ghc(9,2,0)
GenLocated SrcSpanAnnA (HsDecl GhcPs)
expr' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Parser (LHsDecl GhcPs)
parseDecl DynFlags
dflags String
uniq String
rendered
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t a.
Default t =>
LocatedAn t a -> Int -> Int -> LocatedAn t a
setPrecedingLines GenLocated SrcSpanAnnA (HsDecl GhcPs)
expr' Int
1 Int
0
#else
(anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered
let anns' = setPrecedingLines expr' 1 0 anns
modifyAnnsT $ mappend anns'
pure expr'
#endif
render :: Outputable a => DynFlags -> a -> String
render :: forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags = DynFlags -> SDoc -> String
showSDoc DynFlags
dflags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> SDoc
ppr
parenthesize :: LHsExpr GhcPs -> LHsExpr GhcPs
parenthesize :: LHsExpr GhcPs -> LHsExpr GhcPs
parenthesize = forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
appPrec
eqSrcSpan :: SrcSpan -> SrcSpan -> Bool
eqSrcSpan :: SrcSpan -> SrcSpan -> Bool
eqSrcSpan SrcSpan
l SrcSpan
r = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest SrcSpan
l SrcSpan
r forall a. Eq a => a -> a -> Bool
== Ordering
EQ
#if MIN_VERSION_ghc(9,2,0)
eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool
eqSrcSpanA :: forall la b. SrcAnn la -> SrcAnn b -> Bool
eqSrcSpanA SrcAnn la
l SrcAnn b
r = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn la
l) (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn b
r) forall a. Eq a => a -> a -> Bool
== Ordering
EQ
#else
eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool
eqSrcSpanA l r = leftmost_smallest l r == EQ
#endif
#if MIN_VERSION_ghc(9,2,0)
addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
addParensToCtxt Maybe EpaLocation
close_dp = AnnContext -> AnnContext
addOpen forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnContext -> AnnContext
addClose
where
addOpen :: AnnContext -> AnnContext
addOpen it :: AnnContext
it@AnnContext{ac_open :: AnnContext -> [EpaLocation]
ac_open = []} = AnnContext
it{ac_open :: [EpaLocation]
ac_open = [Int -> EpaLocation
epl Int
0]}
addOpen AnnContext
other = AnnContext
other
addClose :: AnnContext -> AnnContext
addClose AnnContext
it
| Just EpaLocation
c <- Maybe EpaLocation
close_dp = AnnContext
it{ac_close :: [EpaLocation]
ac_close = [EpaLocation
c]}
| AnnContext{ac_close :: AnnContext -> [EpaLocation]
ac_close = []} <- AnnContext
it = AnnContext
it{ac_close :: [EpaLocation]
ac_close = [Int -> EpaLocation
epl Int
0]}
| Bool
otherwise = AnnContext
it
epl :: Int -> EpaLocation
epl :: Int -> EpaLocation
epl Int
n = DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
n) []
epAnn :: SrcSpan -> ann -> EpAnn ann
epAnn :: forall ann. SrcSpan -> ann -> EpAnn ann
epAnn SrcSpan
srcSpan ann
anns = forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
srcSpan) ann
anns EpAnnComments
emptyComments
modifyAnns :: LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns :: forall a ast. LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns LocatedAn a ast
x a -> a
f = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> a
f) LocatedAn a ast
x
removeComma :: SrcSpanAnnA -> SrcSpanAnnA
removeComma :: SrcSpanAnnA -> SrcSpanAnnA
removeComma it :: SrcSpanAnnA
it@(SrcSpanAnn EpAnn AnnListItem
EpAnnNotUsed SrcSpan
_) = SrcSpanAnnA
it
removeComma (SrcSpanAnn (EpAnn Anchor
anc (AnnListItem [TrailingAnn]
as) EpAnnComments
cs) SrcSpan
l)
= (forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc ([TrailingAnn] -> AnnListItem
AnnListItem (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrailingAnn -> Bool
isCommaAnn) [TrailingAnn]
as)) EpAnnComments
cs) SrcSpan
l)
where
isCommaAnn :: TrailingAnn -> Bool
isCommaAnn AddCommaAnn{} = Bool
True
isCommaAnn TrailingAnn
_ = Bool
False
addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn
addParens :: Bool -> NameAnn -> NameAnn
addParens Bool
True it :: NameAnn
it@NameAnn{} =
NameAnn
it{nann_adornment :: NameAdornment
nann_adornment = NameAdornment
NameParens, nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
0, nann_close :: EpaLocation
nann_close = Int -> EpaLocation
epl Int
0 }
addParens Bool
True it :: NameAnn
it@NameAnnCommas{} =
NameAnn
it{nann_adornment :: NameAdornment
nann_adornment = NameAdornment
NameParens, nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
0, nann_close :: EpaLocation
nann_close = Int -> EpaLocation
epl Int
0 }
addParens Bool
True it :: NameAnn
it@NameAnnOnly{} =
NameAnn
it{nann_adornment :: NameAdornment
nann_adornment = NameAdornment
NameParens, nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
0, nann_close :: EpaLocation
nann_close = Int -> EpaLocation
epl Int
0 }
addParens Bool
True NameAnnTrailing{[TrailingAnn]
nann_trailing :: [TrailingAnn]
nann_trailing :: NameAnn -> [TrailingAnn]
..} =
NameAnn{nann_adornment :: NameAdornment
nann_adornment = NameAdornment
NameParens, nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
0, nann_close :: EpaLocation
nann_close = Int -> EpaLocation
epl Int
0, nann_name :: EpaLocation
nann_name = Int -> EpaLocation
epl Int
0, [TrailingAnn]
nann_trailing :: [TrailingAnn]
nann_trailing :: [TrailingAnn]
..}
addParens Bool
_ NameAnn
it = NameAnn
it
removeTrailingComma :: GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast
removeTrailingComma :: forall ast.
GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast
removeTrailingComma = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a ast. LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns forall a b. (a -> b) -> a -> b
$ \(AnnListItem [TrailingAnn]
l) -> [TrailingAnn] -> AnnListItem
AnnListItem forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrailingAnn -> Bool
isCommaAnn) [TrailingAnn]
l
isCommaAnn :: TrailingAnn -> Bool
isCommaAnn :: TrailingAnn -> Bool
isCommaAnn AddCommaAnn{} = Bool
True
isCommaAnn TrailingAnn
_ = Bool
False
#endif