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 ParseError
ifTypeInit :: Maybe Text,
        Interface -> Maybe ParseError
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 -> [Char]
(Int -> Interface -> ShowS)
-> (Interface -> [Char])
-> ([Interface] -> ShowS)
-> Show Interface
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Interface -> ShowS
showsPrec :: Int -> Interface -> ShowS
$cshow :: Interface -> [Char]
show :: Interface -> [Char]
$cshowList :: [Interface] -> ShowS
showList :: [Interface] -> ShowS
Show

parseInterface :: Parser (Name, Interface)
parseInterface :: Parser (Name, Interface)
parseInterface = do
  name <- Parser Name
parseName
  props <- parseChildrenWithLocalName "property" parseProperty
  signals <- parseChildrenWithNSName GLibGIRNS "signal" parseSignal
  typeInit <- queryAttrWithNamespace GLibGIRNS "get-type"
  methods <- parseChildrenWithLocalName "method" (parseMethod OrdinaryMethod)
  functions <- parseChildrenWithLocalName "function" (parseMethod MemberFunction)
  constructors <- parseChildrenWithLocalName "constructor" (parseMethod Constructor)
  deprecated <- parseDeprecation
  doc <- parseDocumentation
  ctype <- queryCType
  return (name,
         Interface {
            ifProperties = props
          , ifPrerequisites = error ("unfixed interface " ++ show name)
          , ifSignals = signals
          , ifTypeInit = typeInit
          , ifCType = ctype
          , ifDocumentation = doc
          , ifMethods = constructors ++ methods ++ functions
          , ifAllocationInfo = unknownAllocationInfo
          , ifDeprecated = deprecated
          })