module Data.GI.GIR.Interface
    ( Interface(..)
    , parseInterface
    ) where

import Data.Text (Text)

import Data.GI.GIR.Allocation (AllocationInfo, unknownAllocationInfo)
import Data.GI.GIR.Method (Method, MethodType(..), parseMethod)
import Data.GI.GIR.Property (Property, parseProperty)
import Data.GI.GIR.Signal (Signal, parseSignal)
import Data.GI.GIR.Parser
import Data.GI.GIR.Type (queryCType)

data Interface = Interface {
        Interface -> Maybe Text
ifTypeInit :: Maybe Text,
        Interface -> Maybe Text
ifCType :: Maybe Text,
        Interface -> Documentation
ifDocumentation :: Documentation,
        Interface -> [Name]
ifPrerequisites :: [Name],
        Interface -> [Property]
ifProperties :: [Property],
        Interface -> [Signal]
ifSignals :: [Signal],
        Interface -> [Method]
ifMethods :: [Method],
        Interface -> AllocationInfo
ifAllocationInfo :: AllocationInfo,
        Interface -> Maybe DeprecationInfo
ifDeprecated :: Maybe DeprecationInfo
    } deriving Int -> Interface -> ShowS
[Interface] -> ShowS
Interface -> String
(Int -> Interface -> ShowS)
-> (Interface -> String)
-> ([Interface] -> ShowS)
-> Show Interface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interface] -> ShowS
$cshowList :: [Interface] -> ShowS
show :: Interface -> String
$cshow :: Interface -> String
showsPrec :: Int -> Interface -> ShowS
$cshowsPrec :: Int -> Interface -> ShowS
Show

parseInterface :: Parser (Name, Interface)
parseInterface :: Parser (Name, Interface)
parseInterface = do
  Name
name <- Parser Name
parseName
  [Property]
props <- Text -> Parser Property -> Parser [Property]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"property" Parser Property
parseProperty
  [Signal]
signals <- GIRXMLNamespace -> Text -> Parser Signal -> Parser [Signal]
forall a. GIRXMLNamespace -> Text -> Parser a -> Parser [a]
parseChildrenWithNSName GIRXMLNamespace
GLibGIRNS Text
"signal" Parser Signal
parseSignal
  Maybe Text
typeInit <- GIRXMLNamespace -> Name -> Parser (Maybe Text)
queryAttrWithNamespace GIRXMLNamespace
GLibGIRNS Name
"get-type"
  [Method]
methods <- Text -> Parser Method -> Parser [Method]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"method" (MethodType -> Parser Method
parseMethod MethodType
OrdinaryMethod)
  [Method]
functions <- Text -> Parser Method -> Parser [Method]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"function" (MethodType -> Parser Method
parseMethod MethodType
MemberFunction)
  [Method]
constructors <- Text -> Parser Method -> Parser [Method]
forall a. Text -> Parser a -> Parser [a]
parseChildrenWithLocalName Text
"constructor" (MethodType -> Parser Method
parseMethod MethodType
Constructor)
  Maybe DeprecationInfo
deprecated <- Parser (Maybe DeprecationInfo)
parseDeprecation
  Documentation
doc <- Parser Documentation
parseDocumentation
  Maybe Text
ctype <- Parser (Maybe Text)
queryCType
  (Name, Interface) -> Parser (Name, Interface)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name,
         Interface :: Maybe Text
-> Maybe Text
-> Documentation
-> [Name]
-> [Property]
-> [Signal]
-> [Method]
-> AllocationInfo
-> Maybe DeprecationInfo
-> Interface
Interface {
            ifProperties :: [Property]
ifProperties = [Property]
props
          , ifPrerequisites :: [Name]
ifPrerequisites = String -> [Name]
forall a. HasCallStack => String -> a
error (String
"unfixed interface " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
name)
          , ifSignals :: [Signal]
ifSignals = [Signal]
signals
          , ifTypeInit :: Maybe Text
ifTypeInit = Maybe Text
typeInit
          , ifCType :: Maybe Text
ifCType = Maybe Text
ctype
          , ifDocumentation :: Documentation
ifDocumentation = Documentation
doc
          , ifMethods :: [Method]
ifMethods = [Method]
constructors [Method] -> [Method] -> [Method]
forall a. [a] -> [a] -> [a]
++ [Method]
methods [Method] -> [Method] -> [Method]
forall a. [a] -> [a] -> [a]
++ [Method]
functions
          , ifAllocationInfo :: AllocationInfo
ifAllocationInfo = AllocationInfo
unknownAllocationInfo
          , ifDeprecated :: Maybe DeprecationInfo
ifDeprecated = Maybe DeprecationInfo
deprecated
          })