{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs        #-}

-- | This module hosts various abstractions and utility functions to work with ghc-exactprint.
module Development.IDE.GHC.ExactPrint
#if MIN_VERSION_ghc(9,3,0)
   (  ) where
#else
    ( 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.DeepSeq
import           Control.Monad
import qualified Control.Monad.Fail                      as Fail
import           Control.Monad.IO.Class                  (MonadIO)
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Control.Monad.Zip
import           Data.Bifunctor
import           Data.Bool                               (bool)
import qualified Data.DList                              as DL
import           Data.Either.Extra                       (mapLeft)
import           Data.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.GHC.Compat.ExactPrint
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           Generics.SYB
import           Generics.SYB.GHC
import qualified GHC.Generics                            as 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
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 :: forall ann. Log -> Doc ann
pretty = \case
    LogShake Log
shakeLog -> forall a ann. Pretty a => a -> Doc ann
pretty Log
shakeLog

instance Show (Annotated ParsedSource) where
  show :: Annotated ParsedSource -> String
show Annotated ParsedSource
_ = String
"<Annotated ParsedSource>"
 
instance NFData (Annotated ParsedSource) where
  rnf :: Annotated ParsedSource -> ()
rnf = forall a. a -> ()
rwhnf
 
data GetAnnotatedParsedSource = GetAnnotatedParsedSource
  deriving (GetAnnotatedParsedSource -> GetAnnotatedParsedSource -> Bool
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
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.
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 = forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$ \GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp -> do
  Maybe ParsedModule
pm <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModuleWithComments
GetParsedModuleWithComments NormalizedFilePath
nfp
  forall (m :: * -> *) a. Monad m => a -> m a
return ([], 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 -> Annotated ParsedSource
annotateParsedSource (ParsedModule ModSummary
_ ParsedSource
ps [String]
_ ()
_) = forall ast. ast -> Int -> Annotated ast
unsafeMkA (forall ast. ExactPrint ast => ast -> ast
makeDeltaAst ParsedSource
ps) Int
0
#else
annotateParsedSource :: ParsedModule -> Annotated ParsedSource
annotateParsedSource = 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
    { forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft :: DynFlags -> a -> TransformT m a
    }

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

newtype ExceptStringT m a = ExceptStringT {forall (m :: * -> *) a. ExceptStringT m a -> ExceptT String m a
runExceptString :: ExceptT String m a}
    deriving newtype
        ( forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> ExceptStringT m a
MonadTrans
        , 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 :: forall a. a -> ExceptStringT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
>> :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
>>= :: forall a 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
Monad
        , 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
<$ :: forall a b. a -> ExceptStringT m b -> ExceptStringT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ExceptStringT m b -> ExceptStringT m a
fmap :: forall a b. (a -> b) -> ExceptStringT m a -> ExceptStringT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExceptStringT m a -> ExceptStringT m b
Functor
        , 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
<* :: forall a b.
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
*> :: forall a b.
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ExceptStringT m a -> ExceptStringT m b -> ExceptStringT m b
liftA2 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> ExceptStringT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> ExceptStringT m a
Applicative
        , 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 :: forall a. ExceptStringT m a -> ExceptStringT m [a]
$cmany :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
some :: forall a. ExceptStringT m a -> ExceptStringT m [a]
$csome :: forall (m :: * -> *) a.
Monad m =>
ExceptStringT m a -> ExceptStringT m [a]
<|> :: forall 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 :: forall a. ExceptStringT m a
$cempty :: forall (m :: * -> *) a. Monad m => ExceptStringT m a
Alternative
        , 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 :: forall a. Num a => ExceptStringT m a -> a
$cproduct :: forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
sum :: forall a. Num a => ExceptStringT m a -> a
$csum :: forall (m :: * -> *) a.
(Foldable m, Num a) =>
ExceptStringT m a -> a
minimum :: forall a. Ord a => ExceptStringT m a -> a
$cminimum :: forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
maximum :: forall a. Ord a => ExceptStringT m a -> a
$cmaximum :: forall (m :: * -> *) a.
(Foldable m, Ord a) =>
ExceptStringT m a -> a
elem :: forall a. Eq a => a -> ExceptStringT m a -> Bool
$celem :: forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> ExceptStringT m a -> Bool
length :: forall a. ExceptStringT m a -> Int
$clength :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Int
null :: forall a. ExceptStringT m a -> Bool
$cnull :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> Bool
toList :: forall a. ExceptStringT m a -> [a]
$ctoList :: forall (m :: * -> *) a. Foldable m => ExceptStringT m a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ExceptStringT m a -> a
$cfoldl1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
foldr1 :: forall a. (a -> a -> a) -> ExceptStringT m a -> a
$cfoldr1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ExceptStringT m a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ExceptStringT m a -> b
$cfoldl' :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ExceptStringT m a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ExceptStringT m a -> b
$cfoldl :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ExceptStringT m a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ExceptStringT m a -> b
$cfoldr' :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ExceptStringT m a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ExceptStringT m a -> b
$cfoldr :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ExceptStringT m a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ExceptStringT m a -> m
$cfoldMap' :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ExceptStringT m a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ExceptStringT m a -> m
$cfoldMap :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ExceptStringT m a -> m
fold :: forall m. Monoid m => ExceptStringT m m -> m
$cfold :: forall (m :: * -> *) m.
(Foldable m, Monoid m) =>
ExceptStringT m m -> m
Foldable
        , forall b a. b -> ExceptStringT m b -> ExceptStringT m a
forall a' a. (a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
forall (m :: * -> *) b a.
Contravariant m =>
b -> ExceptStringT m b -> ExceptStringT m a
forall (m :: * -> *) a' a.
Contravariant m =>
(a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: forall b a. b -> ExceptStringT m b -> ExceptStringT m a
$c>$ :: forall (m :: * -> *) b a.
Contravariant m =>
b -> ExceptStringT m b -> ExceptStringT m a
contramap :: forall a' a. (a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
$ccontramap :: forall (m :: * -> *) a' a.
Contravariant m =>
(a' -> a) -> ExceptStringT m a -> ExceptStringT m a'
Contravariant
        , 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 :: forall a. IO a -> ExceptStringT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ExceptStringT m a
MonadIO
        , 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 :: forall a b.
(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
        , forall a b.
(a -> b -> Ordering)
-> ExceptStringT m a -> ExceptStringT m b -> Ordering
forall {m :: * -> *}. Ord1 m => Eq1 (ExceptStringT m)
forall (m :: * -> *) a b.
Ord1 m =>
(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
liftCompare :: forall a b.
(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
Ord1
        , 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 :: forall a.
(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 :: forall a.
(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
        , 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 :: forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
$cliftReadListPrec :: forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptStringT m a]
liftReadPrec :: forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
$cliftReadPrec :: forall (m :: * -> *) a.
Read1 m =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptStringT m a)
liftReadList :: forall a.
(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 :: forall a.
(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
        , 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 :: forall a b.
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 :: forall a b c.
(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 :: forall a b.
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)
MonadZip
        , 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 :: forall a.
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 :: forall a. ExceptStringT m a
$cmzero :: forall (m :: * -> *) a. Monad m => ExceptStringT m a
MonadPlus
        , ExceptStringT m a -> ExceptStringT m a -> Bool
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
        , 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
Ord
        , Int -> ExceptStringT m a -> ShowS
[ExceptStringT m a] -> ShowS
ExceptStringT m a -> String
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]
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 :: forall a. String -> ExceptStringT m a
fail = forall (m :: * -> *) a. ExceptT String m a -> ExceptStringT m a
ExceptStringT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags -> DynFlags -> a -> TransformT m a
a DynFlags
dflags 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 = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const 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 = forall ast. (Data ast, ExactPrint ast) => Annotated ast -> String
printA Annotated ParsedSource
a
    Annotated ParsedSource
a' <- forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ParsedSource
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft Graft (Either String) ParsedSource
f DynFlags
dflags
    let res :: String
res = forall ast. (Data ast, ExactPrint ast) => Annotated ast -> String
printA Annotated ParsedSource
a'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: forall (m :: * -> *).
Monad m =>
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 = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. ExceptStringT m a -> ExceptT String m a
runExceptString forall a b. (a -> b) -> a -> b
$ do
        let src :: String
src = forall ast. (Data ast, ExactPrint ast) => Annotated ast -> String
printA Annotated ParsedSource
a
        Annotated ParsedSource
a' <- forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ParsedSource
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Graft m a -> DynFlags -> a -> TransformT m a
runGraft Graft (ExceptStringT m) ParsedSource
f DynFlags
dflags
        let res :: String
res = forall ast. (Data ast, ExactPrint ast) => Annotated ast -> String
printA Annotated ParsedSource
a'
        forall (f :: * -> *) a. Applicative f => a -> f a
pure 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{}         = forall a. Monoid a => a
mempty
needsParensSpace HsAppType{}     = forall a. Monoid a => a
mempty
needsParensSpace OpApp{}         = 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{}     = forall a. Monoid a => a
mempty
needsParensSpace HsExpr GhcPs
_               = 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' :: 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 LocatedAn l ast
val = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
#if MIN_VERSION_ghc(9,2,0)
    LocatedAn l ast
val' <- forall l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate DynFlags
dflags Bool
needs_space LocatedAn l ast
val
#else
    (anns, val') <- annotate dflags needs_space val
    modifyAnnsT $ mappend anns
#endif
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere'
            ( forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT forall a b. (a -> b) -> a -> b
$
                \case
                    (L SrcAnn l
src ast
_ :: LocatedAn l ast)
                        | forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn l
src SrcSpan -> SrcSpan -> Bool
`eqSrcSpan` SrcSpan
dst -> LocatedAn l ast
val'
                    LocatedAn l ast
l                         -> LocatedAn l ast
l
            )
            a
a


-- | Like 'graft', but specialized to 'LHsExpr', and intelligently inserts
-- parentheses if they're necessary.
graftExpr ::
    forall a.
    (Data a) =>
    SrcSpan ->
    LHsExpr GhcPs ->
    Graft (Either String) a
graftExpr :: forall a.
Data a =>
SrcSpan -> LHsExpr GhcPs -> Graft (Either String) a
graftExpr SrcSpan
dst LHsExpr GhcPs
val = forall (m :: * -> *) a.
(DynFlags -> a -> TransformT m a) -> Graft m a
Graft forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags a
a -> do
    let (Bool
needs_space, LocatedAn AnnListItem (HsExpr GhcPs)
-> LocatedAn AnnListItem (HsExpr GhcPs)
mk_parens) = forall l ast a.
(ASTElement l ast, Data a) =>
SrcSpan -> a -> (Bool, LocatedAn l ast -> LocatedAn l ast)
getNeedsSpaceAndParenthesize SrcSpan
dst a
a

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


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

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

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

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

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

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


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

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

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

instance p ~ GhcPs => ASTElement AnnListItem (HsExpr p) where
    parseAST :: Parser (LocatedAn AnnListItem (HsExpr p))
parseAST = Parser (LHsExpr GhcPs)
parseExpr
    maybeParensAST :: LocatedAn AnnListItem (HsExpr p)
-> LocatedAn AnnListItem (HsExpr p)
maybeParensAST = LHsExpr GhcPs -> LHsExpr GhcPs
parenthesize
    graft :: forall a.
Data a =>
SrcSpan
-> LocatedAn AnnListItem (HsExpr p) -> Graft (Either String) a
graft = 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 AnnListItem (Pat p))
parseAST = Parser (LPat GhcPs)
parsePattern
    maybeParensAST :: LocatedAn AnnListItem (Pat p) -> LocatedAn AnnListItem (Pat p)
maybeParensAST = forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec
#endif

instance p ~ GhcPs => ASTElement AnnListItem (HsType p) where
    parseAST :: Parser (LocatedAn AnnListItem (HsType p))
parseAST = Parser (LHsType GhcPs)
parseType
    maybeParensAST :: LocatedAn AnnListItem (HsType p)
-> LocatedAn AnnListItem (HsType p)
maybeParensAST = forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec

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

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

instance ASTElement NameAnn RdrName where
    parseAST :: Parser (GenLocated SrcSpanAnnN RdrName)
parseAST DynFlags
df String
fp = forall w. DynFlags -> String -> P w -> String -> ParseResult w
parseWith DynFlags
df String
fp P (GenLocated SrcSpanAnnN RdrName)
parseIdentifier
    maybeParensAST :: GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
maybeParensAST = 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 {..} =
    let ranns = relativiseApiAnns pm_parsed_source pm_annotations
     in unsafeMkA pm_parsed_source ranns 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 :: forall l ast.
(ASTElement l ast, Outputable l) =>
DynFlags
-> Bool
-> LocatedAn l ast
-> TransformT (Either String) (LocatedAn l ast)
annotate DynFlags
dflags Bool
needs_space LocatedAn l ast
ast = do
    String
uniq <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    let rendered :: String
rendered = forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags LocatedAn l ast
ast
#if MIN_VERSION_ghc(9,2,0)
    LocatedAn l ast
expr' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall l ast. ASTElement l ast => Parser (LocatedAn l ast)
parseAST DynFlags
dflags String
uniq String
rendered
    forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedAn l ast
expr'
#else
    (anns, expr') <- lift $ mapLeft show $ parseAST dflags uniq rendered
    let anns' = setPrecedingLines expr' 0 (bool 0 1 needs_space) anns
    pure (anns',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 SrcSpanAnnA
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 -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
alt_src alts :: [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
alts@(GenLocated
  SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
_:[GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
_)}
                  })) = do
    let set_matches :: [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
-> HsDecl GhcPs
set_matches [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches =
          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 :: XRec GhcPs [LMatch GhcPs (LocatedAn AnnListItem (HsExpr GhcPs))]
mg_alts = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
alt_src [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
matches }}

#if MIN_VERSION_ghc(9,2,0)
    [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
alts' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
alts forall a b. (a -> b) -> a -> b
$ \GenLocated
  SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
alt -> do
      String
uniq <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
      let rendered :: String
rendered = forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags forall a b. (a -> b) -> a -> b
$ [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
-> HsDecl GhcPs
set_matches [GenLocated
  SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
alt]
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Parser (LHsDecl GhcPs)
parseDecl DynFlags
dflags String
uniq String
rendered) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (L SrcSpanAnnA
_ (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 -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
_ [GenLocated
  SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
alt']}}))
           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated
  SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))
alt'
        GenLocated SrcSpanAnnA (HsDecl GhcPs)
_ ->  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"annotateDecl: didn't parse a single FunBind match"

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
src forall a b. (a -> b) -> a -> b
$ [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
-> HsDecl GhcPs
set_matches [GenLocated
   SrcSpanAnnA (Match GhcPs (LocatedAn AnnListItem (HsExpr GhcPs)))]
alts'
#else
    (anns', alts') <- fmap unzip $ for alts $ \alt -> do
      uniq <- show <$> uniqueSrcSpanT
      let rendered = render dflags $ set_matches [alt]
      lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case
        (ann, L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}}))
           -> pure (setPrecedingLines alt' 1 0 ann, alt')
        _ ->  lift $ Left "annotateDecl: didn't parse a single FunBind match"

    modifyAnnsT $ mappend $ fold anns'
    pure $ L src $ set_matches alts'
#endif
annotateDecl DynFlags
dflags LHsDecl GhcPs
ast = do
    String
uniq <- forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    let rendered :: String
rendered = forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags LHsDecl GhcPs
ast
#if MIN_VERSION_ghc(9,2,0)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Parser (LHsDecl GhcPs)
parseDecl DynFlags
dflags String
uniq String
rendered
#else
    (anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered
    let anns' = setPrecedingLines expr' 1 0 anns
    modifyAnnsT $ mappend anns'
    pure expr'
#endif

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

-- | Print out something 'Outputable'.
render :: Outputable a => DynFlags -> a -> String
render :: forall a. Outputable a => DynFlags -> a -> String
render DynFlags
dflags = DynFlags -> SDoc -> String
showSDoc DynFlags
dflags forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
appPrec

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

-- | Equality on SrcSpan's.
-- Ignores the (Maybe BufSpan) field of SrcSpan's.
eqSrcSpan :: SrcSpan -> SrcSpan -> Bool
eqSrcSpan :: SrcSpan -> SrcSpan -> Bool
eqSrcSpan SrcSpan
l SrcSpan
r = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest SrcSpan
l SrcSpan
r 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 :: forall la b. SrcAnn la -> SrcAnn b -> Bool
eqSrcSpanA SrcAnn la
l SrcAnn b
r = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn la
l) (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn b
r) forall a. Eq a => a -> a -> Bool
== Ordering
EQ
#else
eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool
eqSrcSpanA l r = leftmost_smallest l r == EQ
#endif

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

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

epAnn :: SrcSpan -> ann -> EpAnn ann
epAnn :: forall ann. SrcSpan -> ann -> EpAnn ann
epAnn SrcSpan
srcSpan ann
anns = forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor SrcSpan
srcSpan) ann
anns EpAnnComments
emptyComments

modifyAnns :: LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns :: forall a ast. LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns LocatedAn a ast
x a -> a
f = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> a
f) LocatedAn a ast
x

removeComma :: SrcSpanAnnA -> SrcSpanAnnA
removeComma :: SrcSpanAnnA -> SrcSpanAnnA
removeComma it :: SrcSpanAnnA
it@(SrcSpanAnn EpAnn AnnListItem
EpAnnNotUsed SrcSpan
_) = SrcSpanAnnA
it
removeComma (SrcSpanAnn (EpAnn Anchor
anc (AnnListItem [TrailingAnn]
as) EpAnnComments
cs) SrcSpan
l)
  = (forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc ([TrailingAnn] -> AnnListItem
AnnListItem (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrailingAnn -> Bool
isCommaAnn) [TrailingAnn]
as)) EpAnnComments
cs) SrcSpan
l)
  where
      isCommaAnn :: TrailingAnn -> Bool
isCommaAnn AddCommaAnn{} = Bool
True
      isCommaAnn TrailingAnn
_             = Bool
False

addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn
addParens :: Bool -> NameAnn -> NameAnn
addParens Bool
True it :: NameAnn
it@NameAnn{} =
        NameAnn
it{nann_adornment :: NameAdornment
nann_adornment = NameAdornment
NameParens, nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
0, nann_close :: EpaLocation
nann_close = Int -> EpaLocation
epl Int
0 }
addParens Bool
True it :: NameAnn
it@NameAnnCommas{} =
        NameAnn
it{nann_adornment :: NameAdornment
nann_adornment = NameAdornment
NameParens, nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
0, nann_close :: EpaLocation
nann_close = Int -> EpaLocation
epl Int
0 }
addParens Bool
True it :: NameAnn
it@NameAnnOnly{} =
        NameAnn
it{nann_adornment :: NameAdornment
nann_adornment = NameAdornment
NameParens, nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
0, nann_close :: EpaLocation
nann_close = Int -> EpaLocation
epl Int
0 }
addParens Bool
True NameAnnTrailing{[TrailingAnn]
nann_trailing :: NameAnn -> [TrailingAnn]
nann_trailing :: [TrailingAnn]
..} =
        NameAnn{nann_adornment :: NameAdornment
nann_adornment = NameAdornment
NameParens, nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
0, nann_close :: EpaLocation
nann_close = Int -> EpaLocation
epl Int
0, nann_name :: EpaLocation
nann_name = Int -> EpaLocation
epl Int
0, [TrailingAnn]
nann_trailing :: [TrailingAnn]
nann_trailing :: [TrailingAnn]
..}
addParens Bool
_ NameAnn
it = NameAnn
it

removeTrailingComma :: GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast
removeTrailingComma :: forall ast.
GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast
removeTrailingComma = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a ast. LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns forall a b. (a -> b) -> a -> b
$ \(AnnListItem [TrailingAnn]
l) -> [TrailingAnn] -> AnnListItem
AnnListItem forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrailingAnn -> Bool
isCommaAnn) [TrailingAnn]
l

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

#endif