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

-- We want to use the same name for `parameters` and `signature`, but GHC
-- doesn't allow it.
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] -- Using `names` causes a type conflict.
      , 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