{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Prettyprinter.Generics
( ppGeneric
, PPGeneric(..)
, PPGenericOverride(..)
, Pretty(..)
, Generic
) where
import Data.Bimap (Bimap)
import Data.ByteString.Char8 qualified as C8
import Data.ByteString.Lazy.Char8 qualified as CL8
import Data.ByteString.Short qualified as ShortBS
import Data.DList (DList)
import Data.DList qualified as DL
#ifdef HAVE_ENUMMAPSET
import Data.EnumMap (EnumMap)
import Data.EnumSet (EnumSet)
#endif
import Data.Foldable
import Data.Functor.Compose
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.Int
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import Data.Kind
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Proxy
import Data.Set (Set)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Vector (Vector)
import Data.Void
import Data.Word
import GHC.ForeignPtr (ForeignPtr(..))
import GHC.Generics
import GHC.Real (Ratio(..))
import GHC.Stack (CallStack)
import GHC.TypeLits
import Prettyprinter
import Prettyprinter.Combinators
import Prettyprinter.MetaDoc
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Syntax qualified as TH
newtype PPGeneric a = PPGeneric { forall a. PPGeneric a -> a
unPPGeneric :: a }
instance (Generic a, GPretty (Rep a)) => Pretty (PPGeneric a) where
pretty :: forall ann. PPGeneric a -> Doc ann
pretty = a -> Doc ann
forall a ann. (Generic a, GPretty (Rep a)) => a -> Doc ann
ppGeneric (a -> Doc ann) -> (PPGeneric a -> a) -> PPGeneric a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PPGeneric a -> a
forall a. PPGeneric a -> a
unPPGeneric
ppGeneric :: (Generic a, GPretty (Rep a)) => a -> Doc ann
ppGeneric :: forall a ann. (Generic a, GPretty (Rep a)) => a -> Doc ann
ppGeneric = MetaDoc ann -> Doc ann
forall ann. MetaDoc ann -> Doc ann
mdPayload (MetaDoc ann -> Doc ann) -> (a -> MetaDoc ann) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a Any -> MetaDoc ann
forall ix ann. Rep a ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (Rep a Any -> MetaDoc ann) -> (a -> Rep a Any) -> a -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
class GPretty (a :: Type -> Type) where
gpretty :: a ix -> MetaDoc ann
instance GPretty V1 where
gpretty :: forall ix ann. V1 ix -> MetaDoc ann
gpretty V1 ix
_ = [Char] -> MetaDoc ann
forall a. HasCallStack => [Char] -> a
error [Char]
"gpretty for V1"
instance GPretty U1 where
gpretty :: forall ix ann. U1 ix -> MetaDoc ann
gpretty U1 ix
U1 = MetaDoc ann
forall a. Monoid a => a
mempty
instance (GPretty f, GPretty g) => GPretty (f :+: g) where
gpretty :: forall ix ann. (:+:) f g ix -> MetaDoc ann
gpretty = \case
L1 f ix
x -> f ix -> MetaDoc ann
forall ix ann. f ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty f ix
x
R1 g ix
y -> g ix -> MetaDoc ann
forall ix ann. g ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty g ix
y
instance PPGenericOverride a => GPretty (K1 i a) where
gpretty :: forall ix ann. K1 i a ix -> MetaDoc ann
gpretty = a -> MetaDoc ann
forall ann. a -> MetaDoc ann
forall a ann. PPGenericOverride a => a -> MetaDoc ann
ppGenericOverride (a -> MetaDoc ann) -> (K1 i a ix -> a) -> K1 i a ix -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a ix -> a
forall k i c (p :: k). K1 i c p -> c
unK1
class PPGenericOverride a where
ppGenericOverride :: a -> MetaDoc ann
ppGenericOverrideDoc :: PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc :: forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc = MetaDoc ann -> Doc ann
forall ann. MetaDoc ann -> Doc ann
mdPayload (MetaDoc ann -> Doc ann) -> (a -> MetaDoc ann) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MetaDoc ann
forall ann. a -> MetaDoc ann
forall a ann. PPGenericOverride a => a -> MetaDoc ann
ppGenericOverride
newtype PPGenericOverrideToPretty a = PPGenericOverrideToPretty { forall a. PPGenericOverrideToPretty a -> a
unPPGenericOverrideToPretty :: a }
instance PPGenericOverride a => Pretty (PPGenericOverrideToPretty a) where
pretty :: forall ann. PPGenericOverrideToPretty a -> Doc ann
pretty = MetaDoc ann -> Doc ann
forall ann. MetaDoc ann -> Doc ann
mdPayload (MetaDoc ann -> Doc ann)
-> (PPGenericOverrideToPretty a -> MetaDoc ann)
-> PPGenericOverrideToPretty a
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MetaDoc ann
forall ann. a -> MetaDoc ann
forall a ann. PPGenericOverride a => a -> MetaDoc ann
ppGenericOverride (a -> MetaDoc ann)
-> (PPGenericOverrideToPretty a -> a)
-> PPGenericOverrideToPretty a
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PPGenericOverrideToPretty a -> a
forall a. PPGenericOverrideToPretty a -> a
unPPGenericOverrideToPretty
instance Pretty a => PPGenericOverride a where
ppGenericOverride :: forall ann. a -> MetaDoc ann
ppGenericOverride = Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc (Doc ann -> MetaDoc ann) -> (a -> Doc ann) -> a -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
instance {-# OVERLAPS #-} PPGenericOverride Int where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Int -> MetaDoc ann
ppGenericOverride = Int -> MetaDoc ann
forall ann. Int -> MetaDoc ann
metaDocInt
instance {-# OVERLAPS #-} PPGenericOverride Float where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Float -> MetaDoc ann
ppGenericOverride = Float -> MetaDoc ann
forall ann. Float -> MetaDoc ann
metaDocFloat
instance {-# OVERLAPS #-} PPGenericOverride Double where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Double -> MetaDoc ann
ppGenericOverride = Double -> MetaDoc ann
forall ann. Double -> MetaDoc ann
metaDocDouble
instance {-# OVERLAPS #-} PPGenericOverride Integer where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Integer -> MetaDoc ann
ppGenericOverride = Integer -> MetaDoc ann
forall ann. Integer -> MetaDoc ann
metaDocInteger
instance {-# OVERLAPS #-} PPGenericOverride Natural where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Natural -> MetaDoc ann
ppGenericOverride = Natural -> MetaDoc ann
forall ann. Natural -> MetaDoc ann
metaDocNatural
instance {-# OVERLAPS #-} PPGenericOverride Word where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Word -> MetaDoc ann
ppGenericOverride = Word -> MetaDoc ann
forall ann. Word -> MetaDoc ann
metaDocWord
instance {-# OVERLAPS #-} PPGenericOverride Word8 where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Word8 -> MetaDoc ann
ppGenericOverride = Word8 -> MetaDoc ann
forall ann. Word8 -> MetaDoc ann
metaDocWord8
instance {-# OVERLAPS #-} PPGenericOverride Word16 where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Word16 -> MetaDoc ann
ppGenericOverride = Word16 -> MetaDoc ann
forall ann. Word16 -> MetaDoc ann
metaDocWord16
instance {-# OVERLAPS #-} PPGenericOverride Word32 where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Word32 -> MetaDoc ann
ppGenericOverride = Word32 -> MetaDoc ann
forall ann. Word32 -> MetaDoc ann
metaDocWord32
instance {-# OVERLAPS #-} PPGenericOverride Word64 where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Word64 -> MetaDoc ann
ppGenericOverride = Word64 -> MetaDoc ann
forall ann. Word64 -> MetaDoc ann
metaDocWord64
instance {-# OVERLAPS #-} PPGenericOverride Int8 where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Int8 -> MetaDoc ann
ppGenericOverride = Int8 -> MetaDoc ann
forall ann. Int8 -> MetaDoc ann
metaDocInt8
instance {-# OVERLAPS #-} PPGenericOverride Int16 where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Int16 -> MetaDoc ann
ppGenericOverride = Int16 -> MetaDoc ann
forall ann. Int16 -> MetaDoc ann
metaDocInt16
instance {-# OVERLAPS #-} PPGenericOverride Int32 where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Int32 -> MetaDoc ann
ppGenericOverride = Int32 -> MetaDoc ann
forall ann. Int32 -> MetaDoc ann
metaDocInt32
instance {-# OVERLAPS #-} PPGenericOverride Int64 where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Int64 -> MetaDoc ann
ppGenericOverride = Int64 -> MetaDoc ann
forall ann. Int64 -> MetaDoc ann
metaDocInt64
instance {-# OVERLAPS #-} PPGenericOverride () where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. () -> MetaDoc ann
ppGenericOverride = () -> MetaDoc ann
forall ann. () -> MetaDoc ann
metaDocUnit
instance {-# OVERLAPS #-} PPGenericOverride Bool where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Bool -> MetaDoc ann
ppGenericOverride = Bool -> MetaDoc ann
forall ann. Bool -> MetaDoc ann
metaDocBool
instance {-# OVERLAPS #-} PPGenericOverride Char where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Char -> MetaDoc ann
ppGenericOverride = Char -> MetaDoc ann
forall ann. Char -> MetaDoc ann
metaDocChar
instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Ratio a) where
{-# INLINABLE ppGenericOverride #-}
ppGenericOverride :: forall ann. Ratio a -> MetaDoc ann
ppGenericOverride (a
x :% a
y) =
a -> MetaDoc ann
forall ann. a -> MetaDoc ann
forall a ann. PPGenericOverride a => a -> MetaDoc ann
ppGenericOverride a
x MetaDoc ann -> MetaDoc ann -> MetaDoc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc Doc ann
"/" MetaDoc ann -> MetaDoc ann -> MetaDoc ann
forall a. Semigroup a => a -> a -> a
<> a -> MetaDoc ann
forall ann. a -> MetaDoc ann
forall a ann. PPGenericOverride a => a -> MetaDoc ann
ppGenericOverride a
y
instance {-# OVERLAPS #-} PPGenericOverride CallStack where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. CallStack -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc (Doc ann -> MetaDoc ann)
-> (CallStack -> Doc ann) -> CallStack -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> Doc ann
forall ann. CallStack -> Doc ann
ppCallStack
instance {-# OVERLAPS #-} PPGenericOverride (Doc Void) where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Doc Void -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc (Doc ann -> MetaDoc ann)
-> (Doc Void -> Doc ann) -> Doc Void -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Void -> ann) -> Doc Void -> Doc ann
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Void -> ann
forall a. Void -> a
absurd
instance {-# OVERLAPS #-} PPGenericOverride String where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. [Char] -> MetaDoc ann
ppGenericOverride = [Char] -> MetaDoc ann
forall ann. [Char] -> MetaDoc ann
stringMetaDoc
instance {-# OVERLAPS #-} PPGenericOverride T.Text where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Text -> MetaDoc ann
ppGenericOverride = Text -> MetaDoc ann
forall ann. Text -> MetaDoc ann
strictTextMetaDoc
instance {-# OVERLAPS #-} PPGenericOverride TL.Text where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. Text -> MetaDoc ann
ppGenericOverride = Text -> MetaDoc ann
forall ann. Text -> MetaDoc ann
lazyTextMetaDoc
instance {-# OVERLAPS #-} PPGenericOverride C8.ByteString where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. ByteString -> MetaDoc ann
ppGenericOverride = ByteString -> MetaDoc ann
forall ann. ByteString -> MetaDoc ann
strictByteStringMetaDoc
instance {-# OVERLAPS #-} PPGenericOverride CL8.ByteString where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. ByteString -> MetaDoc ann
ppGenericOverride = ByteString -> MetaDoc ann
forall ann. ByteString -> MetaDoc ann
lazyByteStringMetaDoc
instance {-# OVERLAPS #-} PPGenericOverride ShortBS.ShortByteString where
{-# INLINE ppGenericOverride #-}
ppGenericOverride :: forall ann. ShortByteString -> MetaDoc ann
ppGenericOverride = ShortByteString -> MetaDoc ann
forall ann. ShortByteString -> MetaDoc ann
shortByteStringMetaDoc
instance {-# OVERLAPS #-} PPGenericOverride (ForeignPtr a) where ppGenericOverride :: forall ann. ForeignPtr a -> MetaDoc ann
ppGenericOverride = Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (ForeignPtr a -> Doc ann) -> ForeignPtr a -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann)
-> (ForeignPtr a -> [Char]) -> ForeignPtr a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr a -> [Char]
forall a. Show a => a -> [Char]
show
instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (TH.TyVarBndr a) where ppGenericOverride :: forall ann. TyVarBndr a -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"TyVarBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "PlainTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a))
:+: C1
('MetaCons "KindedTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"TyVarBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "PlainTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a))
:+: C1
('MetaCons "KindedTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"TyVarBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "PlainTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a))
:+: C1
('MetaCons "KindedTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
-> MetaDoc ann)
-> (TyVarBndr a
-> M1
D
('MetaData
"TyVarBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "PlainTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a))
:+: C1
('MetaCons "KindedTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any)
-> TyVarBndr a
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBndr a
-> M1
D
('MetaData
"TyVarBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "PlainTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a))
:+: C1
('MetaCons "KindedTV" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 a)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
TyVarBndr a -> Rep (TyVarBndr a) Any
forall a x. Generic a => a -> Rep a x
forall x. TyVarBndr a -> Rep (TyVarBndr a) x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.OccName where ppGenericOverride :: forall ann. OccName -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"OccName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "OccName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"OccName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "OccName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"OccName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "OccName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
-> MetaDoc ann)
-> (OccName
-> M1
D
('MetaData
"OccName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "OccName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any)
-> OccName
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName
-> M1
D
('MetaData
"OccName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "OccName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
OccName -> Rep OccName Any
forall a x. Generic a => a -> Rep a x
forall x. OccName -> Rep OccName x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.NameFlavour where ppGenericOverride :: forall ann. NameFlavour -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"NameFlavour"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "NameS" 'PrefixI 'False) U1
:+: C1
('MetaCons "NameQ" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 ModName)))
:+: (C1
('MetaCons "NameU" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: (C1
('MetaCons "NameL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: C1
('MetaCons "NameG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameSpace)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 PkgName)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 ModName))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"NameFlavour"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "NameS" 'PrefixI 'False) U1
:+: C1
('MetaCons "NameQ" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 ModName)))
:+: (C1
('MetaCons "NameU" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: (C1
('MetaCons "NameL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: C1
('MetaCons "NameG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameSpace)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 PkgName)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 ModName))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"NameFlavour"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "NameS" 'PrefixI 'False) U1
:+: C1
('MetaCons "NameQ" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 ModName)))
:+: (C1
('MetaCons "NameU" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: (C1
('MetaCons "NameL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: C1
('MetaCons "NameG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameSpace)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 PkgName)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 ModName))))))
Any
-> MetaDoc ann)
-> (NameFlavour
-> M1
D
('MetaData
"NameFlavour"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "NameS" 'PrefixI 'False) U1
:+: C1
('MetaCons "NameQ" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 ModName)))
:+: (C1
('MetaCons "NameU" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: (C1
('MetaCons "NameL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: C1
('MetaCons "NameG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameSpace)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 PkgName)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 ModName))))))
Any)
-> NameFlavour
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameFlavour
-> M1
D
('MetaData
"NameFlavour"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "NameS" 'PrefixI 'False) U1
:+: C1
('MetaCons "NameQ" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 ModName)))
:+: (C1
('MetaCons "NameU" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: (C1
('MetaCons "NameL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict)
(Rec0 Integer))
:+: C1
('MetaCons "NameG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameSpace)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 PkgName)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 ModName))))))
Any
NameFlavour -> Rep NameFlavour Any
forall a x. Generic a => a -> Rep a x
forall x. NameFlavour -> Rep NameFlavour x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.PkgName where ppGenericOverride :: forall ann. PkgName -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"PkgName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "PkgName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"PkgName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "PkgName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"PkgName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "PkgName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
-> MetaDoc ann)
-> (PkgName
-> M1
D
('MetaData
"PkgName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "PkgName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any)
-> PkgName
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName
-> M1
D
('MetaData
"PkgName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "PkgName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
PkgName -> Rep PkgName Any
forall a x. Generic a => a -> Rep a x
forall x. PkgName -> Rep PkgName x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.NameSpace where ppGenericOverride :: forall ann. NameSpace -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"NameSpace" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "VarName" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "DataName" 'PrefixI 'False) U1
:+: C1 ('MetaCons "TcClsName" 'PrefixI 'False) U1))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"NameSpace" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "VarName" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "DataName" 'PrefixI 'False) U1
:+: C1 ('MetaCons "TcClsName" 'PrefixI 'False) U1))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"NameSpace" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "VarName" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "DataName" 'PrefixI 'False) U1
:+: C1 ('MetaCons "TcClsName" 'PrefixI 'False) U1))
Any
-> MetaDoc ann)
-> (NameSpace
-> M1
D
('MetaData
"NameSpace" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "VarName" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "DataName" 'PrefixI 'False) U1
:+: C1 ('MetaCons "TcClsName" 'PrefixI 'False) U1))
Any)
-> NameSpace
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpace
-> M1
D
('MetaData
"NameSpace" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "VarName" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "DataName" 'PrefixI 'False) U1
:+: C1 ('MetaCons "TcClsName" 'PrefixI 'False) U1))
Any
NameSpace -> Rep NameSpace Any
forall a x. Generic a => a -> Rep a x
forall x. NameSpace -> Rep NameSpace x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.ModName where ppGenericOverride :: forall ann. ModName -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"ModName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "ModName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"ModName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "ModName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"ModName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "ModName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
-> MetaDoc ann)
-> (ModName
-> M1
D
('MetaData
"ModName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "ModName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any)
-> ModName
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModName
-> M1
D
('MetaData
"ModName" "Language.Haskell.TH.Syntax" "template-haskell" 'True)
(C1
('MetaCons "ModName" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
Any
ModName -> Rep ModName Any
forall a x. Generic a => a -> Rep a x
forall x. ModName -> Rep ModName x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Name where ppGenericOverride :: forall ann. Name -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Name" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Name" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 OccName)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameFlavour)))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Name" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Name" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 OccName)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameFlavour)))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Name" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Name" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 OccName)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameFlavour)))
Any
-> MetaDoc ann)
-> (Name
-> M1
D
('MetaData
"Name" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Name" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 OccName)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameFlavour)))
Any)
-> Name
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> M1
D
('MetaData
"Name" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Name" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 OccName)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 NameFlavour)))
Any
Name -> Rep Name Any
forall a x. Generic a => a -> Rep a x
forall x. Name -> Rep Name x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.TyLit where ppGenericOverride :: forall ann. TyLit -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"TyLit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NumTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "StrTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CharTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"TyLit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NumTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "StrTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CharTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"TyLit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NumTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "StrTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CharTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))
Any
-> MetaDoc ann)
-> (TyLit
-> M1
D
('MetaData
"TyLit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NumTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "StrTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CharTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))
Any)
-> TyLit
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyLit
-> M1
D
('MetaData
"TyLit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NumTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "StrTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CharTyLit" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))
Any
TyLit -> Rep TyLit Any
forall a x. Generic a => a -> Rep a x
forall x. TyLit -> Rep TyLit x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Type where ppGenericOverride :: forall ann. Kind -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Type" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "ForallT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "ForallVisT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "AppT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "AppKindT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "SigT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "VarT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))))
:+: ((C1
('MetaCons "PromotedT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: (C1
('MetaCons "InfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "UInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "PromotedInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "PromotedUInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: (C1
('MetaCons "ParensT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))))
:+: (((C1
('MetaCons "UnboxedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: (C1
('MetaCons "UnboxedSumT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1 ('MetaCons "ArrowT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "MulArrowT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "EqualityT" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "ListT" 'PrefixI 'False) U1
:+: C1
('MetaCons "PromotedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))))
:+: ((C1 ('MetaCons "PromotedNilT" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "PromotedConsT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StarT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "ConstraintT" 'PrefixI 'False) U1
:+: C1
('MetaCons "LitT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TyLit)))
:+: (C1 ('MetaCons "WildCardT" 'PrefixI 'False) U1
:+: C1
('MetaCons "ImplicitParamT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Type" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "ForallT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "ForallVisT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "AppT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "AppKindT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "SigT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "VarT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))))
:+: ((C1
('MetaCons "PromotedT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: (C1
('MetaCons "InfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "UInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "PromotedInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "PromotedUInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: (C1
('MetaCons "ParensT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))))
:+: (((C1
('MetaCons "UnboxedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: (C1
('MetaCons "UnboxedSumT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1 ('MetaCons "ArrowT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "MulArrowT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "EqualityT" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "ListT" 'PrefixI 'False) U1
:+: C1
('MetaCons "PromotedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))))
:+: ((C1 ('MetaCons "PromotedNilT" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "PromotedConsT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StarT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "ConstraintT" 'PrefixI 'False) U1
:+: C1
('MetaCons "LitT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TyLit)))
:+: (C1 ('MetaCons "WildCardT" 'PrefixI 'False) U1
:+: C1
('MetaCons "ImplicitParamT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Type" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "ForallT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "ForallVisT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "AppT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "AppKindT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "SigT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "VarT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))))
:+: ((C1
('MetaCons "PromotedT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: (C1
('MetaCons "InfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "UInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "PromotedInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "PromotedUInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))
:+: (C1
('MetaCons "ParensT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))))
:+: (((C1
('MetaCons "UnboxedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: (C1
('MetaCons "UnboxedSumT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1 ('MetaCons "ArrowT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "MulArrowT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "EqualityT" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "ListT" 'PrefixI 'False) U1
:+: C1
('MetaCons "PromotedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))))
:+: ((C1 ('MetaCons "PromotedNilT" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "PromotedConsT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StarT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "ConstraintT" 'PrefixI 'False) U1
:+: C1
('MetaCons "LitT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TyLit)))
:+: (C1 ('MetaCons "WildCardT" 'PrefixI 'False) U1
:+: C1
('MetaCons "ImplicitParamT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))))
Any
-> MetaDoc ann)
-> (Kind
-> M1
D
('MetaData
"Type" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "ForallT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "ForallVisT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "AppT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "AppKindT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "SigT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "VarT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))))
:+: ((C1
('MetaCons "PromotedT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: (C1
('MetaCons "InfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "UInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "PromotedInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "PromotedUInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))
:+: (C1
('MetaCons "ParensT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Int))))))
:+: (((C1
('MetaCons "UnboxedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: (C1
('MetaCons "UnboxedSumT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1 ('MetaCons "ArrowT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "MulArrowT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "EqualityT" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "ListT" 'PrefixI 'False) U1
:+: C1
('MetaCons "PromotedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Int)))))
:+: ((C1 ('MetaCons "PromotedNilT" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "PromotedConsT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StarT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "ConstraintT" 'PrefixI 'False) U1
:+: C1
('MetaCons "LitT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 TyLit)))
:+: (C1 ('MetaCons "WildCardT" 'PrefixI 'False) U1
:+: C1
('MetaCons "ImplicitParamT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))))
Any)
-> Kind
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind
-> M1
D
('MetaData
"Type" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "ForallT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "ForallVisT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "AppT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "AppKindT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "SigT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: (C1
('MetaCons "VarT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))))
:+: ((C1
('MetaCons "PromotedT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: (C1
('MetaCons "InfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "UInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "PromotedInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "PromotedUInfixT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))
:+: (C1
('MetaCons "ParensT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))))
:+: (((C1
('MetaCons "UnboxedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: (C1
('MetaCons "UnboxedSumT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1 ('MetaCons "ArrowT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "MulArrowT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "EqualityT" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "ListT" 'PrefixI 'False) U1
:+: C1
('MetaCons "PromotedTupleT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))))
:+: ((C1 ('MetaCons "PromotedNilT" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "PromotedConsT" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StarT" 'PrefixI 'False) U1))
:+: ((C1 ('MetaCons "ConstraintT" 'PrefixI 'False) U1
:+: C1
('MetaCons "LitT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TyLit)))
:+: (C1 ('MetaCons "WildCardT" 'PrefixI 'False) U1
:+: C1
('MetaCons "ImplicitParamT" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))))
Any
Kind -> Rep Kind Any
forall a x. Generic a => a -> Rep a x
forall x. Kind -> Rep Kind x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.SourceUnpackedness where ppGenericOverride :: forall ann. SourceUnpackedness -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"SourceUnpackedness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceUnpackedness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceNoUnpack" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceUnpack" 'PrefixI 'False) U1))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"SourceUnpackedness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceUnpackedness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceNoUnpack" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceUnpack" 'PrefixI 'False) U1))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"SourceUnpackedness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceUnpackedness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceNoUnpack" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceUnpack" 'PrefixI 'False) U1))
Any
-> MetaDoc ann)
-> (SourceUnpackedness
-> M1
D
('MetaData
"SourceUnpackedness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceUnpackedness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceNoUnpack" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceUnpack" 'PrefixI 'False) U1))
Any)
-> SourceUnpackedness
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceUnpackedness
-> M1
D
('MetaData
"SourceUnpackedness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceUnpackedness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceNoUnpack" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceUnpack" 'PrefixI 'False) U1))
Any
SourceUnpackedness -> Rep SourceUnpackedness Any
forall a x. Generic a => a -> Rep a x
forall x. SourceUnpackedness -> Rep SourceUnpackedness x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.SourceStrictness where ppGenericOverride :: forall ann. SourceStrictness -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"SourceStrictness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceStrictness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceLazy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceStrict" 'PrefixI 'False) U1))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"SourceStrictness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceStrictness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceLazy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceStrict" 'PrefixI 'False) U1))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"SourceStrictness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceStrictness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceLazy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceStrict" 'PrefixI 'False) U1))
Any
-> MetaDoc ann)
-> (SourceStrictness
-> M1
D
('MetaData
"SourceStrictness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceStrictness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceLazy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceStrict" 'PrefixI 'False) U1))
Any)
-> SourceStrictness
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceStrictness
-> M1
D
('MetaData
"SourceStrictness"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSourceStrictness" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "SourceLazy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "SourceStrict" 'PrefixI 'False) U1))
Any
SourceStrictness -> Rep SourceStrictness Any
forall a x. Generic a => a -> Rep a x
forall x. SourceStrictness -> Rep SourceStrictness x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Bang where ppGenericOverride :: forall ann. Bang -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Bang" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bang" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceUnpackedness)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceStrictness)))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Bang" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bang" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceUnpackedness)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceStrictness)))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Bang" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bang" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceUnpackedness)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceStrictness)))
Any
-> MetaDoc ann)
-> (Bang
-> M1
D
('MetaData
"Bang" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bang" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceUnpackedness)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceStrictness)))
Any)
-> Bang
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bang
-> M1
D
('MetaData
"Bang" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bang" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceUnpackedness)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 SourceStrictness)))
Any
Bang -> Rep Bang Any
forall a x. Generic a => a -> Rep a x
forall x. Bang -> Rep Bang x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Con where ppGenericOverride :: forall ann. Con -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Con" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "NormalC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType]))
:+: (C1
('MetaCons "RecC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType]))
:+: C1
('MetaCons "InfixC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)))))
:+: (C1
('MetaCons "ForallC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)))
:+: (C1
('MetaCons "GadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "RecGadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Con" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "NormalC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType]))
:+: (C1
('MetaCons "RecC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType]))
:+: C1
('MetaCons "InfixC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)))))
:+: (C1
('MetaCons "ForallC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)))
:+: (C1
('MetaCons "GadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "RecGadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Con" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "NormalC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType]))
:+: (C1
('MetaCons "RecC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType]))
:+: C1
('MetaCons "InfixC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)))))
:+: (C1
('MetaCons "ForallC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)))
:+: (C1
('MetaCons "GadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "RecGadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))))
Any
-> MetaDoc ann)
-> (Con
-> M1
D
('MetaData
"Con" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "NormalC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType]))
:+: (C1
('MetaCons "RecC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType]))
:+: C1
('MetaCons "InfixC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 BangType)))))
:+: (C1
('MetaCons "ForallC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)))
:+: (C1
('MetaCons "GadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "RecGadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [VarBangType])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))))
Any)
-> Con
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Con
-> M1
D
('MetaData
"Con" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "NormalC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType]))
:+: (C1
('MetaCons "RecC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType]))
:+: C1
('MetaCons "InfixC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 BangType)))))
:+: (C1
('MetaCons "ForallC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr Specificity])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)))
:+: (C1
('MetaCons "GadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [BangType])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:+: C1
('MetaCons "RecGadtC" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [VarBangType])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))))
Any
Con -> Rep Con Any
forall a x. Generic a => a -> Rep a x
forall x. Con -> Rep Con x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Lit where ppGenericOverride :: forall ann. Lit -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Lit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "CharL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))
:+: C1
('MetaCons "StringL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "IntegerL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "RationalL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "IntPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer)))))
:+: ((C1
('MetaCons "WordPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "FloatPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "DoublePrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))))
:+: (C1
('MetaCons "StringPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Word8]))
:+: (C1
('MetaCons "BytesPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bytes))
:+: C1
('MetaCons "CharPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Lit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "CharL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))
:+: C1
('MetaCons "StringL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "IntegerL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "RationalL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "IntPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer)))))
:+: ((C1
('MetaCons "WordPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "FloatPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "DoublePrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))))
:+: (C1
('MetaCons "StringPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Word8]))
:+: (C1
('MetaCons "BytesPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bytes))
:+: C1
('MetaCons "CharPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Lit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "CharL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))
:+: C1
('MetaCons "StringL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "IntegerL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "RationalL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "IntPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer)))))
:+: ((C1
('MetaCons "WordPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "FloatPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "DoublePrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))))
:+: (C1
('MetaCons "StringPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Word8]))
:+: (C1
('MetaCons "BytesPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bytes))
:+: C1
('MetaCons "CharPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))))
Any
-> MetaDoc ann)
-> (Lit
-> M1
D
('MetaData
"Lit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "CharL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))
:+: C1
('MetaCons "StringL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "IntegerL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "RationalL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "IntPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer)))))
:+: ((C1
('MetaCons "WordPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "FloatPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "DoublePrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))))
:+: (C1
('MetaCons "StringPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Word8]))
:+: (C1
('MetaCons "BytesPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bytes))
:+: C1
('MetaCons "CharPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Char))))))
Any)
-> Lit
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit
-> M1
D
('MetaData
"Lit" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "CharL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))
:+: C1
('MetaCons "StringL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "IntegerL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "RationalL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "IntPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer)))))
:+: ((C1
('MetaCons "WordPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Integer))
:+: (C1
('MetaCons "FloatPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))
:+: C1
('MetaCons "DoublePrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Rational))))
:+: (C1
('MetaCons "StringPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Word8]))
:+: (C1
('MetaCons "BytesPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bytes))
:+: C1
('MetaCons "CharPrimL" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Char))))))
Any
Lit -> Rep Lit Any
forall a x. Generic a => a -> Rep a x
forall x. Lit -> Rep Lit x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Bytes where ppGenericOverride :: forall ann. Bytes -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Bytes" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bytes" 'PrefixI 'True)
(S1
('MetaSel
('Just "bytesPtr")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (ForeignPtr Word8))
:*: (S1
('MetaSel
('Just "bytesOffset")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word)
:*: S1
('MetaSel
('Just "bytesSize")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Bytes" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bytes" 'PrefixI 'True)
(S1
('MetaSel
('Just "bytesPtr")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (ForeignPtr Word8))
:*: (S1
('MetaSel
('Just "bytesOffset")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word)
:*: S1
('MetaSel
('Just "bytesSize")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Bytes" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bytes" 'PrefixI 'True)
(S1
('MetaSel
('Just "bytesPtr")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (ForeignPtr Word8))
:*: (S1
('MetaSel
('Just "bytesOffset")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word)
:*: S1
('MetaSel
('Just "bytesSize")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word))))
Any
-> MetaDoc ann)
-> (Bytes
-> M1
D
('MetaData
"Bytes" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bytes" 'PrefixI 'True)
(S1
('MetaSel
('Just "bytesPtr")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (ForeignPtr Word8))
:*: (S1
('MetaSel
('Just "bytesOffset")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word)
:*: S1
('MetaSel
('Just "bytesSize")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word))))
Any)
-> Bytes
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes
-> M1
D
('MetaData
"Bytes" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Bytes" 'PrefixI 'True)
(S1
('MetaSel
('Just "bytesPtr")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (ForeignPtr Word8))
:*: (S1
('MetaSel
('Just "bytesOffset")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word)
:*: S1
('MetaSel
('Just "bytesSize")
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Word))))
Any
Bytes -> Rep Bytes Any
forall a x. Generic a => a -> Rep a x
forall x. Bytes -> Rep Bytes x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Stmt where ppGenericOverride :: forall ann. Stmt -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Stmt" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "BindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LetS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: (C1
('MetaCons "NoBindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: (C1
('MetaCons "ParS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [[Stmt]]))
:+: C1
('MetaCons "RecS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Stmt" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "BindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LetS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: (C1
('MetaCons "NoBindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: (C1
('MetaCons "ParS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [[Stmt]]))
:+: C1
('MetaCons "RecS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Stmt" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "BindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LetS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: (C1
('MetaCons "NoBindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: (C1
('MetaCons "ParS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [[Stmt]]))
:+: C1
('MetaCons "RecS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))))
Any
-> MetaDoc ann)
-> (Stmt
-> M1
D
('MetaData
"Stmt" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "BindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LetS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: (C1
('MetaCons "NoBindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: (C1
('MetaCons "ParS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [[Stmt]]))
:+: C1
('MetaCons "RecS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))))
Any)
-> Stmt
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt
-> M1
D
('MetaData
"Stmt" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "BindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LetS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: (C1
('MetaCons "NoBindS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: (C1
('MetaCons "ParS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [[Stmt]]))
:+: C1
('MetaCons "RecS" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))))
Any
Stmt -> Rep Stmt Any
forall a x. Generic a => a -> Rep a x
forall x. Stmt -> Rep Stmt x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Guard where ppGenericOverride :: forall ann. Guard -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Guard" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NormalG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "PatG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Guard" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NormalG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "PatG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Guard" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NormalG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "PatG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))
Any
-> MetaDoc ann)
-> (Guard
-> M1
D
('MetaData
"Guard" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NormalG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "PatG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))
Any)
-> Guard
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Guard
-> M1
D
('MetaData
"Guard" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "NormalG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "PatG" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt])))
Any
Guard -> Rep Guard Any
forall a x. Generic a => a -> Rep a x
forall x. Guard -> Rep Guard x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Body where ppGenericOverride :: forall ann. Body -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Body" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "GuardedB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))
:+: C1
('MetaCons "NormalB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Body" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "GuardedB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))
:+: C1
('MetaCons "NormalB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Body" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "GuardedB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))
:+: C1
('MetaCons "NormalB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
Any
-> MetaDoc ann)
-> (Body
-> M1
D
('MetaData
"Body" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "GuardedB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))
:+: C1
('MetaCons "NormalB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
Any)
-> Body
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body
-> M1
D
('MetaData
"Body" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "GuardedB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))
:+: C1
('MetaCons "NormalB" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
Any
Body -> Rep Body Any
forall a x. Generic a => a -> Rep a x
forall x. Body -> Rep Body x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Match where ppGenericOverride :: forall ann. Match -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Match" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Match" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Match" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Match" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Match" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Match" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
Any
-> MetaDoc ann)
-> (Match
-> M1
D
('MetaData
"Match" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Match" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
Any)
-> Match
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match
-> M1
D
('MetaData
"Match" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Match" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
Any
Match -> Rep Match Any
forall a x. Generic a => a -> Rep a x
forall x. Match -> Rep Match x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Range where ppGenericOverride :: forall ann. Range -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Range" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "FromR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "FromToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Range" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "FromR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "FromToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Range" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "FromR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "FromToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
Any
-> MetaDoc ann)
-> (Range
-> M1
D
('MetaData
"Range" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "FromR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "FromToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
Any)
-> Range
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range
-> M1
D
('MetaData
"Range" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1
('MetaCons "FromR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "FromToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "FromThenToR" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
Any
Range -> Rep Range Any
forall a x. Generic a => a -> Rep a x
forall x. Range -> Rep Range x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Exp where ppGenericOverride :: forall ann. Exp -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Exp" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((((C1
('MetaCons "VarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "LitE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "AppE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))))
:+: ((C1
('MetaCons "AppTypeE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "InfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp)))))
:+: (C1
('MetaCons "UInfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "ParensE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
:+: (((C1
('MetaCons "LamE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LamCaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "LamCasesE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: C1
('MetaCons "TupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))))
:+: ((C1
('MetaCons "UnboxedTupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))
:+: C1
('MetaCons "UnboxedSumE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))
:+: (C1
('MetaCons "CondE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "MultiIfE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))))))
:+: ((((C1
('MetaCons "LetE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "CaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "DoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "MDoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))))
:+: ((C1
('MetaCons "CompE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "ArithSeqE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Range)))
:+: (C1
('MetaCons "ListE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Exp]))
:+: C1
('MetaCons "SigE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))))
:+: (((C1
('MetaCons "RecConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp]))
:+: C1
('MetaCons "RecUpdE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp])))
:+: (C1
('MetaCons "StaticE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "UnboundVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: ((C1
('MetaCons "LabelE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ImplicitParamVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "GetFieldE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ProjectionE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (NonEmpty [Char]))))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Exp" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((((C1
('MetaCons "VarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "LitE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "AppE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))))
:+: ((C1
('MetaCons "AppTypeE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "InfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp)))))
:+: (C1
('MetaCons "UInfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "ParensE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
:+: (((C1
('MetaCons "LamE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LamCaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "LamCasesE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: C1
('MetaCons "TupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))))
:+: ((C1
('MetaCons "UnboxedTupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))
:+: C1
('MetaCons "UnboxedSumE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))
:+: (C1
('MetaCons "CondE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "MultiIfE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))))))
:+: ((((C1
('MetaCons "LetE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "CaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "DoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "MDoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))))
:+: ((C1
('MetaCons "CompE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "ArithSeqE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Range)))
:+: (C1
('MetaCons "ListE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Exp]))
:+: C1
('MetaCons "SigE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))))
:+: (((C1
('MetaCons "RecConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp]))
:+: C1
('MetaCons "RecUpdE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp])))
:+: (C1
('MetaCons "StaticE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "UnboundVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: ((C1
('MetaCons "LabelE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ImplicitParamVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "GetFieldE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ProjectionE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (NonEmpty [Char]))))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Exp" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((((C1
('MetaCons "VarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "LitE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "AppE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))))
:+: ((C1
('MetaCons "AppTypeE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "InfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp)))))
:+: (C1
('MetaCons "UInfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "ParensE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
:+: (((C1
('MetaCons "LamE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LamCaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "LamCasesE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: C1
('MetaCons "TupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))))
:+: ((C1
('MetaCons "UnboxedTupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))
:+: C1
('MetaCons "UnboxedSumE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Int))))
:+: (C1
('MetaCons "CondE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "MultiIfE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))))))
:+: ((((C1
('MetaCons "LetE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "CaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "DoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "MDoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))))
:+: ((C1
('MetaCons "CompE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "ArithSeqE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Range)))
:+: (C1
('MetaCons "ListE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Exp]))
:+: C1
('MetaCons "SigE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))))
:+: (((C1
('MetaCons "RecConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp]))
:+: C1
('MetaCons "RecUpdE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp])))
:+: (C1
('MetaCons "StaticE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "UnboundVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: ((C1
('MetaCons "LabelE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ImplicitParamVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "GetFieldE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ProjectionE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (NonEmpty [Char]))))))))
Any
-> MetaDoc ann)
-> (Exp
-> M1
D
('MetaData
"Exp" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((((C1
('MetaCons "VarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "LitE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "AppE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))))
:+: ((C1
('MetaCons "AppTypeE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "InfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (Maybe Exp)))))
:+: (C1
('MetaCons "UInfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "ParensE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
:+: (((C1
('MetaCons "LamE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LamCaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "LamCasesE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: C1
('MetaCons "TupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))))
:+: ((C1
('MetaCons "UnboxedTupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))
:+: C1
('MetaCons "UnboxedSumE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Int))))
:+: (C1
('MetaCons "CondE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "MultiIfE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [(Guard, Exp)]))))))
:+: ((((C1
('MetaCons "LetE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "CaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "DoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "MDoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Stmt]))))
:+: ((C1
('MetaCons "CompE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "ArithSeqE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Range)))
:+: (C1
('MetaCons "ListE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Exp]))
:+: C1
('MetaCons "SigE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: (((C1
('MetaCons "RecConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp]))
:+: C1
('MetaCons "RecUpdE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [FieldExp])))
:+: (C1
('MetaCons "StaticE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "UnboundVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name))))
:+: ((C1
('MetaCons "LabelE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ImplicitParamVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "GetFieldE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ProjectionE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (NonEmpty [Char]))))))))
Any)
-> Exp
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp
-> M1
D
('MetaData
"Exp" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((((C1
('MetaCons "VarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "LitE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "AppE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))))
:+: ((C1
('MetaCons "AppTypeE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "InfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Exp)))))
:+: (C1
('MetaCons "UInfixE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "ParensE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))))
:+: (((C1
('MetaCons "LamE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "LamCaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "LamCasesE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: C1
('MetaCons "TupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))))
:+: ((C1
('MetaCons "UnboxedTupE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Maybe Exp]))
:+: C1
('MetaCons "UnboxedSumE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Int))))
:+: (C1
('MetaCons "CondE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))
:+: C1
('MetaCons "MultiIfE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [(Guard, Exp)]))))))
:+: ((((C1
('MetaCons "LetE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "CaseE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Match])))
:+: (C1
('MetaCons "DoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "MDoE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe ModName))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))))
:+: ((C1
('MetaCons "CompE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Stmt]))
:+: C1
('MetaCons "ArithSeqE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Range)))
:+: (C1
('MetaCons "ListE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Exp]))
:+: C1
('MetaCons "SigE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: (((C1
('MetaCons "RecConE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp]))
:+: C1
('MetaCons "RecUpdE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldExp])))
:+: (C1
('MetaCons "StaticE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp))
:+: C1
('MetaCons "UnboundVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: ((C1
('MetaCons "LabelE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ImplicitParamVarE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])))
:+: (C1
('MetaCons "GetFieldE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "ProjectionE" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (NonEmpty [Char]))))))))
Any
Exp -> Rep Exp Any
forall a x. Generic a => a -> Rep a x
forall x. Exp -> Rep Exp x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Pat where ppGenericOverride :: forall ann. Pat -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Pat" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "LitP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "VarP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "TupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: C1
('MetaCons "UnboxedTupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: ((C1
('MetaCons "UnboxedSumP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))
:+: C1
('MetaCons "ConP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: (C1
('MetaCons "InfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: C1
('MetaCons "UInfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))))))
:+: (((C1
('MetaCons "ParensP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "TildeP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: (C1
('MetaCons "BangP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "AsP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))))
:+: ((C1 ('MetaCons "WildP" 'PrefixI 'False) U1
:+: C1
('MetaCons "RecP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldPat])))
:+: (C1
('MetaCons "ListP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: (C1
('MetaCons "SigP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ViewP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat)))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Pat" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "LitP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "VarP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "TupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: C1
('MetaCons "UnboxedTupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: ((C1
('MetaCons "UnboxedSumP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))
:+: C1
('MetaCons "ConP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: (C1
('MetaCons "InfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: C1
('MetaCons "UInfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))))))
:+: (((C1
('MetaCons "ParensP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "TildeP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: (C1
('MetaCons "BangP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "AsP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))))
:+: ((C1 ('MetaCons "WildP" 'PrefixI 'False) U1
:+: C1
('MetaCons "RecP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldPat])))
:+: (C1
('MetaCons "ListP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: (C1
('MetaCons "SigP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ViewP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat)))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Pat" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "LitP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "VarP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "TupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: C1
('MetaCons "UnboxedTupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: ((C1
('MetaCons "UnboxedSumP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))
:+: C1
('MetaCons "ConP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: (C1
('MetaCons "InfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: C1
('MetaCons "UInfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))))))
:+: (((C1
('MetaCons "ParensP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "TildeP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: (C1
('MetaCons "BangP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "AsP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))))
:+: ((C1 ('MetaCons "WildP" 'PrefixI 'False) U1
:+: C1
('MetaCons "RecP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldPat])))
:+: (C1
('MetaCons "ListP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: (C1
('MetaCons "SigP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ViewP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat)))))))
Any
-> MetaDoc ann)
-> (Pat
-> M1
D
('MetaData
"Pat" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "LitP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "VarP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "TupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: C1
('MetaCons "UnboxedTupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: ((C1
('MetaCons "UnboxedSumP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))
:+: C1
('MetaCons "ConP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Pat]))))
:+: (C1
('MetaCons "InfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat)))
:+: C1
('MetaCons "UInfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat))))))
:+: (((C1
('MetaCons "ParensP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "TildeP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: (C1
('MetaCons "BangP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "AsP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat))))
:+: ((C1 ('MetaCons "WildP" 'PrefixI 'False) U1
:+: C1
('MetaCons "RecP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [FieldPat])))
:+: (C1
('MetaCons "ListP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: (C1
('MetaCons "SigP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ViewP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat)))))))
Any)
-> Pat
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat
-> M1
D
('MetaData
"Pat" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "LitP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Lit))
:+: C1
('MetaCons "VarP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "TupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: C1
('MetaCons "UnboxedTupP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: ((C1
('MetaCons "UnboxedSumP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)))
:+: C1
('MetaCons "ConP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))))
:+: (C1
('MetaCons "InfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: C1
('MetaCons "UInfixP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat))))))
:+: (((C1
('MetaCons "ParensP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "TildeP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)))
:+: (C1
('MetaCons "BangP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))
:+: C1
('MetaCons "AsP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat))))
:+: ((C1 ('MetaCons "WildP" 'PrefixI 'False) U1
:+: C1
('MetaCons "RecP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FieldPat])))
:+: (C1
('MetaCons "ListP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat]))
:+: (C1
('MetaCons "SigP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ViewP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat)))))))
Any
Pat -> Rep Pat Any
forall a x. Generic a => a -> Rep a x
forall x. Pat -> Rep Pat x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Clause where ppGenericOverride :: forall ann. Clause -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Clause" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Clause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Clause" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Clause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Clause" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Clause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
Any
-> MetaDoc ann)
-> (Clause
-> M1
D
('MetaData
"Clause" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Clause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
Any)
-> Clause
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clause
-> M1
D
('MetaData
"Clause" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Clause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Pat])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
Any
Clause -> Rep Clause Any
forall a x. Generic a => a -> Rep a x
forall x. Clause -> Rep Clause x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.DerivStrategy where ppGenericOverride :: forall ann. DerivStrategy -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"DerivStrategy"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "StockStrategy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "AnyclassStrategy" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "NewtypeStrategy" 'PrefixI 'False) U1
:+: C1
('MetaCons "ViaStrategy" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"DerivStrategy"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "StockStrategy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "AnyclassStrategy" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "NewtypeStrategy" 'PrefixI 'False) U1
:+: C1
('MetaCons "ViaStrategy" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"DerivStrategy"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "StockStrategy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "AnyclassStrategy" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "NewtypeStrategy" 'PrefixI 'False) U1
:+: C1
('MetaCons "ViaStrategy" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
-> MetaDoc ann)
-> (DerivStrategy
-> M1
D
('MetaData
"DerivStrategy"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "StockStrategy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "AnyclassStrategy" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "NewtypeStrategy" 'PrefixI 'False) U1
:+: C1
('MetaCons "ViaStrategy" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any)
-> DerivStrategy
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivStrategy
-> M1
D
('MetaData
"DerivStrategy"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
((C1 ('MetaCons "StockStrategy" 'PrefixI 'False) U1
:+: C1 ('MetaCons "AnyclassStrategy" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "NewtypeStrategy" 'PrefixI 'False) U1
:+: C1
('MetaCons "ViaStrategy" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
DerivStrategy -> Rep DerivStrategy Any
forall a x. Generic a => a -> Rep a x
forall x. DerivStrategy -> Rep DerivStrategy x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.DerivClause where ppGenericOverride :: forall ann. DerivClause -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"DerivClause"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "DerivClause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"DerivClause"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "DerivClause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"DerivClause"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "DerivClause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)))
Any
-> MetaDoc ann)
-> (DerivClause
-> M1
D
('MetaData
"DerivClause"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "DerivClause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)))
Any)
-> DerivClause
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivClause
-> M1
D
('MetaData
"DerivClause"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "DerivClause" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)))
Any
DerivClause -> Rep DerivClause Any
forall a x. Generic a => a -> Rep a x
forall x. DerivClause -> Rep DerivClause x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.FunDep where ppGenericOverride :: forall ann. FunDep -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"FunDep" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "FunDep" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"FunDep" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "FunDep" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"FunDep" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "FunDep" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
Any
-> MetaDoc ann)
-> (FunDep
-> M1
D
('MetaData
"FunDep" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "FunDep" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
Any)
-> FunDep
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDep
-> M1
D
('MetaData
"FunDep" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "FunDep" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
Any
FunDep -> Rep FunDep Any
forall a x. Generic a => a -> Rep a x
forall x. FunDep -> Rep FunDep x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Overlap where ppGenericOverride :: forall ann. Overlap -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Overlap" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "Overlappable" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Overlapping" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "Overlaps" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Incoherent" 'PrefixI 'False) U1))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Overlap" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "Overlappable" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Overlapping" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "Overlaps" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Incoherent" 'PrefixI 'False) U1))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Overlap" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "Overlappable" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Overlapping" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "Overlaps" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Incoherent" 'PrefixI 'False) U1))
Any
-> MetaDoc ann)
-> (Overlap
-> M1
D
('MetaData
"Overlap" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "Overlappable" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Overlapping" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "Overlaps" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Incoherent" 'PrefixI 'False) U1))
Any)
-> Overlap
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlap
-> M1
D
('MetaData
"Overlap" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "Overlappable" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Overlapping" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "Overlaps" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Incoherent" 'PrefixI 'False) U1))
Any
Overlap -> Rep Overlap Any
forall a x. Generic a => a -> Rep a x
forall x. Overlap -> Rep Overlap x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Callconv where ppGenericOverride :: forall ann. Callconv -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Callconv" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "CCall" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StdCall" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "CApi" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Prim" 'PrefixI 'False) U1
:+: C1 ('MetaCons "JavaScript" 'PrefixI 'False) U1)))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Callconv" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "CCall" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StdCall" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "CApi" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Prim" 'PrefixI 'False) U1
:+: C1 ('MetaCons "JavaScript" 'PrefixI 'False) U1)))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Callconv" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "CCall" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StdCall" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "CApi" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Prim" 'PrefixI 'False) U1
:+: C1 ('MetaCons "JavaScript" 'PrefixI 'False) U1)))
Any
-> MetaDoc ann)
-> (Callconv
-> M1
D
('MetaData
"Callconv" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "CCall" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StdCall" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "CApi" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Prim" 'PrefixI 'False) U1
:+: C1 ('MetaCons "JavaScript" 'PrefixI 'False) U1)))
Any)
-> Callconv
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Callconv
-> M1
D
('MetaData
"Callconv" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "CCall" 'PrefixI 'False) U1
:+: C1 ('MetaCons "StdCall" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "CApi" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Prim" 'PrefixI 'False) U1
:+: C1 ('MetaCons "JavaScript" 'PrefixI 'False) U1)))
Any
Callconv -> Rep Callconv Any
forall a x. Generic a => a -> Rep a x
forall x. Callconv -> Rep Callconv x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Safety where ppGenericOverride :: forall ann. Safety -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Safety" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unsafe" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Safe" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Interruptible" 'PrefixI 'False) U1))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Safety" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unsafe" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Safe" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Interruptible" 'PrefixI 'False) U1))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Safety" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unsafe" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Safe" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Interruptible" 'PrefixI 'False) U1))
Any
-> MetaDoc ann)
-> (Safety
-> M1
D
('MetaData
"Safety" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unsafe" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Safe" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Interruptible" 'PrefixI 'False) U1))
Any)
-> Safety
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Safety
-> M1
D
('MetaData
"Safety" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unsafe" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Safe" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Interruptible" 'PrefixI 'False) U1))
Any
Safety -> Rep Safety Any
forall a x. Generic a => a -> Rep a x
forall x. Safety -> Rep Safety x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Foreign where ppGenericOverride :: forall ann. Foreign -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Foreign" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "ImportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Safety))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: C1
('MetaCons "ExportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Foreign" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "ImportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Safety))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: C1
('MetaCons "ExportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Foreign" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "ImportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Safety))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: C1
('MetaCons "ExportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
-> MetaDoc ann)
-> (Foreign
-> M1
D
('MetaData
"Foreign" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "ImportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Safety))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: C1
('MetaCons "ExportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any)
-> Foreign
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Foreign
-> M1
D
('MetaData
"Foreign" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "ImportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Safety))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: C1
('MetaCons "ExportF" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Callconv)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
Foreign -> Rep Foreign Any
forall a x. Generic a => a -> Rep a x
forall x. Foreign -> Rep Foreign x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.FixityDirection where ppGenericOverride :: forall ann. FixityDirection -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"FixityDirection"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "InfixL" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "InfixR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InfixN" 'PrefixI 'False) U1))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"FixityDirection"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "InfixL" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "InfixR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InfixN" 'PrefixI 'False) U1))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"FixityDirection"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "InfixL" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "InfixR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InfixN" 'PrefixI 'False) U1))
Any
-> MetaDoc ann)
-> (FixityDirection
-> M1
D
('MetaData
"FixityDirection"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "InfixL" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "InfixR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InfixN" 'PrefixI 'False) U1))
Any)
-> FixityDirection
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixityDirection
-> M1
D
('MetaData
"FixityDirection"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "InfixL" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "InfixR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InfixN" 'PrefixI 'False) U1))
Any
FixityDirection -> Rep FixityDirection Any
forall a x. Generic a => a -> Rep a x
forall x. FixityDirection -> Rep FixityDirection x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Fixity where ppGenericOverride :: forall ann. Fixity -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Fixity" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Fixity" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FixityDirection)))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Fixity" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Fixity" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FixityDirection)))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Fixity" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Fixity" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FixityDirection)))
Any
-> MetaDoc ann)
-> (Fixity
-> M1
D
('MetaData
"Fixity" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Fixity" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FixityDirection)))
Any)
-> Fixity
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixity
-> M1
D
('MetaData
"Fixity" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "Fixity" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FixityDirection)))
Any
Fixity -> Rep Fixity Any
forall a x. Generic a => a -> Rep a x
forall x. Fixity -> Rep Fixity x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Inline where ppGenericOverride :: forall ann. Inline -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Inline" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "NoInline" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Inline" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Inlinable" 'PrefixI 'False) U1))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Inline" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "NoInline" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Inline" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Inlinable" 'PrefixI 'False) U1))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Inline" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "NoInline" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Inline" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Inlinable" 'PrefixI 'False) U1))
Any
-> MetaDoc ann)
-> (Inline
-> M1
D
('MetaData
"Inline" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "NoInline" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Inline" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Inlinable" 'PrefixI 'False) U1))
Any)
-> Inline
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline
-> M1
D
('MetaData
"Inline" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "NoInline" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "Inline" 'PrefixI 'False) U1
:+: C1 ('MetaCons "Inlinable" 'PrefixI 'False) U1))
Any
Inline -> Rep Inline Any
forall a x. Generic a => a -> Rep a x
forall x. Inline -> Rep Inline x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.RuleMatch where ppGenericOverride :: forall ann. RuleMatch -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"RuleMatch" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ConLike" 'PrefixI 'False) U1
:+: C1 ('MetaCons "FunLike" 'PrefixI 'False) U1)
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"RuleMatch" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ConLike" 'PrefixI 'False) U1
:+: C1 ('MetaCons "FunLike" 'PrefixI 'False) U1)
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"RuleMatch" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ConLike" 'PrefixI 'False) U1
:+: C1 ('MetaCons "FunLike" 'PrefixI 'False) U1)
Any
-> MetaDoc ann)
-> (RuleMatch
-> M1
D
('MetaData
"RuleMatch" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ConLike" 'PrefixI 'False) U1
:+: C1 ('MetaCons "FunLike" 'PrefixI 'False) U1)
Any)
-> RuleMatch
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleMatch
-> M1
D
('MetaData
"RuleMatch" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ConLike" 'PrefixI 'False) U1
:+: C1 ('MetaCons "FunLike" 'PrefixI 'False) U1)
Any
RuleMatch -> Rep RuleMatch Any
forall a x. Generic a => a -> Rep a x
forall x. RuleMatch -> Rep RuleMatch x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Phases where ppGenericOverride :: forall ann. Phases -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Phases" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "AllPhases" 'PrefixI 'False) U1
:+: (C1
('MetaCons "FromPhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1
('MetaCons "BeforePhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Phases" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "AllPhases" 'PrefixI 'False) U1
:+: (C1
('MetaCons "FromPhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1
('MetaCons "BeforePhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Phases" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "AllPhases" 'PrefixI 'False) U1
:+: (C1
('MetaCons "FromPhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1
('MetaCons "BeforePhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))
Any
-> MetaDoc ann)
-> (Phases
-> M1
D
('MetaData
"Phases" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "AllPhases" 'PrefixI 'False) U1
:+: (C1
('MetaCons "FromPhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1
('MetaCons "BeforePhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))
Any)
-> Phases
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phases
-> M1
D
('MetaData
"Phases" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "AllPhases" 'PrefixI 'False) U1
:+: (C1
('MetaCons "FromPhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))
:+: C1
('MetaCons "BeforePhase" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int))))
Any
Phases -> Rep Phases Any
forall a x. Generic a => a -> Rep a x
forall x. Phases -> Rep Phases x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.RuleBndr where ppGenericOverride :: forall ann. RuleBndr -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"RuleBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "RuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "TypedRuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"RuleBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "RuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "TypedRuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"RuleBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "RuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "TypedRuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
Any
-> MetaDoc ann)
-> (RuleBndr
-> M1
D
('MetaData
"RuleBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "RuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "TypedRuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
Any)
-> RuleBndr
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleBndr
-> M1
D
('MetaData
"RuleBndr" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "RuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "TypedRuleVar" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
Any
RuleBndr -> Rep RuleBndr Any
forall a x. Generic a => a -> Rep a x
forall x. RuleBndr -> Rep RuleBndr x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.AnnTarget where ppGenericOverride :: forall ann. AnnTarget -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"AnnTarget" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ModuleAnnotation" 'PrefixI 'False) U1
:+: (C1
('MetaCons "TypeAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ValueAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"AnnTarget" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ModuleAnnotation" 'PrefixI 'False) U1
:+: (C1
('MetaCons "TypeAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ValueAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"AnnTarget" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ModuleAnnotation" 'PrefixI 'False) U1
:+: (C1
('MetaCons "TypeAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ValueAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
Any
-> MetaDoc ann)
-> (AnnTarget
-> M1
D
('MetaData
"AnnTarget" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ModuleAnnotation" 'PrefixI 'False) U1
:+: (C1
('MetaCons "TypeAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ValueAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
Any)
-> AnnTarget
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnTarget
-> M1
D
('MetaData
"AnnTarget" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "ModuleAnnotation" 'PrefixI 'False) U1
:+: (C1
('MetaCons "TypeAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "ValueAnnotation" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
Any
AnnTarget -> Rep AnnTarget Any
forall a x. Generic a => a -> Rep a x
forall x. AnnTarget -> Rep AnnTarget x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Pragma where ppGenericOverride :: forall ann. Pragma -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Pragma" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "InlineP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Inline))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 RuleMatch)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "OpaqueP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "SpecialiseP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Inline))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "SpecialiseInstP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "RuleP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [RuleBndr])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases))))
:+: C1
('MetaCons "AnnP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 AnnTarget)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "LineP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CompleteP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Name))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Pragma" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "InlineP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Inline))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 RuleMatch)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "OpaqueP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "SpecialiseP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Inline))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "SpecialiseInstP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "RuleP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [RuleBndr])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases))))
:+: C1
('MetaCons "AnnP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 AnnTarget)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "LineP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CompleteP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Name))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Pragma" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "InlineP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Inline))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 RuleMatch)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "OpaqueP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "SpecialiseP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Inline))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "SpecialiseInstP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "RuleP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [RuleBndr])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases))))
:+: C1
('MetaCons "AnnP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 AnnTarget)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "LineP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CompleteP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Name))))))
Any
-> MetaDoc ann)
-> (Pragma
-> M1
D
('MetaData
"Pragma" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "InlineP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Inline))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 RuleMatch)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "OpaqueP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "SpecialiseP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Inline))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "SpecialiseInstP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "RuleP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [RuleBndr])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Phases))))
:+: C1
('MetaCons "AnnP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 AnnTarget)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "LineP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CompleteP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Name))))))
Any)
-> Pragma
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pragma
-> M1
D
('MetaData
"Pragma" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "InlineP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Inline))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 RuleMatch)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "OpaqueP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)))
:+: (C1
('MetaCons "SpecialiseP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Inline))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases)))
:+: C1
('MetaCons "SpecialiseInstP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "RuleP" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [RuleBndr])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Phases))))
:+: C1
('MetaCons "AnnP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 AnnTarget)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Exp)))
:+: (C1
('MetaCons "LineP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char]))
:+: C1
('MetaCons "CompleteP" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Name))))))
Any
Pragma -> Rep Pragma Any
forall a x. Generic a => a -> Rep a x
forall x. Pragma -> Rep Pragma x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.TySynEqn where ppGenericOverride :: forall ann. TySynEqn -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"TySynEqn" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "TySynEqn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"TySynEqn" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "TySynEqn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"TySynEqn" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "TySynEqn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
-> MetaDoc ann)
-> (TySynEqn
-> M1
D
('MetaData
"TySynEqn" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "TySynEqn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any)
-> TySynEqn
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TySynEqn
-> M1
D
('MetaData
"TySynEqn" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1
('MetaCons "TySynEqn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
Any
TySynEqn -> Rep TySynEqn Any
forall a x. Generic a => a -> Rep a x
forall x. TySynEqn -> Rep TySynEqn x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.FamilyResultSig where ppGenericOverride :: forall ann. FamilyResultSig -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"FamilyResultSig"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSig" 'PrefixI 'False) U1
:+: (C1
('MetaCons "KindSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TyVarSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (TyVarBndr ())))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"FamilyResultSig"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSig" 'PrefixI 'False) U1
:+: (C1
('MetaCons "KindSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TyVarSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (TyVarBndr ())))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"FamilyResultSig"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSig" 'PrefixI 'False) U1
:+: (C1
('MetaCons "KindSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TyVarSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (TyVarBndr ())))))
Any
-> MetaDoc ann)
-> (FamilyResultSig
-> M1
D
('MetaData
"FamilyResultSig"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSig" 'PrefixI 'False) U1
:+: (C1
('MetaCons "KindSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TyVarSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (TyVarBndr ())))))
Any)
-> FamilyResultSig
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamilyResultSig
-> M1
D
('MetaData
"FamilyResultSig"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "NoSig" 'PrefixI 'False) U1
:+: (C1
('MetaCons "KindSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "TyVarSig" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (TyVarBndr ())))))
Any
FamilyResultSig -> Rep FamilyResultSig Any
forall a x. Generic a => a -> Rep a x
forall x. FamilyResultSig -> Rep FamilyResultSig x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.InjectivityAnn where ppGenericOverride :: forall ann. InjectivityAnn -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"InjectivityAnn"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "InjectivityAnn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"InjectivityAnn"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "InjectivityAnn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"InjectivityAnn"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "InjectivityAnn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
Any
-> MetaDoc ann)
-> (InjectivityAnn
-> M1
D
('MetaData
"InjectivityAnn"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "InjectivityAnn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
Any)
-> InjectivityAnn
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InjectivityAnn
-> M1
D
('MetaData
"InjectivityAnn"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "InjectivityAnn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name])))
Any
InjectivityAnn -> Rep InjectivityAnn Any
forall a x. Generic a => a -> Rep a x
forall x. InjectivityAnn -> Rep InjectivityAnn x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.TypeFamilyHead where ppGenericOverride :: forall ann. TypeFamilyHead -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"TypeFamilyHead"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "TypeFamilyHead" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FamilyResultSig)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe InjectivityAnn)))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"TypeFamilyHead"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "TypeFamilyHead" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FamilyResultSig)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe InjectivityAnn)))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"TypeFamilyHead"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "TypeFamilyHead" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FamilyResultSig)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe InjectivityAnn)))))
Any
-> MetaDoc ann)
-> (TypeFamilyHead
-> M1
D
('MetaData
"TypeFamilyHead"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "TypeFamilyHead" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FamilyResultSig)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe InjectivityAnn)))))
Any)
-> TypeFamilyHead
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeFamilyHead
-> M1
D
('MetaData
"TypeFamilyHead"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "TypeFamilyHead" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 FamilyResultSig)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe InjectivityAnn)))))
Any
TypeFamilyHead -> Rep TypeFamilyHead Any
forall a x. Generic a => a -> Rep a x
forall x. TypeFamilyHead -> Rep TypeFamilyHead x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Role where ppGenericOverride :: forall ann. Role -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Role" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "NominalR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "RepresentationalR" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "PhantomR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferR" 'PrefixI 'False) U1))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Role" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "NominalR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "RepresentationalR" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "PhantomR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferR" 'PrefixI 'False) U1))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Role" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "NominalR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "RepresentationalR" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "PhantomR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferR" 'PrefixI 'False) U1))
Any
-> MetaDoc ann)
-> (Role
-> M1
D
('MetaData
"Role" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "NominalR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "RepresentationalR" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "PhantomR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferR" 'PrefixI 'False) U1))
Any)
-> Role
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role
-> M1
D
('MetaData
"Role" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((C1 ('MetaCons "NominalR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "RepresentationalR" 'PrefixI 'False) U1)
:+: (C1 ('MetaCons "PhantomR" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferR" 'PrefixI 'False) U1))
Any
Role -> Rep Role Any
forall a x. Generic a => a -> Rep a x
forall x. Role -> Rep Role x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.PatSynArgs where ppGenericOverride :: forall ann. PatSynArgs -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"PatSynArgs"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "PrefixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))
:+: (C1
('MetaCons "InfixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "RecordPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"PatSynArgs"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "PrefixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))
:+: (C1
('MetaCons "InfixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "RecordPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"PatSynArgs"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "PrefixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))
:+: (C1
('MetaCons "InfixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "RecordPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))))
Any
-> MetaDoc ann)
-> (PatSynArgs
-> M1
D
('MetaData
"PatSynArgs"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "PrefixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))
:+: (C1
('MetaCons "InfixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "RecordPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))))
Any)
-> PatSynArgs
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatSynArgs
-> M1
D
('MetaData
"PatSynArgs"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1
('MetaCons "PrefixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))
:+: (C1
('MetaCons "InfixPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "RecordPatSyn" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Name]))))
Any
PatSynArgs -> Rep PatSynArgs Any
forall a x. Generic a => a -> Rep a x
forall x. PatSynArgs -> Rep PatSynArgs x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.PatSynDir where ppGenericOverride :: forall ann. PatSynDir -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"PatSynDir" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unidir" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "ImplBidir" 'PrefixI 'False) U1
:+: C1
('MetaCons "ExplBidir" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"PatSynDir" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unidir" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "ImplBidir" 'PrefixI 'False) U1
:+: C1
('MetaCons "ExplBidir" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"PatSynDir" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unidir" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "ImplBidir" 'PrefixI 'False) U1
:+: C1
('MetaCons "ExplBidir" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))))
Any
-> MetaDoc ann)
-> (PatSynDir
-> M1
D
('MetaData
"PatSynDir" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unidir" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "ImplBidir" 'PrefixI 'False) U1
:+: C1
('MetaCons "ExplBidir" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))))
Any)
-> PatSynDir
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatSynDir
-> M1
D
('MetaData
"PatSynDir" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(C1 ('MetaCons "Unidir" 'PrefixI 'False) U1
:+: (C1 ('MetaCons "ImplBidir" 'PrefixI 'False) U1
:+: C1
('MetaCons "ExplBidir" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))))
Any
PatSynDir -> Rep PatSynDir Any
forall a x. Generic a => a -> Rep a x
forall x. PatSynDir -> Rep PatSynDir x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Dec where ppGenericOverride :: forall ann. Dec -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Dec" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "FunD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: (C1
('MetaCons "ValD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "DataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TypeDataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Con])))
:+: C1
('MetaCons "TySynD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))))
:+: ((C1
('MetaCons "ClassD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FunDep])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: (C1
('MetaCons "InstanceD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Overlap))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "SigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "KiSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ForeignD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Foreign)))
:+: (C1
('MetaCons "InfixD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Fixity)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "DefaultD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))))))
:+: (((C1
('MetaCons "PragmaD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pragma))
:+: (C1
('MetaCons "DataFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))))
:+: C1
('MetaCons "DataInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TySynInstD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TySynEqn))
:+: C1
('MetaCons "OpenTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)))))
:+: ((C1
('MetaCons "ClosedTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TySynEqn]))
:+: (C1
('MetaCons "RoleAnnotD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Role]))
:+: C1
('MetaCons "StandaloneDerivD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "DefaultSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "PatSynD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 PatSynArgs))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 PatSynDir)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat))))
:+: (C1
('MetaCons "PatSynSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ImplicitParamBindD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Dec" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "FunD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: (C1
('MetaCons "ValD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "DataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TypeDataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Con])))
:+: C1
('MetaCons "TySynD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))))
:+: ((C1
('MetaCons "ClassD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FunDep])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: (C1
('MetaCons "InstanceD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Overlap))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "SigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "KiSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ForeignD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Foreign)))
:+: (C1
('MetaCons "InfixD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Fixity)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "DefaultD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))))))
:+: (((C1
('MetaCons "PragmaD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pragma))
:+: (C1
('MetaCons "DataFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))))
:+: C1
('MetaCons "DataInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TySynInstD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TySynEqn))
:+: C1
('MetaCons "OpenTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)))))
:+: ((C1
('MetaCons "ClosedTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TySynEqn]))
:+: (C1
('MetaCons "RoleAnnotD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Role]))
:+: C1
('MetaCons "StandaloneDerivD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "DefaultSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "PatSynD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 PatSynArgs))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 PatSynDir)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat))))
:+: (C1
('MetaCons "PatSynSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ImplicitParamBindD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Dec" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "FunD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: (C1
('MetaCons "ValD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "DataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TypeDataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Con])))
:+: C1
('MetaCons "TySynD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))))
:+: ((C1
('MetaCons "ClassD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FunDep])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: (C1
('MetaCons "InstanceD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Overlap))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "SigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "KiSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ForeignD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Foreign)))
:+: (C1
('MetaCons "InfixD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Fixity)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "DefaultD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))))))
:+: (((C1
('MetaCons "PragmaD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pragma))
:+: (C1
('MetaCons "DataFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))))
:+: C1
('MetaCons "DataInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TySynInstD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TySynEqn))
:+: C1
('MetaCons "OpenTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)))))
:+: ((C1
('MetaCons "ClosedTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TySynEqn]))
:+: (C1
('MetaCons "RoleAnnotD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Role]))
:+: C1
('MetaCons "StandaloneDerivD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "DefaultSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "PatSynD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 PatSynArgs))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 PatSynDir)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat))))
:+: (C1
('MetaCons "PatSynSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ImplicitParamBindD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))))))
Any
-> MetaDoc ann)
-> (Dec
-> M1
D
('MetaData
"Dec" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "FunD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: (C1
('MetaCons "ValD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "DataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TypeDataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Con])))
:+: C1
('MetaCons "TySynD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))))
:+: ((C1
('MetaCons "ClassD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FunDep])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Dec]))))
:+: (C1
('MetaCons "InstanceD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Overlap))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "SigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "KiSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ForeignD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Foreign)))
:+: (C1
('MetaCons "InfixD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Fixity)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "DefaultD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Cxt))))))
:+: (((C1
('MetaCons "PragmaD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pragma))
:+: (C1
('MetaCons "DataFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (Maybe Kind))))
:+: C1
('MetaCons "DataInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TySynInstD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TySynEqn))
:+: C1
('MetaCons "OpenTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 TypeFamilyHead)))))
:+: ((C1
('MetaCons "ClosedTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TySynEqn]))
:+: (C1
('MetaCons "RoleAnnotD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Role]))
:+: C1
('MetaCons "StandaloneDerivD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "DefaultSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "PatSynD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 PatSynArgs))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 PatSynDir)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat))))
:+: (C1
('MetaCons "PatSynSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ImplicitParamBindD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))))))
Any)
-> Dec
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec
-> M1
D
('MetaData
"Dec" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
((((C1
('MetaCons "FunD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Clause]))
:+: (C1
('MetaCons "ValD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pat)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Body)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "DataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TypeDataD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()]))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Con])))
:+: C1
('MetaCons "TySynD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))))
:+: ((C1
('MetaCons "ClassD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [FunDep])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: (C1
('MetaCons "InstanceD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Overlap))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec])))
:+: C1
('MetaCons "SigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))
:+: ((C1
('MetaCons "KiSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ForeignD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Foreign)))
:+: (C1
('MetaCons "InfixD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Fixity)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))
:+: C1
('MetaCons "DefaultD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt))))))
:+: (((C1
('MetaCons "PragmaD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Pragma))
:+: (C1
('MetaCons "DataFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TyVarBndr ()])
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))))
:+: C1
('MetaCons "DataInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Con])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))))
:+: (C1
('MetaCons "NewtypeInstD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Cxt)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe [TyVarBndr ()]))
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Kind))
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Con)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [DerivClause]))))
:+: (C1
('MetaCons "TySynInstD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TySynEqn))
:+: C1
('MetaCons "OpenTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)))))
:+: ((C1
('MetaCons "ClosedTypeFamilyD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 TypeFamilyHead)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [TySynEqn]))
:+: (C1
('MetaCons "RoleAnnotD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Role]))
:+: C1
('MetaCons "StandaloneDerivD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe DerivStrategy))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Cxt)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)))))
:+: ((C1
('MetaCons "DefaultSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "PatSynD" 'PrefixI 'False)
((S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 PatSynArgs))
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 PatSynDir)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Pat))))
:+: (C1
('MetaCons "PatSynSigD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))
:+: C1
('MetaCons "ImplicitParamBindD" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 [Char])
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Exp)))))))
Any
Dec -> Rep Dec Any
forall a x. Generic a => a -> Rep a x
forall x. Dec -> Rep Dec x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Info where ppGenericOverride :: forall ann. Info -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Info" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "ClassI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))
:+: C1
('MetaCons "ClassOpI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "TyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec))
:+: C1
('MetaCons "FamilyI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: ((C1
('MetaCons "PrimTyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bool)))
:+: C1
('MetaCons "DataConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "PatSynI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: (C1
('MetaCons "VarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Dec))))
:+: C1
('MetaCons "TyVarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Info" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "ClassI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))
:+: C1
('MetaCons "ClassOpI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "TyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec))
:+: C1
('MetaCons "FamilyI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: ((C1
('MetaCons "PrimTyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bool)))
:+: C1
('MetaCons "DataConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "PatSynI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: (C1
('MetaCons "VarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Dec))))
:+: C1
('MetaCons "TyVarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Info" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "ClassI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))
:+: C1
('MetaCons "ClassOpI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "TyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec))
:+: C1
('MetaCons "FamilyI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: ((C1
('MetaCons "PrimTyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bool)))
:+: C1
('MetaCons "DataConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "PatSynI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: (C1
('MetaCons "VarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (Maybe Dec))))
:+: C1
('MetaCons "TyVarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))))))
Any
-> MetaDoc ann)
-> (Info
-> M1
D
('MetaData
"Info" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "ClassI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))
:+: C1
('MetaCons "ClassOpI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "TyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec))
:+: C1
('MetaCons "FamilyI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: ((C1
('MetaCons "PrimTyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bool)))
:+: C1
('MetaCons "DataConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "PatSynI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: (C1
('MetaCons "VarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (Maybe Dec))))
:+: C1
('MetaCons "TyVarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))))
Any)
-> Info
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info
-> M1
D
('MetaData
"Info" "Language.Haskell.TH.Syntax" "template-haskell" 'False)
(((C1
('MetaCons "ClassI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))
:+: C1
('MetaCons "ClassOpI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "TyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec))
:+: C1
('MetaCons "FamilyI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Dec)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 [Dec]))))
:+: ((C1
('MetaCons "PrimTyConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bool)))
:+: C1
('MetaCons "DataConI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name))))
:+: (C1
('MetaCons "PatSynI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind))
:+: (C1
('MetaCons "VarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Kind)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 (Maybe Dec))))
:+: C1
('MetaCons "TyVarI" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Name)
:*: S1
('MetaSel
'Nothing
'NoSourceUnpackedness
'NoSourceStrictness
'DecidedLazy)
(Rec0 Kind))))))
Any
Info -> Rep Info Any
forall a x. Generic a => a -> Rep a x
forall x. Info -> Rep Info x
from
instance {-# OVERLAPS #-} PPGenericOverride TH.Specificity where ppGenericOverride :: forall ann. Specificity -> MetaDoc ann
ppGenericOverride = M1
D
('MetaData
"Specificity"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "SpecifiedSpec" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferredSpec" 'PrefixI 'False) U1)
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData
"Specificity"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "SpecifiedSpec" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferredSpec" 'PrefixI 'False) U1)
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData
"Specificity"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "SpecifiedSpec" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferredSpec" 'PrefixI 'False) U1)
Any
-> MetaDoc ann)
-> (Specificity
-> M1
D
('MetaData
"Specificity"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "SpecifiedSpec" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferredSpec" 'PrefixI 'False) U1)
Any)
-> Specificity
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specificity
-> M1
D
('MetaData
"Specificity"
"Language.Haskell.TH.Syntax"
"template-haskell"
'False)
(C1 ('MetaCons "SpecifiedSpec" 'PrefixI 'False) U1
:+: C1 ('MetaCons "InferredSpec" 'PrefixI 'False) U1)
Any
Specificity -> Rep Specificity Any
forall a x. Generic a => a -> Rep a x
forall x. Specificity -> Rep Specificity x
from
#if MIN_VERSION_template_haskell(2, 21, 0)
instance {-# OVERLAPS #-} PPGenericOverride TH.BndrVis where ppGenericOverride = gpretty . from
#endif
#if MIN_VERSION_template_haskell(2, 22, 0)
instance {-# OVERLAPS #-} PPGenericOverride TH.NamespaceSpecifier where ppGenericOverride = gpretty . from
#endif
instance {-# OVERLAPS #-}
( PPGenericOverride a
, PPGenericOverride b
) => PPGenericOverride (a, b) where
ppGenericOverride :: forall ann. (a, b) -> MetaDoc ann
ppGenericOverride (a
a, b
b) = Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann) -> Doc ann -> MetaDoc ann
forall a b. (a -> b) -> a -> b
$ (PPGenericOverrideToPretty a, PPGenericOverrideToPretty b)
-> Doc ann
forall ann.
(PPGenericOverrideToPretty a, PPGenericOverrideToPretty b)
-> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
( a -> PPGenericOverrideToPretty a
forall a. a -> PPGenericOverrideToPretty a
PPGenericOverrideToPretty a
a
, b -> PPGenericOverrideToPretty b
forall a. a -> PPGenericOverrideToPretty a
PPGenericOverrideToPretty b
b
)
instance {-# OVERLAPS #-}
( PPGenericOverride a
, PPGenericOverride b
, PPGenericOverride c
) => PPGenericOverride (a, b, c) where
ppGenericOverride :: forall ann. (a, b, c) -> MetaDoc ann
ppGenericOverride (a
a, b
b, c
c) = Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann) -> Doc ann -> MetaDoc ann
forall a b. (a -> b) -> a -> b
$ (PPGenericOverrideToPretty a, PPGenericOverrideToPretty b,
PPGenericOverrideToPretty c)
-> Doc ann
forall ann.
(PPGenericOverrideToPretty a, PPGenericOverrideToPretty b,
PPGenericOverrideToPretty c)
-> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
( a -> PPGenericOverrideToPretty a
forall a. a -> PPGenericOverrideToPretty a
PPGenericOverrideToPretty a
a
, b -> PPGenericOverrideToPretty b
forall a. a -> PPGenericOverrideToPretty a
PPGenericOverrideToPretty b
b
, c -> PPGenericOverrideToPretty c
forall a. a -> PPGenericOverrideToPretty a
PPGenericOverrideToPretty c
c
)
instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (Maybe v) where
ppGenericOverride :: forall ann. Maybe v -> MetaDoc ann
ppGenericOverride =
M1
D
('MetaData "Maybe" "GHC.Maybe" "base" 'False)
(C1 ('MetaCons "Nothing" 'PrefixI 'False) U1
:+: C1
('MetaCons "Just" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (PPGenericOverrideToPretty v))))
Any
-> MetaDoc ann
forall ix ann.
M1
D
('MetaData "Maybe" "GHC.Maybe" "base" 'False)
(C1 ('MetaCons "Nothing" 'PrefixI 'False) U1
:+: C1
('MetaCons "Just" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (PPGenericOverrideToPretty v))))
ix
-> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (M1
D
('MetaData "Maybe" "GHC.Maybe" "base" 'False)
(C1 ('MetaCons "Nothing" 'PrefixI 'False) U1
:+: C1
('MetaCons "Just" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (PPGenericOverrideToPretty v))))
Any
-> MetaDoc ann)
-> (Maybe v
-> M1
D
('MetaData "Maybe" "GHC.Maybe" "base" 'False)
(C1 ('MetaCons "Nothing" 'PrefixI 'False) U1
:+: C1
('MetaCons "Just" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (PPGenericOverrideToPretty v))))
Any)
-> Maybe v
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (PPGenericOverrideToPretty v)
-> M1
D
('MetaData "Maybe" "GHC.Maybe" "base" 'False)
(C1 ('MetaCons "Nothing" 'PrefixI 'False) U1
:+: C1
('MetaCons "Just" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (PPGenericOverrideToPretty v))))
Any
Maybe (PPGenericOverrideToPretty v)
-> Rep (Maybe (PPGenericOverrideToPretty v)) Any
forall a x. Generic a => a -> Rep a x
forall x.
Maybe (PPGenericOverrideToPretty v)
-> Rep (Maybe (PPGenericOverrideToPretty v)) x
from (Maybe (PPGenericOverrideToPretty v)
-> M1
D
('MetaData "Maybe" "GHC.Maybe" "base" 'False)
(C1 ('MetaCons "Nothing" 'PrefixI 'False) U1
:+: C1
('MetaCons "Just" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (PPGenericOverrideToPretty v))))
Any)
-> (Maybe v -> Maybe (PPGenericOverrideToPretty v))
-> Maybe v
-> M1
D
('MetaData "Maybe" "GHC.Maybe" "base" 'False)
(C1 ('MetaCons "Nothing" 'PrefixI 'False) U1
:+: C1
('MetaCons "Just" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 (PPGenericOverrideToPretty v))))
Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> PPGenericOverrideToPretty v)
-> Maybe v -> Maybe (PPGenericOverrideToPretty v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> PPGenericOverrideToPretty v
forall a. a -> PPGenericOverrideToPretty a
PPGenericOverrideToPretty
instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride [v] where
ppGenericOverride :: forall ann. [v] -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann) -> ([v] -> Doc ann) -> [v] -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Doc ann) -> [v] -> Doc ann
forall a ann. (a -> Doc ann) -> [a] -> Doc ann
ppListWith v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} (PPGenericOverride k, PPGenericOverride v) => PPGenericOverride [(k, v)] where
ppGenericOverride :: forall ann. [(k, v)] -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> ([(k, v)] -> Doc ann) -> [(k, v)] -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Doc ann) -> (v -> Doc ann) -> [(k, v)] -> Doc ann
forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> [(k, v)] -> Doc ann
ppAssocListWith k -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} PPGenericOverride k => PPGenericOverride (NonEmpty k) where
ppGenericOverride :: forall ann. NonEmpty k -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (NonEmpty k -> Doc ann) -> NonEmpty k -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Doc ann) -> NonEmpty k -> Doc ann
forall a ann. (a -> Doc ann) -> NonEmpty a -> Doc ann
ppNEWith k -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (Vector v) where
ppGenericOverride :: forall ann. Vector v -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (Vector v -> Doc ann) -> Vector v -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Doc ann) -> Vector v -> Doc ann
forall (v :: * -> *) a ann.
Vector v a =>
(a -> Doc ann) -> v a -> Doc ann
ppVectorWith v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} (PPGenericOverride k, PPGenericOverride v) => PPGenericOverride (Map k v) where
ppGenericOverride :: forall ann. Map k v -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (Map k v -> Doc ann) -> Map k v -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Doc ann) -> (v -> Doc ann) -> Map k v -> Doc ann
forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> Map k v -> Doc ann
ppMapWith k -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (Set v) where
ppGenericOverride :: forall ann. Set v -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (Set v -> Doc ann) -> Set v -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Doc ann) -> Set v -> Doc ann
forall a ann. (a -> Doc ann) -> Set a -> Doc ann
ppSetWith v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} (PPGenericOverride k, PPGenericOverride v) => PPGenericOverride (Bimap k v) where
ppGenericOverride :: forall ann. Bimap k v -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (Bimap k v -> Doc ann) -> Bimap k v -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Doc ann) -> (v -> Doc ann) -> Bimap k v -> Doc ann
forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> Bimap k v -> Doc ann
ppBimapWith k -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} PPGenericOverride IntSet where
ppGenericOverride :: forall ann. IntSet -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (IntSet -> Doc ann) -> IntSet -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc ann) -> IntSet -> Doc ann
forall ann. (Int -> Doc ann) -> IntSet -> Doc ann
ppIntSetWith Int -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (IntMap v) where
ppGenericOverride :: forall ann. IntMap v -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (IntMap v -> Doc ann) -> IntMap v -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc ann) -> (v -> Doc ann) -> IntMap v -> Doc ann
forall ann a.
(Int -> Doc ann) -> (a -> Doc ann) -> IntMap a -> Doc ann
ppIntMapWith Int -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
#ifdef HAVE_ENUMMAPSET
instance {-# OVERLAPS #-} (Enum a, PPGenericOverride a) => PPGenericOverride (EnumSet a) where
ppGenericOverride :: forall ann. EnumSet a -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (EnumSet a -> Doc ann) -> EnumSet a -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc ann) -> EnumSet a -> Doc ann
forall a ann. Enum a => (a -> Doc ann) -> EnumSet a -> Doc ann
ppEnumSetWith a -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} (Enum k, PPGenericOverride k, PPGenericOverride v) => PPGenericOverride (EnumMap k v ) where
ppGenericOverride :: forall ann. EnumMap k v -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (EnumMap k v -> Doc ann) -> EnumMap k v -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Doc ann) -> (v -> Doc ann) -> EnumMap k v -> Doc ann
forall k ann v.
Enum k =>
(k -> Doc ann) -> (v -> Doc ann) -> EnumMap k v -> Doc ann
ppEnumMapWith k -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
#endif
instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (HashSet v) where
ppGenericOverride :: forall ann. HashSet v -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (HashSet v -> Doc ann) -> HashSet v -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Doc ann) -> HashSet v -> Doc ann
forall a ann. (a -> Doc ann) -> HashSet a -> Doc ann
ppHashSetWith v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} (PPGenericOverride k, PPGenericOverride v) => PPGenericOverride (HashMap k v) where
ppGenericOverride :: forall ann. HashMap k v -> MetaDoc ann
ppGenericOverride =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann)
-> (HashMap k v -> Doc ann) -> HashMap k v -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Doc ann) -> (v -> Doc ann) -> HashMap k v -> Doc ann
forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> HashMap k v -> Doc ann
ppHashMapWith k -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc v -> Doc ann
forall a ann. PPGenericOverride a => a -> Doc ann
ppGenericOverrideDoc
instance {-# OVERLAPS #-} PPGenericOverride (f (g a)) => PPGenericOverride (Compose f g a) where
ppGenericOverride :: forall ann. Compose f g a -> MetaDoc ann
ppGenericOverride =
f (g a) -> MetaDoc ann
forall ann. f (g a) -> MetaDoc ann
forall a ann. PPGenericOverride a => a -> MetaDoc ann
ppGenericOverride (f (g a) -> MetaDoc ann)
-> (Compose f g a -> f (g a)) -> Compose f g a -> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
instance (GPretty f, GPretty g) => GPretty (f :*: g) where
gpretty :: forall ix ann. (:*:) f g ix -> MetaDoc ann
gpretty (f ix
x :*: g ix
y) =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc (Doc ann -> MetaDoc ann) -> Doc ann -> MetaDoc ann
forall a b. (a -> b) -> a -> b
$ MetaDoc ann -> Doc ann
forall ann. MetaDoc ann -> Doc ann
mdPayload MetaDoc ann
x' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MetaDoc ann -> Doc ann
forall ann. MetaDoc ann -> Doc ann
mdPayload MetaDoc ann
y'
where
x' :: MetaDoc ann
x' = f ix -> MetaDoc ann
forall ix ann. f ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty f ix
x
y' :: MetaDoc ann
y' = g ix -> MetaDoc ann
forall ix ann. g ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty g ix
y
instance GPretty x => GPretty (M1 D ('MetaData a b c d) x) where
gpretty :: forall ix ann. M1 D ('MetaData a b c d) x ix -> MetaDoc ann
gpretty = x ix -> MetaDoc ann
forall ix ann. x ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (x ix -> MetaDoc ann)
-> (M1 D ('MetaData a b c d) x ix -> x ix)
-> M1 D ('MetaData a b c d) x ix
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 D ('MetaData a b c d) x ix -> x ix
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance GPretty x => GPretty (M1 S ('MetaSel 'Nothing b c d) x) where
gpretty :: forall ix ann. M1 S ('MetaSel 'Nothing b c d) x ix -> MetaDoc ann
gpretty = x ix -> MetaDoc ann
forall ix ann. x ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (x ix -> MetaDoc ann)
-> (M1 S ('MetaSel 'Nothing b c d) x ix -> x ix)
-> M1 S ('MetaSel 'Nothing b c d) x ix
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S ('MetaSel 'Nothing b c d) x ix -> x ix
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance (KnownSymbol name, GFields x) => GPretty (M1 C ('MetaCons name _fixity 'False) x) where
gpretty :: forall ix ann.
M1 C ('MetaCons name _fixity 'False) x ix -> MetaDoc ann
gpretty (M1 x ix
x) =
MetaDoc ann -> [MetaDoc ann] -> MetaDoc ann
forall ann. MetaDoc ann -> [MetaDoc ann] -> MetaDoc ann
constructorAppMetaDoc MetaDoc ann
forall ann. MetaDoc ann
constructor [MetaDoc ann]
forall ann. [MetaDoc ann]
args
where
constructor :: MetaDoc ann
constructor :: forall ann. MetaDoc ann
constructor = Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc (Doc ann -> MetaDoc ann) -> Doc ann -> MetaDoc ann
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> [Char] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy name -> [Char]) -> Proxy name -> [Char]
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name
args :: [MetaDoc ann]
args :: forall ann. [MetaDoc ann]
args = DList (MetaDoc ann) -> [MetaDoc ann]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (DList (MetaDoc ann) -> [MetaDoc ann])
-> DList (MetaDoc ann) -> [MetaDoc ann]
forall a b. (a -> b) -> a -> b
$ x ix -> DList (MetaDoc ann)
forall ix ann. x ix -> DList (MetaDoc ann)
forall {k} (a :: k -> *) (ix :: k) ann.
GFields a =>
a ix -> DList (MetaDoc ann)
gfields x ix
x
class GFields a where
gfields :: a ix -> DList (MetaDoc ann)
instance GFields U1 where
{-# INLINE gfields #-}
gfields :: forall (ix :: k) ann. U1 ix -> DList (MetaDoc ann)
gfields = DList (MetaDoc ann) -> U1 ix -> DList (MetaDoc ann)
forall a b. a -> b -> a
const DList (MetaDoc ann)
forall a. Monoid a => a
mempty
instance GPretty x => GFields (M1 S ('MetaSel a b c d) x) where
{-# INLINABLE gfields #-}
gfields :: forall ix ann. M1 S ('MetaSel a b c d) x ix -> DList (MetaDoc ann)
gfields = MetaDoc ann -> DList (MetaDoc ann)
forall a. a -> DList a
DL.singleton (MetaDoc ann -> DList (MetaDoc ann))
-> (M1 S ('MetaSel a b c d) x ix -> MetaDoc ann)
-> M1 S ('MetaSel a b c d) x ix
-> DList (MetaDoc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x ix -> MetaDoc ann
forall ix ann. x ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty (x ix -> MetaDoc ann)
-> (M1 S ('MetaSel a b c d) x ix -> x ix)
-> M1 S ('MetaSel a b c d) x ix
-> MetaDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S ('MetaSel a b c d) x ix -> x ix
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance (GFields f, GFields g) => GFields (f :*: g) where
{-# INLINABLE gfields #-}
gfields :: forall (ix :: k) ann. (:*:) f g ix -> DList (MetaDoc ann)
gfields (f ix
f :*: g ix
g) = f ix -> DList (MetaDoc ann)
forall (ix :: k) ann. f ix -> DList (MetaDoc ann)
forall {k} (a :: k -> *) (ix :: k) ann.
GFields a =>
a ix -> DList (MetaDoc ann)
gfields f ix
f DList (MetaDoc ann) -> DList (MetaDoc ann) -> DList (MetaDoc ann)
forall a. Semigroup a => a -> a -> a
<> g ix -> DList (MetaDoc ann)
forall (ix :: k) ann. g ix -> DList (MetaDoc ann)
forall {k} (a :: k -> *) (ix :: k) ann.
GFields a =>
a ix -> DList (MetaDoc ann)
gfields g ix
g
instance (KnownSymbol name, GCollectRecord f) => GPretty (M1 C ('MetaCons name _fixity 'True) f) where
gpretty :: forall ix ann.
M1 C ('MetaCons name _fixity 'True) f ix -> MetaDoc ann
gpretty (M1 f ix
x) =
Doc ann -> MetaDoc ann
forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc (Doc ann -> MetaDoc ann) -> Doc ann -> MetaDoc ann
forall a b. (a -> b) -> a -> b
$
Doc ann -> [MapEntry Text (Doc ann)] -> Doc ann
forall ann. Doc ann -> [MapEntry Text (Doc ann)] -> Doc ann
ppDictHeader
([Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)))
((MapEntry Text (MetaDoc ann) -> MapEntry Text (Doc ann))
-> [MapEntry Text (MetaDoc ann)] -> [MapEntry Text (Doc ann)]
forall a b. (a -> b) -> [a] -> [b]
map ((MetaDoc ann -> Doc ann)
-> MapEntry Text (MetaDoc ann) -> MapEntry Text (Doc ann)
forall a b. (a -> b) -> MapEntry Text a -> MapEntry Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaDoc ann -> Doc ann
forall ann. MetaDoc ann -> Doc ann
mdPayload) (DList (MapEntry Text (MetaDoc ann))
-> [MapEntry Text (MetaDoc ann)]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (f ix -> DList (MapEntry Text (MetaDoc ann))
forall ix ann. f ix -> DList (MapEntry Text (MetaDoc ann))
forall {k} (a :: k -> *) (ix :: k) ann.
GCollectRecord a =>
a ix -> DList (MapEntry Text (MetaDoc ann))
gcollectRecord f ix
x)))
class GCollectRecord a where
gcollectRecord :: a ix -> DList (MapEntry Text (MetaDoc ann))
instance (KnownSymbol name, GPretty a) => GCollectRecord (M1 S ('MetaSel ('Just name) su ss ds) a) where
{-# INLINABLE gcollectRecord #-}
gcollectRecord :: forall ix ann.
M1 S ('MetaSel ('Just name) su ss ds) a ix
-> DList (MapEntry Text (MetaDoc ann))
gcollectRecord (M1 a ix
x) =
MapEntry Text (MetaDoc ann) -> DList (MapEntry Text (MetaDoc ann))
forall a. a -> DList a
DL.singleton ([Char] -> Text
T.pack (Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)) Text -> MetaDoc ann -> MapEntry Text (MetaDoc ann)
forall k v. k -> v -> MapEntry k v
:-> a ix -> MetaDoc ann
forall ix ann. a ix -> MetaDoc ann
forall (a :: * -> *) ix ann. GPretty a => a ix -> MetaDoc ann
gpretty a ix
x)
instance (GCollectRecord f, GCollectRecord g) => GCollectRecord (f :*: g) where
{-# INLINABLE gcollectRecord #-}
gcollectRecord :: forall (ix :: k) ann.
(:*:) f g ix -> DList (MapEntry Text (MetaDoc ann))
gcollectRecord (f ix
f :*: g ix
g) = f ix -> DList (MapEntry Text (MetaDoc ann))
forall (ix :: k) ann. f ix -> DList (MapEntry Text (MetaDoc ann))
forall {k} (a :: k -> *) (ix :: k) ann.
GCollectRecord a =>
a ix -> DList (MapEntry Text (MetaDoc ann))
gcollectRecord f ix
f DList (MapEntry Text (MetaDoc ann))
-> DList (MapEntry Text (MetaDoc ann))
-> DList (MapEntry Text (MetaDoc ann))
forall a. Semigroup a => a -> a -> a
<> g ix -> DList (MapEntry Text (MetaDoc ann))
forall (ix :: k) ann. g ix -> DList (MapEntry Text (MetaDoc ann))
forall {k} (a :: k -> *) (ix :: k) ann.
GCollectRecord a =>
a ix -> DList (MapEntry Text (MetaDoc ann))
gcollectRecord g ix
g
instance GCollectRecord U1 where
{-# INLINABLE gcollectRecord #-}
gcollectRecord :: forall (ix :: k) ann. U1 ix -> DList (MapEntry Text (MetaDoc ann))
gcollectRecord = DList (MapEntry Text (MetaDoc ann))
-> U1 ix -> DList (MapEntry Text (MetaDoc ann))
forall a b. a -> b -> a
const DList (MapEntry Text (MetaDoc ann))
forall a. Monoid a => a
mempty