{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

module Development.IDE.GHC.ExactPrint
    ( Graft(..),
      graft,
      graftDecls,
      graftDeclsWithM,
      annotate,
      hoistGraft,
      graftWithM,
      graftWithSmallestM,
      transform,
      transformM,
      useAnnotatedSource,
      annotateParsedSource,
      getAnnotatedParsedSourceRule,
      GetAnnotatedParsedSource(..),
      ASTElement (..),
      ExceptStringT (..),
      Annotated(..),
      TransformT,
      Anns,
      Annotate,
    )
where

import BasicTypes (appPrec)
import Control.Applicative (Alternative)
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Zip
import qualified Data.DList as DL
import Data.Either.Extra (mapLeft)
import Data.Functor.Classes
import Data.Functor.Contravariant
import qualified Data.Text as T
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service (runAction)
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat hiding (parseExpr)
import Development.IDE.Types.Location
import Development.Shake (RuleResult, Rules)
import Development.Shake.Classes
import qualified GHC.Generics as GHC
import Generics.SYB
import Ide.PluginUtils
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Parsers
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Capabilities (ClientCapabilities)
import Outputable (Outputable, ppr, showSDoc)
import Retrie.ExactPrint hiding (parseDecl, parseExpr, parsePattern, parseType)
import Parser (parseIdentifier)
#if __GLASGOW_HASKELL__ == 808
import Control.Arrow
#endif


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


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

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

-- | Get the latest version of the annotated parse source with comments.

getAnnotatedParsedSourceRule :: Rules ()
getAnnotatedParsedSourceRule :: Rules ()
getAnnotatedParsedSourceRule = (GetAnnotatedParsedSource
 -> NormalizedFilePath
 -> Action (IdeResult (Annotated ParsedSource)))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((GetAnnotatedParsedSource
  -> NormalizedFilePath
  -> Action (IdeResult (Annotated ParsedSource)))
 -> Rules ())
-> (GetAnnotatedParsedSource
    -> NormalizedFilePath
    -> Action (IdeResult (Annotated ParsedSource)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp -> do
  Maybe ParsedModule
pm <- GetParsedModuleWithComments
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModuleWithComments
GetParsedModuleWithComments NormalizedFilePath
nfp
  IdeResult (Annotated ParsedSource)
-> Action (IdeResult (Annotated ParsedSource))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (ParsedModule -> Annotated ParsedSource)
-> Maybe ParsedModule -> Maybe (Annotated ParsedSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedModule -> Annotated ParsedSource
annotateParsedSource Maybe ParsedModule
pm)

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

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


{- | A transformation for grafting source trees together. Use the semigroup
 instance to combine 'Graft's, and run them via 'transform'.
-}
newtype Graft m a = Graft
    { Graft m a -> DynFlags -> a -> TransformT m a
runGraft :: DynFlags -> a -> TransformT m a
    }

hoistGraft :: (forall x. m x -> n x) -> Graft m a -> Graft n a
hoistGraft :: (forall x. m x -> n x) -> Graft m a -> Graft n a
hoistGraft forall x. m x -> n x
h (Graft DynFlags -> a -> TransformT m a
f) = (DynFlags -> a -> TransformT n a) -> Graft n a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((TransformT m a -> TransformT n a)
-> (a -> TransformT m a) -> a -> TransformT n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall x. m x -> n x) -> TransformT m a -> TransformT n a
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform forall x. m x -> n x
h) ((a -> TransformT m a) -> a -> TransformT n a)
-> (DynFlags -> a -> TransformT m a)
-> DynFlags
-> a
-> TransformT n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> a -> TransformT m a
f)

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

instance Monad m => Fail.MonadFail (ExceptStringT m) where
    fail :: String -> ExceptStringT m a
fail = ExceptT String m a -> ExceptStringT m a
forall (m :: * -> *) a. ExceptT String m a -> ExceptStringT m a
ExceptStringT (ExceptT String m a -> ExceptStringT m a)
-> (String -> ExceptT String m a) -> String -> ExceptStringT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either String a) -> ExceptT String m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either String a) -> ExceptT String m a)
-> (String -> m (Either String a)) -> String -> ExceptT String m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String a -> m (Either String a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> m (Either String a))
-> (String -> Either String a) -> String -> m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left

instance Monad m => Semigroup (Graft m a) where
    Graft DynFlags -> a -> TransformT m a
a <> :: Graft m a -> Graft m a -> Graft m a
<> Graft DynFlags -> a -> TransformT m a
b = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags -> DynFlags -> a -> TransformT m a
a DynFlags
dflags (a -> TransformT m a)
-> (a -> TransformT m a) -> a -> TransformT m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> DynFlags -> a -> TransformT m a
b DynFlags
dflags

instance Monad m => Monoid (Graft m a) where
    mempty :: Graft m a
mempty = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ (a -> TransformT m a) -> DynFlags -> a -> TransformT m a
forall a b. a -> b -> a
const a -> TransformT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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


-- | Convert a 'Graft' into a 'WorkspaceEdit'.

transform ::
    DynFlags ->
    ClientCapabilities ->
    Uri ->
    Graft (Either String) ParsedSource ->
    Annotated ParsedSource ->
    Either String WorkspaceEdit
transform :: DynFlags
-> ClientCapabilities
-> Uri
-> Graft (Either String) ParsedSource
-> Annotated ParsedSource
-> Either String WorkspaceEdit
transform DynFlags
dflags ClientCapabilities
ccs Uri
uri Graft (Either String) ParsedSource
f Annotated ParsedSource
a = do
    let src :: String
src = Annotated ParsedSource -> String
forall ast. Annotate ast => Annotated (Located ast) -> String
printA Annotated ParsedSource
a
    Annotated ParsedSource
a' <- Annotated ParsedSource
-> (ParsedSource -> TransformT (Either String) ParsedSource)
-> Either String (Annotated ParsedSource)
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ParsedSource
a ((ParsedSource -> TransformT (Either String) ParsedSource)
 -> Either String (Annotated ParsedSource))
-> (ParsedSource -> TransformT (Either String) ParsedSource)
-> Either String (Annotated ParsedSource)
forall a b. (a -> b) -> a -> b
$ Graft (Either String) ParsedSource
-> DynFlags
-> ParsedSource
-> TransformT (Either String) ParsedSource
forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft Graft (Either String) ParsedSource
f DynFlags
dflags
    let res :: String
res = Annotated ParsedSource -> String
forall ast. Annotate ast => Annotated (Located ast) -> String
printA Annotated ParsedSource
a'
    WorkspaceEdit -> Either String WorkspaceEdit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> Either String WorkspaceEdit)
-> WorkspaceEdit -> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
ccs (Uri
uri, String -> Text
T.pack String
src) (String -> Text
T.pack String
res) WithDeletions
IncludeDeletions

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


-- | Convert a 'Graft' into a 'WorkspaceEdit'.

transformM ::
    Monad m =>
    DynFlags ->
    ClientCapabilities ->
    Uri ->
    Graft (ExceptStringT m) ParsedSource ->
    Annotated ParsedSource ->
    m (Either String WorkspaceEdit)
transformM :: DynFlags
-> ClientCapabilities
-> Uri
-> Graft (ExceptStringT m) ParsedSource
-> Annotated ParsedSource
-> m (Either String WorkspaceEdit)
transformM DynFlags
dflags ClientCapabilities
ccs Uri
uri Graft (ExceptStringT m) ParsedSource
f Annotated ParsedSource
a = ExceptT String m WorkspaceEdit -> m (Either String WorkspaceEdit)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String m WorkspaceEdit -> m (Either String WorkspaceEdit))
-> ExceptT String m WorkspaceEdit
-> m (Either String WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$
    ExceptStringT m WorkspaceEdit -> ExceptT String m WorkspaceEdit
forall (m :: * -> *) a. ExceptStringT m a -> ExceptT String m a
runExceptString (ExceptStringT m WorkspaceEdit -> ExceptT String m WorkspaceEdit)
-> ExceptStringT m WorkspaceEdit -> ExceptT String m WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ do
        let src :: String
src = Annotated ParsedSource -> String
forall ast. Annotate ast => Annotated (Located ast) -> String
printA Annotated ParsedSource
a
        Annotated ParsedSource
a' <- Annotated ParsedSource
-> (ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
-> ExceptStringT m (Annotated ParsedSource)
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ParsedSource
a ((ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
 -> ExceptStringT m (Annotated ParsedSource))
-> (ParsedSource -> TransformT (ExceptStringT m) ParsedSource)
-> ExceptStringT m (Annotated ParsedSource)
forall a b. (a -> b) -> a -> b
$ Graft (ExceptStringT m) ParsedSource
-> DynFlags
-> ParsedSource
-> TransformT (ExceptStringT m) ParsedSource
forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft Graft (ExceptStringT m) ParsedSource
f DynFlags
dflags
        let res :: String
res = Annotated ParsedSource -> String
forall ast. Annotate ast => Annotated (Located ast) -> String
printA Annotated ParsedSource
a'
        WorkspaceEdit -> ExceptStringT m WorkspaceEdit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> ExceptStringT m WorkspaceEdit)
-> WorkspaceEdit -> ExceptStringT m WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
ccs (Uri
uri, String -> Text
T.pack String
src) (String -> Text
T.pack String
res) WithDeletions
IncludeDeletions

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


{- | Construct a 'Graft', replacing the node at the given 'SrcSpan' with the
 given 'LHSExpr'. The node at that position must already be a 'LHsExpr', or
 this is a no-op.
-}
graft ::
    forall ast a.
    (Data a, ASTElement ast) =>
    SrcSpan ->
    Located ast ->
    Graft (Either String) a
graft :: SrcSpan -> Located ast -> Graft (Either String) a
graft 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
-> Located ast -> TransformT (Either String) (Anns, Located ast)
forall ast.
ASTElement ast =>
DynFlags
-> Located ast -> TransformT (Either String) (Anns, Located ast)
annotate DynFlags
dflags (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 (Either String) ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT (Either String) ())
-> (Anns -> Anns) -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Anns -> Anns -> Anns
forall a. Monoid a => a -> a -> a
mappend Anns
anns
    a -> TransformT (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> TransformT (Either String) a)
-> a -> TransformT (Either String) a
forall a b. (a -> b) -> a -> b
$
        (forall a. Data a => a -> a) -> a -> a
(forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere'
            ( (Located ast -> Located ast) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT ((Located ast -> Located ast) -> a -> a)
-> (Located ast -> Located ast) -> a -> a
forall a b. (a -> b) -> a -> b
$
                \case
                    (L SrcSpan
src ast
_ :: Located ast) | SrcSpan
src SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
dst -> Located ast
val'
                    Located ast
l -> Located ast
l
            )
            a
a

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


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
-> Located ast -> TransformT (Either String) (Anns, Located ast)
forall ast.
ASTElement ast =>
DynFlags
-> Located ast -> TransformT (Either String) (Anns, Located ast)
annotate DynFlags
dflags (Located ast -> TransformT (Either String) (Anns, Located ast))
-> Located ast -> TransformT (Either String) (Anns, Located ast)
forall a b. (a -> b) -> a -> b
$ Located ast -> Located ast
forall ast. ASTElement ast => Located ast -> Located ast
maybeParensAST Located ast
val'
                                (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT m ())
-> (Anns -> Anns) -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ Anns -> Anns -> Anns
forall a. Monoid a => a -> a -> a
mappend Anns
anns
                                Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
val''
                            Maybe (Located ast)
Nothing -> Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
val
                Located ast
l -> Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
l
        )
        a
a

graftWithSmallestM ::
    forall ast m a.
    (Fail.MonadFail m, Data a, ASTElement ast) =>
    SrcSpan ->
    (Located ast -> TransformT m (Maybe (Located ast))) ->
    Graft m a
graftWithSmallestM :: SrcSpan
-> (Located ast -> TransformT m (Maybe (Located ast))) -> Graft m a
graftWithSmallestM 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
dst SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
src -> 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
-> Located ast -> TransformT (Either String) (Anns, Located ast)
forall ast.
ASTElement ast =>
DynFlags
-> Located ast -> TransformT (Either String) (Anns, Located ast)
annotate DynFlags
dflags (Located ast -> TransformT (Either String) (Anns, Located ast))
-> Located ast -> TransformT (Either String) (Anns, Located ast)
forall a b. (a -> b) -> a -> b
$ Located ast -> Located ast
forall ast. ASTElement ast => Located ast -> Located ast
maybeParensAST Located ast
val'
                                (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT m ())
-> (Anns -> Anns) -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ Anns -> Anns -> Anns
forall a. Monoid a => a -> a -> a
mappend Anns
anns
                                Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
val''
                            Maybe (Located ast)
Nothing -> Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
val
                Located ast
l -> Located ast -> TransformT m (Located ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located ast
l
        )
        a
a

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
        (Anns
anns, LHsDecl GhcPs
decl') <- DynFlags
-> LHsDecl GhcPs
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
decl
        (Anns -> Anns) -> TransformT (Either String) ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT (Either String) ())
-> (Anns -> Anns) -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Anns -> Anns -> Anns
forall a. Monoid a => a -> a -> a
mappend Anns
anns
        LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsDecl GhcPs
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

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 -> do
                        (Anns
anns, LHsDecl GhcPs
decl') <-
                            (forall x. Either String x -> m x)
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
-> TransformT m (Anns, 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) (Anns, LHsDecl GhcPs)
 -> TransformT m (Anns, LHsDecl GhcPs))
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
-> TransformT m (Anns, LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$
                            DynFlags
-> LHsDecl GhcPs
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
decl
                        (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
                        LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsDecl GhcPs
decl'
                    DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs)))
-> DList (LHsDecl GhcPs) -> TransformT m (DList (LHsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
decs DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<> [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
rest
                Maybe [LHsDecl GhcPs]
Nothing -> (LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
e DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<>) (DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs))
-> TransformT m (DList (LHsDecl GhcPs))
-> TransformT m (DList (LHsDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
go [LHsDecl GhcPs]
rest
            | Bool
otherwise = (LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
e DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<>) (DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs))
-> TransformT m (DList (LHsDecl GhcPs))
-> TransformT m (DList (LHsDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
go [LHsDecl GhcPs]
rest
    ([LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs])
-> a -> TransformT m a
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT ((DList (LHsDecl GhcPs) -> [LHsDecl GhcPs])
-> TransformT m (DList (LHsDecl GhcPs))
-> TransformT m [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
forall a. DList a -> [a]
DL.toList (TransformT m (DList (LHsDecl GhcPs))
 -> TransformT m [LHsDecl GhcPs])
-> ([LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT m [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcPs] -> TransformT m (DList (LHsDecl GhcPs))
go) a
a


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

class (Data ast, Outputable ast) => ASTElement ast where
    parseAST :: Parser (Located ast)
    maybeParensAST :: Located ast -> Located ast

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

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 -> Located ast -> TransformT (Either String) (Anns, Located ast)
annotate :: DynFlags
-> Located ast -> TransformT (Either String) (Anns, Located ast)
annotate DynFlags
dflags 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
1 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) (Anns, LHsDecl GhcPs)
annotateDecl :: DynFlags
-> LHsDecl GhcPs
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
ast = do
    String
uniq <- SrcSpan -> String
forall a. Show a => a -> String
show (SrcSpan -> String)
-> TransformT (Either String) SrcSpan
-> TransformT (Either String) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    let rendered :: String
rendered = DynFlags -> 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, LHsDecl GhcPs)
-> TransformT (Either String) (Anns, LHsDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Anns
anns', 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