module Data.GI.CodeGen.OverloadedMethods
    ( genMethodList
    , genMethodInfo
    , genUnsupportedMethodInfo
    ) where

import Control.Monad (forM, forM_, when)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T

import Data.GI.CodeGen.API
import Data.GI.CodeGen.Conversions (ExposeClosures(..))
import Data.GI.CodeGen.Callable (callableSignature, Signature(..),
                                 ForeignSymbol(..), fixupCallerAllocates)
import Data.GI.CodeGen.Code
import Data.GI.CodeGen.ModulePath (dotModulePath)
import Data.GI.CodeGen.SymbolNaming (lowerName, upperName, qualifiedSymbol,
                                     moduleLocation, hackageModuleLink)
import Data.GI.CodeGen.Util (ucFirst)

-- | Qualified name for the info for a given method.
methodInfoName :: Name -> Method -> CodeGen e Text
methodInfoName :: Name -> Method -> CodeGen e Text
methodInfoName n :: Name
n method :: Method
method =
    let infoName :: Text
infoName = Name -> Text
upperName Name
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
ucFirst (Text -> Text) -> (Method -> Text) -> Method -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
lowerName (Name -> Text) -> (Method -> Name) -> Method -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Name
methodName) Method
method
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "MethodInfo"
    in Text -> Name -> CodeGen e Text
forall e. Text -> Name -> CodeGen e Text
qualifiedSymbol Text
infoName Name
n

-- | Appropriate instances so overloaded labels are properly resolved.
genMethodResolver :: Text -> CodeGen e ()
genMethodResolver :: Text -> CodeGen e ()
genMethodResolver n :: Text
n = do
  Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
addLanguagePragma "TypeApplications"
  CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "instance (info ~ Resolve" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Method t " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "O.OverloadedMethod info " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " p) => OL.IsLabel t ("
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " -> p) where"
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "#if MIN_VERSION_base(4,10,0)"
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "fromLabel = O.overloadedMethod @info"
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "#else"
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "fromLabel _ = O.overloadedMethod @info"
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "#endif"

  -- The circular instance trick is to avoid the liberal coverage
  -- condition. We should be using DYSFUNCTIONAL pragmas instead, once
  -- those are implemented:
  -- https://github.com/ghc-proposals/ghc-proposals/pull/374
  CPPGuard -> CodeGen e () -> CodeGen e ()
forall e a. CPPGuard -> CodeGen e a -> CodeGen e a
cppIf (Text -> (Integer, Integer, Integer) -> CPPGuard
CPPMinVersion "base" (4,13,0)) (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "instance (info ~ Resolve" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Method t " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "O.OverloadedMethod info " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " p, "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "R.HasField t " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " p) => "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "R.HasField t " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " p where"
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "getField = O.overloadedMethod @info"

  CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "instance (info ~ Resolve" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Method t " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "O.OverloadedMethodInfo info " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ") => "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "OL.IsLabel t (O.MethodProxy info "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ") where"
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "#if MIN_VERSION_base(4,10,0)"
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "fromLabel = O.MethodProxy"
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "#else"
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "fromLabel _ = O.MethodProxy"
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "#endif"

-- | Generate the `MethodList` instance given the list of methods for
-- the given named type. Returns a Haddock comment summarizing the
-- list of methods available.
genMethodList :: Name -> [(Name, Method)] -> CodeGen e ()
genMethodList :: Name -> [(Name, Method)] -> CodeGen e ()
genMethodList n :: Name
n methods :: [(Name, Method)]
methods = do
  let name :: Text
name = Name -> Text
upperName Name
n
  let filteredMethods :: [(Name, Method)]
filteredMethods = ((Name, Method) -> Bool) -> [(Name, Method)] -> [(Name, Method)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name, Method) -> Bool
isOrdinaryMethod [(Name, Method)]
methods
      gets :: [(Name, Method)]
gets = ((Name, Method) -> Bool) -> [(Name, Method)] -> [(Name, Method)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name, Method) -> Bool
isGet [(Name, Method)]
filteredMethods
      sets :: [(Name, Method)]
sets = ((Name, Method) -> Bool) -> [(Name, Method)] -> [(Name, Method)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name, Method) -> Bool
isSet [(Name, Method)]
filteredMethods
      others :: [(Name, Method)]
others = ((Name, Method) -> Bool) -> [(Name, Method)] -> [(Name, Method)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\m :: (Name, Method)
m -> Bool -> Bool
not ((Name, Method) -> Bool
isSet (Name, Method)
m Bool -> Bool -> Bool
|| (Name, Method) -> Bool
isGet (Name, Method)
m)) [(Name, Method)]
filteredMethods
      orderedMethods :: [(Name, Method)]
orderedMethods = [(Name, Method)]
others [(Name, Method)] -> [(Name, Method)] -> [(Name, Method)]
forall a. [a] -> [a] -> [a]
++ [(Name, Method)]
gets [(Name, Method)] -> [(Name, Method)] -> [(Name, Method)]
forall a. [a] -> [a] -> [a]
++ [(Name, Method)]
sets
  [(Text, Text)]
infos <- [(Name, Method)]
-> ((Name, Method)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Text, Text))
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     [(Text, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, Method)]
orderedMethods (((Name, Method)
  -> ReaderT
       CodeGenConfig
       (StateT (CGState, ModuleInfo) (Except e))
       (Text, Text))
 -> ReaderT
      CodeGenConfig
      (StateT (CGState, ModuleInfo) (Except e))
      [(Text, Text)])
-> ((Name, Method)
    -> ReaderT
         CodeGenConfig
         (StateT (CGState, ModuleInfo) (Except e))
         (Text, Text))
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ \(owner :: Name
owner, method :: Method
method) ->
           do Text
mi <- Name -> Method -> CodeGen e Text
forall e. Name -> Method -> CodeGen e Text
methodInfoName Name
owner Method
method
              (Text, Text)
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name -> Text
lowerName (Name -> Text) -> (Method -> Name) -> Method -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Name
methodName) Method
method, Text
mi)
  CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    let resolver :: Text
resolver = "Resolve" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Method"
    HaddockSection -> Text -> CodeGen e ()
forall e. HaddockSection -> Text -> CodeGen e ()
export (NamedSection -> HaddockSection
Section NamedSection
MethodSection) Text
resolver
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "type family " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
resolver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " (t :: Symbol) (o :: *) :: * where"
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> ((Text, Text) -> CodeGen e ()) -> CodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Text)]
infos (((Text, Text) -> CodeGen e ()) -> CodeGen e ())
-> ((Text, Text) -> CodeGen e ()) -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ \(label :: Text
label, info :: Text
info) -> do
        Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text
resolver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\" o = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
info
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text
resolver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " l o = O.MethodResolutionFailed l o"

  Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
genMethodResolver Text
name

  Text
docs <- [(Name, Method)]
-> [(Name, Method)] -> [(Name, Method)] -> CodeGen e Text
forall e.
[(Name, Method)]
-> [(Name, Method)] -> [(Name, Method)] -> CodeGen e Text
methodListDocumentation [(Name, Method)]
others [(Name, Method)]
gets [(Name, Method)]
sets
  HaddockSection -> Text -> CodeGen e ()
forall e. HaddockSection -> Text -> CodeGen e ()
prependSectionFormattedDocs (NamedSection -> HaddockSection
Section NamedSection
MethodSection) Text
docs

  where isOrdinaryMethod :: (Name, Method) -> Bool
        isOrdinaryMethod :: (Name, Method) -> Bool
isOrdinaryMethod (_, m :: Method
m) = Method -> MethodType
methodType Method
m MethodType -> MethodType -> Bool
forall a. Eq a => a -> a -> Bool
== MethodType
OrdinaryMethod

        isGet :: (Name, Method) -> Bool
        isGet :: (Name, Method) -> Bool
isGet (_, m :: Method
m) = "get_" Text -> Text -> Bool
`T.isPrefixOf` (Name -> Text
name (Name -> Text) -> (Method -> Name) -> Method -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Name
methodName) Method
m

        isSet :: (Name, Method) -> Bool
        isSet :: (Name, Method) -> Bool
isSet (_, m :: Method
m) = "set_" Text -> Text -> Bool
`T.isPrefixOf` (Name -> Text
name (Name -> Text) -> (Method -> Name) -> Method -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Name
methodName) Method
m

-- | Format a haddock comment with the information about available
-- methods.
methodListDocumentation :: [(Name, Method)] -> [(Name, Method)]
                           -> [(Name, Method)] -> CodeGen e Text
methodListDocumentation :: [(Name, Method)]
-> [(Name, Method)] -> [(Name, Method)] -> CodeGen e Text
methodListDocumentation [] [] [] = Text -> CodeGen e Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
methodListDocumentation ordinary :: [(Name, Method)]
ordinary getters :: [(Name, Method)]
getters setters :: [(Name, Method)]
setters = do
  Text
ordinaryFormatted <- [(Name, Method)] -> CodeGen e Text
forall e. [(Name, Method)] -> CodeGen e Text
formatMethods [(Name, Method)]
ordinary
  Text
gettersFormatted <- [(Name, Method)] -> CodeGen e Text
forall e. [(Name, Method)] -> CodeGen e Text
formatMethods [(Name, Method)]
getters
  Text
settersFormatted <- [(Name, Method)] -> CodeGen e Text
forall e. [(Name, Method)] -> CodeGen e Text
formatMethods [(Name, Method)]
setters

  Text -> CodeGen e Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> CodeGen e Text) -> Text -> CodeGen e Text
forall a b. (a -> b) -> a -> b
$ "\n\n === __Click to display all available methods, including inherited ones__\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "==== Methods\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ordinaryFormatted
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n==== Getters\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gettersFormatted
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n==== Setters\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settersFormatted

  where formatMethods :: [(Name, Method)] -> CodeGen e Text
        formatMethods :: [(Name, Method)] -> CodeGen e Text
formatMethods [] = Text -> CodeGen e Text
forall (m :: * -> *) a. Monad m => a -> m a
return "/None/.\n"
        formatMethods methods :: [(Name, Method)]
methods = do
          [Text]
qualifiedMethods <- [(Name, Method)]
-> ((Name, Method) -> CodeGen e Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, Method)]
methods (((Name, Method) -> CodeGen e Text)
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Text])
-> ((Name, Method) -> CodeGen e Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Text]
forall a b. (a -> b) -> a -> b
$ \(owner :: Name
owner, m :: Method
m) -> do
            API
api <- Name -> CodeGen e API
forall e. HasCallStack => Name -> CodeGen e API
findAPIByName Name
owner
            let mn :: Text
mn = Name -> Text
lowerName (Method -> Name
methodName Method
m)
            Text -> CodeGen e Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> CodeGen e Text) -> Text -> CodeGen e Text
forall a b. (a -> b) -> a -> b
$ "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              "](\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModulePath -> Text
dotModulePath (Name -> API -> ModulePath
moduleLocation Name
owner API
api)
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "#g:method:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\")"
          Text -> CodeGen e Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> CodeGen e Text) -> Text -> CodeGen e Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate ", " [Text]
qualifiedMethods Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".\n"

-- | Generate the `MethodInfo` type and instance for the given method.
genMethodInfo :: Name -> Method -> ExcCodeGen ()
genMethodInfo :: Name -> Method -> ExcCodeGen ()
genMethodInfo n :: Name
n m :: Method
m =
    Bool -> ExcCodeGen () -> ExcCodeGen ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Method -> MethodType
methodType Method
m MethodType -> MethodType -> Bool
forall a. Eq a => a -> a -> Bool
== MethodType
OrdinaryMethod) (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$
      ExcCodeGen () -> ExcCodeGen ()
forall e a. CodeGen e a -> CodeGen e a
group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ do
        API
api <- Name -> CodeGen CGError API
forall e. HasCallStack => Name -> CodeGen e API
findAPIByName Name
n
        Text
infoName <- Name -> Method -> CodeGen CGError Text
forall e. Name -> Method -> CodeGen e Text
methodInfoName Name
n Method
m
        let callable :: Callable
callable = Callable -> Callable
fixupCallerAllocates (Method -> Callable
methodCallable Method
m)
        Signature
sig <- Callable -> ForeignSymbol -> ExposeClosures -> ExcCodeGen Signature
callableSignature Callable
callable (Text -> ForeignSymbol
KnownForeignSymbol Text
forall a. HasCallStack => a
undefined) ExposeClosures
WithoutClosures
        Text -> ExcCodeGen ()
forall e. Text -> CodeGen e ()
bline (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ "data " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
infoName
        let (obj :: Text
obj, otherTypes :: [Text]
otherTypes) = case ((Maybe Arg, Text) -> Text) -> [(Maybe Arg, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Arg, Text) -> Text
forall a b. (a, b) -> b
snd (Signature -> [(Maybe Arg, Text)]
signatureArgTypes Signature
sig) of
              -- This should not happen, since ordinary methods always
              -- have the instance as first argument.
              [] -> [Char] -> (Text, [Text])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Text, [Text])) -> [Char] -> (Text, [Text])
forall a b. (a -> b) -> a -> b
$ "Internal error: too few parameters! " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Method -> [Char]
forall a. Show a => a -> [Char]
show Method
m
              (obj' :: Text
obj':otherTypes' :: [Text]
otherTypes') -> (Text
obj', [Text]
otherTypes')
            sigConstraint :: Text
sigConstraint = "signature ~ (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate " -> "
              ([Text]
otherTypes [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Signature -> Text
signatureReturnType Signature
sig]) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"

        Text
hackageLink <- Name -> CodeGen CGError Text
forall e. Name -> CodeGen e Text
hackageModuleLink Name
n
        let mn :: Name
mn = Method -> Name
methodName Method
m
            mangled :: Text
mangled = Name -> Text
lowerName (Name
mn {name :: Text
name = Name -> Text
name Name
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
name Name
mn})
            dbgInfo :: Text
dbgInfo = ModulePath -> Text
dotModulePath (Name -> API -> ModulePath
moduleLocation Name
n API
api) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mangled

        ExcCodeGen () -> ExcCodeGen ()
forall e a. CodeGen e a -> CodeGen e a
group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ do
          Text -> ExcCodeGen ()
forall e. Text -> CodeGen e ()
line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ "instance ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate ", " (Text
sigConstraint Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Signature -> [Text]
signatureConstraints Signature
sig)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ") => O.OverloadedMethod " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
infoName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
obj
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " signature where"
          ExcCodeGen () -> ExcCodeGen ()
forall e a. CodeGen e a -> CodeGen e a
indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ Text -> ExcCodeGen ()
forall e. Text -> CodeGen e ()
line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ "overloadedMethod = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mangled

        ExcCodeGen () -> ExcCodeGen ()
forall e a. CodeGen e a -> CodeGen e a
group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ do
          Text -> ExcCodeGen ()
forall e. Text -> CodeGen e ()
line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ "instance O.OverloadedMethodInfo " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
infoName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
obj
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " where"
          ExcCodeGen () -> ExcCodeGen ()
forall e a. CodeGen e a -> CodeGen e a
indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> ExcCodeGen ()
forall e. Text -> CodeGen e ()
line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ "overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {"
            ExcCodeGen () -> ExcCodeGen ()
forall e a. CodeGen e a -> CodeGen e a
indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ do
              Text -> ExcCodeGen ()
forall e. Text -> CodeGen e ()
line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ "O.resolvedSymbolName = \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dbgInfo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\","
              Text -> ExcCodeGen ()
forall e. Text -> CodeGen e ()
line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ "O.resolvedSymbolURL = \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
hackageLink Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "#v:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mangled Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""
              Text -> ExcCodeGen ()
forall e. Text -> CodeGen e ()
line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ "})"

        HaddockSection -> Text -> ExcCodeGen ()
forall e. HaddockSection -> Text -> CodeGen e ()
export (NamedSection -> Text -> HaddockSection
NamedSubsection NamedSection
MethodSection (Text -> HaddockSection) -> Text -> HaddockSection
forall a b. (a -> b) -> a -> b
$ Name -> Text
lowerName Name
mn) Text
infoName

-- | Generate a method info that is not actually callable, but rather
-- gives a type error when trying to use it.
genUnsupportedMethodInfo :: Name -> Method -> CodeGen e ()
genUnsupportedMethodInfo :: Name -> Method -> CodeGen e ()
genUnsupportedMethodInfo n :: Name
n m :: Method
m = do
  Text
infoName <- Name -> Method -> CodeGen e Text
forall e. Name -> Method -> CodeGen e Text
methodInfoName Name
n Method
m
  Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "-- XXX: Dummy instance, since code generation failed.\n"
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-- Please file a bug at http://github.com/haskell-gi/haskell-gi."
  Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "data " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
infoName
  CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "instance (p ~ (), o ~ O.UnsupportedMethodError \""
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
lowerName (Method -> Name
methodName Method
m) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
name Name
n
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ") => O.OverloadedMethod " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
infoName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " o p where"
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "overloadedMethod = undefined"

  CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "instance (o ~ O.UnsupportedMethodError \""
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
lowerName (Method -> Name
methodName Method
m) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
name Name
n
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ") => O.OverloadedMethodInfo " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
infoName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " o where"
    CodeGen e () -> CodeGen e ()
forall e a. CodeGen e a -> CodeGen e a
indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen e ()
forall e. Text -> CodeGen e ()
line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
forall a b. (a -> b) -> a -> b
$ "overloadedMethodInfo = undefined"

  HaddockSection -> Text -> CodeGen e ()
forall e. HaddockSection -> Text -> CodeGen e ()
export HaddockSection
ToplevelSection Text
infoName