{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.SNMap (
SNMapReaderT,
runSNMapReaderT,
memoizeM,
scopedM
)where
import System.Mem.StableName
import qualified Data.HashTable.IO as HT
import Data.Functor
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Trans.Class
import System.Mem.Weak (addFinalizer)
import Control.Applicative (Applicative)
import Control.Monad.Exception (MonadException, MonadAsyncException)
import Control.Monad.Trans.State.Strict
newtype SNMap m a = SNMap (HT.BasicHashTable (StableName (m a)) a)
newSNMap :: IO (SNMap m a)
newSNMap :: IO (SNMap m a)
newSNMap = HashTable RealWorld (StableName (m a)) a -> SNMap m a
forall (m :: * -> *) a.
BasicHashTable (StableName (m a)) a -> SNMap m a
SNMap (HashTable RealWorld (StableName (m a)) a -> SNMap m a)
-> IO (HashTable RealWorld (StableName (m a)) a) -> IO (SNMap m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (HashTable RealWorld (StableName (m a)) a)
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
HT.new
memoize :: MonadIO m
=> m (SNMap m a)
-> m a
-> m a
memoize :: m (SNMap m a) -> m a -> m a
memoize m (SNMap m a)
getter m a
m = do StableName (m a)
s <- IO (StableName (m a)) -> m (StableName (m a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (StableName (m a)) -> m (StableName (m a)))
-> IO (StableName (m a)) -> m (StableName (m a))
forall a b. (a -> b) -> a -> b
$ m a -> IO (StableName (m a))
forall a. a -> IO (StableName a)
makeStableName (m a -> IO (StableName (m a))) -> m a -> IO (StableName (m a))
forall a b. (a -> b) -> a -> b
$! m a
m
(SNMap BasicHashTable (StableName (m a)) a
h) <- m (SNMap m a)
getter
Maybe a
x <- IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ BasicHashTable (StableName (m a)) a
-> StableName (m a) -> IO (Maybe a)
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
HT.lookup BasicHashTable (StableName (m a)) a
h StableName (m a)
s
case Maybe a
x of
Just a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
Nothing -> do a
a <- m a
m
(SNMap BasicHashTable (StableName (m a)) a
h') <- m (SNMap m a)
getter
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BasicHashTable (StableName (m a)) a
-> StableName (m a) -> a -> IO ()
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
HT.insert BasicHashTable (StableName (m a)) a
h' StableName (m a)
s a
a
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
newtype SNMapReaderT a m b = SNMapReaderT (StateT (SNMap (SNMapReaderT a m) a) m b) deriving (a -> SNMapReaderT a m b -> SNMapReaderT a m a
(a -> b) -> SNMapReaderT a m a -> SNMapReaderT a m b
(forall a b. (a -> b) -> SNMapReaderT a m a -> SNMapReaderT a m b)
-> (forall a b. a -> SNMapReaderT a m b -> SNMapReaderT a m a)
-> Functor (SNMapReaderT a m)
forall a b. a -> SNMapReaderT a m b -> SNMapReaderT a m a
forall a b. (a -> b) -> SNMapReaderT a m a -> SNMapReaderT a m b
forall a (m :: * -> *) a b.
Functor m =>
a -> SNMapReaderT a m b -> SNMapReaderT a m a
forall a (m :: * -> *) a b.
Functor m =>
(a -> b) -> SNMapReaderT a m a -> SNMapReaderT a m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SNMapReaderT a m b -> SNMapReaderT a m a
$c<$ :: forall a (m :: * -> *) a b.
Functor m =>
a -> SNMapReaderT a m b -> SNMapReaderT a m a
fmap :: (a -> b) -> SNMapReaderT a m a -> SNMapReaderT a m b
$cfmap :: forall a (m :: * -> *) a b.
Functor m =>
(a -> b) -> SNMapReaderT a m a -> SNMapReaderT a m b
Functor, Functor (SNMapReaderT a m)
a -> SNMapReaderT a m a
Functor (SNMapReaderT a m)
-> (forall a. a -> SNMapReaderT a m a)
-> (forall a b.
SNMapReaderT a m (a -> b)
-> SNMapReaderT a m a -> SNMapReaderT a m b)
-> (forall a b c.
(a -> b -> c)
-> SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m c)
-> (forall a b.
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b)
-> (forall a b.
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a)
-> Applicative (SNMapReaderT a m)
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
SNMapReaderT a m (a -> b)
-> SNMapReaderT a m a -> SNMapReaderT a m b
(a -> b -> c)
-> SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m c
forall a. a -> SNMapReaderT a m a
forall a b.
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
forall a b.
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
forall a b.
SNMapReaderT a m (a -> b)
-> SNMapReaderT a m a -> SNMapReaderT a m b
forall a b c.
(a -> b -> c)
-> SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m c
forall a (m :: * -> *). Monad m => Functor (SNMapReaderT a m)
forall a (m :: * -> *) a. Monad m => a -> SNMapReaderT a m a
forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m (a -> b)
-> SNMapReaderT a m a -> SNMapReaderT a m b
forall a (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
$c<* :: forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
*> :: SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
$c*> :: forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
liftA2 :: (a -> b -> c)
-> SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m c
$cliftA2 :: forall a (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m c
<*> :: SNMapReaderT a m (a -> b)
-> SNMapReaderT a m a -> SNMapReaderT a m b
$c<*> :: forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m (a -> b)
-> SNMapReaderT a m a -> SNMapReaderT a m b
pure :: a -> SNMapReaderT a m a
$cpure :: forall a (m :: * -> *) a. Monad m => a -> SNMapReaderT a m a
$cp1Applicative :: forall a (m :: * -> *). Monad m => Functor (SNMapReaderT a m)
Applicative, Applicative (SNMapReaderT a m)
a -> SNMapReaderT a m a
Applicative (SNMapReaderT a m)
-> (forall a b.
SNMapReaderT a m a
-> (a -> SNMapReaderT a m b) -> SNMapReaderT a m b)
-> (forall a b.
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b)
-> (forall a. a -> SNMapReaderT a m a)
-> Monad (SNMapReaderT a m)
SNMapReaderT a m a
-> (a -> SNMapReaderT a m b) -> SNMapReaderT a m b
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
forall a. a -> SNMapReaderT a m a
forall a b.
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
forall a b.
SNMapReaderT a m a
-> (a -> SNMapReaderT a m b) -> SNMapReaderT a m b
forall a (m :: * -> *). Monad m => Applicative (SNMapReaderT a m)
forall a (m :: * -> *) a. Monad m => a -> SNMapReaderT a m a
forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m a
-> (a -> SNMapReaderT a m b) -> SNMapReaderT a m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SNMapReaderT a m a
$creturn :: forall a (m :: * -> *) a. Monad m => a -> SNMapReaderT a m a
>> :: SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
$c>> :: forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m b
>>= :: SNMapReaderT a m a
-> (a -> SNMapReaderT a m b) -> SNMapReaderT a m b
$c>>= :: forall a (m :: * -> *) a b.
Monad m =>
SNMapReaderT a m a
-> (a -> SNMapReaderT a m b) -> SNMapReaderT a m b
$cp1Monad :: forall a (m :: * -> *). Monad m => Applicative (SNMapReaderT a m)
Monad, Monad (SNMapReaderT a m)
Monad (SNMapReaderT a m)
-> (forall a. IO a -> SNMapReaderT a m a)
-> MonadIO (SNMapReaderT a m)
IO a -> SNMapReaderT a m a
forall a. IO a -> SNMapReaderT a m a
forall a (m :: * -> *). MonadIO m => Monad (SNMapReaderT a m)
forall a (m :: * -> *) a. MonadIO m => IO a -> SNMapReaderT a m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SNMapReaderT a m a
$cliftIO :: forall a (m :: * -> *) a. MonadIO m => IO a -> SNMapReaderT a m a
$cp1MonadIO :: forall a (m :: * -> *). MonadIO m => Monad (SNMapReaderT a m)
MonadIO, Monad (SNMapReaderT a m)
e -> SNMapReaderT a m a
Monad (SNMapReaderT a m)
-> (forall e a. Exception e => e -> SNMapReaderT a m a)
-> (forall e a.
Exception e =>
SNMapReaderT a m a
-> (e -> SNMapReaderT a m a) -> SNMapReaderT a m a)
-> (forall a b.
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a)
-> MonadException (SNMapReaderT a m)
SNMapReaderT a m a
-> (e -> SNMapReaderT a m a) -> SNMapReaderT a m a
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
forall e a. Exception e => e -> SNMapReaderT a m a
forall e a.
Exception e =>
SNMapReaderT a m a
-> (e -> SNMapReaderT a m a) -> SNMapReaderT a m a
forall a b.
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
forall a (m :: * -> *).
MonadException m =>
Monad (SNMapReaderT a m)
forall a (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> SNMapReaderT a m a
forall a (m :: * -> *) e a.
(MonadException m, Exception e) =>
SNMapReaderT a m a
-> (e -> SNMapReaderT a m a) -> SNMapReaderT a m a
forall a (m :: * -> *) a b.
MonadException m =>
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
$cfinally :: forall a (m :: * -> *) a b.
MonadException m =>
SNMapReaderT a m a -> SNMapReaderT a m b -> SNMapReaderT a m a
catch :: SNMapReaderT a m a
-> (e -> SNMapReaderT a m a) -> SNMapReaderT a m a
$ccatch :: forall a (m :: * -> *) e a.
(MonadException m, Exception e) =>
SNMapReaderT a m a
-> (e -> SNMapReaderT a m a) -> SNMapReaderT a m a
throw :: e -> SNMapReaderT a m a
$cthrow :: forall a (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> SNMapReaderT a m a
$cp1MonadException :: forall a (m :: * -> *).
MonadException m =>
Monad (SNMapReaderT a m)
MonadException, MonadIO (SNMapReaderT a m)
MonadException (SNMapReaderT a m)
MonadIO (SNMapReaderT a m)
-> MonadException (SNMapReaderT a m)
-> (forall b.
((forall a. SNMapReaderT a m a -> SNMapReaderT a m a)
-> SNMapReaderT a m b)
-> SNMapReaderT a m b)
-> MonadAsyncException (SNMapReaderT a m)
((forall a. SNMapReaderT a m a -> SNMapReaderT a m a)
-> SNMapReaderT a m b)
-> SNMapReaderT a m b
forall b.
((forall a. SNMapReaderT a m a -> SNMapReaderT a m a)
-> SNMapReaderT a m b)
-> SNMapReaderT a m b
forall a (m :: * -> *).
MonadAsyncException m =>
MonadIO (SNMapReaderT a m)
forall a (m :: * -> *).
MonadAsyncException m =>
MonadException (SNMapReaderT a m)
forall a (m :: * -> *) b.
MonadAsyncException m =>
((forall a. SNMapReaderT a m a -> SNMapReaderT a m a)
-> SNMapReaderT a m b)
-> SNMapReaderT a m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. SNMapReaderT a m a -> SNMapReaderT a m a)
-> SNMapReaderT a m b)
-> SNMapReaderT a m b
$cmask :: forall a (m :: * -> *) b.
MonadAsyncException m =>
((forall a. SNMapReaderT a m a -> SNMapReaderT a m a)
-> SNMapReaderT a m b)
-> SNMapReaderT a m b
$cp2MonadAsyncException :: forall a (m :: * -> *).
MonadAsyncException m =>
MonadException (SNMapReaderT a m)
$cp1MonadAsyncException :: forall a (m :: * -> *).
MonadAsyncException m =>
MonadIO (SNMapReaderT a m)
MonadAsyncException)
runSNMapReaderT :: MonadIO m => SNMapReaderT a m b -> m b
runSNMapReaderT :: SNMapReaderT a m b -> m b
runSNMapReaderT (SNMapReaderT StateT (SNMap (SNMapReaderT a m) a) m b
m) = do SNMap (SNMapReaderT a m) a
h <- IO (SNMap (SNMapReaderT a m) a) -> m (SNMap (SNMapReaderT a m) a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (SNMap (SNMapReaderT a m) a)
forall (m :: * -> *) a. IO (SNMap m a)
newSNMap
StateT (SNMap (SNMapReaderT a m) a) m b
-> SNMap (SNMapReaderT a m) a -> m b
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (SNMap (SNMapReaderT a m) a) m b
m SNMap (SNMapReaderT a m) a
h
instance MonadTrans (SNMapReaderT a) where
lift :: m a -> SNMapReaderT a m a
lift = StateT (SNMap (SNMapReaderT a m) a) m a -> SNMapReaderT a m a
forall a (m :: * -> *) b.
StateT (SNMap (SNMapReaderT a m) a) m b -> SNMapReaderT a m b
SNMapReaderT (StateT (SNMap (SNMapReaderT a m) a) m a -> SNMapReaderT a m a)
-> (m a -> StateT (SNMap (SNMapReaderT a m) a) m a)
-> m a
-> SNMapReaderT a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT (SNMap (SNMapReaderT a m) a) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
memoizeM :: MonadIO m => SNMapReaderT a m a -> SNMapReaderT a m a
memoizeM :: SNMapReaderT a m a -> SNMapReaderT a m a
memoizeM = SNMapReaderT a m (SNMap (SNMapReaderT a m) a)
-> SNMapReaderT a m a -> SNMapReaderT a m a
forall (m :: * -> *) a. MonadIO m => m (SNMap m a) -> m a -> m a
memoize (StateT (SNMap (SNMapReaderT a m) a) m (SNMap (SNMapReaderT a m) a)
-> SNMapReaderT a m (SNMap (SNMapReaderT a m) a)
forall a (m :: * -> *) b.
StateT (SNMap (SNMapReaderT a m) a) m b -> SNMapReaderT a m b
SNMapReaderT StateT (SNMap (SNMapReaderT a m) a) m (SNMap (SNMapReaderT a m) a)
forall (m :: * -> *) s. Monad m => StateT s m s
get)
scopedM :: MonadIO m => SNMapReaderT a m x -> SNMapReaderT a m x
scopedM :: SNMapReaderT a m x -> SNMapReaderT a m x
scopedM SNMapReaderT a m x
m= do SNMap BasicHashTable (StableName (SNMapReaderT a m a)) a
h <- StateT (SNMap (SNMapReaderT a m) a) m (SNMap (SNMapReaderT a m) a)
-> SNMapReaderT a m (SNMap (SNMapReaderT a m) a)
forall a (m :: * -> *) b.
StateT (SNMap (SNMapReaderT a m) a) m b -> SNMapReaderT a m b
SNMapReaderT StateT (SNMap (SNMapReaderT a m) a) m (SNMap (SNMapReaderT a m) a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
[(StableName (SNMapReaderT a m a), a)]
save <- IO [(StableName (SNMapReaderT a m a), a)]
-> SNMapReaderT a m [(StableName (SNMapReaderT a m a), a)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(StableName (SNMapReaderT a m a), a)]
-> SNMapReaderT a m [(StableName (SNMapReaderT a m a), a)])
-> IO [(StableName (SNMapReaderT a m a), a)]
-> SNMapReaderT a m [(StableName (SNMapReaderT a m a), a)]
forall a b. (a -> b) -> a -> b
$ BasicHashTable (StableName (SNMapReaderT a m a)) a
-> IO [(StableName (SNMapReaderT a m a), a)]
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
HT.toList BasicHashTable (StableName (SNMapReaderT a m a)) a
h
x
x <- SNMapReaderT a m x
m
HashTable RealWorld (StableName (SNMapReaderT a m a)) a
h' <- IO (HashTable RealWorld (StableName (SNMapReaderT a m a)) a)
-> SNMapReaderT
a m (HashTable RealWorld (StableName (SNMapReaderT a m a)) a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashTable RealWorld (StableName (SNMapReaderT a m a)) a)
-> SNMapReaderT
a m (HashTable RealWorld (StableName (SNMapReaderT a m a)) a))
-> IO (HashTable RealWorld (StableName (SNMapReaderT a m a)) a)
-> SNMapReaderT
a m (HashTable RealWorld (StableName (SNMapReaderT a m a)) a)
forall a b. (a -> b) -> a -> b
$ [(StableName (SNMapReaderT a m a), a)]
-> IO (BasicHashTable (StableName (SNMapReaderT a m a)) a)
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
[(k, v)] -> IO (IOHashTable h k v)
HT.fromList [(StableName (SNMapReaderT a m a), a)]
save
StateT (SNMap (SNMapReaderT a m) a) m () -> SNMapReaderT a m ()
forall a (m :: * -> *) b.
StateT (SNMap (SNMapReaderT a m) a) m b -> SNMapReaderT a m b
SNMapReaderT (StateT (SNMap (SNMapReaderT a m) a) m () -> SNMapReaderT a m ())
-> StateT (SNMap (SNMapReaderT a m) a) m () -> SNMapReaderT a m ()
forall a b. (a -> b) -> a -> b
$ SNMap (SNMapReaderT a m) a
-> StateT (SNMap (SNMapReaderT a m) a) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (BasicHashTable (StableName (SNMapReaderT a m a)) a
-> SNMap (SNMapReaderT a m) a
forall (m :: * -> *) a.
BasicHashTable (StableName (m a)) a -> SNMap m a
SNMap HashTable RealWorld (StableName (SNMapReaderT a m a)) a
BasicHashTable (StableName (SNMapReaderT a m a)) a
h')
x -> SNMapReaderT a m x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x