{-# LANGUAGE GADTs        #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | 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(..),
      modifySmallestDeclWithM,
      modifyMgMatchesT,
      modifyMgMatchesT',
      modifySigWithM,
      genAnchor1,
      setPrecedingLines,
      addParens,
      addParensToCtxt,
      modifyAnns,
      removeComma,
      -- * Helper function
      eqSrcSpan,
      epl,
      epAnn,
      removeTrailingComma,
      annotateParsedSource,
      getAnnotatedParsedSourceRule,
      GetAnnotatedParsedSource(..),
      ASTElement (..),
      ExceptStringT (..),
      TransformT,
      Log(..),
    )
where

import           Control.Applicative                     (Alternative)
import           Control.Arrow                           ((***))
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 qualified Data.DList                              as DL
import           Data.Either.Extra                       (mapLeft)
import           Data.Functor.Classes
import           Data.Functor.Contravariant
import           Data.Monoid                             (All (All), getAll)
import qualified Data.Text                               as T
import           Development.IDE.Core.RuleTypes
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           Generics.SYB
import           Generics.SYB.GHC
import qualified GHC.Generics                            as GHC
import           Ide.Logger                              (Pretty (pretty),
                                                          Recorder,
                                                          WithPriority,
                                                          cmapWithPrio)
import           Ide.PluginUtils
import           Language.Haskell.GHC.ExactPrint.Parsers
import           Language.LSP.Protocol.Types

import           Control.Lens                            (_last, (&))
import           Control.Lens.Operators                  ((%~))
import           Data.List                               (partition)
import           GHC                                     (DeltaPos (..),
                                                          SrcSpanAnnN)

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#if !MIN_VERSION_ghc(9,9,0)
import           Data.Default                            (Default)
import           GHC                                     (Anchor (..),
                                                          AnchorOperation,
                                                          EpAnn (..),
                                                          NameAdornment (NameParens),
                                                          NameAnn (..),
                                                          SrcSpanAnn' (SrcSpanAnn),
                                                          SrcSpanAnnA,
                                                          TrailingAnn (AddCommaAnn),
                                                          emptyComments,
                                                          realSrcSpan,
                                                          spanAsAnchor)
import           GHC.Parser.Annotation                   (AnnContext (..),
                                                          EpaLocation (EpaDelta),
                                                          deltaPos)
import           GHC.Types.SrcLoc                        (generatedSrcSpan)
#endif

#if MIN_VERSION_ghc(9,9,0)
import           GHC                                     (Anchor,
                                                          AnnContext (..),
                                                          EpAnn (..),
                                                          EpaLocation,
                                                          EpaLocation' (..),
                                                          NameAdornment (..),
                                                          NameAnn (..),
                                                          SrcSpanAnnA,
                                                          TrailingAnn (..),
                                                          deltaPos,
                                                          emptyComments,
                                                          spanAsAnchor)
#endif

setPrecedingLines ::
#if !MIN_VERSION_ghc(9,9,0)
     Default t =>
#endif
    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 = LocatedAn t a -> DeltaPos -> LocatedAn t a
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)
------------------------------------------------------------------------------

data Log = LogShake Shake.Log deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogShake Log
shakeLog -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
shakeLog

data GetAnnotatedParsedSource = GetAnnotatedParsedSource
  deriving (GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
(GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool)
-> (GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool)
-> Eq GetAnnotatedParsedSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
== :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
$c/= :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
/= :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
Eq, Int -> GetAnnotatedParsedSource -> ShowS
[GetAnnotatedParsedSource] -> ShowS
GetAnnotatedParsedSource -> String
(Int -> GetAnnotatedParsedSource -> ShowS)
-> (GetAnnotatedParsedSource -> String)
-> ([GetAnnotatedParsedSource] -> ShowS)
-> Show GetAnnotatedParsedSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetAnnotatedParsedSource -> ShowS
showsPrec :: Int -> GetAnnotatedParsedSource -> ShowS
$cshow :: GetAnnotatedParsedSource -> String
show :: GetAnnotatedParsedSource -> String
$cshowList :: [GetAnnotatedParsedSource] -> ShowS
showList :: [GetAnnotatedParsedSource] -> ShowS
Show, Typeable, (forall x.
 GetAnnotatedParsedSource -> Rep GetAnnotatedParsedSource x)
-> (forall x.
    Rep GetAnnotatedParsedSource x -> GetAnnotatedParsedSource)
-> Generic GetAnnotatedParsedSource
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
$cfrom :: forall x.
GetAnnotatedParsedSource -> Rep GetAnnotatedParsedSource x
from :: forall x.
GetAnnotatedParsedSource -> Rep GetAnnotatedParsedSource x
$cto :: forall x.
Rep GetAnnotatedParsedSource x -> GetAnnotatedParsedSource
to :: forall x.
Rep GetAnnotatedParsedSource x -> GetAnnotatedParsedSource
GHC.Generic)

instance Hashable GetAnnotatedParsedSource
instance NFData GetAnnotatedParsedSource
type instance RuleResult GetAnnotatedParsedSource = ParsedSource

#if MIN_VERSION_ghc(9,5,0)
instance Show (HsModule GhcPs) where
  show :: HsModule GhcPs -> String
show HsModule GhcPs
_ = String
"<HsModule GhcPs>"
#else
instance Show HsModule where
  show _ = "<HsModule GhcPs>"
#endif

-- | 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 = Recorder (WithPriority Log)
-> (GetAnnotatedParsedSource
    -> NormalizedFilePath -> Action (IdeResult ParsedSource))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetAnnotatedParsedSource
  -> NormalizedFilePath -> Action (IdeResult ParsedSource))
 -> Rules ())
-> (GetAnnotatedParsedSource
    -> NormalizedFilePath -> Action (IdeResult ParsedSource))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp -> do
  Maybe ParsedModule
pm <- GetParsedModuleWithComments
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModuleWithComments
GetParsedModuleWithComments NormalizedFilePath
nfp
  IdeResult ParsedSource -> Action (IdeResult ParsedSource)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (ParsedModule -> ParsedSource)
-> Maybe ParsedModule -> Maybe ParsedSource
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedModule -> ParsedSource
annotateParsedSource Maybe ParsedModule
pm)

annotateParsedSource :: ParsedModule -> ParsedSource
annotateParsedSource :: ParsedModule -> ParsedSource
annotateParsedSource (ParsedModule ModSummary
_ ParsedSource
ps [String]
_ ()
_) =
#if MIN_VERSION_ghc(9,9,0)
    ps
#else
    (ParsedSource -> ParsedSource
forall ast. ExactPrint ast => ast -> ast
makeDeltaAst ParsedSource
ps)
#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) = (DynFlags -> a -> TransformT n a) -> Graft n a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((TransformT m a -> TransformT n a)
-> (a -> TransformT m a) -> a -> TransformT n a
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall x. m x -> n x) -> TransformT m a -> TransformT n a
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform m x -> n x
forall x. m x -> n x
h) ((a -> TransformT m a) -> a -> TransformT n a)
-> (DynFlags -> a -> TransformT m a)
-> DynFlags
-> a
-> TransformT n a
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 :: * -> *). Monad m => Monad (ExceptStringT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a)
-> MonadTrans ExceptStringT
forall (m :: * -> *). Monad m => Monad (ExceptStringT m)
forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
MonadTrans
        , Applicative (ExceptStringT m)
Applicative (ExceptStringT m) =>
(forall a b.
 ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b)
-> (forall a b.
    ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b)
-> (forall a. a -> ExceptStringT m a)
-> Monad (ExceptStringT m)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> (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 -> ExceptStringT m b -> ExceptStringT m b
>> :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
return :: forall a. a -> ExceptStringT m a
Monad
        , (forall a b. (a -> b) -> ExceptStringT m a -> ExceptStringT m b)
-> (forall a b. a -> ExceptStringT m b -> ExceptStringT m a)
-> Functor (ExceptStringT m)
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
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExceptStringT m a -> ExceptStringT m b
fmap :: forall a b. (a -> b) -> ExceptStringT m a -> ExceptStringT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ExceptStringT m b -> ExceptStringT m a
<$ :: forall a b. a -> ExceptStringT m b -> ExceptStringT m a
Functor
        , Functor (ExceptStringT m)
Functor (ExceptStringT m) =>
(forall a. a -> ExceptStringT m a)
-> (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 a b.
    ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b)
-> (forall a b.
    ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a)
-> Applicative (ExceptStringT m)
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
$cpure :: forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
pure :: forall a. a -> ExceptStringT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
<*> :: forall a b.
ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
*> :: 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 a
<* :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a
Applicative
        , Applicative (ExceptStringT m)
Applicative (ExceptStringT m) =>
(forall a. ExceptStringT m a)
-> (forall a.
    ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a)
-> (forall a. ExceptStringT m a -> ExceptStringT m [a])
-> (forall a. ExceptStringT m a -> ExceptStringT m [a])
-> Alternative (ExceptStringT m)
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
$cempty :: forall (m :: * -> *) a. Monad m => ExceptStringT m a
empty :: forall a. ExceptStringT m a
$c<|> :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
<|> :: forall a.
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$csome :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
some :: forall a. ExceptStringT m a -> ExceptStringT m [a]
$cmany :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
many :: forall a. ExceptStringT m a -> ExceptStringT m [a]
Alternative
        , (forall m. Monoid m => ExceptStringT m m -> m)
-> (forall m a. Monoid m => (a -> m) -> ExceptStringT m a -> m)
-> (forall m a. Monoid m => (a -> m) -> ExceptStringT m a -> m)
-> (forall a b. (a -> b -> b) -> b -> ExceptStringT m a -> b)
-> (forall a b. (a -> b -> b) -> b -> ExceptStringT m a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExceptStringT m a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExceptStringT m a -> b)
-> (forall a. (a -> a -> a) -> ExceptStringT m a -> a)
-> (forall a. (a -> a -> a) -> ExceptStringT m a -> a)
-> (forall a. ExceptStringT m a -> [a])
-> (forall a. ExceptStringT m a -> Bool)
-> (forall a. ExceptStringT m a -> Int)
-> (forall a. Eq a => a -> ExceptStringT m a -> Bool)
-> (forall a. Ord a => ExceptStringT m a -> a)
-> (forall a. Ord a => ExceptStringT m a -> a)
-> (forall a. Num a => ExceptStringT m a -> a)
-> (forall a. Num a => ExceptStringT m a -> a)
-> Foldable (ExceptStringT m)
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
$cfold :: forall (m :: * -> *) m.
(Foldable m, Monoid m) =>
ExceptStringT m m -> m
fold :: forall m. Monoid m => ExceptStringT m m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> ExceptStringT m a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> ExceptStringT m a -> b
$cfoldr1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
foldr1 :: forall a. (a -> a -> a) -> ExceptStringT m a -> a
$cfoldl1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
foldl1 :: forall a. (a -> a -> a) -> ExceptStringT m a -> a
$ctoList :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> [a]
toList :: forall a. ExceptStringT m a -> [a]
$cnull :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Bool
null :: forall a. ExceptStringT m a -> Bool
$clength :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Int
length :: forall a. ExceptStringT m a -> Int
$celem :: forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> ExceptStringT m a -> Bool
elem :: forall a. Eq a => a -> ExceptStringT m a -> Bool
$cmaximum :: forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
maximum :: forall a. Ord a => ExceptStringT m a -> a
$cminimum :: forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
minimum :: forall a. Ord a => ExceptStringT m a -> a
$csum :: forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
sum :: forall a. Num a => ExceptStringT m a -> a
$cproduct :: forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
product :: forall a. Num a => ExceptStringT m a -> a
Foldable
        , (forall a' a. (a' -> a) -> ExceptStringT m a -> ExceptStringT m a')
-> (forall b a. b -> ExceptStringT m b -> ExceptStringT m a)
-> Contravariant (ExceptStringT m)
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
$ccontramap :: forall (m :: * -> *) a' a.
Contravariant m =>
(a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
contramap :: forall a' a. (a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
$c>$ :: forall (m :: * -> *) b a.
Contravariant m =>
b -> ExceptStringT m b -> ExceptStringT m a
>$ :: forall b a. b -> ExceptStringT m b -> ExceptStringT m a
Contravariant
        , Monad (ExceptStringT m)
Monad (ExceptStringT m) =>
(forall a. IO a -> ExceptStringT m a) -> MonadIO (ExceptStringT m)
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
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ExceptStringT m a
liftIO :: forall a. IO a -> ExceptStringT m a
MonadIO
        , (forall a. Eq a => Eq (ExceptStringT m a)) =>
(forall a b.
 (a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool)
-> Eq1 (ExceptStringT m)
forall a. Eq a => Eq (ExceptStringT m a)
forall a b.
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
forall (m :: * -> *) a. (Eq1 m, Eq a) => Eq (ExceptStringT m a)
forall (m :: * -> *) a b.
Eq1 m =>
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
forall (f :: * -> *).
(forall a. Eq a => Eq (f a)) =>
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
$cliftEq :: forall (m :: * -> *) a b.
Eq1 m =>
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
liftEq :: forall a b.
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
Eq1
        , Eq1 (ExceptStringT m)
(Eq1 (ExceptStringT m),
 forall a. Ord a => Ord (ExceptStringT m a)) =>
(forall a b.
 (a -> b -> Ordering)
 -> ExceptStringT m a -> ExceptStringT m b -> Ordering)
-> Ord1 (ExceptStringT m)
forall a. Ord a => Ord (ExceptStringT m a)
forall a b.
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
forall (m :: * -> *). Ord1 m => Eq1 (ExceptStringT m)
forall (m :: * -> *) a. (Ord1 m, Ord a) => Ord (ExceptStringT m a)
forall (m :: * -> *) a b.
Ord1 m =>
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
forall (f :: * -> *).
(Eq1 f, forall a. Ord a => Ord (f a)) =>
(forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering)
-> Ord1 f
$cliftCompare :: forall (m :: * -> *) a b.
Ord1 m =>
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
liftCompare :: forall a b.
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
Ord1
        , (forall a. Show a => Show (ExceptStringT m a)) =>
(forall a.
 (Int -> a -> ShowS)
 -> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS)
    -> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS)
-> Show1 (ExceptStringT m)
forall a. Show a => Show (ExceptStringT m a)
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, Show a) =>
Show (ExceptStringT m a)
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. Show a => Show (f a)) =>
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
$cliftShowsPrec :: forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
$cliftShowList :: forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
liftShowList :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
Show1
        , (forall a. Read a => Read (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 a.
    ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a))
-> (forall a.
    ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a])
-> Read1 (ExceptStringT m)
forall a. Read a => Read (ExceptStringT m a)
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, Read a) =>
Read (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. Read a => Read (f a)) =>
(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
$cliftReadsPrec :: forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
$cliftReadList :: forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
liftReadList :: forall a.
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
$cliftReadPrec :: forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
liftReadPrec :: forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
$cliftReadListPrec :: forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
liftReadListPrec :: forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
Read1
        , Monad (ExceptStringT m)
Monad (ExceptStringT m) =>
(forall a b.
 ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b))
-> (forall a b c.
    (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))
-> MonadZip (ExceptStringT m)
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
$cmzip :: forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
mzip :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
$cmzipWith :: forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
mzipWith :: forall a b c.
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
$cmunzip :: forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
munzip :: forall a b.
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
MonadZip
        , Monad (ExceptStringT m)
Alternative (ExceptStringT m)
(Alternative (ExceptStringT m), Monad (ExceptStringT m)) =>
(forall a. ExceptStringT m a)
-> (forall a.
    ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a)
-> MonadPlus (ExceptStringT m)
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
$cmzero :: forall (m :: * -> *) a. Monad m => ExceptStringT m a
mzero :: forall a. ExceptStringT m a
$cmplus :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
mplus :: forall a.
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
MonadPlus
        , ExceptStringT m a -> ExceptStringT m a -> Bool
(ExceptStringT m a -> ExceptStringT m a -> Bool)
-> (ExceptStringT m a -> ExceptStringT m a -> Bool)
-> Eq (ExceptStringT m a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *) a.
(Eq1 m, Eq a) =>
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
/= :: ExceptStringT m a -> ExceptStringT m a -> Bool
Eq
        , Eq (ExceptStringT m a)
Eq (ExceptStringT m a) =>
(ExceptStringT m a -> ExceptStringT m a -> Ordering)
-> (ExceptStringT m a -> ExceptStringT m a -> Bool)
-> (ExceptStringT m a -> ExceptStringT m a -> Bool)
-> (ExceptStringT m a -> ExceptStringT m a -> Bool)
-> (ExceptStringT m a -> ExceptStringT m a -> Bool)
-> (ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a)
-> (ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a)
-> Ord (ExceptStringT m a)
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
$ccompare :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Ordering
compare :: ExceptStringT m a -> ExceptStringT m a -> Ordering
$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
>= :: ExceptStringT m a -> ExceptStringT m a -> Bool
$cmax :: 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
$cmin :: 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
Ord
        , Int -> ExceptStringT m a -> ShowS
[ExceptStringT m a] -> ShowS
ExceptStringT m a -> String
(Int -> ExceptStringT m a -> ShowS)
-> (ExceptStringT m a -> String)
-> ([ExceptStringT m a] -> ShowS)
-> Show (ExceptStringT m a)
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
$cshowsPrec :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
Int -> ExceptStringT m a -> ShowS
showsPrec :: Int -> ExceptStringT m a -> ShowS
$cshow :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
ExceptStringT m a -> String
show :: ExceptStringT m a -> String
$cshowList :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
[ExceptStringT m a] -> ShowS
showList :: [ExceptStringT m a] -> ShowS
Show
        , ReadPrec [ExceptStringT m a]
ReadPrec (ExceptStringT m a)
Int -> ReadS (ExceptStringT m a)
ReadS [ExceptStringT m a]
(Int -> ReadS (ExceptStringT m a))
-> ReadS [ExceptStringT m a]
-> ReadPrec (ExceptStringT m a)
-> ReadPrec [ExceptStringT m a]
-> Read (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]
$creadsPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
Int -> ReadS (ExceptStringT m a)
readsPrec :: Int -> ReadS (ExceptStringT m a)
$creadList :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadS [ExceptStringT m a]
readList :: ReadS [ExceptStringT m a]
$creadPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadPrec (ExceptStringT m a)
readPrec :: ReadPrec (ExceptStringT m a)
$creadListPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadPrec [ExceptStringT m a]
readListPrec :: ReadPrec [ExceptStringT m a]
Read
        )

instance Monad m => Fail.MonadFail (ExceptStringT m) where
    fail :: forall a. String -> ExceptStringT m a
fail = ExceptT String m a -> ExceptStringT m a
forall (m :: * -> *) a. ExceptT String m a -> ExceptStringT m a
ExceptStringT (ExceptT String m a -> ExceptStringT m a)
-> (String -> ExceptT String m a) -> String -> ExceptStringT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either String a) -> ExceptT String m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either String a) -> ExceptT String m a)
-> (String -> m (Either String a)) -> String -> ExceptT String m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String a -> m (Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> m (Either String a))
-> (String -> Either String a) -> String -> m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
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 = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags -> DynFlags -> a -> TransformT m a
a DynFlags
dflags (a -> TransformT m a)
-> (a -> TransformT m a) -> a -> TransformT m a
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 = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ (a -> TransformT m a) -> DynFlags -> a -> TransformT m a
forall a b. a -> b -> a
const a -> TransformT m a
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

-- | Convert a 'Graft' into a 'WorkspaceEdit'.
transform ::
    DynFlags ->
    ClientCapabilities ->
    VersionedTextDocumentIdentifier ->
    Graft (Either String) ParsedSource ->
    ParsedSource ->
    Either String WorkspaceEdit
transform :: DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (Either String) ParsedSource
-> ParsedSource
-> Either String WorkspaceEdit
transform DynFlags
dflags ClientCapabilities
ccs VersionedTextDocumentIdentifier
verTxtDocId Graft (Either String) ParsedSource
f ParsedSource
a = do
    let src :: String
src = ParsedSource -> String
forall ast. ExactPrint ast => ast -> String
printA ParsedSource
a
    ParsedSource
a' <- ParsedSource
-> (ParsedSource -> TransformT (Either String) ParsedSource)
-> Either String ParsedSource
forall (m :: * -> *) ast1 ast2.
Monad m =>
ast1 -> (ast1 -> TransformT m ast2) -> m ast2
transformA ParsedSource
a ((ParsedSource -> TransformT (Either String) ParsedSource)
 -> Either String ParsedSource)
-> (ParsedSource -> TransformT (Either String) ParsedSource)
-> Either String ParsedSource
forall a b. (a -> b) -> a -> b
$ Graft (Either String) ParsedSource
-> DynFlags
-> ParsedSource
-> TransformT (Either String) ParsedSource
forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft Graft (Either String) ParsedSource
f DynFlags
dflags
    let res :: String
res = ParsedSource -> String
forall ast. ExactPrint ast => ast -> String
printA ParsedSource
a'
    WorkspaceEdit -> Either String WorkspaceEdit
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> Either String WorkspaceEdit)
-> WorkspaceEdit -> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ ClientCapabilities
-> (VersionedTextDocumentIdentifier, Text)
-> Text
-> WithDeletions
-> WorkspaceEdit
diffText ClientCapabilities
ccs (VersionedTextDocumentIdentifier
verTxtDocId, 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 ->
    VersionedTextDocumentIdentifier ->
    Graft (ExceptStringT m) ParsedSource ->
    ParsedSource ->
    m (Either String WorkspaceEdit)
transformM :: forall (m :: * -> *).
Monad m =>
DynFlags
-> ClientCapabilities
-> VersionedTextDocumentIdentifier
-> Graft (ExceptStringT m) ParsedSource
-> ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
ccs VersionedTextDocumentIdentifier
verTextDocId Graft (ExceptStringT m) ParsedSource
f ParsedSource
a = ExceptT String m WorkspaceEdit -> m (Either String WorkspaceEdit)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String m WorkspaceEdit -> m (Either String WorkspaceEdit))
-> ExceptT String m WorkspaceEdit
-> m (Either String WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$
    ExceptStringT m WorkspaceEdit -> ExceptT String m WorkspaceEdit
forall (m :: * -> *) a. ExceptStringT m a -> ExceptT String m a
runExceptString (ExceptStringT m WorkspaceEdit -> ExceptT String m WorkspaceEdit)
-> ExceptStringT m WorkspaceEdit -> ExceptT String m WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ do
        let src :: String
src = ParsedSource -> String
forall ast. ExactPrint ast => ast -> String
printA ParsedSource
a
        ParsedSource
a' <- ParsedSource
-> (ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
-> ExceptStringT m ParsedSource
forall (m :: * -> *) ast1 ast2.
Monad m =>
ast1 -> (ast1 -> TransformT m ast2) -> m ast2
transformA ParsedSource
a ((ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
 -> ExceptStringT m ParsedSource)
-> (ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
-> ExceptStringT m ParsedSource
forall a b. (a -> b) -> a -> b
$ Graft (ExceptStringT m) ParsedSource
-> DynFlags
-> ParsedSource
-> TransformT (ExceptStringT m) ParsedSource
forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft Graft (ExceptStringT m) ParsedSource
f DynFlags
dflags
        let res :: String
res = ParsedSource -> String
forall ast. ExactPrint ast => ast -> String
printA ParsedSource
a'
        WorkspaceEdit -> ExceptStringT m WorkspaceEdit
forall a. a -> ExceptStringT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> ExceptStringT m WorkspaceEdit)
-> WorkspaceEdit -> ExceptStringT m WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ ClientCapabilities
-> (VersionedTextDocumentIdentifier, Text)
-> Text
-> WithDeletions
-> WorkspaceEdit
diffText ClientCapabilities
ccs (VersionedTextDocumentIdentifier
verTextDocId, 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)
#if !MIN_VERSION_ghc(9,9,0)
needsParensSpace HsLamCase{}     = (Bool -> All
All Bool
False, Bool -> All
All Bool
True)
#endif
needsParensSpace HsApp{}         = (All, All)
forall a. Monoid a => a
mempty
needsParensSpace HsAppType{}     = (All, All)
forall a. Monoid a => a
mempty
needsParensSpace OpApp{}         = (All, All)
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{}     = (All, All)
forall a. Monoid a => a
mempty
needsParensSpace HsExpr GhcPs
_               = (All, All)
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, 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, ASTElement l ast) =>
Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
needs_space SrcSpan
dst LocatedAn l ast
val = (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT (Either String) a)
 -> Graft (Either String) a)
-> (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
    LocatedAn l ast
val' <- DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
forall l ast.
ASTElement l ast =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate DynFlags
dflags Bool
needs_space LocatedAn l ast
val
    a -> TransformT (Either String) a
forall a. a -> TransformT (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> TransformT (Either String) a)
-> a -> TransformT (Either String) a
forall a b. (a -> b) -> a -> b
$
        (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere'
            ( (LocatedAn l ast -> LocatedAn l ast) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT ((LocatedAn l ast -> LocatedAn l ast) -> a -> a)
-> (LocatedAn l ast -> LocatedAn l ast) -> a -> a
forall a b. (a -> b) -> a -> b
$
                \case
                    (L SrcAnn l
src ast
_ :: LocatedAn l ast)
                        | SrcAnn l -> SrcSpan
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 = (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT (Either String) a)
 -> Graft (Either String) a)
-> (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
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) = SrcSpan
-> a
-> (Bool,
    LocatedAn AnnListItem (HsExpr GhcPs)
    -> LocatedAn AnnListItem (HsExpr GhcPs))
forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a

    Graft (Either String) a
-> DynFlags -> a -> TransformT (Either String) a
forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft
      (Bool
-> SrcSpan
-> LocatedAn AnnListItem (HsExpr GhcPs)
-> Graft (Either String) a
forall ast a l.
(Data a, ASTElement l ast) =>
Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
needs_space SrcSpan
dst (LocatedAn AnnListItem (HsExpr GhcPs) -> Graft (Either String) a)
-> LocatedAn AnnListItem (HsExpr GhcPs) -> Graft (Either String) a
forall a b. (a -> b) -> a -> b
$ LocatedAn AnnListItem (HsExpr GhcPs)
-> LocatedAn AnnListItem (HsExpr GhcPs)
mk_parens LHsExpr GhcPs
LocatedAn AnnListItem (HsExpr 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) =
          (Maybe All, Maybe All)
-> ((Maybe All, Maybe All)
    -> (Maybe All, Maybe All) -> (Maybe All, Maybe All))
-> GenericQ
     ((Maybe All, Maybe All)
      -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> GenericQ (Maybe All, Maybe All)
forall s r.
s -> (r -> r -> r) -> GenericQ (s -> (r, s)) -> GenericQ r
everythingWithContext (Maybe All
forall a. Maybe a
Nothing, Maybe All
forall a. Maybe a
Nothing) (Maybe All, Maybe All)
-> (Maybe All, Maybe All) -> (Maybe All, Maybe All)
forall a. Semigroup a => a -> a -> a
(<>)
            ( ((Maybe All, Maybe All)
 -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> (LocatedAn AnnListItem (HsExpr GhcPs)
    -> (Maybe All, Maybe All)
    -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> a
-> (Maybe All, Maybe All)
-> ((Maybe All, Maybe All), (Maybe All, Maybe All))
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ ((Maybe All, Maybe All)
forall a. Monoid a => a
mempty, ) ((LocatedAn AnnListItem (HsExpr GhcPs)
  -> (Maybe All, Maybe All)
  -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
 -> a
 -> (Maybe All, Maybe All)
 -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> (LocatedAn AnnListItem (HsExpr GhcPs)
    -> (Maybe All, Maybe All)
    -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> a
-> (Maybe All, Maybe All)
-> ((Maybe All, Maybe All), (Maybe All, Maybe All))
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) | SrcSpanAnnA -> SrcSpan
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' -> ((Maybe All, Maybe All)
forall a. Monoid a => a
mempty, All -> Maybe All
forall a. a -> Maybe a
Just (All -> Maybe All)
-> (All -> Maybe All) -> (All, All) -> (Maybe All, Maybe All)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** All -> Maybe All
forall a. a -> Maybe a
Just ((All, All) -> (Maybe All, Maybe All))
-> (All, All) -> (Maybe All, Maybe All)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> (All, All)
needsParensSpace HsExpr GhcPs
x')
            ) a
a
   in ( Bool -> (All -> Bool) -> Maybe All -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True All -> Bool
getAll Maybe All
needs_space
      , (LocatedAn l ast -> LocatedAn l ast)
-> (LocatedAn l ast -> LocatedAn l ast)
-> Bool
-> LocatedAn l ast
-> LocatedAn l ast
forall a. a -> a -> Bool -> a
bool LocatedAn l ast -> LocatedAn l ast
forall a. a -> a
id LocatedAn l ast -> LocatedAn l ast
forall l ast.
ASTElement l ast =>
LocatedAn l ast -> LocatedAn l ast
maybeParensAST (Bool -> LocatedAn l ast -> LocatedAn l ast)
-> Bool -> LocatedAn l ast -> LocatedAn l ast
forall a b. (a -> b) -> a -> b
$ Bool -> (All -> Bool) -> Maybe All -> Bool
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 = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
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) = SrcSpan
-> a
-> (Bool,
    LocatedAn AnnListItem (HsExpr GhcPs)
    -> LocatedAn AnnListItem (HsExpr GhcPs))
forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a

    GenericM (TransformT m) -> GenericM (TransformT m)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM'
        ( (LocatedAn AnnListItem (HsExpr GhcPs)
 -> TransformT m (LocatedAn AnnListItem (HsExpr GhcPs)))
-> a -> TransformT m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM ((LocatedAn AnnListItem (HsExpr GhcPs)
  -> TransformT m (LocatedAn AnnListItem (HsExpr GhcPs)))
 -> a -> TransformT m a)
-> (LocatedAn AnnListItem (HsExpr GhcPs)
    -> TransformT m (LocatedAn AnnListItem (HsExpr GhcPs)))
-> a
-> TransformT m a
forall a b. (a -> b) -> a -> b
$
            \case
                val :: LocatedAn AnnListItem (HsExpr GhcPs)
val@(L SrcSpanAnnA
src HsExpr GhcPs
_ :: LHsExpr GhcPs)
                    | SrcSpanAnnA -> SrcSpan
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 LHsExpr GhcPs
LocatedAn AnnListItem (HsExpr GhcPs)
val
                        case Maybe (LocatedAn AnnListItem (HsExpr GhcPs))
mval of
                            Just LocatedAn AnnListItem (HsExpr GhcPs)
val' -> do
                                LocatedAn AnnListItem (HsExpr GhcPs)
val'' <-
                                    (forall x. Either String x -> m x)
-> TransformT
     (Either String) (LocatedAn AnnListItem (HsExpr GhcPs))
-> TransformT m (LocatedAn AnnListItem (HsExpr GhcPs))
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform ((String -> m x) -> (x -> m x) -> Either String x -> m x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m x
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail x -> m x
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
                                        (forall l ast.
ASTElement l ast =>
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'))
                                LocatedAn AnnListItem (HsExpr GhcPs)
-> TransformT m (LocatedAn AnnListItem (HsExpr GhcPs))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn AnnListItem (HsExpr GhcPs)
val''
                            Maybe (LocatedAn AnnListItem (HsExpr GhcPs))
Nothing -> LocatedAn AnnListItem (HsExpr GhcPs)
-> TransformT m (LocatedAn AnnListItem (HsExpr GhcPs))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn AnnListItem (HsExpr GhcPs)
val
                LocatedAn AnnListItem (HsExpr GhcPs)
l -> LocatedAn AnnListItem (HsExpr GhcPs)
-> TransformT m (LocatedAn AnnListItem (HsExpr GhcPs))
forall a. a -> TransformT m a
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, 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, 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 = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
    GenericM (TransformT m) -> GenericM (TransformT m)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM'
        ( (LocatedAn l ast -> TransformT m (LocatedAn l ast))
-> a -> TransformT m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM ((LocatedAn l ast -> TransformT m (LocatedAn l ast))
 -> a -> TransformT m a)
-> (LocatedAn l ast -> TransformT m (LocatedAn l ast))
-> a
-> TransformT m a
forall a b. (a -> b) -> a -> b
$
            \case
                val :: LocatedAn l ast
val@(L SrcAnn l
src ast
_ :: LocatedAn l ast)
                    | SrcAnn l -> SrcSpan
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
                                LocatedAn l ast
val'' <-
                                    (forall x. Either String x -> m x)
-> TransformT (Either String) (LocatedAn l ast)
-> TransformT m (LocatedAn l ast)
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform ((String -> m x) -> (x -> m x) -> Either String x -> m x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m x
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail x -> m x
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (TransformT (Either String) (LocatedAn l ast)
 -> TransformT m (LocatedAn l ast))
-> TransformT (Either String) (LocatedAn l ast)
-> TransformT m (LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$
                                        DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
forall l ast.
ASTElement l ast =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate DynFlags
dflags Bool
False (LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast))
-> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$ LocatedAn l ast -> LocatedAn l ast
forall l ast.
ASTElement l ast =>
LocatedAn l ast -> LocatedAn l ast
maybeParensAST LocatedAn l ast
val'
                                LocatedAn l ast -> TransformT m (LocatedAn l ast)
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
val''
                            Maybe (LocatedAn l ast)
Nothing -> LocatedAn l ast -> TransformT m (LocatedAn l ast)
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
val
                LocatedAn l ast
l -> LocatedAn l ast -> TransformT m (LocatedAn l ast)
forall a. a -> TransformT m a
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 = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    GenericQ (Maybe (Bool, ast))
-> (ast -> GenericM (TransformT m)) -> GenericM (TransformT m)
forall (m :: * -> *) a.
Monad m =>
GenericQ (Maybe (Bool, a)) -> (a -> GenericM m) -> GenericM m
smallestM (Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe (Bool, ast))
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 = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    GenericQ (Maybe (Bool, ast))
-> (ast -> GenericM (TransformT m)) -> GenericM (TransformT m)
forall (m :: * -> *) a.
Monad m =>
GenericQ (Maybe (Bool, a)) -> (a -> GenericM m) -> GenericM m
largestM (Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe (Bool, ast))
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 = (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT (Either String) a)
 -> Graft (Either String) a)
-> (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
    [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs <- [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> TransformT
         (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs0 ((GenLocated SrcSpanAnnA (HsDecl GhcPs)
  -> TransformT
       (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
 -> TransformT
      (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> TransformT
         (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl -> do
        DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
    let go :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
go [] = DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. DList a
DL.empty
        go (L SrcSpanAnnA
src HsDecl GhcPs
e : [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest)
            | SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
            | Bool
otherwise = GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton (SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
src HsDecl GhcPs
e) DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
go [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
    ([LHsDecl GhcPs] -> TransformT (Either String) [LHsDecl GhcPs])
-> a -> TransformT (Either String) a
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
     (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> TransformT (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> TransformT
      (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
     (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. DList a -> [a]
DL.toList (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
go) a
a


-- | 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 no 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 [] = (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
-> TransformT
     m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. DList a
DL.empty, Maybe r
forall a. Maybe a
Nothing)
      modifyMatchingDecl (ldecl :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl@(L SrcSpanAnnA
src HsDecl GhcPs
_) : [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest) =
        RWST () [String] Int m Bool -> TransformT m Bool
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (m Bool -> RWST () [String] Int m Bool
forall (m :: * -> *) a. Monad m => m a -> RWST () [String] Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> RWST () [String] Int m Bool)
-> m Bool -> RWST () [String] Int m Bool
forall a b. (a -> b) -> a -> b
$ SrcSpan -> m Bool
validSpan (SrcSpan -> m Bool) -> SrcSpan -> m Bool
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src) TransformT m Bool
-> (Bool
    -> TransformT
         m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r))
-> TransformT
     m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
forall a b.
TransformT m a -> (a -> TransformT m b) -> TransformT m b
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 LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl
              (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
-> TransformT
     m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs' DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest, r -> Maybe r
forall a. a -> Maybe a
Just r
r)
            Bool
False -> (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
-> (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl <>) ((DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
 -> (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r))
-> TransformT
     m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
-> TransformT
     m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
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
  ([LHsDecl GhcPs] -> TransformT m ([LHsDecl GhcPs], Maybe r))
-> a -> TransformT m (a, Maybe r)
forall t (m :: * -> *) r.
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r)) -> t -> m (t, r)
modifyDeclsT' (((DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
 -> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], Maybe r))
-> TransformT
     m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
-> TransformT m ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], Maybe r)
forall a b. (a -> b) -> TransformT m a -> TransformT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], Maybe r)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. DList a -> [a]
DL.toList) (TransformT
   m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r)
 -> TransformT m ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], Maybe r))
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> TransformT
         m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)), Maybe r))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], Maybe r)
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

#if MIN_VERSION_ghc(9,9,0)
generatedAnchor :: DeltaPos -> Anchor
generatedAnchor dp = EpaDelta dp []
#else
generatedAnchor :: AnchorOperation -> Anchor
generatedAnchor :: AnchorOperation -> Anchor
generatedAnchor AnchorOperation
anchorOp = RealSrcSpan -> AnchorOperation -> Anchor
GHC.Anchor (SrcSpan -> RealSrcSpan
GHC.realSrcSpan SrcSpan
generatedSrcSpan) AnchorOperation
anchorOp
#endif

setAnchor :: Anchor -> SrcSpanAnnN -> SrcSpanAnnN
#if MIN_VERSION_ghc(9,9,0)
setAnchor anc (EpAnn _ nameAnn comments) =
  EpAnn anc nameAnn comments
#else
setAnchor :: Anchor -> SrcSpanAnnN -> SrcSpanAnnN
setAnchor Anchor
anc (SrcSpanAnn (EpAnn Anchor
_ NameAnn
nameAnn EpAnnComments
comments) SrcSpan
span) =
  EpAnn NameAnn -> SrcSpan -> SrcSpanAnnN
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> NameAnn -> EpAnnComments -> EpAnn NameAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc NameAnn
nameAnn EpAnnComments
comments) SrcSpan
span
setAnchor Anchor
_ SrcSpanAnnN
spanAnnN = SrcSpanAnnN
spanAnnN
#endif

removeTrailingAnns :: SrcSpanAnnN -> SrcSpanAnnN
#if MIN_VERSION_ghc(9,9,0)
removeTrailingAnns (EpAnn anc nameAnn comments) =
  let nameAnnSansTrailings = nameAnn {nann_trailing = []}
  in EpAnn anc nameAnnSansTrailings comments
#else
removeTrailingAnns :: SrcSpanAnnN -> SrcSpanAnnN
removeTrailingAnns (SrcSpanAnn (EpAnn Anchor
anc NameAnn
nameAnn EpAnnComments
comments) SrcSpan
span) =
  let nameAnnSansTrailings :: NameAnn
nameAnnSansTrailings = NameAnn
nameAnn {nann_trailing = []}
  in EpAnn NameAnn -> SrcSpan -> SrcSpanAnnN
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> NameAnn -> EpAnnComments -> EpAnn NameAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc NameAnn
nameAnnSansTrailings EpAnnComments
comments) SrcSpan
span
removeTrailingAnns SrcSpanAnnN
spanAnnN = SrcSpanAnnN
spanAnnN
#endif

-- | 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, ExactPrint a) =>
  IdP GhcPs ->
  (LHsSigType GhcPs -> LHsSigType GhcPs) ->
  a ->
  TransformT m a
modifySigWithM :: forall a (m :: * -> *).
(HasDecls a, Monad m, ExactPrint a) =>
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 [] = DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
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
RdrName
queryId RdrName -> [RdrName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> [GenLocated SrcSpanAnnN RdrName] -> [RdrName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
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
GenLocated SrcSpanAnnA (HsSigType GhcPs)
newSig GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Bool
forall a. Data a => a -> a -> Bool
`geq` LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
lHsSig
              then DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs)))
-> DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
              else case (GenLocated SrcSpanAnnN RdrName -> Bool)
-> [GenLocated SrcSpanAnnN RdrName]
-> ([GenLocated SrcSpanAnnN RdrName],
    [GenLocated SrcSpanAnnN RdrName])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((IdP GhcPs -> IdP GhcPs -> Bool
forall a. Eq a => a -> a -> Bool
== IdP GhcPs
queryId) (RdrName -> Bool)
-> (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ids of
                ([L SrcSpanAnnN
annMatchedId RdrName
matchedId], [GenLocated SrcSpanAnnN RdrName]
otherIds) ->
                  let matchedId' :: GenLocated SrcSpanAnnN RdrName
matchedId' = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (Anchor -> SrcSpanAnnN -> SrcSpanAnnN
setAnchor Anchor
genAnchor0 (SrcSpanAnnN -> SrcSpanAnnN) -> SrcSpanAnnN -> SrcSpanAnnN
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' = XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
xsig (XTypeSig GhcPs
-> [LIdP GhcPs]
-> HsWildCardBndrs GhcPs (LHsSigType GhcPs)
-> Sig GhcPs
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
xTypeSig [LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
matchedId'] (XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC XHsWC GhcPs (LHsSigType GhcPs)
XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
xHsWc LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
newSig))
                            epAnn :: SrcSpanAnnA
epAnn = SrcSpanAnnA -> SrcSpanAnnA -> Bool -> SrcSpanAnnA
forall a. a -> a -> Bool -> a
bool (SrcSpan -> DeltaPos -> SrcSpanAnnA
forall ann.
Monoid ann =>
SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP
#if !MIN_VERSION_ghc(9,9,0)
                                            SrcSpan
generatedSrcSpan
#endif
                                            (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
0))
                                         SrcSpanAnnA
annSigD ([GenLocated SrcSpanAnnN RdrName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnN RdrName]
otherIds)
                        in SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
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
                        [] -> []
#if MIN_VERSION_ghc(9,9,0)
                        (L epAnn id1:ids) ->
#else
                        (L (SrcSpanAnn EpAnn NameAnn
epAnn SrcSpan
span) RdrName
id1:[GenLocated SrcSpanAnnN RdrName]
ids) ->
#endif
                          [
                          let epAnn' :: EpAnn NameAnn
epAnn' = case EpAnn NameAnn
epAnn of
                                EpAnn Anchor
_ NameAnn
nameAnn EpAnnComments
commentsId1 -> Anchor -> NameAnn -> EpAnnComments -> EpAnn NameAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
genAnchor0 NameAnn
nameAnn EpAnnComments
commentsId1
#if MIN_VERSION_ghc(9,9,0)
                              ids' = L epAnn' id1:ids
#else
                                EpAnn NameAnn
EpAnnNotUsed -> Anchor -> NameAnn -> EpAnnComments -> EpAnn NameAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
genAnchor0 NameAnn
forall a. Monoid a => a
mempty EpAnnComments
emptyComments
                              ids' :: [GenLocated SrcSpanAnnN RdrName]
ids' = SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (EpAnn NameAnn -> SrcSpan -> SrcSpanAnnN
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn NameAnn
epAnn' SrcSpan
span) RdrName
id1GenLocated SrcSpanAnnN RdrName
-> [GenLocated SrcSpanAnnN RdrName]
-> [GenLocated SrcSpanAnnN RdrName]
forall a. a -> [a] -> [a]
:[GenLocated SrcSpanAnnN RdrName]
ids
#endif
                              ids'' :: [GenLocated SrcSpanAnnN RdrName]
ids'' = [GenLocated SrcSpanAnnN RdrName]
ids' [GenLocated SrcSpanAnnN RdrName]
-> ([GenLocated SrcSpanAnnN RdrName]
    -> [GenLocated SrcSpanAnnN RdrName])
-> [GenLocated SrcSpanAnnN RdrName]
forall a b. a -> (a -> b) -> b
& (GenLocated SrcSpanAnnN RdrName
 -> Identity (GenLocated SrcSpanAnnN RdrName))
-> [GenLocated SrcSpanAnnN RdrName]
-> Identity [GenLocated SrcSpanAnnN RdrName]
forall s a. Snoc s s a a => Traversal' s a
Traversal'
  [GenLocated SrcSpanAnnN RdrName] (GenLocated SrcSpanAnnN RdrName)
_last ((GenLocated SrcSpanAnnN RdrName
  -> Identity (GenLocated SrcSpanAnnN RdrName))
 -> [GenLocated SrcSpanAnnN RdrName]
 -> Identity [GenLocated SrcSpanAnnN RdrName])
-> (GenLocated SrcSpanAnnN RdrName
    -> GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnN RdrName]
-> [GenLocated SrcSpanAnnN RdrName]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (SrcSpanAnnN -> SrcSpanAnnN)
-> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b c. (a -> b) -> GenLocated a c -> GenLocated b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SrcSpanAnnN -> SrcSpanAnnN
removeTrailingAnns
                            in SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
annSigD (XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
xsig (XTypeSig GhcPs
-> [LIdP GhcPs]
-> HsWildCardBndrs GhcPs (LHsSigType GhcPs)
-> Sig GhcPs
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
xTypeSig [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ids'' (XHsWC GhcPs (LHsSigType GhcPs)
-> LHsSigType GhcPs -> HsWildCardBndrs GhcPs (LHsSigType GhcPs)
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC XHsWC GhcPs (LHsSigType GhcPs)
xHsWc LHsSigType GhcPs
lHsSig)))
                          ]
                  in DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs)))
-> DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
otherSig DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Semigroup a => a -> a -> a
<> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
matchedIdSig DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
                ([GenLocated SrcSpanAnnN RdrName],
 [GenLocated SrcSpanAnnN RdrName])
_ -> String
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. HasCallStack => String -> a
error String
"multiple ids matched"
      modifyMatchingSigD (LHsDecl GhcPs
ldecl : [LHsDecl GhcPs]
rest) = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl <>) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
modifyMatchingSigD [LHsDecl GhcPs]
rest
  ([LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs])
-> a -> TransformT m a
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT ((DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> TransformT m a -> TransformT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. DList a -> [a]
DL.toList (TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
 -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
modifyMatchingSigD) (a -> TransformT m a) -> a -> TransformT m a
forall a b. (a -> b) -> a -> b
$ a -> a
forall ast. ExactPrint ast => ast -> ast
makeDeltaAst a
a

genAnchor0 :: Anchor
genAnchor0 :: Anchor
genAnchor0 = AnchorOperation -> Anchor
generatedAnchor AnchorOperation
m0

genAnchor1 :: Anchor
genAnchor1 :: Anchor
genAnchor1 = AnchorOperation -> Anchor
generatedAnchor AnchorOperation
m1

#if MIN_VERSION_ghc(9,9,0)
m0, m1 :: DeltaPos
m0 = SameLine 0
m1 = SameLine 1
#endif


-- | 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 <- Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> Transform [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ t -> TransformT Identity [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
forall (m :: * -> *). Monad m => t -> TransformT m [LHsDecl GhcPs]
hsDecls t
t
  ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls', r
r) <- [LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r)
action [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
  t
t' <- Transform t -> m t
forall a. Transform a -> m a
forall (m :: * -> *) a. HasTransform m => Transform a -> m a
liftT (Transform t -> m t) -> Transform t -> m t
forall a b. (a -> b) -> a -> b
$ t -> [LHsDecl GhcPs] -> Transform t
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> [LHsDecl GhcPs] -> TransformT m t
forall (m :: * -> *).
Monad m =>
t -> [LHsDecl GhcPs] -> TransformT m t
replaceDecls t
t [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls'
  (t, r) -> m (t, r)
forall a. a -> m a
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 = (MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)), ())
-> MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))
forall a b. (a, b) -> a
fst ((MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)), ())
 -> MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
-> TransformT
     m (MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)), ())
-> TransformT
     m (MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MatchGroup GhcPs (LHsExpr GhcPs)
-> (LMatch GhcPs (LHsExpr GhcPs)
    -> TransformT m (LMatch GhcPs (LHsExpr GhcPs), ()))
-> ()
-> (() -> () -> m ())
-> TransformT m (MatchGroup GhcPs (LHsExpr GhcPs), ())
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 ((GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
 -> (GenLocated
       SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))),
     ()))
-> TransformT
     m
     (GenLocated
        SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))))
-> TransformT
     m
     (GenLocated
        SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))),
      ())
forall a b. (a -> b) -> TransformT m a -> TransformT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) (TransformT
   m
   (GenLocated
      SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))))
 -> TransformT
      m
      (GenLocated
         SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))),
       ()))
-> (GenLocated
      SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
    -> TransformT
         m
         (GenLocated
            SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
-> TransformT
     m
     (GenLocated
        SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))),
      ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
GenLocated
  SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
-> TransformT
     m
     (GenLocated
        SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))))
f) () ((() -> m ()) -> (() -> ()) -> () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((() -> ()) -> () -> m ()) -> (() -> () -> ()) -> () -> () -> m ()
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' :: 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)) LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs), r)
f r
def r -> r -> m r
combineResults = do
  ([(GenLocated
    SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))),
  r)]
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))],
    [r])
forall a b. [(a, b)] -> ([a], [b])
unzip -> ([GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches', [r]
rs)) <- (GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
 -> TransformT
      m
      (GenLocated
         SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))),
       r))
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
-> TransformT
     m
     [(GenLocated
         SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))),
       r)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs), r)
GenLocated
  SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
-> TransformT
     m
     (GenLocated
        SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))),
      r)
f [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches
  r
r' <- RWST () [String] Int m r -> TransformT m r
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (RWST () [String] Int m r -> TransformT m r)
-> RWST () [String] Int m r -> TransformT m r
forall a b. (a -> b) -> a -> b
$ m r -> RWST () [String] Int m r
forall (m :: * -> *) a. Monad m => m a -> RWST () [String] Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m r -> RWST () [String] Int m r)
-> m r -> RWST () [String] Int m r
forall a b. (a -> b) -> a -> b
$ (r -> r -> m r) -> r -> [r] -> m r
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
  (MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)), r)
-> TransformT
     m (MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)), r)
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XMG GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))
-> XRec GhcPs [LMatch GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))]
-> MatchGroup GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (LHsExpr GhcPs)
XMG GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))
xMg (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
locMatches [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches'), r
r')
#else
modifyMgMatchesT' (MG xMg (L locMatches matches) originMg) f def combineResults = do
  (unzip -> (matches', rs)) <- mapM f matches
  r' <- lift $ foldM combineResults def rs
  pure (MG xMg (L locMatches matches') originMg, r')
#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 = (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT (Either String) a)
 -> Graft (Either String) a)
-> (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
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 [] = DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> TransformT (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
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` SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src = LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])
toDecls LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
e TransformT
  (Either String) (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> TransformT
         (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b.
TransformT (Either String) a
-> (a -> TransformT (Either String) b)
-> TransformT (Either String) b
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 <- [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> TransformT
         (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs0 ((GenLocated SrcSpanAnnA (HsDecl GhcPs)
  -> TransformT
       (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
 -> TransformT
      (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> TransformT
         (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl ->
                        DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
                    DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> TransformT (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> TransformT
      (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
                Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
Nothing -> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
e <>) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
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 = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
e <>) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
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
    ([LHsDecl GhcPs] -> TransformT (Either String) [LHsDecl GhcPs])
-> a -> TransformT (Either String) a
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT ((DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT
     (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT
     (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b.
(a -> b)
-> TransformT (Either String) a -> TransformT (Either String) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. DList a -> [a]
DL.toList (TransformT
   (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
 -> TransformT
      (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> TransformT
         (Either String) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT
     (Either String) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
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 = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
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 [] = DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. DList a
DL.empty
        go (e :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
e@(L SrcSpanAnnA
src HsDecl GhcPs
_) : [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest)
            | SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst = LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs])
toDecls LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
e TransformT m (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b.
TransformT m a -> (a -> TransformT m b) -> TransformT m b
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 <- [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs0 ((GenLocated SrcSpanAnnA (HsDecl GhcPs)
  -> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
 -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> TransformT m (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl ->
                        (forall x. Either String x -> m x)
-> TransformT (Either String) (LHsDecl GhcPs)
-> TransformT m (LHsDecl GhcPs)
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform ((String -> m x) -> (x -> m x) -> Either String x -> m x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m x
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail x -> m x
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (TransformT (Either String) (LHsDecl GhcPs)
 -> TransformT m (LHsDecl GhcPs))
-> TransformT (Either String) (LHsDecl GhcPs)
-> TransformT m (LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$
                          DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
decl
                    DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a. a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decs DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. [a] -> DList a
DL.fromList [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
rest
                Maybe [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
Nothing -> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
e <>) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
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 = (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> DList a
DL.singleton GenLocated SrcSpanAnnA (HsDecl GhcPs)
e <>) (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
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
    ([LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs])
-> a -> TransformT m a
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT ((DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> TransformT m a -> TransformT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. DList a -> [a]
DL.toList (TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
 -> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> TransformT m (DList (GenLocated SrcSpanAnnA (HsDecl GhcPs))))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> TransformT m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
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,9,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 = Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
forall ast a l.
(Data a, ASTElement l ast) =>
Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
True SrcSpan
dst (LocatedAn l ast -> Graft (Either String) a)
-> (LocatedAn l ast -> LocatedAn l ast)
-> LocatedAn l ast
-> Graft (Either String) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn l ast -> LocatedAn l ast
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)
Parser (LocatedAn AnnListItem (HsExpr p))
parseExpr
    maybeParensAST :: LocatedAn AnnListItem (HsExpr p)
-> LocatedAn AnnListItem (HsExpr p)
maybeParensAST = LHsExpr GhcPs -> LHsExpr GhcPs
LocatedAn AnnListItem (HsExpr p)
-> LocatedAn AnnListItem (HsExpr p)
parenthesize
    graft :: forall a.
Data a =>
SrcSpan
-> LocatedAn AnnListItem (HsExpr p) -> Graft (Either String) a
graft = SrcSpan -> LHsExpr GhcPs -> Graft (Either String) a
SrcSpan
-> LocatedAn AnnListItem (HsExpr p) -> Graft (Either String) a
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)
Parser (LocatedAn AnnListItem (Pat p))
parsePattern
    maybeParensAST :: LocatedAn AnnListItem (Pat p) -> LocatedAn AnnListItem (Pat p)
maybeParensAST = PprPrec -> LPat GhcPs -> LPat GhcPs
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)
Parser (LocatedAn AnnListItem (HsType p))
parseType
    maybeParensAST :: LocatedAn AnnListItem (HsType p)
-> LocatedAn AnnListItem (HsType p)
maybeParensAST = PprPrec -> LHsType GhcPs -> LHsType GhcPs
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)
Parser (LocatedAn AnnListItem (HsDecl p))
parseDecl
    maybeParensAST :: LocatedAn AnnListItem (HsDecl p)
-> LocatedAn AnnListItem (HsDecl p)
maybeParensAST = LocatedAn AnnListItem (HsDecl p)
-> LocatedAn AnnListItem (HsDecl p)
forall a. a -> a
id

instance p ~ GhcPs => ASTElement AnnListItem (ImportDecl p) where
    parseAST :: Parser (LocatedAn AnnListItem (ImportDecl p))
parseAST = Parser (LImportDecl GhcPs)
Parser (LocatedAn AnnListItem (ImportDecl p))
parseImport
    maybeParensAST :: LocatedAn AnnListItem (ImportDecl p)
-> LocatedAn AnnListItem (ImportDecl p)
maybeParensAST = LocatedAn AnnListItem (ImportDecl p)
-> LocatedAn AnnListItem (ImportDecl p)
forall a. a -> a
id

instance ASTElement NameAnn RdrName where
    parseAST :: Parser (GenLocated SrcSpanAnnN RdrName)
parseAST DynFlags
df String
fp = DynFlags
-> String
-> P (GenLocated SrcSpanAnnN RdrName)
-> String
-> ParseResult (GenLocated SrcSpanAnnN RdrName)
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 = GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
forall a. a -> a
id

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


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


-- | Given an 'LHSExpr', compute its exactprint annotations.
--   Note that this function will throw away any existing annotations (and format)
annotate :: ASTElement l ast
    => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
annotate :: forall l ast.
ASTElement l ast =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate DynFlags
dflags Bool
needs_space LocatedAn l ast
ast = do
    String
uniq <- SrcSpan -> String
forall a. Show a => a -> String
show (SrcSpan -> String)
-> TransformT (Either String) SrcSpan
-> TransformT (Either String) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    let rendered :: String
rendered = DynFlags -> LocatedAn l ast -> String
forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags LocatedAn l ast
ast
#if MIN_VERSION_ghc(9,4,0)
    LocatedAn l ast
expr' <- RWST () [String] Int (Either String) (LocatedAn l ast)
-> TransformT (Either String) (LocatedAn l ast)
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (RWST () [String] Int (Either String) (LocatedAn l ast)
 -> TransformT (Either String) (LocatedAn l ast))
-> RWST () [String] Int (Either String) (LocatedAn l ast)
-> TransformT (Either String) (LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$ Either String (LocatedAn l ast)
-> RWST () [String] Int (Either String) (LocatedAn l ast)
forall (m :: * -> *) a. Monad m => m a -> RWST () [String] Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (LocatedAn l ast)
 -> RWST () [String] Int (Either String) (LocatedAn l ast))
-> Either String (LocatedAn l ast)
-> RWST () [String] Int (Either String) (LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$ (ErrorMessages -> String)
-> Either ErrorMessages (LocatedAn l ast)
-> Either String (LocatedAn l ast)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (SDoc -> String)
-> (ErrorMessages -> SDoc) -> ErrorMessages -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessages -> SDoc
forall a. Outputable a => a -> SDoc
ppr) (Either ErrorMessages (LocatedAn l ast)
 -> Either String (LocatedAn l ast))
-> Either ErrorMessages (LocatedAn l ast)
-> Either String (LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$ Parser (LocatedAn l ast)
forall l ast. ASTElement l ast => Parser (LocatedAn l ast)
parseAST DynFlags
dflags String
uniq String
rendered
    LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
forall a. a -> TransformT (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast))
-> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$ LocatedAn l ast -> Int -> Int -> LocatedAn l ast
forall t a.
Default t =>
LocatedAn t a -> Int -> Int -> LocatedAn t a
setPrecedingLines LocatedAn l ast
expr' Int
0 (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 Bool
needs_space)
#else
    expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered
    pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space)
#endif

-- | Given an 'LHsDecl', compute its exactprint annotations.
annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl :: DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
ast = do
    String
uniq <- SrcSpan -> String
forall a. Show a => a -> String
show (SrcSpan -> String)
-> TransformT (Either String) SrcSpan
-> TransformT (Either String) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    let rendered :: String
rendered = DynFlags -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> String
forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
ast
#if MIN_VERSION_ghc(9,4,0)
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
expr' <- RWST
  ()
  [String]
  Int
  (Either String)
  (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT
     (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (RWST
   ()
   [String]
   Int
   (Either String)
   (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> TransformT
      (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> RWST
     ()
     [String]
     Int
     (Either String)
     (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> TransformT
     (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ Either String (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> RWST
     ()
     [String]
     Int
     (Either String)
     (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (m :: * -> *) a. Monad m => m a -> RWST () [String] Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> RWST
      ()
      [String]
      Int
      (Either String)
      (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> Either String (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> RWST
     ()
     [String]
     Int
     (Either String)
     (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ (ErrorMessages -> String)
-> Either ErrorMessages (LHsDecl GhcPs)
-> Either String (LHsDecl GhcPs)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (SDoc -> String)
-> (ErrorMessages -> SDoc) -> ErrorMessages -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessages -> SDoc
forall a. Outputable a => a -> SDoc
ppr) (Either ErrorMessages (LHsDecl GhcPs)
 -> Either String (LHsDecl GhcPs))
-> Either ErrorMessages (LHsDecl GhcPs)
-> Either String (LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ Parser (LHsDecl GhcPs)
parseDecl DynFlags
dflags String
uniq String
rendered
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT
     (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> TransformT (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> TransformT
      (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> TransformT
     (Either String) (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Int -> Int -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall t a.
Default t =>
LocatedAn t a -> Int -> Int -> LocatedAn t a
setPrecedingLines GenLocated SrcSpanAnnA (HsDecl GhcPs)
expr' Int
1 Int
0
#else
    expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered
    pure $ setPrecedingLines expr' 1 0
#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 (SDoc -> String) -> (a -> SDoc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SDoc
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 = PprPrec -> LHsExpr GhcPs -> LHsExpr GhcPs
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 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
addParensToCtxt Maybe EpaLocation
close_dp = AnnContext -> AnnContext
addOpen (AnnContext -> AnnContext)
-> (AnnContext -> AnnContext) -> AnnContext -> AnnContext
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 = [epl 0]}
      addOpen AnnContext
other                       = AnnContext
other
      addClose :: AnnContext -> AnnContext
addClose AnnContext
it
        | Just EpaLocation
c <- Maybe EpaLocation
close_dp = AnnContext
it{ac_close = [c]}
        | AnnContext{ac_close :: AnnContext -> [EpaLocation]
ac_close = []} <- AnnContext
it = AnnContext
it{ac_close = [epl 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 = Anchor -> ann -> EpAnnComments -> EpAnn ann
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
#if MIN_VERSION_ghc(9,9,0)
modifyAnns x f = first (fmap f) x
#else
modifyAnns :: forall a ast. LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns LocatedAn a ast
x a -> a
f = (SrcSpanAnn' (EpAnn a) -> SrcSpanAnn' (EpAnn a))
-> LocatedAn a ast -> LocatedAn a ast
forall a b c. (a -> b) -> GenLocated a c -> GenLocated b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((EpAnn a -> EpAnn a)
-> SrcSpanAnn' (EpAnn a) -> SrcSpanAnn' (EpAnn a)
forall a b. (a -> b) -> SrcSpanAnn' a -> SrcSpanAnn' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((EpAnn a -> EpAnn a)
 -> SrcSpanAnn' (EpAnn a) -> SrcSpanAnn' (EpAnn a))
-> ((a -> a) -> EpAnn a -> EpAnn a)
-> (a -> a)
-> SrcSpanAnn' (EpAnn a)
-> SrcSpanAnn' (EpAnn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> a) -> EpAnn a -> EpAnn a
forall a b. (a -> b) -> EpAnn a -> EpAnn b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> a
f) LocatedAn a ast
x
#endif

removeComma :: SrcSpanAnnA -> SrcSpanAnnA
#if MIN_VERSION_ghc(9,9,0)
removeComma  (EpAnn anc (AnnListItem as) cs)
  = EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs
  where
      isCommaAnn AddCommaAnn{} = True
      isCommaAnn _             = False
#else
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)
  = EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnListItem -> EpAnnComments -> EpAnn AnnListItem
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc ([TrailingAnn] -> AnnListItem
AnnListItem ((TrailingAnn -> Bool) -> [TrailingAnn] -> [TrailingAnn]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TrailingAnn -> Bool) -> TrailingAnn -> Bool
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
#endif

addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn
addParens :: Bool -> NameAnn -> NameAnn
addParens Bool
True it :: NameAnn
it@NameAnn{} =
        NameAnn
it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
addParens Bool
True it :: NameAnn
it@NameAnnCommas{} =
        NameAnn
it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
addParens Bool
True it :: NameAnn
it@NameAnnOnly{} =
        NameAnn
it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
addParens Bool
True NameAnnTrailing{[TrailingAnn]
nann_trailing :: NameAnn -> [TrailingAnn]
nann_trailing :: [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 = (GenLocated SrcSpanAnnA ast
 -> (AnnListItem -> AnnListItem) -> GenLocated SrcSpanAnnA ast)
-> (AnnListItem -> AnnListItem)
-> GenLocated SrcSpanAnnA ast
-> GenLocated SrcSpanAnnA ast
forall a b c. (a -> b -> c) -> b -> a -> c
flip GenLocated SrcSpanAnnA ast
-> (AnnListItem -> AnnListItem) -> GenLocated SrcSpanAnnA ast
forall a ast. LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns ((AnnListItem -> AnnListItem)
 -> GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast)
-> (AnnListItem -> AnnListItem)
-> GenLocated SrcSpanAnnA ast
-> GenLocated SrcSpanAnnA ast
forall a b. (a -> b) -> a -> b
$ \(AnnListItem [TrailingAnn]
l) -> [TrailingAnn] -> AnnListItem
AnnListItem ([TrailingAnn] -> AnnListItem) -> [TrailingAnn] -> AnnListItem
forall a b. (a -> b) -> a -> b
$ (TrailingAnn -> Bool) -> [TrailingAnn] -> [TrailingAnn]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TrailingAnn -> Bool) -> TrailingAnn -> Bool
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