```----------------------------------------
-- |
-- Module    : Data.QuotientRef
-- Copyright : (c) Luke Palmer 2008
--
-- Maintainer : Luke Palmer <lrpalmer@gmail.com>
-- Stability : experimental
--
-- A Quotient Reference is a reference cell that needs two values to
-- dereference.  In a way it is a two-dimensional table indexed by references.
-- The trick is that if a cell is indexed by @a@ and @b@, then if /either/
-- @a@ or @b@ gets cleaned up by the garbage collector, then so does the
-- cell, because it would not be able to be accessed anymore.
--
-- There are two different types of indices, "LeftRef" and "RightRef".  You
-- need one of each, of the same type, to access a cell.
--
-- The name comes from the idea that the product of two indices is a reference,
-- so each index is a quotient.
--
-- Example usage:
--
-- > do
-- >   l_1 <- newLeft
-- >   l_2 <- newLeft
-- >   r_1 <- newRight
-- >   r_2 <- newRight
-- >   write l_1 r_1 "Foo"
-- >   write l_2 r_1 "Bar"
-- >   print =<< read l_1 r_1  -- Just "Foo"
-- >   print =<< read l_1 r_2  -- Nothing
-- >   print =<< read l_2 r_1  -- Just "Bar"
-- >   print =<< read l_2 r_2  -- Nothing
--
module Data.QuotientRef
( LeftRef, RightRef
, newLeft, newRight
)
where

import qualified Data.HashTable as Hash
import Data.Unique
import Control.Applicative
import Control.Exception
import System.Mem.Weak

-- | The left half of a reference cell.  Combine this with a "RightRef" to
-- access a cell.
newtype LeftRef a
= LeftRef (Hash.HashTable Unique a)

-- RightRef is data rather than newtype, so we have something real to make
-- a weak reference from.

-- | The right half of a reference cell.  Combine this with a "LeftRef" to
-- access a cell.
data RightRef a
= RightRef Unique

newLeft :: IO (LeftRef a)
newLeft = LeftRef <\$> Hash.new (==) (fromIntegral . hashUnique)

newRight :: IO (RightRef a)
newRight = RightRef <\$> newUnique

-- | Combine the two halves of a reference and return the result if
-- it exists.
read :: LeftRef a -> RightRef a -> IO (Maybe a)
read (LeftRef hash) (RightRef ident) = do
Hash.lookup hash ident

-- | Combine the two halves of a reference and write a value to the
-- product.
write :: LeftRef a -> RightRef a -> a -> IO ()
write (LeftRef hash) right@(RightRef ident) val = block \$ do
existed <- Hash.update hash ident val
unless existed \$ do
hashW <- mkWeakPtr hash Nothing