-- GENERATED by C->Haskell Compiler, version 0.16.4 Crystal Seed, 24 Jan 2009 (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           Prelude hiding (Ordering (..), print)
import qualified Data.Text as T
import           System.IO (Handle, hPutStrLn)

import           CPython.Internal hiding (toBool)
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 a1 =
  withObject a1 $ \a1' -> 
  getType'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 77 "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 a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  isInstance'_ a1' a2' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')
{-# LINE 104 "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 a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  isSubclass'_ a1' a2' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')
{-# LINE 117 "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 obj = do
	let castObj = case toObject obj of
		SomeObject ptr -> fromForeignPtr $ castForeignPtr ptr
	validCast <- isInstance obj $ concreteType castObj
	return $ if validCast
		then Just castObj
		else 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 a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  hasAttribute'_ a1' a2' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (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 a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  getAttribute'_ a1' a2' >>= \res ->
  stealObject res >>= \res' ->
  return (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 a1 a2 a3 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  withObject a3 $ \a3' -> 
  setAttribute'_ a1' a2' a3' >>= \res ->
  checkStatusCode res >>= \res' ->
  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 a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  deleteAttribute'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  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 a1 =
  withObject a1 $ \a1' -> 
  repr'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (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 a1 =
  withObject a1 $ \a1' -> 
  ascii'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (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 a1 =
  withObject a1 $ \a1' -> 
  string'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (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 a1 =
  withObject a1 $ \a1' -> 
  bytes'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# 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 args kwargs =
	withObject self $ \selfPtr ->
	withObject args $ \argsPtr ->
	withObject kwargs $ \kwargsPtr ->
	pyObjectCall selfPtr argsPtr kwargsPtr
	>>= stealObject

-- | Call a callable Python object /self/, with arguments given by the list.
callArgs :: Object self => self -> [SomeObject] -> IO SomeObject
callArgs self args = do
	args' <- Tuple.toTuple args
	D.new >>= call self 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 name args kwargs = do
	method <- getAttribute self =<< U.toUnicode name
	call method args 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 name args = do
	args' <- Tuple.toTuple args
	D.new >>= callMethod self name args'

data Comparison = LT | LE | EQ | NE | GT | GE
	deriving (Show)

data HSCPythonComparisonEnum = HSCPYTHON_LT
                             | HSCPYTHON_LE
                             | HSCPYTHON_EQ
                             | HSCPYTHON_NE
                             | HSCPYTHON_GT
                             | HSCPYTHON_GE
                             
instance Enum HSCPythonComparisonEnum where
  fromEnum HSCPYTHON_LT = 0
  fromEnum HSCPYTHON_LE = 1
  fromEnum HSCPYTHON_EQ = 2
  fromEnum HSCPYTHON_NE = 3
  fromEnum HSCPYTHON_GT = 4
  fromEnum HSCPYTHON_GE = 5

  toEnum 0 = HSCPYTHON_LT
  toEnum 1 = HSCPYTHON_LE
  toEnum 2 = HSCPYTHON_EQ
  toEnum 3 = HSCPYTHON_NE
  toEnum 4 = HSCPYTHON_GT
  toEnum 5 = HSCPYTHON_GE
  toEnum unmatched = error ("HSCPythonComparisonEnum.toEnum: Cannot match " ++ show unmatched)

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

comparisonToInt :: Comparison -> CInt
comparisonToInt = fromIntegral . fromEnum . enum where
	enum LT = HSCPYTHON_LT
	enum LE = HSCPYTHON_LE
	enum EQ = HSCPYTHON_EQ
	enum NE = HSCPYTHON_NE
	enum GT = HSCPYTHON_GT
	enum GE = 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 a1 a2 a3 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  let {a3' = comparisonToInt a3} in 
  richCompare'_ a1' a2' a3' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')
{-# LINE 264 "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 a1 =
  withObject a1 $ \a1' -> 
  toBool'_ a1' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')
{-# LINE 272 "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 a1 =
  withObject a1 $ \a1' -> 
  hash'_ a1' >>= \res ->
  checkIntReturn res >>= \res' ->
  return (res')
{-# LINE 280 "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 a1 =
  withObject a1 $ \a1' -> 
  dir'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 288 "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 a1 =
  withObject a1 $ \a1' -> 
  getIterator'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 297 "lib/CPython/Protocols/Object.chs" #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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