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 (parseTransferString)
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 -> Maybe ParseError
propSetter :: Maybe Text,
        Property -> Maybe ParseError
propGetter :: Maybe Text,
        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
  name <- Name -> Parser ParseError
getAttr Name
"name"
  t <- parseType
  transfer <- optionalAttr "transfer-ownership" TransferNothing parseTransferString
  deprecated <- parseDeprecation
  readable <- optionalAttr "readable" True parseBool
  writable <- optionalAttr "writable" False parseBool
  construct <- optionalAttr "construct" False parseBool
  setter <- queryAttr "setter"
  getter <- queryAttr "getter"
  constructOnly <- optionalAttr "construct-only" False parseBool
  maybeNullable <- optionalAttr "nullable" 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 = (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 [])
  doc <- parseDocumentation
  return $ Property {
                  propName = name
                , propType = t
                , propFlags = flags
                , propTransfer = transfer
                , propDeprecated = deprecated
                , propDoc = doc
                , propReadNullable = maybeNullable
                , propWriteNullable = maybeNullable
                , propSetter = setter
                , propGetter = getter
                }