-- GENERATED by C->Haskell Compiler, version 0.28.7 Switcheroo, 25 November 2017 (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 qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp





import           CPython.Internal hiding (new)

instance Concrete Dictionary where
  concreteType _ = dictionaryType

dictionaryType :: (Type)
dictionaryType =
  C2HSImp.unsafePerformIO (IO Type -> Type) -> IO Type -> Type
forall a b. (a -> b) -> a -> b
$
  IO (Ptr ())
dictionaryType'_ IO (Ptr ()) -> (Ptr () -> IO Type) -> IO Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO Type
forall obj a. Object obj => Ptr a -> IO obj
peekStaticObject Ptr ()
res IO Type -> (Type -> IO Type) -> IO Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Type
res' ->
  Type -> IO Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
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 :: Dictionary -> key -> IO Bool
contains a1 :: Dictionary
a1 a2 :: key
a2 =
  Dictionary -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
a1 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  key -> (Ptr () -> IO Bool) -> IO Bool
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject key
a2 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  Ptr () -> Ptr () -> IO CInt
contains'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO Bool
checkBoolReturn CInt
res IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Bool
res' ->
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
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 :: Dictionary -> IO Dictionary
copy a1 :: Dictionary
a1 =
  Dictionary -> (Ptr () -> IO Dictionary) -> IO Dictionary
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
a1 ((Ptr () -> IO Dictionary) -> IO Dictionary)
-> (Ptr () -> IO Dictionary) -> IO Dictionary
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
copy'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO Dictionary) -> IO Dictionary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO Dictionary
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO Dictionary -> (Dictionary -> IO Dictionary) -> IO Dictionary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Dictionary
res' ->
  Dictionary -> IO Dictionary
forall (m :: * -> *) a. Monad m => a -> m a
return (Dictionary
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 :: Dictionary -> key -> value -> IO ()
setItem a1 :: Dictionary
a1 a2 :: key
a2 a3 :: value
a3 =
  Dictionary -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  key -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject key
a2 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  value -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject value
a3 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a3' :: Ptr ()
a3' -> 
  Ptr () -> Ptr () -> Ptr () -> IO CInt
setItem'_ Ptr ()
a1' Ptr ()
a2' Ptr ()
a3' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 :: Dictionary -> key -> IO ()
deleteItem a1 :: Dictionary
a1 a2 :: key
a2 =
  Dictionary -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  key -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject key
a2 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  Ptr () -> Ptr () -> IO CInt
deleteItem'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 :: Dictionary -> IO List
items a1 :: Dictionary
a1 =
  Dictionary -> (Ptr () -> IO List) -> IO List
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
a1 ((Ptr () -> IO List) -> IO List) -> (Ptr () -> IO List) -> IO List
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO (Ptr ())
items'_ Ptr ()
a1' IO (Ptr ()) -> (Ptr () -> IO List) -> IO List
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  Ptr () -> IO List
forall obj a. Object obj => Ptr a -> IO obj
stealObject Ptr ()
res IO List -> (List -> IO List) -> IO List
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: List
res' ->
  List -> IO List
forall (m :: * -> *) a. Monad m => a -> m a
return (List
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 :: Dictionary -> b -> Bool -> IO ()
merge a1 :: Dictionary
a1 a2 :: b
a2 a3 :: Bool
a3 =
  Dictionary -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  b -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject b
a2 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  let {a3' :: CInt
a3' = Bool -> CInt
forall a. Num a => Bool -> a
C2HSImp.fromBool Bool
a3} in 
  Ptr () -> Ptr () -> CInt -> IO CInt
merge'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 :: Dictionary -> b -> IO ()
update a1 :: Dictionary
a1 a2 :: b
a2 =
  Dictionary -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  b -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject b
a2 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  Ptr () -> Ptr () -> IO CInt
update'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 :: Dictionary -> seq2 -> Bool -> IO ()
mergeFromSeq2 a1 :: Dictionary
a1 a2 :: seq2
a2 a3 :: Bool
a3 =
  Dictionary -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Dictionary
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  seq2 -> (Ptr () -> IO ()) -> IO ()
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject seq2
a2 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a2' :: Ptr ()
a2' -> 
  let {a3' :: CInt
a3' = Bool -> CInt
forall a. Num a => Bool -> a
C2HSImp.fromBool Bool
a3} in 
  Ptr () -> Ptr () -> CInt -> IO CInt
mergeFromSeq2'_ Ptr ()
a1' Ptr ()
a2' CInt
a3' IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  CInt -> IO ()
checkStatusCode CInt
res IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: ()
res' ->
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (()
res')

{-# LINE 173 "lib/CPython/Types/Dictionary.chs" #-}


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

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

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

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

foreign import ccall safe "CPython/Types/Dictionary.chs.h PyDict_Copy"
  copy'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.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 :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))

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

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

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

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

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

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

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

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

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

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