about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous/Data/Memo.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Data/Memo.hs')
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/Memo.hs98
1 files changed, 0 insertions, 98 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Data/Memo.hs b/users/grfn/xanthous/src/Xanthous/Data/Memo.hs
deleted file mode 100644
index 2b2ee0f96028..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/Memo.hs
+++ /dev/null
@@ -1,98 +0,0 @@
---------------------------------------------------------------------------------
--- | Memoized values
---------------------------------------------------------------------------------
-module Xanthous.Data.Memo
-  ( Memoized(UnMemoized)
-  , memoizeWith
-  , getMemoized
-  , runMemoized
-  , fillWith
-  , fillWithM
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
-import Data.Aeson (FromJSON, ToJSON)
-import Test.QuickCheck (Arbitrary (arbitrary), oneof, CoArbitrary, Function)
-import Test.QuickCheck.Checkers (EqProp)
-import Xanthous.Util (EqEqProp(EqEqProp))
-import Control.Monad.State.Class (MonadState)
---------------------------------------------------------------------------------
-
--- | A memoized value, keyed by a key
---
--- If key is different than what is stored here, then val is invalid
-data Memoized key val = Memoized key val | UnMemoized
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (Hashable, FromJSON, ToJSON, NFData, CoArbitrary, Function)
-  deriving EqProp via EqEqProp (Memoized key val)
-
-instance (Arbitrary k, Arbitrary v) => Arbitrary (Memoized k v) where
-  arbitrary = oneof [ pure UnMemoized
-                    , Memoized <$> arbitrary <*> arbitrary
-                    ]
-
--- | Construct a memoized value with the given key
-memoizeWith :: forall key val. key -> val -> Memoized key val
-memoizeWith = Memoized
-{-# INLINE memoizeWith #-}
-
--- | Retrieve a memoized value providing the key. If the value is unmemoized or
--- the keys do not match, returns Nothing.
---
--- >>> getMemoized 1 (memoizeWith @Int @Int 1 2)
--- Just 2
---
--- >>> getMemoized 2 (memoizeWith @Int @Int 1 2)
--- Nothing
---
--- >>> getMemoized 1 (UnMemoized :: Memoized Int Int)
--- Nothing
-getMemoized :: Eq key => key -> Memoized key val -> Maybe val
-getMemoized key (Memoized key' v)
-  | key == key' = Just v
-  | otherwise = Nothing
-getMemoized _ UnMemoized = Nothing
-{-# INLINE getMemoized #-}
-
--- | Get a memoized value using an applicative action to obtain the key
-runMemoized
-  :: (Eq key, Applicative m)
-  => Memoized key val
-  -> m key
-  -> m (Maybe val)
-runMemoized m mk = getMemoized <$> mk <*> pure m
-
--- | In a monadic state containing a 'MemoState', look up the current memoized
--- target of some lens keyed by k, filling it with v if not present and
--- returning either the new or old value
-fillWith
-  :: forall m s k v.
-    (MonadState s m, Eq k)
-  => Lens' s (Memoized k v)
-  -> k
-  -> v
-  -> m v
-fillWith l k v' = do
-  uses l (getMemoized k) >>= \case
-    Just v -> pure v
-    Nothing -> do
-      l .= memoizeWith k v'
-      pure v'
-
--- | In a monadic state, look up the current memoized target of some lens keyed
--- by k, filling it with the result of some monadic action v if not present and
--- returning either the new or old value
-fillWithM
-  :: forall m s k v.
-    (MonadState s m, Eq k)
-  => Lens' s (Memoized k v)
-  -> k
-  -> m v
-  -> m v
-fillWithM l k mv = do
-  uses l (getMemoized k) >>= \case
-    Just v -> pure v
-    Nothing -> do
-      v' <- mv
-      l .= memoizeWith k v'
-      pure v'