-- 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/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           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 =
  getBuiltins'_ >>= \res ->
  peekObject res >>= \res' ->
  return (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 = pyEvalGetGlobals >>= maybePeek peekObject

-- | Return the current thread state's frame, which is 'Nothing' if no frame
-- is currently executing.
getFrame :: IO (Maybe SomeObject)
getFrame = pyEvalGetFrame >>= maybePeek 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 a1 =
  withObject a1 $ \a1' -> 
  getFunctionName'_ a1' >>= \res ->
  peekText res >>= \res' ->
  return (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 a1 =
  withObject a1 $ \a1' -> 
  getFunctionDescription'_ a1' >>= \res ->
  peekText res >>= \res' ->
  return (res')
{-# LINE 67 "lib/CPython/Reflection.chs" #-}

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

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

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

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

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

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