module CPython.Protocols.Object
( Object
, Concrete
, SomeObject
, getType
, isInstance
, isSubclass
, toObject
, cast
, hasAttribute
, getAttribute
, setAttribute
, deleteAttribute
, print
, repr
, ascii
, string
, bytes
, callable
, call
, callArgs
, callMethod
, callMethodArgs
, 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
getType :: Object self => self -> IO (Type)
getType a1 =
withObject a1 $ \a1' ->
getType'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
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')
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')
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
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')
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')
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')
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')
print :: Object self => self -> Handle -> IO ()
print obj h = repr obj >>= U.fromUnicode >>= (hPutStrLn h . T.unpack)
repr :: Object self => self -> IO (U.Unicode)
repr a1 =
withObject a1 $ \a1' ->
repr'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
ascii :: Object self => self -> IO (U.Unicode)
ascii a1 =
withObject a1 $ \a1' ->
ascii'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
string :: Object self => self -> IO (U.Unicode)
string a1 =
withObject a1 $ \a1' ->
string'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
bytes :: Object self => self -> IO (B.Bytes)
bytes a1 =
withObject a1 $ \a1' ->
bytes'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
callable :: Object self => self -> IO (Bool)
callable a1 =
withObject a1 $ \a1' ->
callable'_ a1' >>= \res ->
checkBoolReturn res >>= \res' ->
return (res')
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
callArgs :: Object self => self -> [SomeObject] -> IO SomeObject
callArgs self args = do
args' <- Tuple.toTuple args
D.new >>= call self 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
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)
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
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')
toBool :: Object self => self -> IO (Bool)
toBool a1 =
withObject a1 $ \a1' ->
toBool'_ a1' >>= \res ->
checkBoolReturn res >>= \res' ->
return (res')
hash :: Object self => self -> IO (Integer)
hash a1 =
withObject a1 $ \a1' ->
hash'_ a1' >>= \res ->
checkIntReturn res >>= \res' ->
return (res')
dir :: Object self => self -> IO (List)
dir a1 =
withObject a1 $ \a1' ->
dir'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
getIterator :: Object self => self -> IO (SomeObject)
getIterator a1 =
withObject a1 $ \a1' ->
getIterator'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
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 ())))