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

-- | This module hosts various abstractions and utility functions to work with ghc-exactprint.
module Development.IDE.GHC.ExactPrint
    ( Graft(..),
      graftDecls,
      graftDeclsWithM,
      annotate,
      annotateDecl,
      hoistGraft,
      graftWithM,
      graftExprWithM,
      genericGraftWithSmallestM,
      genericGraftWithLargestM,
      graftSmallestDeclsWithM,
      transform,
      transformM,
      ExactPrint(..),
#if !MIN_VERSION_ghc(9,2,0)
      Anns,
      Annotate,
      setPrecedingLinesT,
#else
      addParens,
      addParensToCtxt,
      modifyAnns,
      removeComma,
      -- * Helper function
      eqSrcSpan,
      epl,
      epAnn,
      removeTrailingComma,
#endif
      annotateParsedSource,
      getAnnotatedParsedSourceRule,
      GetAnnotatedParsedSource(..),
      ASTElement (..),
      ExceptStringT (..),
      TransformT,
      Log(..),
    )
where

import           Control.Applicative                     (Alternative)
import           Control.Arrow                           (right, (***))
import           Control.Monad
import qualified Control.Monad.Fail                      as Fail
import           Control.Monad.IO.Class                  (MonadIO)
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Control.Monad.Zip
import           Data.Bifunctor
import           Data.Bool                               (bool)
import qualified Data.DList                              as DL
import           Data.Either.Extra                       (mapLeft)
import           Data.Foldable                           (Foldable (fold))
import           Data.Functor.Classes
import           Data.Functor.Contravariant
import           Data.Monoid                             (All (All), getAll)
import qualified Data.Text                               as T
import           Data.Traversable                        (for)
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service            (runAction)
import           Development.IDE.Core.Shake              hiding (Log)
import qualified Development.IDE.Core.Shake              as Shake
import           Development.IDE.GHC.Compat              hiding (parseImport,
                                                          parsePattern,
                                                          parseType)
import           Development.IDE.Graph                   (RuleResult, Rules)
import           Development.IDE.Graph.Classes
import           Development.IDE.Types.Location
import           Development.IDE.Types.Logger            (Pretty (pretty),
                                                          Recorder,
                                                          WithPriority,
                                                          cmapWithPrio)
import qualified GHC.Generics                            as GHC
import           Generics.SYB
import           Generics.SYB.GHC
import           Ide.PluginUtils
import           Language.Haskell.GHC.ExactPrint.Parsers
import           Language.LSP.Types
import           Language.LSP.Types.Capabilities         (ClientCapabilities)
import           Retrie.ExactPrint                       hiding (Annotated (..),
                                                          parseDecl, parseExpr,
                                                          parsePattern,
                                                          parseType)
#if MIN_VERSION_ghc(9,2,0)
import           GHC                                     (EpAnn (..),
                                                          NameAdornment (NameParens),
                                                          NameAnn (..),
                                                          SrcSpanAnn' (SrcSpanAnn),
                                                          SrcSpanAnnA,
                                                          TrailingAnn (AddCommaAnn),
                                                          emptyComments,
                                                          spanAsAnchor)
import           GHC.Parser.Annotation                   (AnnContext (..),
                                                          DeltaPos (SameLine),
                                                          EpaLocation (EpaDelta))
#endif

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

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

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

data GetAnnotatedParsedSource = GetAnnotatedParsedSource
  deriving (GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
(GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool)
-> (GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool)
-> Eq GetAnnotatedParsedSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
type instance RuleResult GetAnnotatedParsedSource = Annotated ParsedSource

-- | Get the latest version of the annotated parse source with comments.
getAnnotatedParsedSourceRule :: Recorder (WithPriority Log) -> Rules ()
getAnnotatedParsedSourceRule :: Recorder (WithPriority Log) -> Rules ()
getAnnotatedParsedSourceRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (GetAnnotatedParsedSource
    -> NormalizedFilePath
    -> Action (IdeResult (Annotated ParsedSource)))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetAnnotatedParsedSource
  -> NormalizedFilePath
  -> Action (IdeResult (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)

#if MIN_VERSION_ghc(9,2,0)
annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource (ParsedModule _ ps _ _) = unsafeMkA (makeDeltaAst ps) 0
#else
annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource = ParsedModule -> Annotated ParsedSource
fixAnns
#endif

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

{- | A transformation for grafting source trees together. Use the semigroup
 instance to combine 'Graft's, and run them via 'transform'.
-}
newtype Graft m a = Graft
    { 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 l.
    (Data a, Typeable l, ASTElement l ast) =>
    -- | Do we need to insert a space before this grafting? In do blocks, the
    -- answer is no, or we will break layout. But in function applications,
    -- the answer is yes, or the function call won't get its argument. Yikes!
    --
    -- More often the answer is yes, so when in doubt, use that.
    Bool ->
    SrcSpan ->
    LocatedAn l ast ->
    Graft (Either String) a
graft' :: Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
needs_space SrcSpan
dst LocatedAn l ast
val = (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT (Either String) a)
 -> Graft (Either String) a)
-> (DynFlags -> a -> TransformT (Either String) a)
-> Graft (Either String) a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
#if MIN_VERSION_ghc(9,2,0)
    val' <- annotate dflags needs_space val
#else
    (Anns
anns, LocatedAn l ast
val') <- DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (Anns, LocatedAn l ast)
forall l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (Anns, LocatedAn l ast)
annotate DynFlags
dflags Bool
needs_space LocatedAn l 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
#endif
    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'
            ( (LocatedAn l ast -> LocatedAn l ast) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT ((LocatedAn l ast -> LocatedAn l ast) -> a -> a)
-> (LocatedAn l ast -> LocatedAn l ast) -> a -> a
forall a b. (a -> b) -> a -> b
$
                \case
                    (L SrcSpan
src ast
_ :: LocatedAn l ast)
                        | SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst -> LocatedAn l ast
val'
                    LocatedAn l ast
l                         -> LocatedAn l ast
l
            )
            a
a


-- | Like 'graft', but specialized to 'LHsExpr', and intelligently inserts
-- parentheses if they're necessary.
graftExpr ::
    forall a.
    (Data a) =>
    SrcSpan ->
    LHsExpr GhcPs ->
    Graft (Either String) a
graftExpr :: 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 l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a

    Graft (Either String) a
-> DynFlags -> a -> TransformT (Either String) a
forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft
      (Bool -> SrcSpan -> LHsExpr GhcPs -> Graft (Either String) a
forall ast a l.
(Data a, Typeable l, ASTElement l ast) =>
Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
needs_space SrcSpan
dst (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 l ast, Data a) =>
    SrcSpan ->
    a ->
    (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize :: SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a =
  -- Traverse the tree, looking for our replacement node. But keep track of
  -- the context (parent HsExpr constructor) we're in while we do it. This
  -- lets us determine 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 -> SrcSpan
forall a. a -> a
locA SrcSpan
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` 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
      , (LocatedAn l ast -> LocatedAn l ast)
-> (LocatedAn l ast -> LocatedAn l ast)
-> Bool
-> LocatedAn l ast
-> LocatedAn l ast
forall a. a -> a -> Bool -> a
bool LocatedAn l ast -> LocatedAn l ast
forall a. a -> a
id LocatedAn l ast -> LocatedAn l ast
forall l ast.
ASTElement l ast =>
LocatedAn l ast -> LocatedAn l ast
maybeParensAST (Bool -> LocatedAn l ast -> LocatedAn l ast)
-> Bool -> LocatedAn l ast -> LocatedAn l ast
forall a b. (a -> b) -> a -> b
$ Bool -> (All -> Bool) -> Maybe All -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False All -> Bool
getAll Maybe All
needs_parens
      )


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

graftExprWithM ::
    forall m a.
    (Fail.MonadFail m, Data a) =>
    SrcSpan ->
    (LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))) ->
    Graft m a
graftExprWithM :: 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 l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a

    GenericM (TransformT m) -> 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 -> SrcSpan
forall a. a -> a
locA SrcSpan
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` 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
#if MIN_VERSION_ghc(9,2,0)
                                val'' <-
                                    hoistTransform (either Fail.fail pure)
                                        (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val'))
                                pure val''
#else
                                (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 l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (Anns, LocatedAn l ast)
annotate @AnnListItem @(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
                                LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr GhcPs
val''
#endif
                            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 l.
    (Fail.MonadFail m, Data a, Typeable l, ASTElement l ast) =>
    SrcSpan ->
    (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))) ->
    Graft m a
graftWithM :: SrcSpan
-> (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast)))
-> Graft m a
graftWithM SrcSpan
dst LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))
trans = (DynFlags -> a -> TransformT m a) -> Graft m a
forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft ((DynFlags -> a -> TransformT m a) -> Graft m a)
-> (DynFlags -> a -> TransformT m a) -> Graft m a
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
    GenericM (TransformT m) -> a -> TransformT m a
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM'
        ( (LocatedAn l ast -> TransformT m (LocatedAn l ast))
-> a -> TransformT m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM ((LocatedAn l ast -> TransformT m (LocatedAn l ast))
 -> a -> TransformT m a)
-> (LocatedAn l ast -> TransformT m (LocatedAn l ast))
-> a
-> TransformT m a
forall a b. (a -> b) -> a -> b
$
            \case
                val :: LocatedAn l ast
val@(L SrcSpan
src ast
_ :: LocatedAn l ast)
                    | SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst -> do
                        Maybe (LocatedAn l ast)
mval <- LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))
trans LocatedAn l ast
val
                        case Maybe (LocatedAn l ast)
mval of
                            Just LocatedAn l ast
val' -> do
#if MIN_VERSION_ghc(9,2,0)
                                val'' <-
                                    hoistTransform (either Fail.fail pure) $
                                        annotate dflags True $ maybeParensAST val'
                                pure val''
#else
                                (Anns
anns, LocatedAn l ast
val'') <-
                                    (forall x. Either String x -> m x)
-> TransformT (Either String) (Anns, LocatedAn l ast)
-> TransformT m (Anns, LocatedAn l ast)
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> TransformT m a -> TransformT n a
hoistTransform ((String -> m x) -> (x -> m x) -> Either String x -> m x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m x
forall (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, LocatedAn l ast)
 -> TransformT m (Anns, LocatedAn l ast))
-> TransformT (Either String) (Anns, LocatedAn l ast)
-> TransformT m (Anns, LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$
                                        DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (Anns, LocatedAn l ast)
forall l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (Anns, LocatedAn l ast)
annotate DynFlags
dflags Bool
True (LocatedAn l ast
 -> TransformT (Either String) (Anns, LocatedAn l ast))
-> LocatedAn l ast
-> TransformT (Either String) (Anns, LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$ LocatedAn l ast -> LocatedAn l ast
forall l ast.
ASTElement l ast =>
LocatedAn l ast -> LocatedAn l ast
maybeParensAST LocatedAn l ast
val'
                                (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
                                LocatedAn l ast -> TransformT m (LocatedAn l ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
val''
#endif
                            Maybe (LocatedAn l ast)
Nothing -> LocatedAn l ast -> TransformT m (LocatedAn l ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
val
                LocatedAn l ast
l -> LocatedAn l ast -> TransformT m (LocatedAn l ast)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
l
        )
        a
a

-- | Run the given transformation only on the smallest node in the tree that
-- contains the 'SrcSpan'.
genericGraftWithSmallestM ::
    forall m a ast.
    (Monad m, Data a, Typeable ast) =>
    -- | The type of nodes we'd like to consider when finding the smallest.
    Proxy (Located ast) ->
    SrcSpan ->
    (DynFlags -> ast -> GenericM (TransformT m)) ->
    Graft m a
genericGraftWithSmallestM :: 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 -> SrcSpan
forall a. a -> a
locA SrcSpan
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` 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 -> SrcSpan
forall a. a -> a
locA SrcSpan
src = LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])
toDecls LHsDecl GhcPs
e TransformT (Either String) (Maybe [LHsDecl GhcPs])
-> (Maybe [LHsDecl GhcPs]
    -> TransformT (Either String) (DList (LHsDecl GhcPs)))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just [LHsDecl GhcPs]
decs0 -> do
                    [LHsDecl GhcPs]
decs <- [LHsDecl GhcPs]
-> (LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
-> TransformT (Either String) [LHsDecl GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LHsDecl GhcPs]
decs0 ((LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
 -> TransformT (Either String) [LHsDecl GhcPs])
-> (LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs))
-> TransformT (Either String) [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ \LHsDecl GhcPs
decl ->
                        DynFlags
-> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
annotateDecl DynFlags
dflags LHsDecl GhcPs
decl
                    DList (LHsDecl GhcPs)
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (LHsDecl GhcPs)
 -> TransformT (Either String) (DList (LHsDecl GhcPs)))
-> DList (LHsDecl GhcPs)
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
decs DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<> [LHsDecl GhcPs] -> DList (LHsDecl GhcPs)
forall a. [a] -> DList a
DL.fromList [LHsDecl GhcPs]
rest
                Maybe [LHsDecl GhcPs]
Nothing -> (LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
e DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<>) (DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs]
-> TransformT (Either String) (DList (LHsDecl GhcPs))
go [LHsDecl GhcPs]
rest
            | Bool
otherwise = (LHsDecl GhcPs -> DList (LHsDecl GhcPs)
forall a. a -> DList a
DL.singleton LHsDecl GhcPs
e DList (LHsDecl GhcPs)
-> DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs)
forall a. Semigroup a => a -> a -> a
<>) (DList (LHsDecl GhcPs) -> DList (LHsDecl GhcPs))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
-> TransformT (Either String) (DList (LHsDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs]
-> TransformT (Either String) (DList (LHsDecl GhcPs))
go [LHsDecl GhcPs]
rest
    ([LHsDecl GhcPs] -> TransformT (Either String) [LHsDecl GhcPs])
-> a -> TransformT (Either String) a
forall t (m :: * -> *).
(HasDecls t, HasTransform m) =>
([LHsDecl GhcPs] -> m [LHsDecl GhcPs]) -> t -> m t
modifyDeclsT ((DList (LHsDecl GhcPs) -> [LHsDecl GhcPs])
-> TransformT (Either String) (DList (LHsDecl GhcPs))
-> TransformT (Either String) [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
forall a. DList a -> [a]
DL.toList (TransformT (Either String) (DList (LHsDecl GhcPs))
 -> TransformT (Either String) [LHsDecl GhcPs])
-> ([LHsDecl GhcPs]
    -> TransformT (Either String) (DList (LHsDecl GhcPs)))
-> [LHsDecl GhcPs]
-> TransformT (Either String) [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcPs]
-> TransformT (Either String) (DList (LHsDecl GhcPs))
go) a
a

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


class (Data ast, Typeable l, Outputable l, Outputable ast) => ASTElement l ast | ast -> l where
    parseAST :: Parser (LocatedAn l ast)
    maybeParensAST :: LocatedAn l ast -> LocatedAn l ast
    {- | Construct a 'Graft', replacing the node at the given 'SrcSpan' with
        the given @Located ast@. The node at that position must already be
        a @Located ast@, or this is a no-op.
    -}
    graft ::
        forall a.
        (Data a) =>
        SrcSpan ->
        LocatedAn l ast ->
        Graft (Either String) a
    graft SrcSpan
dst = Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
forall ast a l.
(Data a, Typeable l, ASTElement l ast) =>
Bool -> SrcSpan -> LocatedAn l ast -> Graft (Either String) a
graft' Bool
True SrcSpan
dst (LocatedAn l ast -> Graft (Either String) a)
-> (LocatedAn l ast -> LocatedAn l ast)
-> LocatedAn l ast
-> Graft (Either String) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn l ast -> LocatedAn l ast
forall l ast.
ASTElement l ast =>
LocatedAn l ast -> LocatedAn l ast
maybeParensAST

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

instance p ~ GhcPs => ASTElement AnnListItem (Pat p) where
#if __GLASGOW_HASKELL__ == 808
    parseAST = fmap (fmap $ right $ second dL) . parsePattern
    maybeParensAST = dL . parenthesizePat appPrec . unLoc
#else
    parseAST :: Parser (LocatedAn SrcSpan (Pat p))
parseAST = Parser (LPat GhcPs)
Parser (LocatedAn SrcSpan (Pat p))
parsePattern
    maybeParensAST :: LocatedAn SrcSpan (Pat p) -> LocatedAn SrcSpan (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 AnnListItem (HsType p) where
    parseAST :: Parser (LocatedAn SrcSpan (HsType p))
parseAST = Parser (LocatedAn SrcSpan (HsType p))
Parser (LHsType GhcPs)
parseType
    maybeParensAST :: LocatedAn SrcSpan (HsType p) -> LocatedAn SrcSpan (HsType p)
maybeParensAST = PprPrec -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec

instance p ~ GhcPs => ASTElement AnnListItem (HsDecl p) where
    parseAST :: Parser (LocatedAn SrcSpan (HsDecl p))
parseAST = Parser (LocatedAn SrcSpan (HsDecl p))
Parser (LHsDecl GhcPs)
parseDecl
    maybeParensAST :: LocatedAn SrcSpan (HsDecl p) -> LocatedAn SrcSpan (HsDecl p)
maybeParensAST = LocatedAn SrcSpan (HsDecl p) -> LocatedAn SrcSpan (HsDecl p)
forall a. a -> a
id

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

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

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

#if !MIN_VERSION_ghc(9,2,0)
-- | Dark magic I stole from retrie. No idea what it does.
fixAnns :: ParsedModule -> Annotated ParsedSource
fixAnns :: ParsedModule -> 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
#endif

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

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

-- | 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 }}

#if MIN_VERSION_ghc(9,2,0)
    alts' <- for alts $ \alt -> do
      uniq <- show <$> uniqueSrcSpanT
      let rendered = render dflags $ set_matches [alt]
      lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case
        (L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}}))
           -> pure alt'
        _ ->  lift $ Left "annotateDecl: didn't parse a single FunBind match"

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

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

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

-- | 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

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

-- | Equality on SrcSpan's.
-- Ignores the (Maybe BufSpan) field of SrcSpan's.
eqSrcSpan :: SrcSpan -> SrcSpan -> Bool
eqSrcSpan :: SrcSpan -> SrcSpan -> Bool
eqSrcSpan SrcSpan
l SrcSpan
r = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest SrcSpan
l SrcSpan
r Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- | Equality on SrcSpan's.
-- Ignores the (Maybe BufSpan) field of SrcSpan's.
#if MIN_VERSION_ghc(9,2,0)
eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool
eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ
#else
eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool
eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool
eqSrcSpanA SrcSpan
l SrcSpan
r = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest SrcSpan
l SrcSpan
r Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
#endif

#if MIN_VERSION_ghc(9,2,0)
addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext
addParensToCtxt close_dp = addOpen . addClose
  where
      addOpen it@AnnContext{ac_open = []} = it{ac_open = [epl 0]}
      addOpen other                       = other
      addClose it
        | Just c <- close_dp = it{ac_close = [c]}
        | AnnContext{ac_close = []} <- it = it{ac_close = [epl 0]}
        | otherwise = it

epl :: Int -> EpaLocation
epl n = EpaDelta (SameLine n) []

epAnn :: SrcSpan -> ann -> EpAnn ann
epAnn srcSpan anns = EpAnn (spanAsAnchor srcSpan) anns emptyComments

modifyAnns :: LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns x f = first ((fmap.fmap) f) x

removeComma :: SrcSpanAnnA -> SrcSpanAnnA
removeComma it@(SrcSpanAnn EpAnnNotUsed _) = it
removeComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l)
  = (SrcSpanAnn (EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs) l)
  where
      isCommaAnn AddCommaAnn{} = True
      isCommaAnn _             = False

addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn
addParens True it@NameAnn{} =
        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
addParens True it@NameAnnCommas{} =
        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
addParens True it@NameAnnOnly{} =
        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }
addParens True NameAnnTrailing{..} =
        NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..}
addParens _ it = it

removeTrailingComma :: GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast
removeTrailingComma = flip modifyAnns $ \(AnnListItem l) -> AnnListItem $ filter (not . isCommaAnn) l

isCommaAnn :: TrailingAnn -> Bool
isCommaAnn AddCommaAnn{} = True
isCommaAnn _             = False
#endif