module Data.GI.GIR.Arg
    ( Arg(..)
    , Direction(..)
    , Scope(..)
    , parseArg
    , parseTransfer
    ) where

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

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

data Direction = DirectionIn
               | DirectionOut
               | DirectionInout
                 deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord)

data Scope = ScopeTypeInvalid
           | ScopeTypeCall
           | ScopeTypeAsync
           | ScopeTypeNotified
             deriving (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scope -> ShowS
showsPrec :: Int -> Scope -> ShowS
$cshow :: Scope -> String
show :: Scope -> String
$cshowList :: [Scope] -> ShowS
showList :: [Scope] -> ShowS
Show, Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
/= :: Scope -> Scope -> Bool
Eq, Eq Scope
Eq Scope
-> (Scope -> Scope -> Ordering)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Scope)
-> (Scope -> Scope -> Scope)
-> Ord Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scope -> Scope -> Ordering
compare :: Scope -> Scope -> Ordering
$c< :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
>= :: Scope -> Scope -> Bool
$cmax :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
min :: Scope -> Scope -> Scope
Ord)

data Arg = Arg {
        Arg -> Text
argCName :: Text,  -- ^ "C" name for the argument. For a
                           -- escaped name valid in Haskell code, use
                           -- `GI.SymbolNaming.escapedArgName`.
        Arg -> Type
argType :: Type,
        Arg -> Direction
direction :: Direction,
        Arg -> Bool
mayBeNull :: Bool,
        Arg -> Documentation
argDoc :: Documentation,
        Arg -> Scope
argScope :: Scope,
        Arg -> Int
argClosure :: Int,
        Arg -> Int
argDestroy :: Int,
        Arg -> Bool
argCallerAllocates :: Bool,
        Arg -> Transfer
transfer :: Transfer
    } deriving (Int -> Arg -> ShowS
[Arg] -> ShowS
Arg -> String
(Int -> Arg -> ShowS)
-> (Arg -> String) -> ([Arg] -> ShowS) -> Show Arg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Arg -> ShowS
showsPrec :: Int -> Arg -> ShowS
$cshow :: Arg -> String
show :: Arg -> String
$cshowList :: [Arg] -> ShowS
showList :: [Arg] -> ShowS
Show, Arg -> Arg -> Bool
(Arg -> Arg -> Bool) -> (Arg -> Arg -> Bool) -> Eq Arg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Arg -> Arg -> Bool
== :: Arg -> Arg -> Bool
$c/= :: Arg -> Arg -> Bool
/= :: Arg -> Arg -> Bool
Eq, Eq Arg
Eq Arg
-> (Arg -> Arg -> Ordering)
-> (Arg -> Arg -> Bool)
-> (Arg -> Arg -> Bool)
-> (Arg -> Arg -> Bool)
-> (Arg -> Arg -> Bool)
-> (Arg -> Arg -> Arg)
-> (Arg -> Arg -> Arg)
-> Ord Arg
Arg -> Arg -> Bool
Arg -> Arg -> Ordering
Arg -> Arg -> Arg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Arg -> Arg -> Ordering
compare :: Arg -> Arg -> Ordering
$c< :: Arg -> Arg -> Bool
< :: Arg -> Arg -> Bool
$c<= :: Arg -> Arg -> Bool
<= :: Arg -> Arg -> Bool
$c> :: Arg -> Arg -> Bool
> :: Arg -> Arg -> Bool
$c>= :: Arg -> Arg -> Bool
>= :: Arg -> Arg -> Bool
$cmax :: Arg -> Arg -> Arg
max :: Arg -> Arg -> Arg
$cmin :: Arg -> Arg -> Arg
min :: Arg -> Arg -> Arg
Ord)

parseTransfer :: Parser Transfer
parseTransfer :: Parser Transfer
parseTransfer = Name -> Parser Text
getAttr Name
"transfer-ownership" Parser Text -> (Text -> Parser Transfer) -> Parser Transfer
forall a b.
ReaderT ParseContext (Except Text) a
-> (a -> ReaderT ParseContext (Except Text) b)
-> ReaderT ParseContext (Except Text) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Text
"none" -> Transfer -> Parser Transfer
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer
TransferNothing
                Text
"container" -> Transfer -> Parser Transfer
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer
TransferContainer
                Text
"full" -> Transfer -> Parser Transfer
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer
TransferEverything
                Text
t -> Text -> Parser Transfer
forall a. Text -> Parser a
parseError (Text -> Parser Transfer) -> Text -> Parser Transfer
forall a b. (a -> b) -> a -> b
$ Text
"Unknown transfer type \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

parseScope :: Text -> Parser Scope
parseScope :: Text -> Parser Scope
parseScope Text
"call" = Scope -> Parser Scope
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Scope
ScopeTypeCall
parseScope Text
"async" = Scope -> Parser Scope
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Scope
ScopeTypeAsync
parseScope Text
"notified" = Scope -> Parser Scope
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Scope
ScopeTypeNotified
parseScope Text
s = Text -> Parser Scope
forall a. Text -> Parser a
parseError (Text -> Parser Scope) -> Text -> Parser Scope
forall a b. (a -> b) -> a -> b
$ Text
"Unknown scope type \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

parseDirection :: Text -> Parser Direction
parseDirection :: Text -> Parser Direction
parseDirection Text
"in" = Direction -> Parser Direction
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Direction
DirectionIn
parseDirection Text
"out" = Direction -> Parser Direction
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Direction
DirectionOut
parseDirection Text
"inout" = Direction -> Parser Direction
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return Direction
DirectionInout
parseDirection Text
d = Text -> Parser Direction
forall a. Text -> Parser a
parseError (Text -> Parser Direction) -> Text -> Parser Direction
forall a b. (a -> b) -> a -> b
$ Text
"Unknown direction \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

parseArg :: Parser Arg
parseArg :: Parser Arg
parseArg = do
  Text
name <- Name -> Parser Text
getAttr Name
"name"
  Transfer
ownership <- Parser Transfer
parseTransfer
  Scope
scope <- Name -> Scope -> (Text -> Parser Scope) -> Parser Scope
forall a. Name -> a -> (Text -> Parser a) -> Parser a
optionalAttr Name
"scope" Scope
ScopeTypeInvalid Text -> Parser Scope
parseScope
  Direction
d <- Name -> Direction -> (Text -> Parser Direction) -> Parser Direction
forall a. Name -> a -> (Text -> Parser a) -> Parser a
optionalAttr Name
"direction" Direction
DirectionIn Text -> Parser Direction
parseDirection
  Int
closure <- Name -> Int -> (Text -> Parser Int) -> Parser Int
forall a. Name -> a -> (Text -> Parser a) -> Parser a
optionalAttr Name
"closure" (-Int
1) Text -> Parser Int
forall a. Integral a => Text -> Parser a
parseIntegral
  Int
destroy <- Name -> Int -> (Text -> Parser Int) -> Parser Int
forall a. Name -> a -> (Text -> Parser a) -> Parser a
optionalAttr Name
"destroy" (-Int
1) Text -> Parser Int
forall a. Integral a => Text -> Parser a
parseIntegral
  Bool
nullable <- Name -> Bool -> (Text -> Parser Bool) -> Parser Bool
forall a. Name -> a -> (Text -> Parser a) -> Parser a
optionalAttr Name
"nullable" Bool
False Text -> Parser Bool
parseBool
  Bool
allowNone <- Name -> Bool -> (Text -> Parser Bool) -> Parser Bool
forall a. Name -> a -> (Text -> Parser a) -> Parser a
optionalAttr Name
"allow-none" Bool
False Text -> Parser Bool
parseBool
  -- "allow-none" is deprecated, but still produced by Vala. Support
  -- it for in arguments.
  let mayBeNull :: Bool
mayBeNull = if Direction
d Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
DirectionIn
                  then Bool
nullable Bool -> Bool -> Bool
|| Bool
allowNone
                  else Bool
nullable
  Bool
callerAllocates <- Name -> Bool -> (Text -> Parser Bool) -> Parser Bool
forall a. Name -> a -> (Text -> Parser a) -> Parser a
optionalAttr Name
"caller-allocates" Bool
False Text -> Parser Bool
parseBool
  Type
t <- Parser Type
parseType
  Documentation
doc <- Parser Documentation
parseDocumentation
  Arg -> Parser Arg
forall a. a -> ReaderT ParseContext (Except Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Arg -> Parser Arg) -> Arg -> Parser Arg
forall a b. (a -> b) -> a -> b
$ Arg { argCName :: Text
argCName = Text
name
               , argType :: Type
argType = Type
t
               , argDoc :: Documentation
argDoc = Documentation
doc
               , direction :: Direction
direction = Direction
d
               , mayBeNull :: Bool
mayBeNull = Bool
mayBeNull
               , argScope :: Scope
argScope = Scope
scope
               , argClosure :: Int
argClosure = Int
closure
               , argDestroy :: Int
argDestroy = Int
destroy
               , argCallerAllocates :: Bool
argCallerAllocates = Bool
callerAllocates
               , transfer :: Transfer
transfer = Transfer
ownership
               }