{-# LINE 1 "lib/CPython/Protocols/Object.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
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 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
getType :: Object self => (self) -> IO ((Type))
getType a1 =
withObject a1 $ \a1' ->
getType'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
{-# LINE 78 "lib/CPython/Protocols/Object.chs" #-}
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 105 "lib/CPython/Protocols/Object.chs" #-}
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 118 "lib/CPython/Protocols/Object.chs" #-}
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')
{-# LINE 138 "lib/CPython/Protocols/Object.chs" #-}
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 147 "lib/CPython/Protocols/Object.chs" #-}
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 157 "lib/CPython/Protocols/Object.chs" #-}
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 166 "lib/CPython/Protocols/Object.chs" #-}
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')
{-# LINE 177 "lib/CPython/Protocols/Object.chs" #-}
ascii :: Object self => (self) -> IO ((U.Unicode))
ascii a1 =
withObject a1 $ \a1' ->
ascii'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
{-# LINE 186 "lib/CPython/Protocols/Object.chs" #-}
string :: Object self => (self) -> IO ((U.Unicode))
string a1 =
withObject a1 $ \a1' ->
string'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
{-# LINE 193 "lib/CPython/Protocols/Object.chs" #-}
bytes :: Object self => (self) -> IO ((B.Bytes))
bytes a1 =
withObject a1 $ \a1' ->
bytes'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
{-# LINE 200 "lib/CPython/Protocols/Object.chs" #-}
callable :: Object self => (self) -> IO ((Bool))
callable a1 =
withObject a1 $ \a1' ->
callable'_ a1' >>= \res ->
checkBoolReturn res >>= \res' ->
return (res')
{-# LINE 206 "lib/CPython/Protocols/Object.chs" #-}
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)
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')
{-# LINE 263 "lib/CPython/Protocols/Object.chs" #-}
toBool :: Object self => (self) -> IO ((Bool))
toBool a1 =
withObject a1 $ \a1' ->
toBool'_ a1' >>= \res ->
checkBoolReturn res >>= \res' ->
return (res')
{-# LINE 271 "lib/CPython/Protocols/Object.chs" #-}
hash :: Object self => (self) -> IO ((Integer))
hash a1 =
withObject a1 $ \a1' ->
hash'_ a1' >>= \res ->
checkIntReturn res >>= \res' ->
return (res')
{-# LINE 279 "lib/CPython/Protocols/Object.chs" #-}
dir :: Object self => (self) -> IO ((List))
dir a1 =
withObject a1 $ \a1' ->
dir'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
{-# LINE 287 "lib/CPython/Protocols/Object.chs" #-}
getIterator :: Object self => (self) -> IO ((SomeObject))
getIterator a1 =
withObject a1 $ \a1' ->
getIterator'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
{-# LINE 296 "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 CLong))
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 ())))