-- | Parsing of object/struct/union fields.
module Data.GI.GIR.Field
    ( Field(..)
    , FieldInfoFlag
    , parseFields
    ) where

import Control.Monad.Except (catchError, throwError)

import Data.Maybe (isJust, catMaybes)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text, isSuffixOf)

import Data.GI.GIR.BasicTypes (Type(..))
import Data.GI.GIR.Callback (Callback, parseCallback)
import Data.GI.GIR.Type (parseType, queryElementCType)
import Data.GI.GIR.Parser

data Field = Field {
      Field -> ParseError
fieldName :: Text,
      Field -> Bool
fieldVisible :: Bool,
      Field -> Type
fieldType :: Type,
      Field -> Maybe Bool
fieldIsPointer :: Maybe Bool, -- ^ `Nothing` if not known.
      Field -> Maybe Callback
fieldCallback :: Maybe Callback,
      Field -> Int
fieldOffset :: Int,
      Field -> [FieldInfoFlag]
fieldFlags :: [FieldInfoFlag],
      Field -> Documentation
fieldDocumentation :: Documentation,
      Field -> Maybe DeprecationInfo
fieldDeprecated :: Maybe DeprecationInfo }
    deriving Int -> Field -> ShowS
[Field] -> ShowS
Field -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> [Char]
$cshow :: Field -> [Char]
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show

data FieldInfoFlag = FieldIsReadable | FieldIsWritable
                   deriving Int -> FieldInfoFlag -> ShowS
[FieldInfoFlag] -> ShowS
FieldInfoFlag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FieldInfoFlag] -> ShowS
$cshowList :: [FieldInfoFlag] -> ShowS
show :: FieldInfoFlag -> [Char]
$cshow :: FieldInfoFlag -> [Char]
showsPrec :: Int -> FieldInfoFlag -> ShowS
$cshowsPrec :: Int -> FieldInfoFlag -> ShowS
Show

-- | Parse a single field in a struct or union. We parse
-- non-introspectable fields too (but set fieldVisible = False for
-- them), this is necessary since they affect the computation of
-- offsets of fields and sizes of containing structs.
parseField :: Parser (Maybe Field)
parseField :: Parser (Maybe Field)
parseField = do
  ParseError
name <- Name -> Parser ParseError
getAttr Name
"name"
  Maybe DeprecationInfo
deprecated <- Parser (Maybe DeprecationInfo)
parseDeprecation
  Bool
readable <- forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"readable" Bool
True ParseError -> Parser Bool
parseBool
  Bool
writable <- forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"writable" Bool
False ParseError -> Parser Bool
parseBool
  let flags :: [FieldInfoFlag]
flags = if Bool
readable then [FieldInfoFlag
FieldIsReadable] else []
             forall a. Semigroup a => a -> a -> a
<> if Bool
writable then [FieldInfoFlag
FieldIsWritable] else []
  Bool
introspectable <- forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"introspectable" Bool
True ParseError -> Parser Bool
parseBool
  Bool
private <- forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"private" Bool
False ParseError -> Parser Bool
parseBool
  Documentation
doc <- Parser Documentation
parseDocumentation
  -- Sometimes fields marked as not introspectable contain invalid
  -- introspection info. We are lenient in these cases with parsing
  -- errors, and simply ignore the fields.
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (\ParseError
e -> if (Bool -> Bool
not Bool
introspectable) Bool -> Bool -> Bool
&& Bool
private
                         then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                         else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ParseError
e) forall a b. (a -> b) -> a -> b
$ do
    (Type
t, Maybe Bool
isPtr, Maybe Callback
callback) <-
      if Bool
introspectable
      then do
        [(Name, Callback)]
callbacks <- forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"callback" Parser (Name, Callback)
parseCallback
        (Maybe Name
cbn, Maybe Callback
callback) <- case [(Name, Callback)]
callbacks of
                             [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
                             [(Name
n, Callback
cb)] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Name
n, forall a. a -> Maybe a
Just Callback
cb)
                             [(Name, Callback)]
_ -> forall a. ParseError -> Parser a
parseError ParseError
"Multiple callbacks in field"
        (Type
t, Maybe Bool
isPtr) <- case Maybe Name
cbn of
               Maybe Name
Nothing -> do
                 Type
t <- Parser Type
parseType
                 Maybe ParseError
ct <- Parser (Maybe ParseError)
queryElementCType
                 forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseError
"*" ParseError -> ParseError -> Bool
`isSuffixOf`) Maybe ParseError
ct)
               Just Name
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
TInterface Name
n, forall a. Maybe a
Nothing)
        forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, Maybe Bool
isPtr, Maybe Callback
callback)
      else do
        [Name]
callbacks <- forall a. ParseError -> Parser a -> Parser [a]
parseAllChildrenWithLocalName ParseError
"callback" Parser Name
parseName
        case [Name]
callbacks of
          [] -> do
               Type
t <- Parser Type
parseType
               Maybe ParseError
ct <- Parser (Maybe ParseError)
queryElementCType
               forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseError
"*" ParseError -> ParseError -> Bool
`isSuffixOf`) Maybe ParseError
ct, forall a. Maybe a
Nothing)
          [Name
n] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
TInterface Name
n, forall a. a -> Maybe a
Just Bool
True, forall a. Maybe a
Nothing)
          [Name]
_ -> forall a. ParseError -> Parser a
parseError ParseError
"Multiple callbacks in field"

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Field {
               fieldName :: ParseError
fieldName = ParseError
name
             , fieldVisible :: Bool
fieldVisible = Bool
introspectable Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
private
             , fieldType :: Type
fieldType = Type
t
             , fieldIsPointer :: Maybe Bool
fieldIsPointer = if forall a. Maybe a -> Bool
isJust Maybe Callback
callback
                                then forall a. a -> Maybe a
Just Bool
True
                                else Maybe Bool
isPtr
             , fieldCallback :: Maybe Callback
fieldCallback = Maybe Callback
callback
             , fieldOffset :: Int
fieldOffset = forall a. HasCallStack => [Char] -> a
error ([Char]
"unfixed field offset " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ParseError
name)
             , fieldFlags :: [FieldInfoFlag]
fieldFlags = [FieldInfoFlag]
flags
             , fieldDocumentation :: Documentation
fieldDocumentation = Documentation
doc
             , fieldDeprecated :: Maybe DeprecationInfo
fieldDeprecated = Maybe DeprecationInfo
deprecated
          }

parseFields :: Parser [Field]
parseFields :: Parser [Field]
parseFields = forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseError -> Parser a -> Parser [a]
parseAllChildrenWithLocalName ParseError
"field" Parser (Maybe Field)
parseField