{-# LANGUAGE CPP          #-}
{-# LANGUAGE DerivingVia  #-}
{-# LANGUAGE GADTs        #-}
{-# LANGUAGE RankNTypes   #-}
{-# LANGUAGE TypeFamilies #-}

module Development.IDE.GHC.ExactPrint
    ( Graft(..),
      graftDecls,
      graftDeclsWithM,
      annotate,
      annotateDecl,
      hoistGraft,
      graftWithM,
      genericGraftWithSmallestM,
      genericGraftWithLargestM,
      graftSmallestDeclsWithM,
      transform,
      transformM,
      useAnnotatedSource,
      annotateParsedSource,
      getAnnotatedParsedSourceRule,
      GetAnnotatedParsedSource(..),
      ASTElement (..),
      ExceptStringT (..),
      Annotated(..),
      TransformT,
      Anns,
      Annotate,
      mkBindListT,
      setPrecedingLinesT,
      everywhereM',
    )
where

import BasicTypes (appPrec)
import Control.Applicative (Alternative)
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 qualified Data.DList as DL
import Data.Either.Extra (mapLeft)
import Data.Functor.Classes
import Data.Functor.Contravariant
import qualified Data.Text as T
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service (runAction)
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat hiding (parseExpr)
import Development.IDE.Types.Location
import Development.Shake (RuleResult, Rules)
import Development.Shake.Classes
import qualified GHC.Generics as GHC
import Generics.SYB
import Ide.PluginUtils
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Parsers
import Language.LSP.Types
import Language.LSP.Types.Capabilities (ClientCapabilities)
import Outputable (Outputable, ppr, showSDoc)
import Retrie.ExactPrint hiding (parseDecl, parseExpr, parsePattern, parseType)
import Parser (parseIdentifier)
import Data.Traversable (for)
import Data.Foldable (Foldable(fold))
import Data.Bool (bool)
import Data.Monoid (All(All), Any(Any))
import Data.Functor.Compose (Compose(Compose))
#if __GLASGOW_HASKELL__ == 808
import Control.Arrow
#endif


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

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
/= :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
$c/= :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
== :: GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
$c== :: 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
showList :: [GetAnnotatedParsedSource] -> ShowS
$cshowList :: [GetAnnotatedParsedSource] -> ShowS
show :: GetAnnotatedParsedSource -> String
$cshow :: GetAnnotatedParsedSource -> String
showsPrec :: Int -> GetAnnotatedParsedSource -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x.
Rep GetAnnotatedParsedSource x -> GetAnnotatedParsedSource
$cfrom :: forall x.
GetAnnotatedParsedSource -> Rep GetAnnotatedParsedSource x
GHC.Generic)

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

-- | Get the latest version of the annotated parse source with comments.
getAnnotatedParsedSourceRule :: Rules ()
getAnnotatedParsedSourceRule :: Rules ()
getAnnotatedParsedSourceRule = (GetAnnotatedParsedSource
 -> NormalizedFilePath
 -> Action (IdeResult (Annotated ParsedSource)))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((GetAnnotatedParsedSource
  -> NormalizedFilePath
  -> Action (IdeResult (Annotated ParsedSource)))
 -> Rules ())
-> (GetAnnotatedParsedSource
    -> NormalizedFilePath
    -> Action (IdeResult (Annotated 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 (Annotated ParsedSource)
-> Action (IdeResult (Annotated ParsedSource))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (ParsedModule -> Annotated ParsedSource)
-> Maybe ParsedModule -> Maybe (Annotated ParsedSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedModule -> Annotated ParsedSource
annotateParsedSource Maybe ParsedModule
pm)

annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource = ParsedModule -> Annotated ParsedSource
fixAnns

useAnnotatedSource ::
  String ->
  IdeState ->
  NormalizedFilePath ->
  IO (Maybe (Annotated ParsedSource))
useAnnotatedSource :: String
-> IdeState
-> NormalizedFilePath
-> IO (Maybe (Annotated ParsedSource))
useAnnotatedSource String
herald IdeState
state NormalizedFilePath
nfp =
    String
-> IdeState
-> Action (Maybe (Annotated ParsedSource))
-> IO (Maybe (Annotated ParsedSource))
forall a. String -> IdeState -> Action a -> IO a
runAction String
herald IdeState
state (GetAnnotatedParsedSource
-> NormalizedFilePath -> Action (Maybe (Annotated ParsedSource))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp)
------------------------------------------------------------------------------

{- | 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
    { 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 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 (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 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 {ExceptStringT m a -> ExceptT String m a
runExceptString :: ExceptT String m a}
    deriving newtype
        ( m a -> ExceptStringT m a
(forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a)
-> MonadTrans ExceptStringT
forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ExceptStringT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
MonadTrans
        , Applicative (ExceptStringT m)
a -> ExceptStringT m a
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)
ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
forall a. a -> ExceptStringT m a
forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
forall a b.
ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
forall (m :: * -> *). Monad m => Applicative (ExceptStringT m)
forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ExceptStringT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
>> :: ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
>>= :: ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> (a -> ExceptStringT m b) -> ExceptStringT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (ExceptStringT m)
Monad
        , a -> ExceptStringT m b -> ExceptStringT m a
(a -> b) -> ExceptStringT m a -> ExceptStringT m b
(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
<$ :: a -> ExceptStringT m b -> ExceptStringT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ExceptStringT m b -> ExceptStringT m a
fmap :: (a -> b) -> ExceptStringT m a -> ExceptStringT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExceptStringT m a -> ExceptStringT m b
Functor
        , Functor (ExceptStringT m)
a -> ExceptStringT m a
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)
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a
ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
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
<* :: ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m a
*> :: ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
liftA2 :: (a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
<*> :: ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m (a -> b) -> ExceptStringT m a -> ExceptStringT m b
pure :: a -> ExceptStringT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (ExceptStringT m)
Applicative
        , Applicative (ExceptStringT m)
ExceptStringT m a
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)
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
ExceptStringT m a -> ExceptStringT m [a]
ExceptStringT m a -> ExceptStringT m [a]
forall a. ExceptStringT m a
forall a. ExceptStringT m a -> ExceptStringT m [a]
forall a.
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall (m :: * -> *). Monad m => Applicative (ExceptStringT m)
forall (m :: * -> *) a. Monad m => ExceptStringT m a
forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: ExceptStringT m a -> ExceptStringT m [a]
$cmany :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
some :: ExceptStringT m a -> ExceptStringT m [a]
$csome :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
<|> :: ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$c<|> :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
empty :: ExceptStringT m a
$cempty :: forall (m :: * -> *) a. Monad m => ExceptStringT m a
$cp1Alternative :: forall (m :: * -> *). Monad m => Applicative (ExceptStringT m)
Alternative
        , a -> ExceptStringT m a -> Bool
ExceptStringT m m -> m
ExceptStringT m a -> [a]
ExceptStringT m a -> Bool
ExceptStringT m a -> Int
ExceptStringT m a -> a
ExceptStringT m a -> a
ExceptStringT m a -> a
ExceptStringT m a -> a
(a -> m) -> ExceptStringT m a -> m
(a -> m) -> ExceptStringT m a -> m
(a -> b -> b) -> b -> ExceptStringT m a -> b
(a -> b -> b) -> b -> ExceptStringT m a -> b
(b -> a -> b) -> b -> ExceptStringT m a -> b
(b -> a -> b) -> b -> ExceptStringT m a -> b
(a -> a -> a) -> ExceptStringT m a -> a
(a -> a -> a) -> ExceptStringT m a -> a
(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
product :: ExceptStringT m a -> a
$cproduct :: forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
sum :: ExceptStringT m a -> a
$csum :: forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
minimum :: ExceptStringT m a -> a
$cminimum :: forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
maximum :: ExceptStringT m a -> a
$cmaximum :: forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
elem :: a -> ExceptStringT m a -> Bool
$celem :: forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> ExceptStringT m a -> Bool
length :: ExceptStringT m a -> Int
$clength :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Int
null :: ExceptStringT m a -> Bool
$cnull :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Bool
toList :: ExceptStringT m a -> [a]
$ctoList :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> [a]
foldl1 :: (a -> a -> a) -> ExceptStringT m a -> a
$cfoldl1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
foldr1 :: (a -> a -> a) -> ExceptStringT m a -> a
$cfoldr1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
foldl' :: (b -> a -> b) -> b -> ExceptStringT m a -> b
$cfoldl' :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ExceptStringT m a -> b
foldl :: (b -> a -> b) -> b -> ExceptStringT m a -> b
$cfoldl :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ExceptStringT m a -> b
foldr' :: (a -> b -> b) -> b -> ExceptStringT m a -> b
$cfoldr' :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ExceptStringT m a -> b
foldr :: (a -> b -> b) -> b -> ExceptStringT m a -> b
$cfoldr :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ExceptStringT m a -> b
foldMap' :: (a -> m) -> ExceptStringT m a -> m
$cfoldMap' :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ExceptStringT m a -> m
foldMap :: (a -> m) -> ExceptStringT m a -> m
$cfoldMap :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ExceptStringT m a -> m
fold :: ExceptStringT m m -> m
$cfold :: forall (m :: * -> *) m.
(Foldable m, Monoid m) =>
ExceptStringT m m -> m
Foldable
        , b -> ExceptStringT m b -> ExceptStringT m a
(a -> b) -> ExceptStringT m b -> ExceptStringT m a
(forall a b. (a -> b) -> ExceptStringT m b -> 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 b. (a -> b) -> ExceptStringT m b -> ExceptStringT m a
forall (m :: * -> *) b a.
Contravariant m =>
b -> ExceptStringT m b -> ExceptStringT m a
forall (m :: * -> *) a b.
Contravariant m =>
(a -> b) -> ExceptStringT m b -> ExceptStringT m a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> f a)
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: b -> ExceptStringT m b -> ExceptStringT m a
$c>$ :: forall (m :: * -> *) b a.
Contravariant m =>
b -> ExceptStringT m b -> ExceptStringT m a
contramap :: (a -> b) -> ExceptStringT m b -> ExceptStringT m a
$ccontramap :: forall (m :: * -> *) a b.
Contravariant m =>
(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)
IO a -> ExceptStringT m a
forall a. IO a -> ExceptStringT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (ExceptStringT m)
forall (m :: * -> *) a. MonadIO m => IO a -> ExceptStringT m a
liftIO :: IO a -> ExceptStringT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ExceptStringT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (ExceptStringT m)
MonadIO
        , (a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
(forall a b.
 (a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool)
-> Eq1 (ExceptStringT m)
forall a b.
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
forall (m :: * -> *) a b.
Eq1 m =>
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
forall (f :: * -> *).
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
liftEq :: (a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
$cliftEq :: forall (m :: * -> *) a b.
Eq1 m =>
(a -> b -> Bool) -> ExceptStringT m a -> ExceptStringT m b -> Bool
Eq1
        , Eq1 (ExceptStringT m)
Eq1 (ExceptStringT m)
-> (forall a b.
    (a -> b -> Ordering)
    -> ExceptStringT m a -> ExceptStringT m b -> Ordering)
-> Ord1 (ExceptStringT m)
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
forall a b.
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
forall (f :: * -> *).
Eq1 f
-> (forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering)
-> Ord1 f
forall (m :: * -> *). Ord1 m => Eq1 (ExceptStringT m)
forall (m :: * -> *) a b.
Ord1 m =>
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
liftCompare :: (a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
$cliftCompare :: forall (m :: * -> *) a b.
Ord1 m =>
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
$cp1Ord1 :: forall (m :: * -> *). Ord1 m => Eq1 (ExceptStringT m)
Ord1
        , (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
(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.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
forall (f :: * -> *).
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
liftShowList :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
$cliftShowList :: forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [ExceptStringT m a] -> ShowS
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
$cliftShowsPrec :: forall (m :: * -> *) a.
Show1 m =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptStringT m a -> ShowS
Show1
        , ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
(Int -> ReadS a) -> ReadS [a] -> ReadS [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.
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
forall (f :: * -> *).
(forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a))
-> (forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [f a])
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a))
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [f a])
-> Read1 f
liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
$cliftReadListPrec :: forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
$cliftReadPrec :: forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
$cliftReadList :: forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptStringT m a]
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
$cliftReadsPrec :: forall (m :: * -> *) a.
Read1 m =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptStringT m a)
Read1
        , 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)
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
forall a b.
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
forall a b c.
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
forall (m :: * -> *).
Monad m
-> (forall a b. m a -> m b -> m (a, b))
-> (forall a b c. (a -> b -> c) -> m a -> m b -> m c)
-> (forall a b. m (a, b) -> (m a, m b))
-> MonadZip m
forall (m :: * -> *). MonadZip m => Monad (ExceptStringT m)
forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
munzip :: ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
$cmunzip :: forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m (a, b) -> (ExceptStringT m a, ExceptStringT m b)
mzipWith :: (a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
$cmzipWith :: forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c)
-> ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m c
mzip :: ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
$cmzip :: forall (m :: * -> *) a b.
MonadZip m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m (a, b)
$cp1MonadZip :: forall (m :: * -> *). MonadZip m => Monad (ExceptStringT m)
MonadZip
        , Monad (ExceptStringT m)
Alternative (ExceptStringT m)
ExceptStringT m a
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)
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall a. ExceptStringT m a
forall a.
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall (m :: * -> *). Monad m => Monad (ExceptStringT m)
forall (m :: * -> *). Monad m => Alternative (ExceptStringT m)
forall (m :: * -> *) a. Monad m => ExceptStringT m a
forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$cmplus :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
mzero :: ExceptStringT m a
$cmzero :: forall (m :: * -> *) a. Monad m => ExceptStringT m a
$cp2MonadPlus :: forall (m :: * -> *). Monad m => Monad (ExceptStringT m)
$cp1MonadPlus :: forall (m :: * -> *). Monad m => Alternative (ExceptStringT m)
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
/= :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c/= :: forall (m :: * -> *) a.
(Eq1 m, Eq a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
== :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c== :: forall (m :: * -> *) a.
(Eq1 m, Eq a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
Eq
        , 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
min :: ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$cmin :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
max :: ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
$cmax :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> ExceptStringT m a
>= :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c>= :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
> :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c> :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
<= :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c<= :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
< :: ExceptStringT m a -> ExceptStringT m a -> Bool
$c< :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Bool
compare :: ExceptStringT m a -> ExceptStringT m a -> Ordering
$ccompare :: forall (m :: * -> *) a.
(Ord1 m, Ord a) =>
ExceptStringT m a -> ExceptStringT m a -> Ordering
$cp1Ord :: forall (m :: * -> *) a. (Ord1 m, Ord a) => Eq (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
showList :: [ExceptStringT m a] -> ShowS
$cshowList :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
[ExceptStringT m a] -> ShowS
show :: ExceptStringT m a -> String
$cshow :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
ExceptStringT m a -> String
showsPrec :: Int -> ExceptStringT m a -> ShowS
$cshowsPrec :: forall (m :: * -> *) a.
(Show1 m, Show a) =>
Int -> ExceptStringT m a -> ShowS
Show
        , ReadPrec [ExceptStringT m a]
ReadPrec (ExceptStringT m a)
Int -> ReadS (ExceptStringT m a)
ReadS [ExceptStringT m a]
(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]
readListPrec :: ReadPrec [ExceptStringT m a]
$creadListPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadPrec [ExceptStringT m a]
readPrec :: ReadPrec (ExceptStringT m a)
$creadPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadPrec (ExceptStringT m a)
readList :: ReadS [ExceptStringT m a]
$creadList :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
ReadS [ExceptStringT m a]
readsPrec :: Int -> ReadS (ExceptStringT m a)
$creadsPrec :: forall (m :: * -> *) a.
(Read1 m, Read a) =>
Int -> ReadS (ExceptStringT m a)
Read
        )

instance Monad m => Fail.MonadFail (ExceptStringT m) where
    fail :: 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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure

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

-- | Convert a 'Graft' into a 'WorkspaceEdit'.
transform ::
    DynFlags ->
    ClientCapabilities ->
    Uri ->
    Graft (Either String) ParsedSource ->
    Annotated ParsedSource ->
    Either String WorkspaceEdit
transform :: DynFlags
-> ClientCapabilities
-> Uri
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform DynFlags
dflags ClientCapabilities
ccs Uri
uri Graft (Either String) ParsedSource
f Annotated ParsedSource
a = do
    let src :: String
src = Annotated ParsedSource -> String
forall ast. Annotate ast => Annotated (Located ast) -> String
printA Annotated ParsedSource
a
    Annotated ParsedSource
a' <- Annotated ParsedSource
-> (ParsedSource -> TransformT (Either String) ParsedSource)
-> Either String (Annotated ParsedSource)
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ParsedSource
a ((ParsedSource -> TransformT (Either String) ParsedSource)
 -> Either String (Annotated ParsedSource))
-> (ParsedSource -> TransformT (Either String) ParsedSource)
-> Either String (Annotated 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 = Annotated ParsedSource -> String
forall ast. Annotate ast => Annotated (Located ast) -> String
printA Annotated ParsedSource
a'
    WorkspaceEdit -> Either String WorkspaceEdit
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
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
ccs (Uri
uri, String -> Text
T.pack String
src) (String -> Text
T.pack String
res) WithDeletions
IncludeDeletions

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

-- | Convert a 'Graft' into a 'WorkspaceEdit'.
transformM ::
    Monad m =>
    DynFlags ->
    ClientCapabilities ->
    Uri ->
    Graft (ExceptStringT m) ParsedSource ->
    Annotated ParsedSource ->
    m (Either String WorkspaceEdit)
transformM :: DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
ccs Uri
uri Graft (ExceptStringT m) ParsedSource
f Annotated ParsedSource
a = 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 = Annotated ParsedSource -> String
forall ast. Annotate ast => Annotated (Located ast) -> String
printA Annotated ParsedSource
a
        Annotated ParsedSource
a' <- Annotated ParsedSource
-> (ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
-> ExceptStringT m (Annotated ParsedSource)
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ParsedSource
a ((ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
 -> ExceptStringT m (Annotated ParsedSource))
-> (ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
-> ExceptStringT m (Annotated 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 = Annotated ParsedSource -> String
forall ast. Annotate ast => Annotated (Located ast) -> String
printA Annotated ParsedSource
a'
        WorkspaceEdit -> ExceptStringT m WorkspaceEdit
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
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
ccs (Uri
uri, String -> Text
T.pack String
src) (String -> Text
T.pack String
res) WithDeletions
IncludeDeletions


-- | Returns whether or not this node requires its immediate children to have
-- be parenthesized and have a leading space.
--
-- A more natural type for this function would be to return @(Bool, Bool)@, but
-- we use 'All' instead for its monoid instance.
needsParensSpace ::
    HsExpr GhcPs ->
    -- | (Needs parens, needs space)
    (All, All)
needsParensSpace :: HsExpr GhcPs -> (All, All)
needsParensSpace HsLam{}         = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace HsLamCase{}     = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
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
False)
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
False)
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.
    (Data a, ASTElement 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 ->
    Located ast ->
    Graft (Either String) a
graft' :: Bool -> SrcSpan -> Located ast -> Graft (Either String) a
graft' Bool
needs_space SrcSpan
dst Located 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
    (Anns
anns, Located ast
val') <- DynFlags
-> Bool
-> Located ast
-> TransformT (Either String) (Anns, Located ast)
forall ast.
ASTElement ast =>
DynFlags
-> Bool
-> Located ast
-> TransformT (Either String) (Anns, Located ast)
annotate DynFlags
dflags Bool
needs_space Located ast
val
    (Anns -> Anns) -> TransformT (Either String) ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT (Either String) ())
-> (Anns -> Anns) -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Anns -> Anns -> Anns
forall a. Monoid a => a -> a -> a
mappend Anns
anns
    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) -> a -> a
(forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere'
            ( (Located ast -> Located ast) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT ((Located ast -> Located ast) -> a -> a)
-> (Located ast -> Located ast) -> a -> a
forall a b. (a -> b) -> a -> b
$
                \case
                    (L SrcSpan
src ast
_ :: Located ast) | SrcSpan
src SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
dst -> Located ast
val'
                    Located ast
l -> Located 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 :: 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
    -- 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 wehther or not we need parentheses.
    let (All Bool
needs_parens, All Bool
needs_space) =
          (All, All)
-> ((All, All) -> (All, All) -> (All, All))
-> GenericQ ((All, All) -> ((All, All), (All, All)))
-> a
-> (All, All)
forall s r.
s -> (r -> r -> r) -> GenericQ (s -> (r, s)) -> GenericQ r
everythingWithContext (Bool -> All
All Bool
True, Bool -> All
All Bool
True) (All, All) -> (All, All) -> (All, All)
forall a. Semigroup a => a -> a -> a
(<>)
            ( ((All, All) -> ((All, All), (All, All)))
-> (LHsExpr GhcPs -> (All, All) -> ((All, All), (All, All)))
-> a
-> (All, All)
-> ((All, All), (All, All))
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ ((All, All)
forall a. Monoid a => a
mempty, ) ((LHsExpr GhcPs -> (All, All) -> ((All, All), (All, All)))
 -> a -> (All, All) -> ((All, All), (All, All)))
-> (LHsExpr GhcPs -> (All, All) -> ((All, All), (All, All)))
-> a
-> (All, All)
-> ((All, All), (All, All))
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
x (All, All)
s -> case LHsExpr GhcPs
x of
                (L SrcSpan
src HsExpr GhcPs
_ :: LHsExpr GhcPs) | SrcSpan
src SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
dst ->
                  ((All, All)
s, (All, All)
s)
                L SrcSpan
_ HsExpr GhcPs
x' -> ((All, All)
forall a. Monoid a => a
mempty, HsExpr GhcPs -> (All, All)
needsParensSpace HsExpr GhcPs
x')
            ) 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 -> LHsExpr GhcPs -> Graft (Either String) a
forall ast a.
(Data a, ASTElement ast) =>
Bool -> SrcSpan -> Located ast -> Graft (Either String) a
graft' Bool
needs_space SrcSpan
dst (LHsExpr GhcPs -> Graft (Either String) a)
-> LHsExpr GhcPs -> Graft (Either String) a
forall a b. (a -> b) -> a -> b
$ (LHsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> Bool
-> LHsExpr GhcPs
-> LHsExpr GhcPs
forall a. a -> a -> Bool -> a
bool LHsExpr GhcPs -> LHsExpr GhcPs
forall a. a -> a
id LHsExpr GhcPs -> LHsExpr GhcPs
forall ast. ASTElement ast => Located ast -> Located ast
maybeParensAST Bool
needs_parens LHsExpr GhcPs
val)
      DynFlags
dflags
      a
a


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

graftWithM ::
    forall ast m a.
    (Fail.MonadFail m, Data a, ASTElement ast) =>
    SrcSpan ->
    (Located ast -> TransformT m (Maybe (Located ast))) ->
    Graft m a
graftWithM :: SrcSpan
-> (Located ast -> TransformT m (Maybe (Located ast))) -> Graft m a
graftWithM SrcSpan
dst Located ast -> TransformT m (Maybe (Located 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) -> a -> TransformT m a
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM'
        ( (Located ast -> TransformT m (Located ast)) -> a -> TransformT m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM ((Located ast -> TransformT m (Located ast))
 -> a -> TransformT m a)
-> (Located ast -> TransformT m (Located ast))
-> a
-> TransformT m a
forall a b. (a -> b) -> a -> b
$
            \case
                val :: Located ast
val@(L SrcSpan
src ast
_ :: Located ast)
                    | SrcSpan
src SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
dst -> do
                        Maybe (Located ast)
mval <- Located ast -> TransformT m (Maybe (Located ast))
trans Located ast
val
                        case Maybe (Located ast)
mval of
                            Just Located ast
val' -> do
                                (Anns
anns, Located ast
val'') <-
                                    (forall x. Either String x -> m x)
-> TransformT (Either String) (Anns, Located ast)
-> TransformT m (Anns, Located 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 (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail x -> m x
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (TransformT (Either String) (Anns, Located ast)
 -> TransformT m (Anns, Located ast))
-> TransformT (Either String) (Anns, Located ast)
-> TransformT m (Anns, Located ast)
forall a b. (a -> b) -> a -> b
$
                                        DynFlags
-> Bool
-> Located ast
-> TransformT (Either String) (Anns, Located ast)
forall ast.
ASTElement ast =>
DynFlags
-> Bool
-> Located ast
-> TransformT (Either String) (Anns, Located ast)
annotate DynFlags
dflags Bool
True (Located ast -> TransformT (Either String) (Anns, Located ast))
-> Located ast -> TransformT (Either String) (Anns, Located ast)
forall a b. (a -> b) -> a -> b
$ Located ast -> Located ast
forall ast. ASTElement ast => Located ast -> Located ast
maybeParensAST Located ast
val'
                                (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT m ())
-> (Anns -> Anns) -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ Anns -> Anns -> Anns
forall a. Monoid a => a -> a -> a
mappend Anns
anns
                                Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
val''
                            Maybe (Located ast)
Nothing -> Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
val
                Located ast
l -> Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
l
        )
        a
a

-- | A generic query intended to be used for calling 'smallestM' and
-- 'largestM'. If the current node is a 'Located', returns whether or not the
-- given 'SrcSpan' is a subspan. For all other nodes, returns 'Nothing', which
-- indicates uncertainty. The search strategy in 'smallestM' et al. will
-- continue searching uncertain nodes.
genericIsSubspan ::
    forall ast.
    Typeable ast =>
    -- | The type of nodes we'd like to consider.
    Proxy (Located ast) ->
    SrcSpan ->
    GenericQ (Maybe Bool)
genericIsSubspan :: Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe Bool)
genericIsSubspan Proxy (Located ast)
_ SrcSpan
dst = Maybe Bool -> (Located ast -> Maybe Bool) -> a -> Maybe Bool
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Maybe Bool
forall a. Maybe a
Nothing ((Located ast -> Maybe Bool) -> a -> Maybe Bool)
-> (Located ast -> Maybe Bool) -> a -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ \case
  (L SrcSpan
span ast
_ :: Located ast) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ SrcSpan
dst SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
span

-- | 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 -> GenericM (TransformT m)) ->
    Graft m a
genericGraftWithSmallestM :: Proxy (Located ast)
-> SrcSpan -> (DynFlags -> GenericM (TransformT m)) -> Graft m a
genericGraftWithSmallestM Proxy (Located ast)
proxy SrcSpan
dst DynFlags -> 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)
-> GenericM (TransformT m) -> GenericM (TransformT m)
forall (m :: * -> *).
Monad m =>
GenericQ (Maybe Bool) -> GenericM m -> GenericM m
smallestM (Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe Bool)
forall ast.
Typeable ast =>
Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe Bool)
genericIsSubspan Proxy (Located ast)
proxy SrcSpan
dst) (DynFlags -> 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 -> GenericM (TransformT m)) ->
    Graft m a
genericGraftWithLargestM :: Proxy (Located ast)
-> SrcSpan -> (DynFlags -> GenericM (TransformT m)) -> Graft m a
genericGraftWithLargestM Proxy (Located ast)
proxy SrcSpan
dst DynFlags -> 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)
-> GenericM (TransformT m) -> GenericM (TransformT m)
forall (m :: * -> *).
Monad m =>
GenericQ (Maybe Bool) -> GenericM m -> GenericM m
largestM (Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe Bool)
forall ast.
Typeable ast =>
Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe Bool)
genericIsSubspan Proxy (Located ast)
proxy SrcSpan
dst) (DynFlags -> GenericM (TransformT m)
trans DynFlags
dflags)


-- | Lift a function that replaces a value with several values into a generic
-- function. The result doesn't perform any searching, so should be driven via
-- 'everywhereM' or friends.
--
-- The 'Int' argument is the index in the list being bound.
mkBindListT :: forall b m. (Typeable b, Data b, Monad m) => (Int -> b -> m [b]) -> GenericM m
mkBindListT :: (Int -> b -> m [b]) -> GenericM m
mkBindListT Int -> b -> m [b]
f = ([b] -> m [b]) -> a -> m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM (([b] -> m [b]) -> a -> m a) -> ([b] -> m [b]) -> a -> m a
forall a b. (a -> b) -> a -> b
$ ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[b]] -> [b]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m [[b]] -> m [b]) -> ([b] -> m [[b]]) -> [b] -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, b) -> m [b]) -> [(Int, b)] -> m [[b]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Int -> b -> m [b]) -> (Int, b) -> m [b]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> b -> m [b]
f) ([(Int, b)] -> m [[b]]) -> ([b] -> [(Int, b)]) -> [b] -> m [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [b] -> [(Int, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]


graftDecls ::
    forall a.
    (HasDecls a) =>
    SrcSpan ->
    [LHsDecl GhcPs] ->
    Graft (Either String) a
graftDecls :: 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
    [LHsDecl GhcPs]
decs <- [LHsDecl GhcPs]
-> (LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
-> TransformT (Either String) [LHsDecl GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LHsDecl GhcPs]
decs0 ((LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
 -> TransformT (Either String) [LHsDecl GhcPs])
-> (LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
-> TransformT (Either String) [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ \LHsDecl GhcPs
decl -> do
        DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
decl
    let go :: [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
go [] = DList (LHsDecl GhcPs)
forall a. DList a
DL.empty
        go (L SrcSpan
src HsDecl GhcPs
e : [LHsDecl GhcPs]
rest)
            | SrcSpan
src SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
dst = [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
decs DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<> [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
rest
            | Bool
otherwise = LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton (SrcSpan -> HsDecl GhcPs -> LHsDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
src HsDecl GhcPs
e) DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<> [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
go [LHsDecl 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 ([LHsDecl GhcPs] -> TransformT (Either String) [LHsDecl GhcPs]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LHsDecl GhcPs] -> TransformT (Either String) [LHsDecl GhcPs])
-> ([LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> [LHsDecl GhcPs]
-> TransformT (Either String) [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
forall a. DList a -> [a]
DL.toList (DList (LHsDecl GhcPs) -> [LHsDecl GhcPs])
-> ([LHsDecl GhcPs] -> DList (LHsDecl GhcPs))
-> [LHsDecl GhcPs]
-> [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
go) a
a

graftSmallestDeclsWithM ::
    forall a.
    (HasDecls a) =>
    SrcSpan ->
    (LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])) ->
    Graft (Either String) a
graftSmallestDeclsWithM :: 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 :: [LHsDecl GhcPs]
-> TransformT (Either String) (DList (LHsDecl GhcPs))
go [] = DList (LHsDecl GhcPs)
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (LHsDecl GhcPs)
forall a. DList a
DL.empty
        go (e :: LHsDecl GhcPs
e@(L SrcSpan
src HsDecl GhcPs
_) : [LHsDecl GhcPs]
rest)
            | SrcSpan
dst SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
src = LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])
toDecls LHsDecl GhcPs
e TransformT (Either String) (Maybe [LHsDecl GhcPs])
-> (Maybe [LHsDecl GhcPs]
    -> TransformT (Either String) (DList (LHsDecl GhcPs)))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just [LHsDecl GhcPs]
decs0 -> do
                    [LHsDecl GhcPs]
decs <- [LHsDecl GhcPs]
-> (LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
-> TransformT (Either String) [LHsDecl GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LHsDecl GhcPs]
decs0 ((LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
 -> TransformT (Either String) [LHsDecl GhcPs])
-> (LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
-> TransformT (Either String) [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ \LHsDecl GhcPs
decl ->
                        DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
decl
                    DList (LHsDecl GhcPs)
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (LHsDecl GhcPs)
 -> TransformT (Either String) (DList (LHsDecl GhcPs)))
-> DList (LHsDecl GhcPs)
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
decs DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<> [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
rest
                Maybe [LHsDecl GhcPs]
Nothing -> (LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
e DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<>) (DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs]
-> TransformT (Either String) (DList (LHsDecl GhcPs))
go [LHsDecl GhcPs]
rest
            | Bool
otherwise = (LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
e DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<>) (DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs]
-> TransformT (Either String) (DList (LHsDecl GhcPs))
go [LHsDecl 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 (LHsDecl GhcPs) -> [LHsDecl GhcPs])
-> TransformT (Either String) (DList (LHsDecl GhcPs))
-> TransformT (Either String) [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
forall a. DList a -> [a]
DL.toList (TransformT (Either String) (DList (LHsDecl GhcPs))
 -> TransformT (Either String) [LHsDecl GhcPs])
-> ([LHsDecl GhcPs]
    -> TransformT (Either String) (DList (LHsDecl GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT (Either String) [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcPs]
-> TransformT (Either String) (DList (LHsDecl 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 :: 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 :: [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
go [] = DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (LHsDecl GhcPs)
forall a. DList a
DL.empty
        go (e :: LHsDecl GhcPs
e@(L SrcSpan
src HsDecl GhcPs
_) : [LHsDecl GhcPs]
rest)
            | SrcSpan
src SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
dst = LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs])
toDecls LHsDecl GhcPs
e TransformT m (Maybe [LHsDecl GhcPs])
-> (Maybe [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs)))
-> TransformT m (DList (LHsDecl GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just [LHsDecl GhcPs]
decs0 -> do
                    [LHsDecl GhcPs]
decs <- [LHsDecl GhcPs]
-> (LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs))
-> TransformT m [LHsDecl GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LHsDecl GhcPs]
decs0 ((LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs))
 -> TransformT m [LHsDecl GhcPs])
-> (LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs))
-> TransformT m [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ \LHsDecl 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 (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail x -> m x
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
decl
                    DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs))
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
$ [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
decs DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<> [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
rest
                Maybe [LHsDecl GhcPs]
Nothing -> (LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
e DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<>) (DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs))
-> TransformT m (DList (LHsDecl GhcPs))
-> TransformT m (DList (LHsDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
go [LHsDecl GhcPs]
rest
            | Bool
otherwise = (LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
e DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<>) (DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs))
-> TransformT m (DList (LHsDecl GhcPs))
-> TransformT m (DList (LHsDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
go [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 (LHsDecl GhcPs) -> [LHsDecl GhcPs])
-> TransformT m (DList (LHsDecl GhcPs))
-> TransformT m [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
forall a. DList a -> [a]
DL.toList (TransformT m (DList (LHsDecl GhcPs))
 -> TransformT m [LHsDecl GhcPs])
-> ([LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT m [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
go) a
a


everywhereM' :: forall m. Monad m => GenericM m -> GenericM m
everywhereM' :: GenericM m -> GenericM m
everywhereM' GenericM m
f = a -> m a
GenericM m
go
    where
        go :: GenericM m
        go :: a -> m a
go = GenericM m -> a -> m a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM GenericM m
go (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m a
GenericM m
f

class (Data ast, Outputable ast) => ASTElement ast where
    parseAST :: Parser (Located ast)
    maybeParensAST :: Located ast -> Located 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 ->
        Located ast ->
        Graft (Either String) a
    graft SrcSpan
dst = Bool -> SrcSpan -> Located ast -> Graft (Either String) a
forall ast a.
(Data a, ASTElement ast) =>
Bool -> SrcSpan -> Located ast -> Graft (Either String) a
graft' Bool
True SrcSpan
dst (Located ast -> Graft (Either String) a)
-> (Located ast -> Located ast)
-> Located ast
-> Graft (Either String) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ast -> Located ast
forall ast. ASTElement ast => Located ast -> Located ast
maybeParensAST

instance p ~ GhcPs => ASTElement (HsExpr p) where
    parseAST :: Parser (Located (HsExpr p))
parseAST = Parser (Located (HsExpr p))
Parser (LHsExpr GhcPs)
parseExpr
    maybeParensAST :: Located (HsExpr p) -> Located (HsExpr p)
maybeParensAST = Located (HsExpr p) -> Located (HsExpr p)
LHsExpr GhcPs -> LHsExpr GhcPs
parenthesize
    graft :: SrcSpan -> Located (HsExpr p) -> Graft (Either String) a
graft = SrcSpan -> Located (HsExpr p) -> Graft (Either String) a
forall a.
Data a =>
SrcSpan -> LHsExpr GhcPs -> Graft (Either String) a
graftExpr

instance p ~ GhcPs => ASTElement (Pat p) where
#if __GLASGOW_HASKELL__ == 808
    parseAST = fmap (fmap $ right $ second dL) . parsePattern
    maybeParensAST = dL . parenthesizePat appPrec . unLoc
#else
    parseAST :: Parser (Located (Pat p))
parseAST = Parser (LPat GhcPs)
Parser (Located (Pat p))
parsePattern
    maybeParensAST :: Located (Pat p) -> Located (Pat p)
maybeParensAST = PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass). PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec
#endif

instance p ~ GhcPs => ASTElement (HsType p) where
    parseAST :: Parser (Located (HsType p))
parseAST = Parser (Located (HsType p))
Parser (LHsType GhcPs)
parseType
    maybeParensAST :: Located (HsType p) -> Located (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 (HsDecl p) where
    parseAST :: Parser (Located (HsDecl p))
parseAST = Parser (Located (HsDecl p))
Parser (LHsDecl GhcPs)
parseDecl
    maybeParensAST :: Located (HsDecl p) -> Located (HsDecl p)
maybeParensAST = Located (HsDecl p) -> Located (HsDecl p)
forall a. a -> a
id

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

instance ASTElement RdrName where
    parseAST :: Parser (Located RdrName)
parseAST DynFlags
df String
fp = DynFlags
-> String
-> P (Located RdrName)
-> String
-> ParseResult (Located RdrName)
forall w.
(Data (SrcSpanLess w), Annotate w, HasSrcSpan w) =>
DynFlags -> String -> P w -> String -> ParseResult w
parseWith DynFlags
df String
fp P (Located RdrName)
parseIdentifier
    maybeParensAST :: Located RdrName -> Located RdrName
maybeParensAST = Located RdrName -> Located RdrName
forall a. a -> a
id

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

-- | Dark magic I stole from retrie. No idea what it does.
fixAnns :: ParsedModule -> Annotated ParsedSource
fixAnns :: ParsedModule -> Annotated ParsedSource
fixAnns ParsedModule {[String]
ApiAnns
ModSummary
ParsedSource
pm_mod_summary :: ParsedModule -> ModSummary
pm_parsed_source :: ParsedModule -> ParsedSource
pm_extra_src_files :: ParsedModule -> [String]
pm_annotations :: ParsedModule -> ApiAnns
pm_annotations :: ApiAnns
pm_extra_src_files :: [String]
pm_parsed_source :: ParsedSource
pm_mod_summary :: ModSummary
..} =
    let ranns :: Anns
ranns = ParsedSource -> ApiAnns -> Anns
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> ApiAnns -> Anns
relativiseApiAnns ParsedSource
pm_parsed_source ApiAnns
pm_annotations
     in ParsedSource -> Anns -> Int -> Annotated ParsedSource
forall ast. ast -> Anns -> Int -> Annotated ast
unsafeMkA ParsedSource
pm_parsed_source Anns
ranns Int
0

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

-- | Given an 'LHSExpr', compute its exactprint annotations.
--   Note that this function will throw away any existing annotations (and format)
annotate :: ASTElement ast => DynFlags -> Bool -> Located ast -> TransformT (Either String) (Anns, Located ast)
annotate :: DynFlags
-> Bool
-> Located ast
-> TransformT (Either String) (Anns, Located ast)
annotate DynFlags
dflags Bool
needs_space Located 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 -> Located ast -> String
forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags Located ast
ast
    (Anns
anns, Located ast
expr') <- Either String (Anns, Located ast)
-> TransformT (Either String) (Anns, Located ast)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (Anns, Located ast)
 -> TransformT (Either String) (Anns, Located ast))
-> Either String (Anns, Located ast)
-> TransformT (Either String) (Anns, Located ast)
forall a b. (a -> b) -> a -> b
$ (ErrorMessages -> String)
-> Either ErrorMessages (Anns, Located ast)
-> Either String (Anns, Located ast)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ErrorMessages -> String
forall a. Show a => a -> String
show (Either ErrorMessages (Anns, Located ast)
 -> Either String (Anns, Located ast))
-> Either ErrorMessages (Anns, Located ast)
-> Either String (Anns, Located ast)
forall a b. (a -> b) -> a -> b
$ Parser (Located ast)
forall ast. ASTElement ast => Parser (Located ast)
parseAST DynFlags
dflags String
uniq String
rendered
    let anns' :: Anns
anns' = Located ast -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines Located ast
expr' Int
0 (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 Bool
needs_space) Anns
anns
    (Anns, Located ast)
-> TransformT (Either String) (Anns, Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Anns
anns', Located ast
expr')

-- | Given an 'LHsDecl', compute its exactprint annotations.
annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
-- The 'parseDecl' function fails to parse 'FunBind' 'ValD's which contain
-- multiple matches. To work around this, we split the single
-- 'FunBind'-of-multiple-'Match'es into multiple 'FunBind's-of-one-'Match',
-- and then merge them all back together.
annotateDecl :: DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags
            (L SrcSpan
src (
                ValD XValD GhcPs
ext fb :: HsBind GhcPs
fb@FunBind
                  { fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = mg :: MatchGroup GhcPs (LHsExpr GhcPs)
mg@MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = L SrcSpan
alt_src alts :: [LMatch GhcPs (LHsExpr GhcPs)]
alts@(LMatch GhcPs (LHsExpr GhcPs)
_:[LMatch GhcPs (LHsExpr GhcPs)]
_)}
                  })) = do
    let set_matches :: [LMatch GhcPs (LHsExpr GhcPs)] -> HsDecl GhcPs
set_matches [LMatch GhcPs (LHsExpr GhcPs)]
matches =
          XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
ext HsBind GhcPs
fb { fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches = MatchGroup GhcPs (LHsExpr GhcPs)
mg { mg_alts :: GenLocated SrcSpan [LMatch GhcPs (LHsExpr GhcPs)]
mg_alts = SrcSpan
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> GenLocated SrcSpan [LMatch GhcPs (LHsExpr GhcPs)]
forall l e. l -> e -> GenLocated l e
L SrcSpan
alt_src [LMatch GhcPs (LHsExpr GhcPs)]
matches }}

    ([Anns]
anns', [LMatch GhcPs (LHsExpr GhcPs)]
alts') <- ([(Anns, LMatch GhcPs (LHsExpr GhcPs))]
 -> ([Anns], [LMatch GhcPs (LHsExpr GhcPs)]))
-> TransformT
     (Either String) [(Anns, LMatch GhcPs (LHsExpr GhcPs))]
-> TransformT
     (Either String) ([Anns], [LMatch GhcPs (LHsExpr GhcPs)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Anns, LMatch GhcPs (LHsExpr GhcPs))]
-> ([Anns], [LMatch GhcPs (LHsExpr GhcPs)])
forall a b. [(a, b)] -> ([a], [b])
unzip (TransformT (Either String) [(Anns, LMatch GhcPs (LHsExpr GhcPs))]
 -> TransformT
      (Either String) ([Anns], [LMatch GhcPs (LHsExpr GhcPs)]))
-> TransformT
     (Either String) [(Anns, LMatch GhcPs (LHsExpr GhcPs))]
-> TransformT
     (Either String) ([Anns], [LMatch GhcPs (LHsExpr GhcPs)])
forall a b. (a -> b) -> a -> b
$ [LMatch GhcPs (LHsExpr GhcPs)]
-> (LMatch GhcPs (LHsExpr GhcPs)
    -> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs)))
-> TransformT
     (Either String) [(Anns, LMatch GhcPs (LHsExpr GhcPs))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [LMatch GhcPs (LHsExpr GhcPs)]
alts ((LMatch GhcPs (LHsExpr GhcPs)
  -> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs)))
 -> TransformT
      (Either String) [(Anns, LMatch GhcPs (LHsExpr GhcPs))])
-> (LMatch GhcPs (LHsExpr GhcPs)
    -> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs)))
-> TransformT
     (Either String) [(Anns, LMatch GhcPs (LHsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ \LMatch GhcPs (LHsExpr GhcPs)
alt -> 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 -> HsDecl GhcPs -> String
forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags (HsDecl GhcPs -> String) -> HsDecl GhcPs -> String
forall a b. (a -> b) -> a -> b
$ [LMatch GhcPs (LHsExpr GhcPs)] -> HsDecl GhcPs
set_matches [LMatch GhcPs (LHsExpr GhcPs)
alt]
      Either String (Anns, LHsDecl GhcPs)
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((ErrorMessages -> String)
-> Either ErrorMessages (Anns, LHsDecl GhcPs)
-> Either String (Anns, LHsDecl GhcPs)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ErrorMessages -> String
forall a. Show a => a -> String
show (Either ErrorMessages (Anns, LHsDecl GhcPs)
 -> Either String (Anns, LHsDecl GhcPs))
-> Either ErrorMessages (Anns, LHsDecl GhcPs)
-> Either String (Anns, LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ Parser (LHsDecl GhcPs)
parseDecl DynFlags
dflags String
uniq String
rendered) TransformT (Either String) (Anns, LHsDecl GhcPs)
-> ((Anns, LHsDecl GhcPs)
    -> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs)))
-> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (Anns
ann, L SrcSpan
_ (ValD XValD GhcPs
_ FunBind { fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = L SrcSpan
_ [LMatch GhcPs (LHsExpr GhcPs)
alt']}}))
           -> (Anns, LMatch GhcPs (LHsExpr GhcPs))
-> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LMatch GhcPs (LHsExpr GhcPs) -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines LMatch GhcPs (LHsExpr GhcPs)
alt' Int
1 Int
0 Anns
ann, LMatch GhcPs (LHsExpr GhcPs)
alt')
        (Anns, LHsDecl GhcPs)
_ ->  Either String (Anns, LMatch GhcPs (LHsExpr GhcPs))
-> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (Anns, LMatch GhcPs (LHsExpr GhcPs))
 -> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs)))
-> Either String (Anns, LMatch GhcPs (LHsExpr GhcPs))
-> TransformT (Either String) (Anns, LMatch GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Anns, LMatch GhcPs (LHsExpr GhcPs))
forall a b. a -> Either a b
Left String
"annotateDecl: didn't parse a single FunBind match"

    (Anns -> Anns) -> TransformT (Either String) ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT (Either String) ())
-> (Anns -> Anns) -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Anns -> Anns -> Anns
forall a. Monoid a => a -> a -> a
mappend (Anns -> Anns -> Anns) -> Anns -> Anns -> Anns
forall a b. (a -> b) -> a -> b
$ [Anns] -> Anns
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Anns]
anns'
    LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsDecl GhcPs -> LHsDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
src (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ [LMatch GhcPs (LHsExpr GhcPs)] -> HsDecl GhcPs
set_matches [LMatch GhcPs (LHsExpr GhcPs)]
alts'
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 -> LHsDecl GhcPs -> String
forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags LHsDecl GhcPs
ast
    (Anns
anns, LHsDecl GhcPs
expr') <- Either String (Anns, LHsDecl GhcPs)
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (Anns, LHsDecl GhcPs)
 -> TransformT (Either String) (Anns, LHsDecl GhcPs))
-> Either String (Anns, LHsDecl GhcPs)
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ (ErrorMessages -> String)
-> Either ErrorMessages (Anns, LHsDecl GhcPs)
-> Either String (Anns, LHsDecl GhcPs)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ErrorMessages -> String
forall a. Show a => a -> String
show (Either ErrorMessages (Anns, LHsDecl GhcPs)
 -> Either String (Anns, LHsDecl GhcPs))
-> Either ErrorMessages (Anns, LHsDecl GhcPs)
-> Either String (Anns, LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ Parser (LHsDecl GhcPs)
parseDecl DynFlags
dflags String
uniq String
rendered
    let anns' :: Anns
anns' = LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines LHsDecl GhcPs
expr' Int
1 Int
0 Anns
anns
    (Anns -> Anns) -> TransformT (Either String) ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT (Either String) ())
-> (Anns -> Anns) -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Anns -> Anns -> Anns
forall a. Monoid a => a -> a -> a
mappend Anns
anns'
    LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsDecl GhcPs
expr'

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

-- | Print out something 'Outputable'.
render :: Outputable a => DynFlags -> a -> String
render :: 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).
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
appPrec


------------------------------------------------------------------------------
-- Custom SYB machinery
------------------------------------------------------------------------------

-- | Generic monadic transformations that return side-channel data.
type GenericMQ r m = forall a. Data a => a -> m (r, a)

------------------------------------------------------------------------------
-- | Apply the given 'GenericM' at all every node whose children fail the
-- 'GenericQ', but which passes the query itself.
--
-- The query must be a monotonic function when it returns 'Just'. That is, if
-- @s@ is a subtree of @t@, @q t@ should return @Just True@ if @q s@ does. It
-- is the True-to-false edge of the query that triggers the transformation.
--
-- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
-- with data nodes, so for any given node we can only definitely return an
-- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
-- used.
smallestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
smallestM :: GenericQ (Maybe Bool) -> GenericM m -> GenericM m
smallestM GenericQ (Maybe Bool)
q GenericM m
f = ((Any, a) -> a) -> m (Any, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Any, a) -> a
forall a b. (a, b) -> b
snd (m (Any, a) -> m a) -> (a -> m (Any, a)) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Any, a)
GenericMQ Any m
go
  where
    go :: GenericMQ Any m
    go :: a -> m (Any, a)
go a
x = do
      case a -> Maybe Bool
GenericQ (Maybe Bool)
q a
x of
        Maybe Bool
Nothing -> GenericMQ Any m -> a -> m (Any, a)
forall (f :: * -> *) r a.
(Monoid r, Data a, Applicative f) =>
(forall d. Data d => d -> f (r, d)) -> a -> f (r, a)
gmapMQ GenericMQ Any m
go a
x
        Just Bool
True -> do
          it :: (Any, a)
it@(Any
r, a
x') <- GenericMQ Any m -> a -> m (Any, a)
forall (f :: * -> *) r a.
(Monoid r, Data a, Applicative f) =>
(forall d. Data d => d -> f (r, d)) -> a -> f (r, a)
gmapMQ GenericMQ Any m
go a
x
          case Any
r of
            Any Bool
True -> (Any, a) -> m (Any, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Any, a)
it
            Any Bool
False -> (a -> (Any, a)) -> m a -> m (Any, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Any
Any Bool
True,) (m a -> m (Any, a)) -> m a -> m (Any, a)
forall a b. (a -> b) -> a -> b
$ a -> m a
GenericM m
f a
x'
        Just Bool
False -> (Any, a) -> m (Any, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Any
forall a. Monoid a => a
mempty, a
x)

------------------------------------------------------------------------------
-- | Apply the given 'GenericM' at every node that passes the 'GenericQ', but
-- don't descend into children if the query matches. Because this traversal is
-- root-first, this policy will find the largest subtrees for which the query
-- holds true.
--
-- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
-- with data nodes, so for any given node we can only definitely return an
-- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
-- used.
largestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
largestM :: GenericQ (Maybe Bool) -> GenericM m -> GenericM m
largestM GenericQ (Maybe Bool)
q GenericM m
f = a -> m a
GenericM m
go
  where
    go :: GenericM m
    go :: a -> m a
go a
x = do
      case a -> Maybe Bool
GenericQ (Maybe Bool)
q a
x of
        Just Bool
True -> a -> m a
GenericM m
f a
x
        Just Bool
False -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        Maybe Bool
Nothing -> GenericM m -> a -> m a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM GenericM m
go a
x

newtype MonadicQuery r m a = MonadicQuery
  { MonadicQuery r m a -> m (r, a)
runMonadicQuery :: m (r, a)
  }
  deriving stock (a -> MonadicQuery r m b -> MonadicQuery r m a
(a -> b) -> MonadicQuery r m a -> MonadicQuery r m b
(forall a b. (a -> b) -> MonadicQuery r m a -> MonadicQuery r m b)
-> (forall a b. a -> MonadicQuery r m b -> MonadicQuery r m a)
-> Functor (MonadicQuery r m)
forall a b. a -> MonadicQuery r m b -> MonadicQuery r m a
forall a b. (a -> b) -> MonadicQuery r m a -> MonadicQuery r m b
forall r (m :: * -> *) a b.
Functor m =>
a -> MonadicQuery r m b -> MonadicQuery r m a
forall r (m :: * -> *) a b.
Functor m =>
(a -> b) -> MonadicQuery r m a -> MonadicQuery r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MonadicQuery r m b -> MonadicQuery r m a
$c<$ :: forall r (m :: * -> *) a b.
Functor m =>
a -> MonadicQuery r m b -> MonadicQuery r m a
fmap :: (a -> b) -> MonadicQuery r m a -> MonadicQuery r m b
$cfmap :: forall r (m :: * -> *) a b.
Functor m =>
(a -> b) -> MonadicQuery r m a -> MonadicQuery r m b
Functor)
  deriving Functor (MonadicQuery r m)
a -> MonadicQuery r m a
Functor (MonadicQuery r m)
-> (forall a. a -> MonadicQuery r m a)
-> (forall a b.
    MonadicQuery r m (a -> b)
    -> MonadicQuery r m a -> MonadicQuery r m b)
-> (forall a b c.
    (a -> b -> c)
    -> MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m c)
-> (forall a b.
    MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m b)
-> (forall a b.
    MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m a)
-> Applicative (MonadicQuery r m)
MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m b
MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m a
MonadicQuery r m (a -> b)
-> MonadicQuery r m a -> MonadicQuery r m b
(a -> b -> c)
-> MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m c
forall a. a -> MonadicQuery r m a
forall a b.
MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m a
forall a b.
MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m b
forall a b.
MonadicQuery r m (a -> b)
-> MonadicQuery r m a -> MonadicQuery r m b
forall a b c.
(a -> b -> c)
-> MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *) r.
(Applicative m, Monoid r) =>
Functor (MonadicQuery r m)
forall (m :: * -> *) r a.
(Applicative m, Monoid r) =>
a -> MonadicQuery r m a
forall (m :: * -> *) r a b.
(Applicative m, Monoid r) =>
MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m a
forall (m :: * -> *) r a b.
(Applicative m, Monoid r) =>
MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m b
forall (m :: * -> *) r a b.
(Applicative m, Monoid r) =>
MonadicQuery r m (a -> b)
-> MonadicQuery r m a -> MonadicQuery r m b
forall (m :: * -> *) r a b c.
(Applicative m, Monoid r) =>
(a -> b -> c)
-> MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m c
<* :: MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m a
$c<* :: forall (m :: * -> *) r a b.
(Applicative m, Monoid r) =>
MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m a
*> :: MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m b
$c*> :: forall (m :: * -> *) r a b.
(Applicative m, Monoid r) =>
MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m b
liftA2 :: (a -> b -> c)
-> MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m c
$cliftA2 :: forall (m :: * -> *) r a b c.
(Applicative m, Monoid r) =>
(a -> b -> c)
-> MonadicQuery r m a -> MonadicQuery r m b -> MonadicQuery r m c
<*> :: MonadicQuery r m (a -> b)
-> MonadicQuery r m a -> MonadicQuery r m b
$c<*> :: forall (m :: * -> *) r a b.
(Applicative m, Monoid r) =>
MonadicQuery r m (a -> b)
-> MonadicQuery r m a -> MonadicQuery r m b
pure :: a -> MonadicQuery r m a
$cpure :: forall (m :: * -> *) r a.
(Applicative m, Monoid r) =>
a -> MonadicQuery r m a
$cp1Applicative :: forall (m :: * -> *) r.
(Applicative m, Monoid r) =>
Functor (MonadicQuery r m)
Applicative via Compose m ((,) r)


------------------------------------------------------------------------------
-- | Like 'gmapM', but also returns side-channel data.
gmapMQ ::
    forall f r a. (Monoid r, Data a, Applicative f) =>
    (forall d. Data d => d -> f (r, d)) ->
    a ->
    f (r, a)
gmapMQ :: (forall d. Data d => d -> f (r, d)) -> a -> f (r, a)
gmapMQ forall d. Data d => d -> f (r, d)
f = MonadicQuery r f a -> f (r, a)
forall r (m :: * -> *) a. MonadicQuery r m a -> m (r, a)
runMonadicQuery (MonadicQuery r f a -> f (r, a))
-> (a -> MonadicQuery r f a) -> a -> f (r, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall d b.
 Data d =>
 MonadicQuery r f (d -> b) -> d -> MonadicQuery r f b)
-> (forall g. g -> MonadicQuery r f g) -> a -> MonadicQuery r f a
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b.
Data d =>
MonadicQuery r f (d -> b) -> d -> MonadicQuery r f b
k forall g. g -> MonadicQuery r f g
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    k :: Data d => MonadicQuery r f (d -> b) -> d -> MonadicQuery r f b
    k :: MonadicQuery r f (d -> b) -> d -> MonadicQuery r f b
k MonadicQuery r f (d -> b)
c d
x = MonadicQuery r f (d -> b)
c MonadicQuery r f (d -> b)
-> MonadicQuery r f d -> MonadicQuery r f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (r, d) -> MonadicQuery r f d
forall r (m :: * -> *) a. m (r, a) -> MonadicQuery r m a
MonadicQuery (d -> f (r, d)
forall d. Data d => d -> f (r, d)
f d
x)