{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
module HIndent.Ast.Declaration.Signature
( Signature
, mkSignature
) where
import qualified GHC.Types.Basic as GHC
import HIndent.Applicative
import HIndent.Ast.Declaration.Signature.BooleanFormula
import HIndent.Ast.Declaration.Signature.Fixity
import HIndent.Ast.Declaration.Signature.Inline.Phase
import HIndent.Ast.Declaration.Signature.Inline.Spec
import HIndent.Ast.Name.Infix
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
import HIndent.Pretty.Types
data Signature
= Type
{ Signature -> [WithComments PrefixName]
names :: [WithComments PrefixName]
, Signature -> LHsSigWcType GhcPs
parameters :: GHC.LHsSigWcType GHC.GhcPs
}
| Pattern
{ names :: [WithComments PrefixName]
, Signature -> LHsSigType GhcPs
signature :: GHC.LHsSigType GHC.GhcPs
}
| DefaultClassMethod
{ names :: [WithComments PrefixName]
, signature :: GHC.LHsSigType GHC.GhcPs
}
| ClassMethod
{ names :: [WithComments PrefixName]
, signature :: GHC.LHsSigType GHC.GhcPs
}
| Fixity
{ Signature -> [WithComments InfixName]
opNames :: [WithComments InfixName]
, Signature -> Fixity
fixity :: Fixity
}
| Inline
{ Signature -> WithComments PrefixName
name :: WithComments PrefixName
, Signature -> InlineSpec
spec :: InlineSpec
, Signature -> Maybe InlinePhase
phase :: Maybe InlinePhase
}
| Specialise
{ name :: WithComments PrefixName
, Signature -> [LHsSigType GhcPs]
sigs :: [GHC.LHsSigType GHC.GhcPs]
}
| SpecialiseInstance (GHC.LHsSigType GHC.GhcPs)
| Minimal (WithComments BooleanFormula)
| Scc (WithComments PrefixName)
| Complete (WithComments [WithComments PrefixName])
instance CommentExtraction Signature where
nodeComments :: Signature -> NodeComments
nodeComments Type {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments Pattern {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments DefaultClassMethod {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments ClassMethod {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments Fixity {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments Inline {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments Specialise {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments SpecialiseInstance {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments Minimal {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments Scc {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
nodeComments Complete {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
instance Pretty Signature where
pretty' :: Signature -> Printer ()
pretty' Type {[WithComments PrefixName]
LHsSigWcType GhcPs
names :: Signature -> [WithComments PrefixName]
parameters :: Signature -> LHsSigWcType GhcPs
names :: [WithComments PrefixName]
parameters :: LHsSigWcType GhcPs
..} = do
Printer ()
printFunName
HasCallStack => String -> Printer ()
String -> Printer ()
string String
" ::"
Printer ()
horizontal Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
vertical
where
horizontal :: Printer ()
horizontal = do
Printer ()
space
GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (GenLocated SrcSpanAnnA HsSigType' -> Printer ())
-> GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig (HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
GHC.hswc_body LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
parameters
vertical :: Printer ()
vertical = do
Int64
headLen <- Printer () -> Printer Int64
forall a. Printer a -> Printer Int64
printerLength Printer ()
printFunName
Int64
indentSpaces <- Printer Int64
getIndentSpaces
if Int64
headLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
indentSpaces
then Printer ()
space
Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
(HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig (HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
GHC.hswc_body LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
parameters)
else do
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
(Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
3
(Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
(GenLocated SrcSpanAnnA HsSigType' -> Printer ())
-> GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig (HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
GHC.hswc_body LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
parameters
printFunName :: Printer ()
printFunName = [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments PrefixName -> Printer ())
-> [WithComments PrefixName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments PrefixName]
names
pretty' Pattern {[WithComments PrefixName]
LHsSigType GhcPs
names :: Signature -> [WithComments PrefixName]
signature :: Signature -> LHsSigType GhcPs
names :: [WithComments PrefixName]
signature :: LHsSigType GhcPs
..} =
[Printer ()] -> Printer ()
spaced
[ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"pattern"
, [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments PrefixName -> Printer ())
-> [WithComments PrefixName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments PrefixName]
names
, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::"
, GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
signature
]
pretty' DefaultClassMethod {[WithComments PrefixName]
LHsSigType GhcPs
names :: Signature -> [WithComments PrefixName]
signature :: Signature -> LHsSigType GhcPs
names :: [WithComments PrefixName]
signature :: LHsSigType GhcPs
..} =
[Printer ()] -> Printer ()
spaced
[ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"default"
, [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments PrefixName -> Printer ())
-> [WithComments PrefixName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments PrefixName]
names
, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::"
, GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
signature HsSigType GhcPs -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
]
pretty' ClassMethod {[WithComments PrefixName]
LHsSigType GhcPs
names :: Signature -> [WithComments PrefixName]
signature :: Signature -> LHsSigType GhcPs
names :: [WithComments PrefixName]
signature :: LHsSigType GhcPs
..} = do
[Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments PrefixName -> Printer ())
-> [WithComments PrefixName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments PrefixName]
names
HasCallStack => String -> Printer ()
String -> Printer ()
string String
" ::"
Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
where
hor :: Printer ()
hor =
Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
signature (HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsSigType' -> Printer ())
-> (HsSigType GhcPs -> HsSigType') -> HsSigType GhcPs -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig)
ver :: Printer ()
ver = do
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
(Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithSpace Int64
3
(Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> Printer ()) -> Printer ()
forall l e.
CommentExtraction l =>
GenLocated l e -> (e -> Printer ()) -> Printer ()
printCommentsAnd LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
signature (HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty (HsSigType' -> Printer ())
-> (HsSigType GhcPs -> HsSigType') -> HsSigType GhcPs -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig)
pretty' Fixity {[WithComments InfixName]
Fixity
opNames :: Signature -> [WithComments InfixName]
fixity :: Signature -> Fixity
opNames :: [WithComments InfixName]
fixity :: Fixity
..} = [Printer ()] -> Printer ()
spaced [Fixity -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Fixity
fixity, [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments InfixName -> Printer ())
-> [WithComments InfixName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments InfixName]
opNames]
pretty' Inline {Maybe InlinePhase
WithComments PrefixName
InlineSpec
name :: Signature -> WithComments PrefixName
spec :: Signature -> InlineSpec
phase :: Signature -> Maybe InlinePhase
name :: WithComments PrefixName
spec :: InlineSpec
phase :: Maybe InlinePhase
..} = do
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# "
InlineSpec -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty InlineSpec
spec
Maybe InlinePhase -> (InlinePhase -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe InlinePhase
phase ((InlinePhase -> Printer ()) -> Printer ())
-> (InlinePhase -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \InlinePhase
x -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InlinePhase -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty InlinePhase
x
Printer ()
space
WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
name
HasCallStack => String -> Printer ()
String -> Printer ()
string String
" #-}"
pretty' Specialise {[LHsSigType GhcPs]
WithComments PrefixName
name :: Signature -> WithComments PrefixName
sigs :: Signature -> [LHsSigType GhcPs]
name :: WithComments PrefixName
sigs :: [LHsSigType GhcPs]
..} =
[Printer ()] -> Printer ()
spaced
[ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SPECIALISE"
, WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
name
, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::"
, [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LHsSigType GhcPs]
[GenLocated SrcSpanAnnA (HsSigType GhcPs)]
sigs
, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"
]
pretty' (SpecialiseInstance LHsSigType GhcPs
sig) =
[Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SPECIALISE instance", GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
sig, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
pretty' (Minimal WithComments BooleanFormula
xs) =
HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# MINIMAL " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
WithComments BooleanFormula -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments BooleanFormula
xs
HasCallStack => String -> Printer ()
String -> Printer ()
string String
" #-}"
pretty' (Scc WithComments PrefixName
name) = [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SCC", WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
name, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
pretty' (Complete WithComments [WithComments PrefixName]
names) =
[Printer ()] -> Printer ()
spaced
[ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# COMPLETE"
, WithComments [WithComments PrefixName]
-> ([WithComments PrefixName] -> Printer ()) -> Printer ()
forall a. WithComments a -> (a -> Printer ()) -> Printer ()
prettyWith WithComments [WithComments PrefixName]
names ([Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ())
-> ([WithComments PrefixName] -> [Printer ()])
-> [WithComments PrefixName]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithComments PrefixName -> Printer ())
-> [WithComments PrefixName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty)
, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"
]
mkSignature :: GHC.Sig GHC.GhcPs -> Signature
mkSignature :: Sig GhcPs -> Signature
mkSignature (GHC.TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
ns LHsSigWcType GhcPs
parameters) = Type {[WithComments PrefixName]
LHsSigWcType GhcPs
names :: [WithComments PrefixName]
parameters :: LHsSigWcType GhcPs
parameters :: LHsSigWcType GhcPs
names :: [WithComments PrefixName]
..}
where
names :: [WithComments PrefixName]
names = (GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName)
-> [GenLocated SrcSpanAnnN RdrName] -> [WithComments PrefixName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> (GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> WithComments PrefixName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ns
mkSignature (GHC.PatSynSig XPatSynSig GhcPs
_ [LIdP GhcPs]
ns LHsSigType GhcPs
signature) = Pattern {[WithComments PrefixName]
LHsSigType GhcPs
names :: [WithComments PrefixName]
signature :: LHsSigType GhcPs
signature :: LHsSigType GhcPs
names :: [WithComments PrefixName]
..}
where
names :: [WithComments PrefixName]
names = (GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName)
-> [GenLocated SrcSpanAnnN RdrName] -> [WithComments PrefixName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> (GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> WithComments PrefixName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ns
mkSignature (GHC.ClassOpSig XClassOpSig GhcPs
_ Bool
True [LIdP GhcPs]
ns LHsSigType GhcPs
signature) = DefaultClassMethod {[WithComments PrefixName]
LHsSigType GhcPs
names :: [WithComments PrefixName]
signature :: LHsSigType GhcPs
signature :: LHsSigType GhcPs
names :: [WithComments PrefixName]
..}
where
names :: [WithComments PrefixName]
names = (GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName)
-> [GenLocated SrcSpanAnnN RdrName] -> [WithComments PrefixName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> (GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> WithComments PrefixName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ns
mkSignature (GHC.ClassOpSig XClassOpSig GhcPs
_ Bool
False [LIdP GhcPs]
ns LHsSigType GhcPs
signature) = ClassMethod {[WithComments PrefixName]
LHsSigType GhcPs
names :: [WithComments PrefixName]
signature :: LHsSigType GhcPs
signature :: LHsSigType GhcPs
names :: [WithComments PrefixName]
..}
where
names :: [WithComments PrefixName]
names = (GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName)
-> [GenLocated SrcSpanAnnN RdrName] -> [WithComments PrefixName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> (GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> WithComments PrefixName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ns
mkSignature (GHC.FixSig XFixSig GhcPs
_ (GHC.FixitySig XFixitySig GhcPs
_ [LIdP GhcPs]
ops Fixity
fy)) = Fixity {[WithComments InfixName]
Fixity
opNames :: [WithComments InfixName]
fixity :: Fixity
fixity :: Fixity
opNames :: [WithComments InfixName]
..}
where
fixity :: Fixity
fixity = Fixity -> Fixity
mkFixity Fixity
fy
opNames :: [WithComments InfixName]
opNames = (GenLocated SrcSpanAnnN RdrName -> WithComments InfixName)
-> [GenLocated SrcSpanAnnN RdrName] -> [WithComments InfixName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN InfixName -> WithComments InfixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN InfixName -> WithComments InfixName)
-> (GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> WithComments InfixName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixName
mkInfixName) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ops
mkSignature (GHC.InlineSig XInlineSig GhcPs
_ LIdP GhcPs
n GHC.InlinePragma {Maybe Arity
SourceText
InlineSpec
RuleMatchInfo
Activation
inl_src :: SourceText
inl_inline :: InlineSpec
inl_sat :: Maybe Arity
inl_act :: Activation
inl_rule :: RuleMatchInfo
inl_rule :: InlinePragma -> RuleMatchInfo
inl_act :: InlinePragma -> Activation
inl_sat :: InlinePragma -> Maybe Arity
inl_inline :: InlinePragma -> InlineSpec
inl_src :: InlinePragma -> SourceText
..}) = Inline {Maybe InlinePhase
WithComments PrefixName
InlineSpec
name :: WithComments PrefixName
spec :: InlineSpec
phase :: Maybe InlinePhase
name :: WithComments PrefixName
spec :: InlineSpec
phase :: Maybe InlinePhase
..}
where
name :: WithComments PrefixName
name = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
spec :: InlineSpec
spec = InlineSpec -> InlineSpec
mkInlineSpec InlineSpec
inl_inline
phase :: Maybe InlinePhase
phase = Activation -> Maybe InlinePhase
mkInlinePhase Activation
inl_act
mkSignature (GHC.SpecSig XSpecSig GhcPs
_ LIdP GhcPs
n [LHsSigType GhcPs]
sigs InlinePragma
_) = Specialise {[LHsSigType GhcPs]
WithComments PrefixName
name :: WithComments PrefixName
sigs :: [LHsSigType GhcPs]
sigs :: [LHsSigType GhcPs]
name :: WithComments PrefixName
..}
where
name :: WithComments PrefixName
name = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
mkSignature (GHC.SCCFunSig XSCCFunSig GhcPs
_ LIdP GhcPs
n Maybe (XRec GhcPs StringLiteral)
_) = WithComments PrefixName -> Signature
Scc WithComments PrefixName
name
where
name :: WithComments PrefixName
name = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
mkSignature (GHC.CompleteMatchSig XCompleteMatchSig GhcPs
_ [LIdP GhcPs]
ns Maybe (LIdP GhcPs)
_) = WithComments [WithComments PrefixName] -> Signature
Complete WithComments [WithComments PrefixName]
names
where
names :: WithComments [WithComments PrefixName]
names = [WithComments PrefixName] -> WithComments [WithComments PrefixName]
forall a. a -> WithComments a
mkWithComments ([WithComments PrefixName]
-> WithComments [WithComments PrefixName])
-> [WithComments PrefixName]
-> WithComments [WithComments PrefixName]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName)
-> [GenLocated SrcSpanAnnN RdrName] -> [WithComments PrefixName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> (GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> WithComments PrefixName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ns
#elif MIN_VERSION_ghc_lib_parser(9, 6, 0)
mkSignature (GHC.SCCFunSig _ n _) = Scc name
where
name = fromGenLocated $ fmap mkPrefixName n
mkSignature (GHC.CompleteMatchSig _ ns _) = Complete names
where
names = fromGenLocated $ fmap (fmap (fromGenLocated . fmap mkPrefixName)) ns
#elif MIN_VERSION_ghc_lib_parser(9, 4, 0)
mkSignature (GHC.SCCFunSig _ _ name _) =
Scc $ fromGenLocated $ fmap mkPrefixName name
mkSignature (GHC.CompleteMatchSig _ _ names _) =
Complete
$ fromGenLocated
$ fmap (fmap (fromGenLocated . fmap mkPrefixName)) names
#else
mkSignature (GHC.SCCFunSig _ _ name _) =
Scc $ fromGenLocated $ fmap mkPrefixName name
mkSignature (GHC.CompleteMatchSig _ _ names _) =
Complete
$ fromGenLocated
$ fmap (fmap (fromGenLocated . fmap mkPrefixName)) names
#endif
#if MIN_VERSION_ghc_lib_parser(9, 6, 0)
mkSignature (GHC.SpecInstSig XSpecInstSig GhcPs
_ LHsSigType GhcPs
sig) = LHsSigType GhcPs -> Signature
SpecialiseInstance LHsSigType GhcPs
sig
mkSignature (GHC.MinimalSig XMinimalSig GhcPs
_ LBooleanFormula (LIdP GhcPs)
xs) =
WithComments BooleanFormula -> Signature
Minimal (WithComments BooleanFormula -> Signature)
-> WithComments BooleanFormula -> Signature
forall a b. (a -> b) -> a -> b
$ BooleanFormula (LIdP GhcPs) -> BooleanFormula
BooleanFormula (GenLocated SrcSpanAnnN RdrName) -> BooleanFormula
mkBooleanFormula (BooleanFormula (GenLocated SrcSpanAnnN RdrName) -> BooleanFormula)
-> WithComments (BooleanFormula (GenLocated SrcSpanAnnN RdrName))
-> WithComments BooleanFormula
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated
SrcSpanAnnL (BooleanFormula (GenLocated SrcSpanAnnN RdrName))
-> WithComments (BooleanFormula (GenLocated SrcSpanAnnN RdrName))
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LBooleanFormula (LIdP GhcPs)
GenLocated
SrcSpanAnnL (BooleanFormula (GenLocated SrcSpanAnnN RdrName))
xs
#else
mkSignature (GHC.SpecInstSig _ _ sig) = SpecialiseInstance sig
mkSignature (GHC.MinimalSig _ _ xs) =
Minimal $ mkBooleanFormula <$> fromGenLocated xs
mkSignature GHC.IdSig {} =
error "`ghc-lib-parser` never generates this AST node."
#endif