module Data.GI.GIR.Property
    ( Property(..)
    , PropertyFlag(..)
    , parseProperty
    ) where

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

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

data PropertyFlag = PropertyReadable
                  | PropertyWritable
                  | PropertyConstruct
                  | PropertyConstructOnly
                    deriving (Int -> PropertyFlag -> ShowS
[PropertyFlag] -> ShowS
PropertyFlag -> String
(Int -> PropertyFlag -> ShowS)
-> (PropertyFlag -> String)
-> ([PropertyFlag] -> ShowS)
-> Show PropertyFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PropertyFlag -> ShowS
showsPrec :: Int -> PropertyFlag -> ShowS
$cshow :: PropertyFlag -> String
show :: PropertyFlag -> String
$cshowList :: [PropertyFlag] -> ShowS
showList :: [PropertyFlag] -> ShowS
Show,PropertyFlag -> PropertyFlag -> Bool
(PropertyFlag -> PropertyFlag -> Bool)
-> (PropertyFlag -> PropertyFlag -> Bool) -> Eq PropertyFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyFlag -> PropertyFlag -> Bool
== :: PropertyFlag -> PropertyFlag -> Bool
$c/= :: PropertyFlag -> PropertyFlag -> Bool
/= :: PropertyFlag -> PropertyFlag -> Bool
Eq)

data Property = Property {
        Property -> ParseError
propName :: Text,
        Property -> Type
propType :: Type,
        Property -> [PropertyFlag]
propFlags :: [PropertyFlag],
        Property -> Maybe Bool
propReadNullable :: Maybe Bool,
        Property -> Maybe Bool
propWriteNullable :: Maybe Bool,
        Property -> Transfer
propTransfer :: Transfer,
        Property -> Documentation
propDoc :: Documentation,
        Property -> Maybe DeprecationInfo
propDeprecated :: Maybe DeprecationInfo
    } deriving (Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Property -> ShowS
showsPrec :: Int -> Property -> ShowS
$cshow :: Property -> String
show :: Property -> String
$cshowList :: [Property] -> ShowS
showList :: [Property] -> ShowS
Show, Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
/= :: Property -> Property -> Bool
Eq)

parseProperty :: Parser Property
parseProperty :: Parser Property
parseProperty = do
  ParseError
name <- Name -> Parser ParseError
getAttr Name
"name"
  Type
t <- Parser Type
parseType
  Transfer
transfer <- Parser Transfer
parseTransfer
  Maybe DeprecationInfo
deprecated <- Parser (Maybe DeprecationInfo)
parseDeprecation
  Bool
readable <- Name -> Bool -> (ParseError -> Parser Bool) -> Parser Bool
forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"readable" Bool
True ParseError -> Parser Bool
parseBool
  Bool
writable <- Name -> Bool -> (ParseError -> Parser Bool) -> Parser Bool
forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"writable" Bool
False ParseError -> Parser Bool
parseBool
  Bool
construct <- Name -> Bool -> (ParseError -> Parser Bool) -> Parser Bool
forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"construct" Bool
False ParseError -> Parser Bool
parseBool
  Bool
constructOnly <- Name -> Bool -> (ParseError -> Parser Bool) -> Parser Bool
forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"construct-only" Bool
False ParseError -> Parser Bool
parseBool
  Maybe Bool
maybeNullable <- Name
-> Maybe Bool
-> (ParseError -> Parser (Maybe Bool))
-> Parser (Maybe Bool)
forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"nullable" Maybe Bool
forall a. Maybe a
Nothing (\ParseError
t -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseError -> Parser Bool
parseBool ParseError
t)
  let flags :: [PropertyFlag]
flags = (if Bool
readable then [PropertyFlag
PropertyReadable] else [])
              [PropertyFlag] -> [PropertyFlag] -> [PropertyFlag]
forall a. Semigroup a => a -> a -> a
<> (if Bool
writable then [PropertyFlag
PropertyWritable] else [])
              [PropertyFlag] -> [PropertyFlag] -> [PropertyFlag]
forall a. Semigroup a => a -> a -> a
<> (if Bool
construct then [PropertyFlag
PropertyConstruct] else [])
              [PropertyFlag] -> [PropertyFlag] -> [PropertyFlag]
forall a. Semigroup a => a -> a -> a
<> (if Bool
constructOnly then [PropertyFlag
PropertyConstructOnly] else [])
  Documentation
doc <- Parser Documentation
parseDocumentation
  Property -> Parser Property
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> Parser Property) -> Property -> Parser Property
forall a b. (a -> b) -> a -> b
$ Property {
                  propName :: ParseError
propName = ParseError
name
                , propType :: Type
propType = Type
t
                , propFlags :: [PropertyFlag]
propFlags = [PropertyFlag]
flags
                , propTransfer :: Transfer
propTransfer = Transfer
transfer
                , propDeprecated :: Maybe DeprecationInfo
propDeprecated = Maybe DeprecationInfo
deprecated
                , propDoc :: Documentation
propDoc = Documentation
doc
                , propReadNullable :: Maybe Bool
propReadNullable = Maybe Bool
maybeNullable
                , propWriteNullable :: Maybe Bool
propWriteNullable = Maybe Bool
maybeNullable
                }