(original) (raw)

{-# LANGUAGE NoImplicitPrelude, TupleSections, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts, RankNTypes #-}

module Control.Monad.Memo.Class (

  [MonadCache](Control.Monad.Memo.Class.html#MonadCache)(..),
  [MonadMemo](Control.Monad.Memo.Class.html#MonadMemo)(..),

  [for2](Control.Monad.Memo.Class.html#for2),
  [for3](Control.Monad.Memo.Class.html#for3),
  [for4](Control.Monad.Memo.Class.html#for4),

  [memoln](Control.Monad.Memo.Class.html#memoln),
  [memol0](Control.Monad.Memo.Class.html#memol0),
  [memol1](Control.Monad.Memo.Class.html#memol1),
  [memol2](Control.Monad.Memo.Class.html#memol2),
  [memol3](Control.Monad.Memo.Class.html#memol3),
  [memol4](Control.Monad.Memo.Class.html#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)