{-# LANGUAGE ForeignFunctionInterface #-}

-- | Module which generates globally unique 'ObjectID's.
module Util.Object (
   ObjectID(..),
   Object(..),
   newObject, -- generates a unique object
   staticObject,
      -- generates a not-necessarily unique object given a
      -- postive integer.  But at least it will be different from all those
      -- generated by newObject, or with a different integer.
   newInt -- generates a unique integer.
   ) where

-- --------------------------------------------------------------------------
-- Class Object
-- --------------------------------------------------------------------------

newtype ObjectID = ObjectID Int deriving (ObjectID -> ObjectID -> Bool
(ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> Bool) -> Eq ObjectID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectID -> ObjectID -> Bool
$c/= :: ObjectID -> ObjectID -> Bool
== :: ObjectID -> ObjectID -> Bool
$c== :: ObjectID -> ObjectID -> Bool
Eq,Eq ObjectID
Eq ObjectID
-> (ObjectID -> ObjectID -> Ordering)
-> (ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> ObjectID)
-> (ObjectID -> ObjectID -> ObjectID)
-> Ord ObjectID
ObjectID -> ObjectID -> Bool
ObjectID -> ObjectID -> Ordering
ObjectID -> ObjectID -> ObjectID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ObjectID -> ObjectID -> ObjectID
$cmin :: ObjectID -> ObjectID -> ObjectID
max :: ObjectID -> ObjectID -> ObjectID
$cmax :: ObjectID -> ObjectID -> ObjectID
>= :: ObjectID -> ObjectID -> Bool
$c>= :: ObjectID -> ObjectID -> Bool
> :: ObjectID -> ObjectID -> Bool
$c> :: ObjectID -> ObjectID -> Bool
<= :: ObjectID -> ObjectID -> Bool
$c<= :: ObjectID -> ObjectID -> Bool
< :: ObjectID -> ObjectID -> Bool
$c< :: ObjectID -> ObjectID -> Bool
compare :: ObjectID -> ObjectID -> Ordering
$ccompare :: ObjectID -> ObjectID -> Ordering
$cp1Ord :: Eq ObjectID
Ord)

class Object o where
   objectID :: o -> ObjectID

instance Show ObjectID where
   showsPrec :: Int -> ObjectID -> ShowS
showsPrec Int
d (ObjectID Int
n) String
r = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Int
n String
r

instance Read ObjectID where
   readsPrec :: Int -> ReadS ObjectID
readsPrec Int
p String
b =
      case ReadS Int
forall a. Read a => ReadS a
reads String
b of
         [] -> []
         ((Int
v,String
xs):[(Int, String)]
_) ->[(Int -> ObjectID
ObjectID Int
v,String
xs)]

-- --------------------------------------------------------------------------
-- New Object Identifier
-- --------------------------------------------------------------------------

foreign import ccall unsafe "new_object.h next_object_id" newInt :: IO Int

newObject :: IO ObjectID
newObject :: IO ObjectID
newObject =
   do
      Int
nextInt <- IO Int
newInt
      ObjectID -> IO ObjectID
forall (m :: * -> *) a. Monad m => a -> m a
return(Int -> ObjectID
ObjectID Int
nextInt)

staticObject :: Int -> ObjectID
staticObject :: Int -> ObjectID
staticObject Int
i
   | Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 = Int -> ObjectID
ObjectID (-Int
i)
   | Bool
True = String -> ObjectID
forall a. HasCallStack => String -> a
error String
"staticObject not given positive integer"