-- GENERATED by C->Haskell Compiler, version 0.17.2 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "lib/CPython/Types/Set.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/>.

-- | Any functionality not listed below is best accessed using the either
-- the 'Object' protocol (including 'callMethod', 'richCompare', 'hash',
-- 'repr', 'isTrue', and 'getIter') or the 'Number' protocol (including 'and',
-- 'subtract', 'or', 'xor', 'inPlaceAnd', 'inPlaceSubtract', 'inPlaceOr',
-- and 'inPlaceXor').
module CPython.Types.Set
	( AnySet
	, Set
	, FrozenSet
	, setType
	, frozenSetType
	, toSet
	, toFrozenSet
	, iterableToSet
	, iterableToFrozenSet
	, fromSet
	, size
	, contains
	, add
	, discard
	, pop
	, clear
	) where



import           CPython.Internal
import           CPython.Types.Tuple (toTuple, iterableToTuple, fromTuple)

class Object a => AnySet a

newtype Set = Set (ForeignPtr Set)

instance Object Set where
	toObject (Set x) = SomeObject x
	fromForeignPtr = Set

instance Concrete Set where
	concreteType _ = setType

newtype FrozenSet = FrozenSet (ForeignPtr FrozenSet)

instance Object FrozenSet where
	toObject (FrozenSet x) = SomeObject x
	fromForeignPtr = FrozenSet

instance Concrete FrozenSet where
	concreteType _ = frozenSetType

instance AnySet Set
instance AnySet FrozenSet

setType :: (Type)
setType =
  unsafePerformIO $
  let {res = setType'_} in
  peekStaticObject res >>= \res' ->
  return (res')

{-# LINE 71 "lib/CPython/Types/Set.chs" #-}


frozenSetType :: (Type)
frozenSetType =
  unsafePerformIO $
  let {res = frozenSetType'_} in
  peekStaticObject res >>= \res' ->
  return (res')

{-# LINE 74 "lib/CPython/Types/Set.chs" #-}


toSet :: [SomeObject] -> IO Set
toSet xs = toTuple xs >>= iterableToSet

toFrozenSet :: [SomeObject] -> IO FrozenSet
toFrozenSet xs = toTuple xs >>= iterableToFrozenSet

-- | Return a new 'Set' from the contents of an iterable 'Object'. The object
-- may be 'Nothing' to create an empty set. Throws a @TypeError@ if the object
-- is not iterable.
iterableToSet :: Object obj => (obj) -> IO ((Set))
iterableToSet a1 =
  withObject a1 $ \a1' -> 
  iterableToSet'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')

{-# LINE 88 "lib/CPython/Types/Set.chs" #-}


-- | Return a new 'FrozenSet' from the contents of an iterable 'Object'. The
-- object may be 'Nothing' to create an empty frozen set. Throws a @TypeError@
-- if the object is not iterable.
iterableToFrozenSet :: Object obj => (obj) -> IO ((FrozenSet))
iterableToFrozenSet a1 =
  withObject a1 $ \a1' -> 
  iterableToFrozenSet'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')

{-# LINE 96 "lib/CPython/Types/Set.chs" #-}


fromSet :: AnySet set => set -> IO [SomeObject]
fromSet set = iterableToTuple set >>= fromTuple

-- | Return the size of a 'Set' or 'FrozenSet'.
size :: AnySet set => (set) -> IO ((Integer))
size a1 =
  withObject a1 $ \a1' -> 
  size'_ a1' >>= \res ->
  checkIntReturn res >>= \res' ->
  return (res')

{-# LINE 105 "lib/CPython/Types/Set.chs" #-}


-- | Return 'True' if found, 'False' if not found. Unlike the Python
-- @__contains__()@ method, this computation does not automatically convert
-- unhashable 'Set's into temporary 'FrozenSet's. Throws a @TypeError@ if the
-- key is unhashable.
contains :: (AnySet set, Object key) => (set) -> (key) -> IO ((Bool))
contains a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  contains'_ a1' a2' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')

{-# LINE 115 "lib/CPython/Types/Set.chs" #-}


-- | Add /key/ to a 'Set'. Also works with 'FrozenSet' (like
-- 'CPython.Types.Tuple.setItem' it can be used to fill-in the values of
-- brand new 'FrozenSet's before they are exposed to other code). Throws a
-- @TypeError@ if the key is unhashable. Throws a @MemoryError@ if there is
-- no room to grow.
add :: (AnySet set, Object key) => set -> key -> IO ()
add = c_add

-- c2hs won't accept functions named "add" any more, so have it generate
-- c_add and then wrap that manually.
c_add :: (AnySet set, Object key) => (set) -> (key) -> IO ((()))
c_add a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  c_add'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')

{-# LINE 131 "lib/CPython/Types/Set.chs" #-}


-- | Return 'True' if found and removed, 'False' if not found (no action
-- taken). Does not throw @KeyError@ for missing keys. Throws a @TypeError@
-- if /key/ is unhashable. Unlike the Python @discard()@ method, this
-- computation does not automatically convert unhashable sets into temporary
-- 'FrozenSet's.
discard :: Object key => (Set) -> (key) -> IO ((Bool))
discard a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  discard'_ a1' a2' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')

{-# LINE 142 "lib/CPython/Types/Set.chs" #-}


-- | Return an arbitrary object in the set, and removes the object from the
-- set. Throws @KeyError@ if the set is empty.
pop :: (Set) -> IO ((SomeObject))
pop a1 =
  withObject a1 $ \a1' -> 
  pop'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')

{-# LINE 148 "lib/CPython/Types/Set.chs" #-}


-- | Remove all elements from a set.
clear :: (Set) -> IO ((()))
clear a1 =
  withObject a1 $ \a1' -> 
  clear'_ a1' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')

{-# LINE 153 "lib/CPython/Types/Set.chs" #-}


foreign import ccall unsafe "CPython/Types/Set.chs.h hscpython_PySet_Type"
  setType'_ :: (Ptr ())

foreign import ccall unsafe "CPython/Types/Set.chs.h hscpython_PyFrozenSet_Type"
  frozenSetType'_ :: (Ptr ())

foreign import ccall safe "CPython/Types/Set.chs.h PySet_New"
  iterableToSet'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Types/Set.chs.h PyFrozenSet_New"
  iterableToFrozenSet'_ :: ((Ptr ()) -> (IO (Ptr ())))

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

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

foreign import ccall safe "CPython/Types/Set.chs.h PySet_Add"
  c_add'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Types/Set.chs.h PySet_Discard"
  discard'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Types/Set.chs.h PySet_Pop"
  pop'_ :: ((Ptr ()) -> (IO (Ptr ())))

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