memoization-utils (empty) → 0.1.0.0
raw patch · 5 files changed
+173/−0 lines, 5 filesdep +basedep +containersdep +hspecsetup-changed
Dependencies added: base, containers, hspec, lrucache, memoization-utils, time, time-units
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- memoization-utils.cabal +39/−0
- src/Control/Memoization/Utils.hs +110/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2015 Pedro Tacla Yamada++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ memoization-utils.cabal view
@@ -0,0 +1,39 @@+name: memoization-utils+version: 0.1.0.0+synopsis: Utilities for memoizing functions+-- description:+homepage: http://github.com/yamadapc/haskell-memoization-utils+license: MIT+license-file: LICENSE+author: Pedro Tacla Yamada+maintainer: tacla.yamada@gmail.com+copyright: Copyright (c) 2015 Pedro Tacla Yamada+category: Control+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Control.Memoization.Utils+ build-depends: base >= 4.7 && < 5+ , containers >= 0.5.6.2+ , lrucache > 1.2 && < 1.3+ , time >= 1.4 && < 1.6+ , time-units > 1 && < 2+ default-language: Haskell2010++test-suite hspec+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , time-units > 1 && < 2+ , time+ , hspec+ , memoization-utils+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/yamadapc/haskell-memoization-utils
+ src/Control/Memoization/Utils.hs view
@@ -0,0 +1,110 @@+module Control.Memoization.Utils+ ( memoize+ , memoizeLru+ , memoizeTime+ , constMemoize+ , constMemoizeTime+ ) where++import Control.Concurrent.MVar (newMVar, putMVar, readMVar, swapMVar,+ takeMVar)+import qualified Data.Cache.LRU.IO as LRU+import qualified Data.Map.Strict as Map+import Data.Time (diffUTCTime, getCurrentTime)+import Data.Time.Units (Millisecond, toMicroseconds)++-- |+-- Caches function return values so that when the same arguments are provided+-- to a function, it's not called+memoize :: Ord a => (a -> IO b) -> IO (a -> IO b)+memoize action = do+ mm <- newMVar Map.empty+ return $ \arg -> do+ m <- takeMVar mm+ case Map.lookup arg m of+ Just ret -> return ret+ Nothing -> do+ ret <- action arg+ putMVar mm (Map.insert arg ret m)+ return ret++-- |+-- Version of 'memoize' that uses an LRU cache rather than always keeping results+-- in memory+memoizeLru :: Ord a => (Maybe Integer) -> (a -> IO b) -> IO (a -> IO b)+memoizeLru msize action = do+ lru <- LRU.newAtomicLRU msize+ return $ \arg -> do+ mret <- LRU.lookup arg lru+ case mret of+ Just ret -> return ret+ Nothing -> do+ ret <- action arg+ LRU.insert arg ret lru+ return ret++-- |+-- Version of 'memoize' keeps results for a certain amount of time+memoizeTime :: Ord a => Millisecond -> (a -> IO b) -> IO (a -> IO b)+memoizeTime delay action = do+ let delayDiff :: Double+ delayDiff = (fromInteger (toMicroseconds delay)) / 1000000+ mm <- newMVar Map.empty+ return $ \arg -> do+ m <- takeMVar mm+ case Map.lookup arg m of+ Just (ret, lastcall) -> do+ now <- getCurrentTime+ let diff = fromRational $ toRational $ diffUTCTime now lastcall+ if diff >= delayDiff+ then do+ ret' <- action arg+ putMVar mm (Map.insert arg (ret', now) m)+ return ret'+ else do+ putMVar mm m+ return ret+ Nothing -> do+ now <- getCurrentTime+ ret <- action arg+ putMVar mm (Map.insert arg (ret, now) m)+ return ret++-- |+-- Caches an IO actions result+constMemoize :: IO b -> IO (IO b)+constMemoize action = do+ retmvar <- newMVar Nothing+ return $ do+ mret <- readMVar retmvar+ case mret of+ Just ret -> return ret+ Nothing -> do+ ret <- action+ _ <- swapMVar retmvar (Just ret)+ return ret++-- |+-- Caches an IO actions result for some amount of time+constMemoizeTime :: Millisecond -> IO b -> IO (IO b)+constMemoizeTime delay action = do+ let delayDiff :: Double+ delayDiff = (fromInteger (toMicroseconds delay)) / 1000000+ retmvar <- newMVar Nothing+ return $ do+ mret <- readMVar retmvar+ case mret of+ Just (ret, lastcall) -> do+ now <- getCurrentTime+ let diff = fromRational $ toRational $ diffUTCTime now lastcall+ if diff >= delayDiff+ then do+ ret' <- action+ _ <- swapMVar retmvar (Just (ret, now))+ return ret'+ else return ret+ Nothing -> do+ ret <- action+ lastcall <- getCurrentTime+ _ <- swapMVar retmvar (Just (ret, lastcall))+ return ret
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}