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


{-# LINE 1 "lib/CPython/Reflection.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.Reflection
  ( getBuiltins
  , getLocals
  , getGlobals
  , getFrame
  , getFunctionName
  , getFunctionDescription
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





import           Data.Text (Text)

import           CPython.Internal

-- | Return a 'Dictionary' of the builtins in the current execution frame,
-- or the interpreter of the thread state if no frame is currently executing.
getBuiltins :: IO ((Dictionary))
getBuiltins :: IO Dictionary
getBuiltins =
  IO (Ptr ())
getBuiltins'_ IO (Ptr ()) -> (Ptr () -> IO Dictionary) -> IO Dictionary
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  Ptr () -> IO Dictionary
forall obj a. Object obj => Ptr a -> IO obj
peekObject Ptr ()
res IO Dictionary -> (Dictionary -> IO Dictionary) -> IO Dictionary
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Dictionary
res' ->
  Dictionary -> IO Dictionary
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dictionary
res')

{-# LINE 36 "lib/CPython/Reflection.chs" #-}


-- | Return a 'Dictionary' of the local variables in the current execution
-- frame, or 'Nothing' if no frame is currently executing.
getLocals :: IO (Maybe Dictionary)
getLocals = pyEvalGetLocals >>= maybePeek peekObject

-- | Return a 'Dictionary' of the global variables in the current execution
-- frame, or 'Nothing' if no frame is currently executing.
getGlobals :: IO (Maybe Dictionary)
getGlobals :: IO (Maybe Dictionary)
getGlobals = IO (Ptr ())
pyEvalGetGlobals IO (Ptr ())
-> (Ptr () -> IO (Maybe Dictionary)) -> IO (Maybe Dictionary)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr () -> IO Dictionary) -> Ptr () -> IO (Maybe Dictionary)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr () -> IO Dictionary
forall obj a. Object obj => Ptr a -> IO obj
peekObject

-- | Return the current thread state's frame, which is 'Nothing' if no frame
-- is currently executing.
getFrame :: IO (Maybe SomeObject)
getFrame :: IO (Maybe SomeObject)
getFrame = IO (Ptr ())
pyEvalGetFrame IO (Ptr ())
-> (Ptr () -> IO (Maybe SomeObject)) -> IO (Maybe SomeObject)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr () -> IO SomeObject) -> Ptr () -> IO (Maybe SomeObject)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr () -> IO SomeObject
forall obj a. Object obj => Ptr a -> IO obj
peekObject

-- | Return the name of /func/ if it is a function, class or instance object,
-- else the name of /func/'s type.
getFunctionName :: Object func => (func) -> IO ((Text))
getFunctionName :: forall func. Object func => func -> IO Text
getFunctionName func
a1 =
  func -> (Ptr () -> IO Text) -> IO Text
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject func
a1 ((Ptr () -> IO Text) -> IO Text) -> (Ptr () -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' -> 
  Ptr () -> IO (Ptr CChar)
getFunctionName'_ Ptr ()
a1' IO (Ptr CChar) -> (Ptr CChar -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr CChar
res ->
  Ptr CChar -> IO Text
peekText Ptr CChar
res IO Text -> (Text -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
res' ->
  Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
res')

{-# LINE 58 "lib/CPython/Reflection.chs" #-}


-- | Return a description string, depending on the type of func. Return
-- values include @\"()\"@ for functions and methods, @\"constructor\"@,
-- @\"instance\"@, and @\"object\"@. Concatenated with the result of
-- 'getFunctionName', the result will be a description of /func/.
getFunctionDescription :: Object func => (func) -> IO ((Text))
getFunctionDescription :: forall func. Object func => func -> IO Text
getFunctionDescription func
a1 =
  func -> (Ptr () -> IO Text) -> IO Text
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject func
a1 ((Ptr () -> IO Text) -> IO Text) -> (Ptr () -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' -> 
  Ptr () -> IO (Ptr CChar)
getFunctionDescription'_ Ptr ()
a1' IO (Ptr CChar) -> (Ptr CChar -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr CChar
res ->
  Ptr CChar -> IO Text
peekText Ptr CChar
res IO Text -> (Text -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
res' ->
  Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
res')

{-# LINE 67 "lib/CPython/Reflection.chs" #-}


foreign import ccall safe "CPython/Reflection.chs.h PyEval_GetBuiltins"
  getBuiltins'_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "CPython/Reflection.chs.h PyEval_GetLocals"
  pyEvalGetLocals :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "CPython/Reflection.chs.h PyEval_GetGlobals"
  pyEvalGetGlobals :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "CPython/Reflection.chs.h PyEval_GetFrame"
  pyEvalGetFrame :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "CPython/Reflection.chs.h PyEval_GetFuncName"
  getFunctionName'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "CPython/Reflection.chs.h PyEval_GetFuncDesc"
  getFunctionDescription'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))