-- GENERATED by C->Haskell Compiler, version 0.28.7 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "lib/CPython/Protocols/Object.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module CPython.Protocols.Object
  ( Object
  , Concrete
  , SomeObject
  
  -- * Types and casting
  , getType
  , isInstance
  , isSubclass
  , toObject
  , cast
  
  -- * Attributes
  , hasAttribute
  , getAttribute
  , setAttribute
  , deleteAttribute
  
  -- * Display and debugging
  , print
  , repr
  , ascii
  , string
  , bytes
  
  -- * Callables
  , callable
  , call
  , callArgs
  , callMethod
  , callMethodArgs
  
  -- * Misc
  , Comparison (..)
  , richCompare
  , toBool
  , hash
  , dir
  , getIterator
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





import           Prelude hiding (Ordering (..), print)
import qualified Data.Text as T
import           System.IO (Handle, hPutStrLn)

import           CPython.Internal hiding (toBool)
import           CPython.Protocols.Object.Enums
import qualified CPython.Types.Bytes as B
import qualified CPython.Types.Dictionary as D
import qualified CPython.Types.Tuple as Tuple
import qualified CPython.Types.Unicode as U

-- | Returns a 'Type' object corresponding to the object type of /self/. On
-- failure, throws @SystemError@. This is equivalent to the Python expression
-- @type(o)@.
getType :: Object self => (self) -> IO ((Type))
getType :: self -> IO Type
getType a1 :: self
a1 =
  self -> (Ptr () -> IO Type) -> IO Type
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Type) -> IO Type) -> (Ptr () -> IO Type) -> IO Type
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
getType'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO Type) -> IO Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO Type
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO Type -> (Type -> IO Type) -> IO Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Type
res' ->
  Type -> IO Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
res')

{-# LINE 78 "lib/CPython/Protocols/Object.chs" #-}


-- | Returns 'True' if /inst/ is an instance of the class /cls/ or a
-- subclass of /cls/, or 'False' if not. On error, throws an exception.
-- If /cls/ is a type object rather than a class object, 'isInstance'
-- returns 'True' if /inst/ is of type /cls/. If /cls/ is a tuple, the check
-- will be done against every entry in /cls/. The result will be 'True' when
-- at least one of the checks returns 'True', otherwise it will be 'False'. If
-- /inst/ is not a class instance and /cls/ is neither a type object, nor a
-- class object, nor a tuple, /inst/ must have a @__class__@ attribute &#2014;
-- the class relationship of the value of that attribute with /cls/ will be
-- used to determine the result of this function.
--
-- Subclass determination is done in a fairly straightforward way, but
-- includes a wrinkle that implementors of extensions to the class system
-- may want to be aware of. If A and B are class objects, B is a subclass of
-- A if it inherits from A either directly or indirectly. If either is not a
-- class object, a more general mechanism is used to determine the class
-- relationship of the two objects. When testing if B is a subclass of A, if
-- A is B, 'isSubclass' returns 'True'. If A and B are different objects,
-- B&#2018;s @__bases__@ attribute is searched in a depth-first fashion for
-- A &#2014; the presence of the @__bases__@ attribute is considered
-- sufficient for this determination.
isInstance :: (Object self, Object cls) => (self) -> (cls) -> IO ((Bool))
isInstance :: self -> cls -> IO Bool
isInstance a1 :: self
a1 a2 :: cls
a2 =
  self -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  cls -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject cls
a2 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  Ptr () -> Ptr () -> IO CInt
isInstance'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO Bool
checkBoolReturn CInt
res IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Bool
res' ->
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 105 "lib/CPython/Protocols/Object.chs" #-}


-- | Returns 'True' if the class /derived/ is identical to or derived from
-- the class /cls/, otherwise returns 'False'. In case of an error, throws
-- an exception. If /cls/ is a tuple, the check will be done against every
-- entry in /cls/. The result will be 'True' when at least one of the checks
-- returns 'True', otherwise it will be 'False'. If either /derived/ or /cls/
-- is not an actual class object (or tuple), this function uses the generic
-- algorithm described above.
isSubclass :: (Object derived, Object cls) => (derived) -> (cls) -> IO ((Bool))
isSubclass :: derived -> cls -> IO Bool
isSubclass a1 :: derived
a1 a2 :: cls
a2 =
  derived -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject derived
a1 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  cls -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject cls
a2 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  Ptr () -> Ptr () -> IO CInt
isSubclass'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO Bool
checkBoolReturn CInt
res IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Bool
res' ->
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 118 "lib/CPython/Protocols/Object.chs" #-}


-- | Attempt to cast an object to some concrete class. If the object
-- isn't an instance of the class or subclass, returns 'Nothing'.
cast :: (Object a, Concrete b) => a -> IO (Maybe b)
cast :: a -> IO (Maybe b)
cast obj :: a
obj = let castObj :: b
castObj = case a -> SomeObject
forall a. Object a => a -> SomeObject
toObject a
obj of SomeObject ptr :: ForeignPtr a
ptr -> ForeignPtr b -> b
forall a. Object a => ForeignPtr a -> a
fromForeignPtr (ForeignPtr b -> b) -> ForeignPtr b -> b
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> ForeignPtr b
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr a
ptr
  in do
    Bool
validCast <- a -> Type -> IO Bool
forall self cls.
(Object self, Object cls) =>
self -> cls -> IO Bool
isInstance a
obj (Type -> IO Bool) -> Type -> IO Bool
forall a b. (a -> b) -> a -> b
$ b -> Type
forall a. Concrete a => a -> Type
concreteType b
castObj
    Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> IO (Maybe b)) -> Maybe b -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$ if Bool
validCast
      then b -> Maybe b
forall a. a -> Maybe a
Just b
castObj
      else Maybe b
forall a. Maybe a
Nothing

-- | Returns 'True' if /self/ has an attribute with the given name, and
-- 'False' otherwise. This is equivalent to the Python expression
-- @hasattr(self, name)@
hasAttribute :: Object self => (self) -> (U.Unicode) -> IO ((Bool))
hasAttribute :: self -> Unicode -> IO Bool
hasAttribute a1 :: self
a1 a2 :: Unicode
a2 =
  self -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Unicode -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Unicode
a2 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  Ptr () -> Ptr () -> IO CInt
hasAttribute'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO Bool
checkBoolReturn CInt
res IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Bool
res' ->
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 137 "lib/CPython/Protocols/Object.chs" #-}


-- | Retrieve an attribute with the given name from object /self/. Returns
-- the attribute value on success, and throws an exception on failure. This
-- is the equivalent of the Python expression @self.name@.
getAttribute :: Object self => (self) -> (U.Unicode) -> IO ((SomeObject))
getAttribute :: self -> Unicode -> IO SomeObject
getAttribute a1 :: self
a1 a2 :: Unicode
a2 =
  self -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO SomeObject) -> IO SomeObject)
-> (Ptr () -> IO SomeObject) -> IO SomeObject
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Unicode -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Unicode
a2 ((Ptr () -> IO SomeObject) -> IO SomeObject)
-> (Ptr () -> IO SomeObject) -> IO SomeObject
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  Ptr () -> Ptr () -> IO (Ptr ())
getAttribute'_ Ptr ()
a1' Ptr ()
a2' IO (Ptr ()) -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO SomeObject
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO SomeObject -> (SomeObject -> IO SomeObject) -> IO SomeObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: SomeObject
res' ->
  SomeObject -> IO SomeObject
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeObject
res')

{-# LINE 146 "lib/CPython/Protocols/Object.chs" #-}


-- | Set the value of the attribute with the given name, for object /self/,
-- to the value /v/. THrows an exception on failure. This is the equivalent
-- of the Python statement @self.name = v@.
setAttribute :: (Object self, Object v) => (self) -> (U.Unicode) -> (v) -> IO ((()))
setAttribute :: self -> Unicode -> v -> IO ()
setAttribute a1 :: self
a1 a2 :: Unicode
a2 a3 :: v
a3 =
  self -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Unicode -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Unicode
a2 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  v -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject v
a3 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr ()
a3' -> 
  Ptr () -> Ptr () -> Ptr () -> IO CInt
setAttribute'_ Ptr ()
a1' Ptr ()
a2' Ptr ()
a3' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (()
res')

{-# LINE 156 "lib/CPython/Protocols/Object.chs" #-}


-- | Delete an attribute with the given name, for object /self/. Throws an
-- exception on failure. This is the equivalent of the Python statement
-- @del self.name@.
deleteAttribute :: Object self => (self) -> (U.Unicode) -> IO ((()))
deleteAttribute :: self -> Unicode -> IO ()
deleteAttribute a1 :: self
a1 a2 :: Unicode
a2 =
  self -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Unicode -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Unicode
a2 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  Ptr () -> Ptr () -> IO CInt
deleteAttribute'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (()
res')

{-# LINE 165 "lib/CPython/Protocols/Object.chs" #-}


-- | Print @repr(self)@ to a handle.
print :: Object self => self -> Handle -> IO ()
print obj h = repr obj >>= U.fromUnicode >>= (hPutStrLn h . T.unpack)

-- | Compute a string representation of object /self/, or throw an exception
-- on failure. This is the equivalent of the Python expression @repr(self)@.
repr :: Object self => (self) -> IO ((U.Unicode))
repr :: self -> IO Unicode
repr a1 :: self
a1 =
  self -> (Ptr () -> IO Unicode) -> IO Unicode
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Unicode) -> IO Unicode)
-> (Ptr () -> IO Unicode) -> IO Unicode
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
repr'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO Unicode) -> IO Unicode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO Unicode
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO Unicode -> (Unicode -> IO Unicode) -> IO Unicode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Unicode
res' ->
  Unicode -> IO Unicode
forall (m :: * -> *) a. Monad m => a -> m a
return (Unicode
res')

{-# LINE 176 "lib/CPython/Protocols/Object.chs" #-}


-- \ As 'ascii', compute a string representation of object /self/, but escape
-- the non-ASCII characters in the string returned by 'repr' with @\x@, @\u@
-- or @\U@ escapes. This generates a string similar to that returned by
-- 'repr' in Python 2.
ascii :: Object self => (self) -> IO ((U.Unicode))
ascii :: self -> IO Unicode
ascii a1 :: self
a1 =
  self -> (Ptr () -> IO Unicode) -> IO Unicode
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Unicode) -> IO Unicode)
-> (Ptr () -> IO Unicode) -> IO Unicode
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
ascii'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO Unicode) -> IO Unicode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO Unicode
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO Unicode -> (Unicode -> IO Unicode) -> IO Unicode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Unicode
res' ->
  Unicode -> IO Unicode
forall (m :: * -> *) a. Monad m => a -> m a
return (Unicode
res')

{-# LINE 185 "lib/CPython/Protocols/Object.chs" #-}


-- | Compute a string representation of object /self/, or throw an exception
-- on failure. This is the equivalent of the Python expression @str(self)@.
string :: Object self => (self) -> IO ((U.Unicode))
string :: self -> IO Unicode
string a1 :: self
a1 =
  self -> (Ptr () -> IO Unicode) -> IO Unicode
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Unicode) -> IO Unicode)
-> (Ptr () -> IO Unicode) -> IO Unicode
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
string'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO Unicode) -> IO Unicode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO Unicode
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO Unicode -> (Unicode -> IO Unicode) -> IO Unicode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Unicode
res' ->
  Unicode -> IO Unicode
forall (m :: * -> *) a. Monad m => a -> m a
return (Unicode
res')

{-# LINE 192 "lib/CPython/Protocols/Object.chs" #-}


-- | Compute a bytes representation of object /self/, or throw an exception
-- on failure. This is equivalent to the Python expression @bytes(self)@.
bytes :: Object self => (self) -> IO ((B.Bytes))
bytes :: self -> IO Bytes
bytes a1 :: self
a1 =
  self -> (Ptr () -> IO Bytes) -> IO Bytes
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Bytes) -> IO Bytes)
-> (Ptr () -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
bytes'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO Bytes) -> IO Bytes
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO Bytes
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO Bytes -> (Bytes -> IO Bytes) -> IO Bytes
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Bytes
res' ->
  Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
res')

callable :: self -> IO Bool
{-# LINE 199 "lib/CPython/Protocols/Object.chs" #-}


-- | Determine if the object /self/ is callable.
callable :: Object self => (self) -> IO ((Bool))
callable a1 =
  withObject a1 $ \a1' -> 
  callable'_ a1' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')

{-# LINE 205 "lib/CPython/Protocols/Object.chs" #-}


-- | Call a callable Python object /self/, with arguments given by the
-- tuple and named arguments given by the dictionary. Returns the result of
-- the call on success, or throws an exception on failure. This is the
-- equivalent of the Python expression @self(*args, **kw)@.
call :: Object self => self -> Tuple -> Dictionary -> IO SomeObject
call :: self -> Tuple -> Dictionary -> IO SomeObject
call self :: self
self args :: Tuple
args kwargs :: Dictionary
kwargs =
  self -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
self ((Ptr () -> IO SomeObject) -> IO SomeObject)
-> (Ptr () -> IO SomeObject) -> IO SomeObject
forall a b. (a -> b) -> a -> b
$ \selfPtr :: Ptr ()
selfPtr ->
  Tuple -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Tuple
args ((Ptr () -> IO SomeObject) -> IO SomeObject)
-> (Ptr () -> IO SomeObject) -> IO SomeObject
forall a b. (a -> b) -> a -> b
$ \argsPtr :: Ptr ()
argsPtr ->
  Dictionary -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
kwargs ((Ptr () -> IO SomeObject) -> IO SomeObject)
-> (Ptr () -> IO SomeObject) -> IO SomeObject
forall a b. (a -> b) -> a -> b
$ \kwargsPtr :: Ptr ()
kwargsPtr ->
  Ptr () -> Ptr () -> Ptr () -> IO (Ptr ())
pyObjectCall Ptr ()
selfPtr Ptr ()
argsPtr Ptr ()
kwargsPtr
  IO (Ptr ()) -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr () -> IO SomeObject
forall obj a. Object obj => Ptr a -> IO obj
stealObject

-- | Call a callable Python object /self/, with arguments given by the list.
callArgs :: Object self => self -> [SomeObject] -> IO SomeObject
callArgs :: self -> [SomeObject] -> IO SomeObject
callArgs self :: self
self args :: [SomeObject]
args = do
  Tuple
args' <- [SomeObject] -> IO Tuple
Tuple.toTuple [SomeObject]
args
  IO Dictionary
D.new IO Dictionary -> (Dictionary -> IO SomeObject) -> IO SomeObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= self -> Tuple -> Dictionary -> IO SomeObject
forall self.
Object self =>
self -> Tuple -> Dictionary -> IO SomeObject
call self
self Tuple
args'

-- | Call the named method of object /self/, with arguments given by the
-- tuple and named arguments given by the dictionary. Returns the result of
-- the call on success, or throws an exception on failure. This is the
-- equivalent of the Python expression @self.method(args)@.
callMethod :: Object self => self -> T.Text -> Tuple -> Dictionary -> IO SomeObject
callMethod :: self -> Text -> Tuple -> Dictionary -> IO SomeObject
callMethod self :: self
self name :: Text
name args :: Tuple
args kwargs :: Dictionary
kwargs = do
  SomeObject
method <- self -> Unicode -> IO SomeObject
forall self. Object self => self -> Unicode -> IO SomeObject
getAttribute self
self (Unicode -> IO SomeObject) -> IO Unicode -> IO SomeObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> IO Unicode
U.toUnicode Text
name
  SomeObject -> Tuple -> Dictionary -> IO SomeObject
forall self.
Object self =>
self -> Tuple -> Dictionary -> IO SomeObject
call SomeObject
method Tuple
args Dictionary
kwargs

-- | Call the named method of object /self/, with arguments given by the
-- list. Returns the result of the call on success, or throws an exception
-- on failure. This is the equivalent of the Python expression
-- @self.method(args)@.
callMethodArgs :: Object self => self -> T.Text -> [SomeObject] -> IO SomeObject
callMethodArgs :: self -> Text -> [SomeObject] -> IO SomeObject
callMethodArgs self :: self
self name :: Text
name args :: [SomeObject]
args = do
  Tuple
args' <- [SomeObject] -> IO Tuple
Tuple.toTuple [SomeObject]
args
  IO Dictionary
D.new IO Dictionary -> (Dictionary -> IO SomeObject) -> IO SomeObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= self -> Text -> Tuple -> Dictionary -> IO SomeObject
forall self.
Object self =>
self -> Text -> Tuple -> Dictionary -> IO SomeObject
callMethod self
self Text
name Tuple
args'

data Comparison = LT | LE | EQ | NE | GT | GE
  deriving (Int -> Comparison -> ShowS
[Comparison] -> ShowS
Comparison -> String
(Int -> Comparison -> ShowS)
-> (Comparison -> String)
-> ([Comparison] -> ShowS)
-> Show Comparison
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comparison] -> ShowS
$cshowList :: [Comparison] -> ShowS
show :: Comparison -> String
$cshow :: Comparison -> String
showsPrec :: Int -> Comparison -> ShowS
$cshowsPrec :: Int -> Comparison -> ShowS
Show)

comparisonToInt :: Comparison -> CInt
comparisonToInt :: Comparison -> CInt
comparisonToInt = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Comparison -> Int) -> Comparison -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HSCPythonComparisonEnum -> Int
forall a. Enum a => a -> Int
fromEnum (HSCPythonComparisonEnum -> Int)
-> (Comparison -> HSCPythonComparisonEnum) -> Comparison -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comparison -> HSCPythonComparisonEnum
enum where
  enum :: Comparison -> HSCPythonComparisonEnum
enum LT = HSCPythonComparisonEnum
HSCPYTHON_LT
  enum LE = HSCPythonComparisonEnum
HSCPYTHON_LE
  enum EQ = HSCPythonComparisonEnum
HSCPYTHON_EQ
  enum NE = HSCPythonComparisonEnum
HSCPYTHON_NE
  enum GT = HSCPythonComparisonEnum
HSCPYTHON_GT
  enum GE = HSCPythonComparisonEnum
HSCPYTHON_GE

-- | Compare the values of /a/ and /b/ using the specified comparison.
-- If an exception is raised, throws an exception.
richCompare :: (Object a, Object b) => (a) -> (b) -> (Comparison) -> IO ((Bool))
richCompare :: a -> b -> Comparison -> IO Bool
richCompare a1 :: a
a1 a2 :: b
a2 a3 :: Comparison
a3 =
  a -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject a
a1 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  b -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject b
a2 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  let {a3' :: CInt
a3' = Comparison -> CInt
comparisonToInt Comparison
a3} in 
  Ptr () -> Ptr () -> CInt -> IO CInt
richCompare'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO Bool
checkBoolReturn CInt
res IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Bool
res' ->
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 262 "lib/CPython/Protocols/Object.chs" #-}


-- | Returns 'True' if the object /self/ is considered to be true, and 'False'
-- otherwise. This is equivalent to the Python expression @not not self@. On
-- failure, throws an exception.
toBool :: Object self => (self) -> IO ((Bool))
toBool :: self -> IO Bool
toBool a1 :: self
a1 =
  self -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO CInt
toBool'_ Ptr ()
a1' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO Bool
checkBoolReturn CInt
res IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Bool
res' ->
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 270 "lib/CPython/Protocols/Object.chs" #-}


-- | Compute and return the hash value of an object /self/. On failure,
-- throws an exception. This is the equivalent of the Python expression
-- @hash(self)@.
hash :: Object self => (self) -> IO ((Integer))
hash :: self -> IO Integer
hash a1 :: self
a1 =
  self -> (Ptr () -> IO Integer) -> IO Integer
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO Integer) -> IO Integer)
-> (Ptr () -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO CLong
hash'_ Ptr ()
a1' IO CLong -> (CLong -> IO Integer) -> IO Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CLong
res ->
  CLong -> IO Integer
forall a. Integral a => a -> IO Integer
checkIntReturn CLong
res IO Integer -> (Integer -> IO Integer) -> IO Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Integer
res' ->
  Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
res')

{-# LINE 278 "lib/CPython/Protocols/Object.chs" #-}


-- | This is equivalent to the Python expression @dir(self)@, returning a
-- (possibly empty) list of strings appropriate for the object argument,
-- or throws an exception if there was an error.
dir :: Object self => (self) -> IO ((List))
dir :: self -> IO List
dir a1 :: self
a1 =
  self -> (Ptr () -> IO List) -> IO List
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO List) -> IO List) -> (Ptr () -> IO List) -> IO List
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
dir'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO List) -> IO List
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO List
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO List -> (List -> IO List) -> IO List
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: List
res' ->
  List -> IO List
forall (m :: * -> *) a. Monad m => a -> m a
return (List
res')

{-# LINE 286 "lib/CPython/Protocols/Object.chs" #-}


-- | This is equivalent to the Python expression @iter(self)@. It returns a
-- new iterator for the object argument, or the object itself if the object
-- is already an iterator. Throws @TypeError@ if the object cannot be
-- iterated.
getIterator :: Object self => (self) -> IO ((SomeObject))
getIterator :: self -> IO SomeObject
getIterator a1 :: self
a1 =
  self -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject self
a1 ((Ptr () -> IO SomeObject) -> IO SomeObject)
-> (Ptr () -> IO SomeObject) -> IO SomeObject
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
getIterator'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO SomeObject) -> IO SomeObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO SomeObject
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO SomeObject -> (SomeObject -> IO SomeObject) -> IO SomeObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: SomeObject
res' ->
  SomeObject -> IO SomeObject
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeObject
res')

{-# LINE 295 "lib/CPython/Protocols/Object.chs" #-}


foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_Type"
  getType'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_IsInstance"
  isInstance'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_IsSubclass"
  isSubclass'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_HasAttr"
  hasAttribute'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_GetAttr"
  getAttribute'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_SetAttr"
  setAttribute'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "CPython/Protocols/Object.chs.h hscpython_PyObject_DelAttr"
  deleteAttribute'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_Repr"
  repr'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_ASCII"
  ascii'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_Str"
  string'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_Bytes"
  bytes'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyCallable_Check"
  callable'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_Call"
  pyObjectCall :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_RichCompareBool"
  richCompare'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_IsTrue"
  toBool'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_Hash"
  hash'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CLong))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_Dir"
  dir'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "CPython/Protocols/Object.chs.h PyObject_GetIter"
  getIterator'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))