{-# LANGUAGE NoImplicitPrelude, TupleSections,
MultiParamTypeClasses, FunctionalDependencies,
UndecidableInstances, FlexibleInstances, FlexibleContexts, RankNTypes #-}
module Control.Monad.Memo.Class
(
MonadCache(..),
MonadMemo(..),
for2,
for3,
for4,
memoln,
memol0,
memol1,
memol2,
memol3,
memol4,
) where
import Data.Tuple
import Data.Function
import Data.Maybe
import Data.Either
import Data.Monoid
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.State.Lazy as SL
import qualified Control.Monad.Trans.State.Strict as SS
import qualified Control.Monad.Trans.Writer.Lazy as WL
import qualified Control.Monad.Trans.Writer.Strict as WS
import qualified Control.Monad.Trans.RWS.Lazy as RWSL
import qualified Control.Monad.Trans.RWS.Strict as RWSS
class Monad m => MonadCache k v m | m -> k, m -> v where
lookup :: k -> m (Maybe v)
add :: k -> v -> m ()
class Monad m => MonadMemo k v m | m -> k, m -> v where
memo :: (k -> m v) -> k -> m v
{-# INLINE memoln #-}
memoln :: (MonadCache k2 v m1, Monad m1, Monad m2) =>
(forall a.m1 a -> m2 a) -> (k1 -> k2) -> (k1 -> m2 v) -> k1 -> m2 v
memoln :: (forall a. m1 a -> m2 a)
-> (k1 -> k2) -> (k1 -> m2 v) -> k1 -> m2 v
memoln forall a. m1 a -> m2 a
fl k1 -> k2
fk k1 -> m2 v
f k1
k = do
Maybe v
mr <- m1 (Maybe v) -> m2 (Maybe v)
forall a. m1 a -> m2 a
fl (m1 (Maybe v) -> m2 (Maybe v)) -> m1 (Maybe v) -> m2 (Maybe v)
forall a b. (a -> b) -> a -> b
$ k2 -> m1 (Maybe v)
forall k v (m :: * -> *). MonadCache k v m => k -> m (Maybe v)
lookup (k1 -> k2
fk k1
k)
case Maybe v
mr of
Just v
r -> v -> m2 v
forall (m :: * -> *) a. Monad m => a -> m a
return v
r
Maybe v
Nothing -> do
v
r <- k1 -> m2 v
f k1
k
m1 () -> m2 ()
forall a. m1 a -> m2 a
fl (m1 () -> m2 ()) -> m1 () -> m2 ()
forall a b. (a -> b) -> a -> b
$ k2 -> v -> m1 ()
forall k v (m :: * -> *). MonadCache k v m => k -> v -> m ()
add (k1 -> k2
fk k1
k) v
r
v -> m2 v
forall (m :: * -> *) a. Monad m => a -> m a
return v
r
for2 :: (((k1, k2) -> mv) -> (k1, k2) -> mv) -> (k1 -> k2 -> mv) -> k1 -> k2 -> mv
for2 :: (((k1, k2) -> mv) -> (k1, k2) -> mv)
-> (k1 -> k2 -> mv) -> k1 -> k2 -> mv
for2 ((k1, k2) -> mv) -> (k1, k2) -> mv
m k1 -> k2 -> mv
f = ((k1, k2) -> mv) -> k1 -> k2 -> mv
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((k1, k2) -> mv) -> (k1, k2) -> mv
m ((k1 -> k2 -> mv) -> (k1, k2) -> mv
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k1 -> k2 -> mv
f))
for3 :: (((k1, k2, k3) -> mv) -> (k1, k2, k3) -> mv) -> (k1 -> k2 -> k3 -> mv) -> k1 -> k2 -> k3 -> mv
for3 :: (((k1, k2, k3) -> mv) -> (k1, k2, k3) -> mv)
-> (k1 -> k2 -> k3 -> mv) -> k1 -> k2 -> k3 -> mv
for3 ((k1, k2, k3) -> mv) -> (k1, k2, k3) -> mv
m k1 -> k2 -> k3 -> mv
f k1
a k2
b k3
c = ((k1, k2, k3) -> mv) -> (k1, k2, k3) -> mv
m (\(k1
a,k2
b,k3
c) -> k1 -> k2 -> k3 -> mv
f k1
a k2
b k3
c) (k1
a,k2
b,k3
c)
for4 :: (((k1, k2, k3, k4) -> mv) -> (k1, k2, k3, k4) -> mv) -> (k1 -> k2 -> k3 -> k4 -> mv) -> k1 -> k2 -> k3 -> k4 -> mv
for4 :: (((k1, k2, k3, k4) -> mv) -> (k1, k2, k3, k4) -> mv)
-> (k1 -> k2 -> k3 -> k4 -> mv) -> k1 -> k2 -> k3 -> k4 -> mv
for4 ((k1, k2, k3, k4) -> mv) -> (k1, k2, k3, k4) -> mv
m k1 -> k2 -> k3 -> k4 -> mv
f k1
a k2
b k3
c k4
d = ((k1, k2, k3, k4) -> mv) -> (k1, k2, k3, k4) -> mv
m (\(k1
a,k2
b,k3
c,k4
d) -> k1 -> k2 -> k3 -> k4 -> mv
f k1
a k2
b k3
c k4
d) (k1
a,k2
b,k3
c,k4
d)
{-# INLINE memol0 #-}
memol0
:: (MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 :: (k -> m v) -> k -> m v
memol0 = (forall a. m a -> m a) -> (k -> k) -> (k -> m v) -> k -> m v
forall k2 v (m1 :: * -> *) (m2 :: * -> *) k1.
(MonadCache k2 v m1, Monad m1, Monad m2) =>
(forall a. m1 a -> m2 a)
-> (k1 -> k2) -> (k1 -> m2 v) -> k1 -> m2 v
memoln forall a. a -> a
forall a. m a -> m a
id k -> k
forall a. a -> a
id
{-# INLINE memol1 #-}
memol1
:: (MonadTrans t1,
MonadCache k v m,
Monad (t1 m)) =>
(k -> t1 m v) -> k -> t1 m v
memol1 :: (k -> t1 m v) -> k -> t1 m v
memol1 = (forall a. m a -> t1 m a)
-> (k -> k) -> (k -> t1 m v) -> k -> t1 m v
forall k2 v (m1 :: * -> *) (m2 :: * -> *) k1.
(MonadCache k2 v m1, Monad m1, Monad m2) =>
(forall a. m1 a -> m2 a)
-> (k1 -> k2) -> (k1 -> m2 v) -> k1 -> m2 v
memoln forall a. m a -> t1 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift k -> k
forall a. a -> a
id
{-# INLINE memol2 #-}
memol2
:: (MonadTrans t1,
MonadTrans t2,
MonadCache k v m,
Monad (t2 m),
Monad (t1 (t2 m))) =>
(k -> t1 (t2 m) v) -> k -> t1 (t2 m) v
memol2 :: (k -> t1 (t2 m) v) -> k -> t1 (t2 m) v
memol2 = (forall a. m a -> t1 (t2 m) a)
-> (k -> k) -> (k -> t1 (t2 m) v) -> k -> t1 (t2 m) v
forall k2 v (m1 :: * -> *) (m2 :: * -> *) k1.
(MonadCache k2 v m1, Monad m1, Monad m2) =>
(forall a. m1 a -> m2 a)
-> (k1 -> k2) -> (k1 -> m2 v) -> k1 -> m2 v
memoln (t2 m a -> t1 (t2 m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t2 m a -> t1 (t2 m) a) -> (m a -> t2 m a) -> m a -> t1 (t2 m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> t2 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) k -> k
forall a. a -> a
id
{-# INLINE memol3 #-}
memol3
:: (MonadTrans t1,
MonadTrans t2,
MonadTrans t3,
MonadCache k v m,
Monad (t3 m),
Monad (t2 (t3 m)),
Monad (t1 (t2 (t3 m))) ) =>
(k -> t1 (t2 (t3 m)) v) -> k -> t1 (t2 (t3 m)) v
memol3 :: (k -> t1 (t2 (t3 m)) v) -> k -> t1 (t2 (t3 m)) v
memol3 = (forall a. m a -> t1 (t2 (t3 m)) a)
-> (k -> k) -> (k -> t1 (t2 (t3 m)) v) -> k -> t1 (t2 (t3 m)) v
forall k2 v (m1 :: * -> *) (m2 :: * -> *) k1.
(MonadCache k2 v m1, Monad m1, Monad m2) =>
(forall a. m1 a -> m2 a)
-> (k1 -> k2) -> (k1 -> m2 v) -> k1 -> m2 v
memoln (t2 (t3 m) a -> t1 (t2 (t3 m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(t2 (t3 m) a -> t1 (t2 (t3 m)) a)
-> (m a -> t2 (t3 m) a) -> m a -> t1 (t2 (t3 m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t3 m a -> t2 (t3 m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(t3 m a -> t2 (t3 m) a) -> (m a -> t3 m a) -> m a -> t2 (t3 m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.m a -> t3 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) k -> k
forall a. a -> a
id
{-# INLINE memol4 #-}
memol4
:: (MonadTrans t1,
MonadTrans t2,
MonadTrans t3,
MonadTrans t4,
MonadCache k v m,
Monad (t4 m),
Monad (t3 (t4 m)),
Monad (t2 (t3 (t4 m))),
Monad (t1 (t2 (t3 (t4 m)))) ) =>
(k -> t1 (t2 (t3 (t4 m))) v) -> k -> t1 (t2 (t3 (t4 m))) v
memol4 :: (k -> t1 (t2 (t3 (t4 m))) v) -> k -> t1 (t2 (t3 (t4 m))) v
memol4 = (forall a. m a -> t1 (t2 (t3 (t4 m))) a)
-> (k -> k)
-> (k -> t1 (t2 (t3 (t4 m))) v)
-> k
-> t1 (t2 (t3 (t4 m))) v
forall k2 v (m1 :: * -> *) (m2 :: * -> *) k1.
(MonadCache k2 v m1, Monad m1, Monad m2) =>
(forall a. m1 a -> m2 a)
-> (k1 -> k2) -> (k1 -> m2 v) -> k1 -> m2 v
memoln (t2 (t3 (t4 m)) a -> t1 (t2 (t3 (t4 m))) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(t2 (t3 (t4 m)) a -> t1 (t2 (t3 (t4 m))) a)
-> (m a -> t2 (t3 (t4 m)) a) -> m a -> t1 (t2 (t3 (t4 m))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t3 (t4 m) a -> t2 (t3 (t4 m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(t3 (t4 m) a -> t2 (t3 (t4 m)) a)
-> (m a -> t3 (t4 m) a) -> m a -> t2 (t3 (t4 m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t4 m a -> t3 (t4 m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(t4 m a -> t3 (t4 m) a) -> (m a -> t4 m a) -> m a -> t3 (t4 m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.m a -> t4 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) k -> k
forall a. a -> a
id
instance (MonadCache k v m) => MonadMemo k v (IdentityT m) where
memo :: (k -> IdentityT m v) -> k -> IdentityT m v
memo k -> IdentityT m v
f = m v -> IdentityT m v
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m v -> IdentityT m v) -> (k -> m v) -> k -> IdentityT m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> m v) -> k -> m v
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (IdentityT m v -> m v
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (IdentityT m v -> m v) -> (k -> IdentityT m v) -> k -> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> IdentityT m v
f)
instance (MonadCache k v m) => MonadMemo k v (ContT r m) where
memo :: (k -> ContT r m v) -> k -> ContT r m v
memo = (k -> ContT r m v) -> k -> ContT r m v
forall (t1 :: (* -> *) -> * -> *) k v (m :: * -> *).
(MonadTrans t1, MonadCache k v m, Monad (t1 m)) =>
(k -> t1 m v) -> k -> t1 m v
memol1
instance (MonadCache k (Maybe v) m) => MonadMemo k v (MaybeT m) where
memo :: (k -> MaybeT m v) -> k -> MaybeT m v
memo k -> MaybeT m v
f = m (Maybe v) -> MaybeT m v
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe v) -> MaybeT m v)
-> (k -> m (Maybe v)) -> k -> MaybeT m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> m (Maybe v)) -> k -> m (Maybe v)
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (MaybeT m v -> m (Maybe v)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m v -> m (Maybe v))
-> (k -> MaybeT m v) -> k -> m (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> MaybeT m v
f)
instance (MonadCache k (Either e v) m) => MonadMemo k v (ExceptT e m) where
memo :: (k -> ExceptT e m v) -> k -> ExceptT e m v
memo k -> ExceptT e m v
f = m (Either e v) -> ExceptT e m v
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e v) -> ExceptT e m v)
-> (k -> m (Either e v)) -> k -> ExceptT e m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> m (Either e v)) -> k -> m (Either e v)
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (ExceptT e m v -> m (Either e v)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m v -> m (Either e v))
-> (k -> ExceptT e m v) -> k -> m (Either e v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> ExceptT e m v
f)
instance (MonadCache (r,k) v m) => MonadMemo k v (ReaderT r m) where
memo :: (k -> ReaderT r m v) -> k -> ReaderT r m v
memo k -> ReaderT r m v
f k
k = (r -> m v) -> ReaderT r m v
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m v) -> ReaderT r m v) -> (r -> m v) -> ReaderT r m v
forall a b. (a -> b) -> a -> b
$ \r
r -> ((r, k) -> m v) -> (r, k) -> m v
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (\(r
r, k
k) -> ReaderT r m v -> r -> m v
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (k -> ReaderT r m v
f k
k) r
r) (r
r, k
k)
instance (Monoid w, MonadCache k (v,w) m) => MonadMemo k v (WL.WriterT w m) where
memo :: (k -> WriterT w m v) -> k -> WriterT w m v
memo k -> WriterT w m v
f = m (v, w) -> WriterT w m v
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WL.WriterT (m (v, w) -> WriterT w m v)
-> (k -> m (v, w)) -> k -> WriterT w m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> m (v, w)) -> k -> m (v, w)
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (WriterT w m v -> m (v, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WL.runWriterT (WriterT w m v -> m (v, w))
-> (k -> WriterT w m v) -> k -> m (v, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> WriterT w m v
f)
instance (Monoid w, MonadCache k (v,w) m) => MonadMemo k v (WS.WriterT w m) where
memo :: (k -> WriterT w m v) -> k -> WriterT w m v
memo k -> WriterT w m v
f = m (v, w) -> WriterT w m v
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WS.WriterT (m (v, w) -> WriterT w m v)
-> (k -> m (v, w)) -> k -> WriterT w m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> m (v, w)) -> k -> m (v, w)
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (WriterT w m v -> m (v, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WS.runWriterT (WriterT w m v -> m (v, w))
-> (k -> WriterT w m v) -> k -> m (v, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> WriterT w m v
f)
instance (MonadCache (s,k) (v,s) m) => MonadMemo k v (SS.StateT s m) where
memo :: (k -> StateT s m v) -> k -> StateT s m v
memo k -> StateT s m v
f k
k = (s -> m (v, s)) -> StateT s m v
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
SS.StateT ((s -> m (v, s)) -> StateT s m v)
-> (s -> m (v, s)) -> StateT s m v
forall a b. (a -> b) -> a -> b
$ \s
s -> ((s, k) -> m (v, s)) -> (s, k) -> m (v, s)
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (\(s
s, k
k) -> StateT s m v -> s -> m (v, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
SS.runStateT (k -> StateT s m v
f k
k) s
s) (s
s, k
k)
instance (MonadCache (s,k) (v,s) m) => MonadMemo k v (SL.StateT s m) where
memo :: (k -> StateT s m v) -> k -> StateT s m v
memo k -> StateT s m v
f k
k = (s -> m (v, s)) -> StateT s m v
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
SL.StateT ((s -> m (v, s)) -> StateT s m v)
-> (s -> m (v, s)) -> StateT s m v
forall a b. (a -> b) -> a -> b
$ \s
s -> ((s, k) -> m (v, s)) -> (s, k) -> m (v, s)
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (\(s
s, k
k) -> StateT s m v -> s -> m (v, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
SL.runStateT (k -> StateT s m v
f k
k) s
s) (s
s, k
k)
instance (Monoid w, MonadCache (r,s,k) (v,s,w) m) => MonadMemo k v (RWSL.RWST r w s m) where
memo :: (k -> RWST r w s m v) -> k -> RWST r w s m v
memo k -> RWST r w s m v
f k
k = (r -> s -> m (v, s, w)) -> RWST r w s m v
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSL.RWST ((r -> s -> m (v, s, w)) -> RWST r w s m v)
-> (r -> s -> m (v, s, w)) -> RWST r w s m v
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> ((r, s, k) -> m (v, s, w)) -> (r, s, k) -> m (v, s, w)
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (\(r
r, s
s, k
k) -> RWST r w s m v -> r -> s -> m (v, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWSL.runRWST (k -> RWST r w s m v
f k
k) r
r s
s) (r
r, s
s, k
k)
instance (Monoid w, MonadCache (r,s,k) (v,s,w) m) => MonadMemo k v (RWSS.RWST r w s m) where
memo :: (k -> RWST r w s m v) -> k -> RWST r w s m v
memo k -> RWST r w s m v
f k
k = (r -> s -> m (v, s, w)) -> RWST r w s m v
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSS.RWST ((r -> s -> m (v, s, w)) -> RWST r w s m v)
-> (r -> s -> m (v, s, w)) -> RWST r w s m v
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> ((r, s, k) -> m (v, s, w)) -> (r, s, k) -> m (v, s, w)
forall k v (m :: * -> *).
(MonadCache k v m, Monad m) =>
(k -> m v) -> k -> m v
memol0 (\(r
r, s
s, k
k) -> RWST r w s m v -> r -> s -> m (v, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWSS.runRWST (k -> RWST r w s m v
f k
k) r
r s
s) (r
r, s
s, k
k)