module Data.GI.GIR.Callable
    ( Callable(..)
    , parseCallable
    ) where

import Data.GI.GIR.Arg (Arg(..), parseArg, parseTransfer)
import Data.GI.GIR.BasicTypes (Transfer(..), Type)
import Data.GI.GIR.Parser
import Data.GI.GIR.Type (parseOptionalType)

data Callable = Callable {
        Callable -> Maybe Type
returnType :: Maybe Type,
        Callable -> Bool
returnMayBeNull :: Bool,
        Callable -> Transfer
returnTransfer :: Transfer,
        Callable -> Documentation
returnDocumentation :: Documentation,
        Callable -> [Arg]
args :: [Arg],
        Callable -> Bool
skipReturn :: Bool,
        Callable -> Bool
callableThrows :: Bool,
        Callable -> Maybe DeprecationInfo
callableDeprecated :: Maybe DeprecationInfo,
        Callable -> Documentation
callableDocumentation :: Documentation,
        -- | Whether the symbol for this callable can be resolved in
        -- the dynamical library associated with the current
        -- introspection data. 'Nothing' means that we have not
        -- checked yet.
        Callable -> Maybe Bool
callableResolvable :: Maybe Bool
    } deriving (Int -> Callable -> ShowS
[Callable] -> ShowS
Callable -> String
(Int -> Callable -> ShowS)
-> (Callable -> String) -> ([Callable] -> ShowS) -> Show Callable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Callable -> ShowS
showsPrec :: Int -> Callable -> ShowS
$cshow :: Callable -> String
show :: Callable -> String
$cshowList :: [Callable] -> ShowS
showList :: [Callable] -> ShowS
Show, Callable -> Callable -> Bool
(Callable -> Callable -> Bool)
-> (Callable -> Callable -> Bool) -> Eq Callable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Callable -> Callable -> Bool
== :: Callable -> Callable -> Bool
$c/= :: Callable -> Callable -> Bool
/= :: Callable -> Callable -> Bool
Eq)

parseArgs :: Parser [Arg]
parseArgs :: Parser [Arg]
parseArgs = do
  paramSets <- ParseError -> Parser [Arg] -> Parser [[Arg]]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"parameters" Parser [Arg]
parseArgSet
  case paramSets of
    [] -> [Arg] -> Parser [Arg]
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    ([Arg]
ps:[]) -> [Arg] -> Parser [Arg]
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Arg]
ps
    [[Arg]]
_ -> ParseError -> Parser [Arg]
forall a. ParseError -> Parser a
parseError (ParseError -> Parser [Arg]) -> ParseError -> Parser [Arg]
forall a b. (a -> b) -> a -> b
$ ParseError
"Unexpected multiple \"parameters\" tag"
  where parseArgSet :: Parser [Arg]
parseArgSet = ParseError -> Parser Arg -> Parser [Arg]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"parameter" Parser Arg
parseArg

parseOneReturn :: Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
parseOneReturn :: Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
parseOneReturn = do
  returnType <- Parser (Maybe Type)
parseOptionalType
  allowNone <- optionalAttr "allow-none" False parseBool
  nullable <- optionalAttr "nullable" False parseBool
  transfer <- parseTransfer
  doc <- parseDocumentation
  skip <- optionalAttr "skip" False parseBool
  return (returnType, allowNone || nullable, transfer, skip, doc)

parseReturn :: Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
parseReturn :: Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
parseReturn = do
  returnSets <- ParseError
-> Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
-> Parser [(Maybe Type, Bool, Transfer, Bool, Documentation)]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"return-value" Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
parseOneReturn
  case returnSets of
    ((Maybe Type, Bool, Transfer, Bool, Documentation)
r:[]) -> (Maybe Type, Bool, Transfer, Bool, Documentation)
-> Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type, Bool, Transfer, Bool, Documentation)
r
    [] -> ParseError
-> Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
forall a. ParseError -> Parser a
parseError (ParseError
 -> Parser (Maybe Type, Bool, Transfer, Bool, Documentation))
-> ParseError
-> Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
forall a b. (a -> b) -> a -> b
$ ParseError
"No return information found"
    [(Maybe Type, Bool, Transfer, Bool, Documentation)]
_ -> ParseError
-> Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
forall a. ParseError -> Parser a
parseError (ParseError
 -> Parser (Maybe Type, Bool, Transfer, Bool, Documentation))
-> ParseError
-> Parser (Maybe Type, Bool, Transfer, Bool, Documentation)
forall a b. (a -> b) -> a -> b
$ ParseError
"Multiple return values found"

parseCallable :: Parser Callable
parseCallable :: Parser Callable
parseCallable = do
  args <- Parser [Arg]
parseArgs
  (returnType, mayBeNull, transfer, skip, returnDoc) <- parseReturn
  deprecated <- parseDeprecation
  docs <- parseDocumentation
  throws <- optionalAttr "throws" False parseBool
  return $ Callable {
                  returnType = returnType
                , returnMayBeNull = mayBeNull
                , returnTransfer = transfer
                , returnDocumentation = returnDoc
                , args = args
                , skipReturn = skip
                , callableThrows = throws
                , callableDeprecated = deprecated
                , callableDocumentation = docs
                  -- Some symbols are present in the @.gir@ file, but
                  -- they are absent from the library
                  -- itself. Generating bindings for such symbols
                  -- could then lead to linker errors, so later on we
                  -- check whether the callables are actually
                  -- resolvable, and adjust the callable info
                  -- appropriately.
                , callableResolvable = Nothing
                }