-- 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/Types/Dictionary.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.Types.Dictionary
	( Dictionary
	, dictionaryType
	, new
	, clear
	, contains
	, copy
	, getItem
	, setItem
	, deleteItem
	, items
	, keys
	, values
	, size
	, merge
	, update
	, mergeFromSeq2
	) where


import           CPython.Internal hiding (new)

instance Concrete Dictionary where
	concreteType _ = dictionaryType

dictionaryType :: Type
dictionaryType =
  unsafePerformIO $
  let {res = dictionaryType'_} in
  peekStaticObject res >>= \res' ->
  return (res')
{-# LINE 45 "lib/CPython/Types/Dictionary.chs" #-}

new :: IO (Dictionary)
new =
  new'_ >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 48 "lib/CPython/Types/Dictionary.chs" #-}

-- newProxy

-- | Empty an existing dictionary of all key-value pairs.
clear :: Dictionary -> IO (())
clear a1 =
  withObject a1 $ \a1' -> 
  clear'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 55 "lib/CPython/Types/Dictionary.chs" #-}

-- | Determine if a dictionary contains /key/. If an item in the dictionary
-- matches /key/, return 'True', otherwise return 'False'. On error, throws
-- an exception. This is equivalent to the Python expression @key in d@.
contains :: Object key => Dictionary -> key -> IO (Bool)
contains a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  contains'_ a1' a2' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')
{-# LINE 64 "lib/CPython/Types/Dictionary.chs" #-}

-- | Return a new dictionary that contains the same key-value pairs as the
-- old dictionary.
copy :: Dictionary -> IO (Dictionary)
copy a1 =
  withObject a1 $ \a1' -> 
  copy'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 70 "lib/CPython/Types/Dictionary.chs" #-}

-- | Return the object from a dictionary which has a key /key/. Return
-- 'Nothing' if the key is not present.
getItem :: Object key => Dictionary -> key -> IO (Maybe SomeObject)
getItem dict key =
	withObject dict $ \dict' ->
	withObject key $ \key' -> do
	pyErrClear
{-# LINE 78 "lib/CPython/Types/Dictionary.chs" #-}
	raw <- pyDictGetItemWithError dict' key'
	if raw /= nullPtr
		then Just `fmap` peekObject raw
		else do
			exc <- pyErrOccurred
{-# LINE 83 "lib/CPython/Types/Dictionary.chs" #-}
			exceptionIf $ exc /= nullPtr
			return Nothing

-- getItemString

-- | Inserts /value/ into a dictionary with a key of /key/. /key/ must be
-- hashable; if it isn&#x2019;t, throws @TypeError@.
setItem :: (Object key, Object value) => Dictionary -> key -> value -> IO (())
setItem a1 a2 a3 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  withObject a3 $ \a3' -> 
  setItem'_ a1' a2' a3' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 96 "lib/CPython/Types/Dictionary.chs" #-}

-- setItemString

-- | Remove the entry in a dictionary with key /key/. /key/ must be hashable;
-- if it isn&#x2019;t, throws @TypeError@.
deleteItem :: Object key => Dictionary -> key -> IO (())
deleteItem a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  deleteItem'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 106 "lib/CPython/Types/Dictionary.chs" #-}

-- deleteItemString

-- | Return a 'List' containing all the items in the dictionary, as in
-- the Python method @dict.items()@.
items :: Dictionary -> IO (List)
items a1 =
  withObject a1 $ \a1' -> 
  items'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 114 "lib/CPython/Types/Dictionary.chs" #-}

-- | Return a 'List' containing all the keys in the dictionary, as in
-- the Python method @dict.keys()@.
keys :: Dictionary -> IO (List)
keys a1 =
  withObject a1 $ \a1' -> 
  keys'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 120 "lib/CPython/Types/Dictionary.chs" #-}

-- | Return a 'List' containing all the values in the dictionary, as in
-- the Python method @dict.values()@.
values :: Dictionary -> IO (List)
values a1 =
  withObject a1 $ \a1' -> 
  values'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 126 "lib/CPython/Types/Dictionary.chs" #-}

-- | Return the number of items in the dictionary. This is equivalent to
-- @len(d)@.
size :: Dictionary -> IO (Integer)
size a1 =
  withObject a1 $ \a1' -> 
  size'_ a1' >>= \res ->
  checkIntReturn res >>= \res' ->
  return (res')
{-# LINE 132 "lib/CPython/Types/Dictionary.chs" #-}

-- next

-- | Iterate over mapping object /b/ adding key-value pairs to a dictionary.
-- /b/ may be a dictionary, or any object supporting 'keys' and 'getItem'.
-- If the third parameter is 'True', existing pairs in will be replaced if a
-- matching key is found in /b/, otherwise pairs will only be added if there
-- is not already a matching key.
merge :: Mapping b => Dictionary -> b -> Bool -> IO (())
merge a1 a2 a3 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  let {a3' = fromBool a3} in 
  merge'_ a1' a2' a3' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 146 "lib/CPython/Types/Dictionary.chs" #-}

-- | This is the same as @(\\a b -> 'merge' a b True)@ in Haskell, or
-- @a.update(b)@ in Python.
update :: Mapping b => Dictionary -> b -> IO (())
update a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  update'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 154 "lib/CPython/Types/Dictionary.chs" #-}

-- | Update or merge into a dictionary, from the key-value pairs in /seq2/.
-- /seq2/ must be an iterable object producing iterable objects of length 2,
-- viewed as key-value pairs. In case of duplicate keys, the last wins if
-- the third parameter is 'True', otherwise the first wins. Equivalent
-- Python:
--
-- @
-- def mergeFromSeq2(a, seq2, override):
-- 	for key, value in seq2:
-- 		if override or key not in a:
-- 			a[key] = value
-- @
mergeFromSeq2 :: Object seq2 => Dictionary -> seq2 -> Bool -> IO (())
mergeFromSeq2 a1 a2 a3 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  let {a3' = fromBool a3} in 
  mergeFromSeq2'_ a1' a2' a3' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 173 "lib/CPython/Types/Dictionary.chs" #-}

foreign import ccall unsafe "CPython/Types/Dictionary.chs.h hscpython_PyDict_Type"
  dictionaryType'_ :: (Ptr ())

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_New"
  new'_ :: (IO (Ptr ()))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Clear"
  clear'_ :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Contains"
  contains'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Copy"
  copy'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyErr_Clear"
  pyErrClear :: (IO ())

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_GetItemWithError"
  pyDictGetItemWithError :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyErr_Occurred"
  pyErrOccurred :: (IO (Ptr ()))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_SetItem"
  setItem'_ :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO CInt))))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_DelItem"
  deleteItem'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Items"
  items'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Keys"
  keys'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Values"
  values'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Size"
  size'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Merge"
  merge'_ :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO CInt))))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Update"
  update'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_MergeFromSeq2"
  mergeFromSeq2'_ :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> (IO CInt))))