module Control.Monad.Squishy
( Squishy , runSquishy
, Identifier
, Distinct , distinguish , conflate , identify
, Ref , newRef , readRef , writeRef , modifyRef
) where
import Control.Monad.ST.Lazy
import Data.STRef.Lazy
import Control.Monad.State
import Control.Monad.Reader
import Control.Applicative
newtype Squishy s a =
Squishy { getSquishy :: StateT ID (ST s) a }
deriving ( Functor, Applicative, Monad )
runSquishy :: forall a. (forall s. Squishy s a) -> a
runSquishy x = runST $ evalStateT (getSquishy x) initialID
newtype Identifier s = Identifier ID deriving ( Eq, Ord )
data Distinct s a =
Distinct a (Identifier s)
instance Eq (Distinct s a) where
a == b = identify a == identify b
instance Ord (Distinct s a) where
compare a b = compare (identify a) (identify b)
distinguish :: a -> Squishy s (Distinct s a)
distinguish a = Distinct a <$> newIdentifier
where
newIdentifier = Squishy $ do
x <- get
put (succ x)
return (Identifier x)
conflate :: Distinct s a -> a
conflate (Distinct a _) = a
identify :: Distinct s a -> Identifier s
identify (Distinct _ i) = i
newtype Ref s a = Ref (STRef s a)
newRef :: a -> Squishy s (Ref s a)
newRef a = Squishy $ lift (Ref <$> newSTRef a)
readRef :: Ref s a -> Squishy s a
readRef (Ref r) = Squishy $ lift (readSTRef r)
writeRef :: Ref s a -> a -> Squishy s ()
writeRef (Ref r) a = Squishy $ lift (writeSTRef r a)
modifyRef :: Ref s a -> (a -> a) -> Squishy s ()
modifyRef (Ref r) a = Squishy $ lift (modifySTRef r a)
type ID = Int
initialID :: ID
initialID = minBound