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

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

import           BasicTypes                              (appPrec)
import           Control.Applicative                     (Alternative)
import           Control.Arrow
import           Control.Monad
import qualified Control.Monad.Fail                      as Fail
import           Control.Monad.IO.Class                  (MonadIO)
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Control.Monad.Zip
import           Data.Bool                               (bool)
import qualified Data.DList                              as DL
import           Data.Either.Extra                       (mapLeft)
import           Data.Foldable                           (Foldable (fold))
import           Data.Functor.Classes
import           Data.Functor.Contravariant
import           Data.Monoid                             (All (All), getAll)
import qualified Data.Text                               as T
import           Data.Traversable                        (for)
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service            (runAction)
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Compat              hiding (parseExpr)
import           Development.IDE.Graph                   (RuleResult, Rules)
import           Development.IDE.Graph.Classes
import           Development.IDE.Types.Location
import qualified GHC.Generics                            as GHC
import           Generics.SYB
import           Generics.SYB.GHC
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           Parser                                  (parseIdentifier)
import           Retrie.ExactPrint                       hiding (parseDecl,
                                                          parseExpr,
                                                          parsePattern,
                                                          parseType)


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

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
  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
True)
needsParensSpace HsApp{}         = (All, All)
forall a. Monoid a => a
mempty
needsParensSpace HsAppType{}     = (All, All)
forall a. Monoid a => a
mempty
needsParensSpace OpApp{}         = (All, All)
forall a. Monoid a => a
mempty
needsParensSpace HsPar{}         = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace SectionL{}      = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace SectionR{}      = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace ExplicitTuple{} = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace ExplicitSum{}   = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace HsCase{}        = (Bool -> All
All Bool
False, Bool -> All
All Bool
True)
needsParensSpace HsIf{}          = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace HsMultiIf{}     = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace HsLet{}         = (Bool -> All
All Bool
False, Bool -> All
All Bool
True)
needsParensSpace HsDo{}          = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace ExplicitList{}  = (Bool -> All
All Bool
False, Bool -> All
All Bool
False)
needsParensSpace RecordCon{}     = (Bool -> All
All Bool
False, Bool -> All
All Bool
True)
needsParensSpace RecordUpd{}     = (All, All)
forall a. Monoid a => a
mempty
needsParensSpace HsExpr GhcPs
_               = (All, All)
forall a. Monoid a => a
mempty


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

{- | Construct a 'Graft', replacing the node at the given 'SrcSpan' with the
 given @Located ast@. The node at that position must already be a @Located
 ast@, or this is a no-op.
-}
graft' ::
    forall ast a.
    (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
    pure $
        (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
    let (Bool
needs_space, LHsExpr GhcPs -> LHsExpr GhcPs
mk_parens) = SrcSpan -> a -> (Bool, LHsExpr GhcPs -> LHsExpr GhcPs)
forall ast a.
(ASTElement ast, Data a) =>
SrcSpan -> a -> (Bool, Located ast -> Located ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a

    Graft (Either String) a
-> DynFlags -> a -> TransformT (Either String) a
forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft
      (Bool -> SrcSpan -> 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
mk_parens LHsExpr GhcPs
val)
      DynFlags
dflags
      a
a


getNeedsSpaceAndParenthesize ::
    (ASTElement ast, Data a) =>
    SrcSpan ->
    a ->
    (Bool, Located ast -> Located ast)
getNeedsSpaceAndParenthesize :: SrcSpan -> a -> (Bool, Located ast -> Located ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a =
  -- Traverse the tree, looking for our replacement node. But keep track of
  -- the context (parent HsExpr constructor) we're in while we do it. This
  -- lets us determine wehther or not we need parentheses.
  let (Maybe All
needs_parens, Maybe All
needs_space) =
          (Maybe All, Maybe All)
-> ((Maybe All, Maybe All)
    -> (Maybe All, Maybe All) -> (Maybe All, Maybe All))
-> GenericQ
     ((Maybe All, Maybe All)
      -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> a
-> (Maybe All, Maybe All)
forall s r.
s -> (r -> r -> r) -> GenericQ (s -> (r, s)) -> GenericQ r
everythingWithContext (Maybe All
forall a. Maybe a
Nothing, Maybe All
forall a. Maybe a
Nothing) (Maybe All, Maybe All)
-> (Maybe All, Maybe All) -> (Maybe All, Maybe All)
forall a. Semigroup a => a -> a -> a
(<>)
            ( ((Maybe All, Maybe All)
 -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> (LHsExpr GhcPs
    -> (Maybe All, Maybe All)
    -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> a
-> (Maybe All, Maybe All)
-> ((Maybe All, Maybe All), (Maybe All, Maybe All))
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ ((Maybe All, Maybe All)
forall a. Monoid a => a
mempty, ) ((LHsExpr GhcPs
  -> (Maybe All, Maybe All)
  -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
 -> a
 -> (Maybe All, Maybe All)
 -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> (LHsExpr GhcPs
    -> (Maybe All, Maybe All)
    -> ((Maybe All, Maybe All), (Maybe All, Maybe All)))
-> a
-> (Maybe All, Maybe All)
-> ((Maybe All, Maybe All), (Maybe All, Maybe All))
forall a b. (a -> b) -> a -> b
$ \LHsExpr GhcPs
x (Maybe All, Maybe 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 ->
                  ((Maybe All, Maybe All)
s, (Maybe All, Maybe All)
s)
                L SrcSpan
_ HsExpr GhcPs
x' -> ((Maybe All, Maybe All)
forall a. Monoid a => a
mempty, All -> Maybe All
forall a. a -> Maybe a
Just (All -> Maybe All)
-> (All -> Maybe All) -> (All, All) -> (Maybe All, Maybe All)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** All -> Maybe All
forall a. a -> Maybe a
Just ((All, All) -> (Maybe All, Maybe All))
-> (All, All) -> (Maybe All, Maybe All)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> (All, All)
needsParensSpace HsExpr GhcPs
x')
            ) a
a
   in ( Bool -> (All -> Bool) -> Maybe All -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True All -> Bool
getAll Maybe All
needs_space
      , (Located ast -> Located ast)
-> (Located ast -> Located ast)
-> Bool
-> Located ast
-> Located ast
forall a. a -> a -> Bool -> a
bool Located ast -> Located ast
forall a. a -> a
id Located ast -> Located ast
forall ast. ASTElement ast => Located ast -> Located ast
maybeParensAST (Bool -> Located ast -> Located ast)
-> Bool -> Located ast -> Located ast
forall a b. (a -> b) -> a -> b
$ Bool -> (All -> Bool) -> Maybe All -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False All -> Bool
getAll Maybe All
needs_parens
      )


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

graftExprWithM ::
    forall m a.
    (Fail.MonadFail m, Data a) =>
    SrcSpan ->
    (LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))) ->
    Graft m a
graftExprWithM :: SrcSpan
-> (LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs)))
-> Graft m a
graftExprWithM SrcSpan
dst LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))
trans = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
    let (Bool
needs_space, LHsExpr GhcPs -> LHsExpr GhcPs
mk_parens) = SrcSpan -> a -> (Bool, LHsExpr GhcPs -> LHsExpr GhcPs)
forall ast a.
(ASTElement ast, Data a) =>
SrcSpan -> a -> (Bool, Located ast -> Located ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a

    GenericM (TransformT m) -> a -> TransformT m a
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM'
        ( (LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> a -> TransformT m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM ((LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
 -> a -> TransformT m a)
-> (LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> a
-> TransformT m a
forall a b. (a -> b) -> a -> b
$
            \case
                val :: LHsExpr GhcPs
val@(L SrcSpan
src HsExpr GhcPs
_ :: LHsExpr GhcPs)
                    | SrcSpan
src SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
dst -> do
                        Maybe (LHsExpr GhcPs)
mval <- LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))
trans LHsExpr GhcPs
val
                        case Maybe (LHsExpr GhcPs)
mval of
                            Just LHsExpr GhcPs
val' -> do
                                (Anns
anns, LHsExpr GhcPs
val'') <-
                                    (forall x. Either String x -> m x)
-> TransformT (Either String) (Anns, LHsExpr GhcPs)
-> TransformT m (Anns, LHsExpr 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)
                                        (DynFlags
-> Bool
-> LHsExpr GhcPs
-> TransformT (Either String) (Anns, LHsExpr GhcPs)
forall ast.
ASTElement ast =>
DynFlags
-> Bool
-> Located ast
-> TransformT (Either String) (Anns, Located ast)
annotate @(HsExpr GhcPs) DynFlags
dflags Bool
needs_space (LHsExpr GhcPs -> LHsExpr GhcPs
mk_parens LHsExpr GhcPs
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
                                pure LHsExpr GhcPs
val''
                            Maybe (LHsExpr GhcPs)
Nothing -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr GhcPs
val
                LHsExpr GhcPs
l -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr GhcPs
l
        )
        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
                                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

-- | Run the given transformation only on the smallest node in the tree that
-- contains the 'SrcSpan'.
genericGraftWithSmallestM ::
    forall m a ast.
    (Monad m, Data a, Typeable ast) =>
    -- | The type of nodes we'd like to consider when finding the smallest.
    Proxy (Located ast) ->
    SrcSpan ->
    (DynFlags -> ast -> GenericM (TransformT m)) ->
    Graft m a
genericGraftWithSmallestM :: Proxy (Located ast)
-> SrcSpan
-> (DynFlags -> ast -> GenericM (TransformT m))
-> Graft m a
genericGraftWithSmallestM Proxy (Located ast)
proxy SrcSpan
dst DynFlags -> ast -> GenericM (TransformT m)
trans = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    GenericQ (Maybe (Bool, ast))
-> (ast -> GenericM (TransformT m)) -> GenericM (TransformT m)
forall (m :: * -> *) a.
Monad m =>
GenericQ (Maybe (Bool, a)) -> (a -> GenericM m) -> GenericM m
smallestM (Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe (Bool, ast))
forall ast.
Typeable ast =>
Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe (Bool, ast))
genericIsSubspan Proxy (Located ast)
proxy SrcSpan
dst) (DynFlags -> ast -> GenericM (TransformT m)
trans DynFlags
dflags)

-- | Run the given transformation only on the largest node in the tree that
-- contains the 'SrcSpan'.
genericGraftWithLargestM ::
    forall m a ast.
    (Monad m, Data a, Typeable ast) =>
    -- | The type of nodes we'd like to consider when finding the largest.
    Proxy (Located ast) ->
    SrcSpan ->
    (DynFlags -> ast -> GenericM (TransformT m)) ->
    Graft m a
genericGraftWithLargestM :: Proxy (Located ast)
-> SrcSpan
-> (DynFlags -> ast -> GenericM (TransformT m))
-> Graft m a
genericGraftWithLargestM Proxy (Located ast)
proxy SrcSpan
dst DynFlags -> ast -> GenericM (TransformT m)
trans = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    GenericQ (Maybe (Bool, ast))
-> (ast -> GenericM (TransformT m)) -> GenericM (TransformT m)
forall (m :: * -> *) a.
Monad m =>
GenericQ (Maybe (Bool, a)) -> (a -> GenericM m) -> GenericM m
largestM (Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe (Bool, ast))
forall ast.
Typeable ast =>
Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe (Bool, ast))
genericIsSubspan Proxy (Located ast)
proxy SrcSpan
dst) (DynFlags -> ast -> GenericM (TransformT m)
trans DynFlags
dflags)


graftDecls ::
    forall a.
    (HasDecls a) =>
    SrcSpan ->
    [LHsDecl GhcPs] ->
    Graft (Either String) a
graftDecls :: 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
                    pure $ [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
                    pure $ [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


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'
    pure $ 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'
    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