-- | Parsing of structs.
module Data.GI.GIR.Struct
    ( Struct(..)
    , parseStruct
    ) where

import Data.Text (Text)

import Data.GI.GIR.Allocation (AllocationInfo(..), unknownAllocationInfo)
import Data.GI.GIR.Field (Field, parseFields)
import Data.GI.GIR.Method (Method, MethodType(..), parseMethod)
import Data.GI.GIR.Parser
import Data.GI.GIR.Type (queryCType)

data Struct = Struct {
    Struct -> Bool
structIsBoxed :: Bool,
    Struct -> AllocationInfo
structAllocationInfo :: AllocationInfo,
    Struct -> Maybe ParseError
structTypeInit :: Maybe Text,
    Struct -> Maybe ParseError
structCType :: Maybe Text,
    Struct -> Int
structSize :: Int,
    Struct -> Maybe Name
gtypeStructFor :: Maybe Name,
    -- https://bugzilla.gnome.org/show_bug.cgi?id=560248
    Struct -> Bool
structIsDisguised :: Bool,
    Struct -> Bool
structForceVisible :: Bool,
    Struct -> [Field]
structFields :: [Field],
    Struct -> [Method]
structMethods :: [Method],
    Struct -> Maybe DeprecationInfo
structDeprecated :: Maybe DeprecationInfo,
    Struct -> Documentation
structDocumentation :: Documentation }
    deriving Int -> Struct -> ShowS
[Struct] -> ShowS
Struct -> [Char]
(Int -> Struct -> ShowS)
-> (Struct -> [Char]) -> ([Struct] -> ShowS) -> Show Struct
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Struct -> ShowS
showsPrec :: Int -> Struct -> ShowS
$cshow :: Struct -> [Char]
show :: Struct -> [Char]
$cshowList :: [Struct] -> ShowS
showList :: [Struct] -> ShowS
Show

parseStruct :: Parser (Name, Struct)
parseStruct :: Parser (Name, Struct)
parseStruct = do
  name <- Parser Name
parseName
  deprecated <- parseDeprecation
  doc <- parseDocumentation
  structFor <- queryAttrWithNamespace GLibGIRNS "is-gtype-struct-for" >>= \case
               Just ParseError
t -> ((Name -> Maybe Name)
-> Parser Name
-> ReaderT ParseContext (Except ParseError) (Maybe Name)
forall a b.
(a -> b)
-> ReaderT ParseContext (Except ParseError) a
-> ReaderT ParseContext (Except ParseError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Maybe Name
forall a. a -> Maybe a
Just (Parser Name
 -> ReaderT ParseContext (Except ParseError) (Maybe Name))
-> (ParseError -> Parser Name)
-> ParseError
-> ReaderT ParseContext (Except ParseError) (Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Parser Name
qualifyName) ParseError
t
               Maybe ParseError
Nothing -> Maybe Name -> ReaderT ParseContext (Except ParseError) (Maybe Name)
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
  typeInit <- queryAttrWithNamespace GLibGIRNS "get-type"
  maybeCType <- queryCType
  disguised <- optionalAttr "disguised" False parseBool
  forceVisible <- optionalAttr "haskell-gi-force-visible" False parseBool
  fields <- parseFields
  constructors <- parseChildrenWithLocalName "constructor" (parseMethod Constructor)
  methods <- parseChildrenWithLocalName "method" (parseMethod OrdinaryMethod)
  functions <- parseChildrenWithLocalName "function" (parseMethod MemberFunction)
  return (name,
          Struct {
            structIsBoxed = error ("[boxed] unfixed struct " ++ show name)
          , structAllocationInfo = unknownAllocationInfo
          , structTypeInit = typeInit
          , structCType = maybeCType
          , structSize = error ("[size] unfixed struct " ++ show name)
          , gtypeStructFor = structFor
          , structIsDisguised = disguised
          , structForceVisible = forceVisible
          , structFields = fields
          , structMethods = constructors ++ methods ++ functions
          , structDeprecated = deprecated
          , structDocumentation = doc
          })