{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs        #-}

-- | This module hosts various abstractions and utility functions to work with ghc-exactprint.
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,
      -- * Helper function
      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

-- | Get the latest version of the annotated parse source with comments.
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

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

{- | A transformation for grafting source trees together. Use the semigroup
 instance to combine 'Graft's, and run them via 'transform'.
-}
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

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

-- | Convert a 'Graft' into a 'WorkspaceEdit'.
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

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

-- | Convert a 'Graft' into a 'WorkspaceEdit'.
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


-- | Returns whether or not this node requires its immediate children to have
-- be parenthesized and have a leading space.
--
-- A more natural type for this function would be to return @(Bool, Bool)@, but
-- we use 'All' instead for its monoid instance.
needsParensSpace ::
    HsExpr GhcPs ->
    -- | (Needs parens, needs space)
    (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


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

{- | Construct a 'Graft', replacing the node at the given 'SrcSpan' with the
 given @Located ast@. The node at that position must already be a @Located
 ast@, or this is a no-op.
-}
graft' ::
    forall ast a l.
    (Data a, Typeable l, ASTElement l ast) =>
    -- | Do we need to insert a space before this grafting? In do blocks, the
    -- answer is no, or we will break layout. But in function applications,
    -- the answer is yes, or the function call won't get its argument. Yikes!
    --
    -- More often the answer is yes, so when in doubt, use that.
    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


-- | Like 'graft', but specialized to 'LHsExpr', and intelligently inserts
-- parentheses if they're necessary.
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 =
  -- Traverse the tree, looking for our replacement node. But keep track of
  -- the context (parent HsExpr constructor) we're in while we do it. This
  -- lets us determine whether or not we need parentheses.
  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

-- | Run the given transformation only on the smallest node in the tree that
-- contains the 'SrcSpan'.
genericGraftWithSmallestM ::
    forall m a ast.
    (Monad m, Data a, Typeable ast) =>
    -- | The type of nodes we'd like to consider when finding the smallest.
    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)

-- | Run the given transformation only on the largest node in the tree that
-- contains the 'SrcSpan'.
genericGraftWithLargestM ::
    forall m a ast.
    (Monad m, Data a, Typeable ast) =>
    -- | The type of nodes we'd like to consider when finding the largest.
    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)

-- | Replace the smallest declaration whose SrcSpan satisfies the given condition with a new
-- list of declarations.
--
-- For example, if you would like to move a where-clause-defined variable to the same
-- level as its parent HsDecl, you could use this function.
--
-- When matching declaration is found in the sub-declarations of `a`, `Just r` is also returned with the new `a`. If
-- not declaration matched, then `Nothing` is returned.
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

-- | Modify the type signature for the given IdP. This function handles splitting a multi-sig
-- SigD into multiple SigD if the type signature is changed.
--
-- For example, update the type signature for `foo` from `Int` to `Bool`:
--
-- - foo :: Int
-- + foo :: Bool
--
-- - foo, bar :: Int
-- + bar :: Int
-- + foo :: Bool
--
-- - foo, bar, baz :: Int
-- + bar, baz :: Int
-- + foo :: Bool
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 this signature update caused no change, then we don't need to split up multi-signatures
            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

-- | Apply a transformation to the decls contained in @t@
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)

-- | Modify each LMatch in a MatchGroup
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)

-- | Modify the each LMatch in a MatchGroup
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


-- In 9.2+, we need `Default l` to do `setPrecedingLines` on annotated elements.
-- In older versions, we pass around annotations explicitly, so the instance isn't needed.
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
    {- | Construct a 'Graft', replacing the node at the given 'SrcSpan' with
        the given @Located ast@. The node at that position must already be
        a @Located ast@, or this is a no-op.
    -}
    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)
-- | Dark magic I stole from retrie. No idea what it does.
fixAnns :: ParsedModule -> Annotated ParsedSource
fixAnns ParsedModule {..} =
    let ranns = relativiseApiAnns pm_parsed_source pm_annotations
     in unsafeMkA pm_parsed_source ranns 0
#endif

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


-- | Given an 'LHSExpr', compute its exactprint annotations.
--   Note that this function will throw away any existing annotations (and format)
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

-- | Given an 'LHsDecl', compute its exactprint annotations.
annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
#if !MIN_VERSION_ghc(9,2,0)
-- The 'parseDecl' function fails to parse 'FunBind' 'ValD's which contain
-- multiple matches. To work around this, we split the single
-- 'FunBind'-of-multiple-'Match'es into multiple 'FunBind's-of-one-'Match',
-- and then merge them all back together.
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

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

-- | Print out something 'Outputable'.
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

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

-- | Put parentheses around an expression if required.
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

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

-- | Equality on SrcSpan's.
-- Ignores the (Maybe BufSpan) field of SrcSpan's.
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

-- | Equality on SrcSpan's.
-- Ignores the (Maybe BufSpan) field of SrcSpan's.
#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