cache-polysemy (empty) → 0.1.0

raw patch · 7 files changed

+221/−0 lines, 7 filesdep +basedep +cachedep +cache-polysemysetup-changed

Dependencies added: base, cache, cache-polysemy, clock, hashable, polysemy, polysemy-plugin

Files

• CHANGELOG.md +5/−0
• LICENSE +11/−0
• README.md +3/−0
• Setup.hs +3/−0
• cache-polysemy.cabal +65/−0
• src/Polysemy/Cache.hs +131/−0
• test/Spec.hs +3/−0

@@ -0,0 +1,5 @@+# cache-polysemy++## 0.1.0++Initial release

@@ -0,0 +1,11 @@+Copyright Poscat (c) 2020++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,3 @@+# cache-polysemy++An polysemy interface for cached hashmap and an interpreter implemented using [cache](https://hackage.haskell.org/package/cache)

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,65 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 0878f19b63f0664c2593af52422410abd99dc284e18d369f0f1fd5ab1fdf8077++name:           cache-polysemy+version:        0.1.0+synopsis:       cached hashmap+description:    An polysemy interface for cached hashmap and an interpreter implemented using <https://hackage.haskell.org/package/cache cache>+category:       Cache+homepage:       https://github.com/poscat0x04/cache-polysemy#readme+bug-reports:    https://github.com/poscat0x04/cache-polysemy/issues+author:         Poscat+maintainer:     poscat@mail.poscat.moe+copyright:      (c) 2020 Poscat+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/poscat0x04/cache-polysemy++library+  exposed-modules:+      Polysemy.Cache+  other-modules:+      Paths_cache_polysemy+  hs-source-dirs:+      src+  default-extensions: OverloadedStrings FlexibleInstances FlexibleContexts FunctionalDependencies ConstraintKinds DeriveGeneric DeriveFunctor DeriveFoldable DeriveTraversable TypeOperators TypeApplications TypeFamilies KindSignatures PartialTypeSignatures DataKinds StarIsType ScopedTypeVariables ExplicitForAll ViewPatterns BangPatterns LambdaCase TupleSections EmptyCase MultiWayIf UnicodeSyntax PatternSynonyms RecordWildCards+  ghc-options: -fplugin=Polysemy.Plugin+  build-depends:+      base >=4.10 && <5+    , cache >=0.1.3.0 && <0.2+    , clock >=0.8 && <0.9+    , hashable >=1.3.0.0 && <1.4+    , polysemy >=1.3.0.0 && <1.4+    , polysemy-plugin >=0.2.5.0 && <0.3+  default-language: Haskell2010++test-suite cache-polysemy-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_cache_polysemy+  hs-source-dirs:+      test+  default-extensions: OverloadedStrings FlexibleInstances FlexibleContexts FunctionalDependencies ConstraintKinds DeriveGeneric DeriveFunctor DeriveFoldable DeriveTraversable TypeOperators TypeApplications TypeFamilies KindSignatures PartialTypeSignatures DataKinds StarIsType ScopedTypeVariables ExplicitForAll ViewPatterns BangPatterns LambdaCase TupleSections EmptyCase MultiWayIf UnicodeSyntax PatternSynonyms RecordWildCards+  ghc-options: -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.10 && <5+    , cache >=0.1.3.0 && <0.2+    , cache-polysemy+    , clock >=0.8 && <0.9+    , hashable >=1.3.0.0 && <1.4+    , polysemy >=1.3.0.0 && <1.4+    , polysemy-plugin >=0.2.5.0 && <0.3+  default-language: Haskell2010

@@ -0,0 +1,131 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TemplateHaskell #-}++module Polysemy.Cache where++import qualified Data.Cache as C+import Data.Function ((&))+import Data.Hashable+import Data.IORef+import Polysemy+import Polysemy.AtomicState+import System.Clock++data Cache k v (m :: * -> *) a where+  Insert :: (Eq k, Hashable k) => k -> v -> Cache k v m ()+  Insert' :: (Eq k, Hashable k) => Maybe TimeSpec -> k -> v -> Cache k v m ()+  Lookup :: (Eq k, Hashable k) => k -> Cache k v m (Maybe v)+  Lookup' :: (Eq k, Hashable k) => k -> Cache k v m (Maybe v)+  Keys :: (Eq k, Hashable k) => Cache k v m [k]+  Delete :: (Eq k, Hashable k) => k -> Cache k v m ()+  FilterWithKey :: (Eq k, Hashable k) => (k -> v -> Bool) -> Cache k v m ()+  Purge :: (Eq k, Hashable k) => Cache k v m ()+  PurgeExpired :: (Eq k, Hashable k) => Cache k v m ()+  Size :: (Eq k, Hashable k) => Cache k v m Int+  DefaultExipration :: (Eq k, Hashable k) => Cache k v m (Maybe TimeSpec)+  SetDefaultExpiration :: (Eq k, Hashable k) => Maybe TimeSpec -> Cache k v m ()++makeSem_ ''Cache++-- | Insert an item into the cache, using the default expiration value of the cache.+insert :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => k -> v -> Sem r ()++-- | Insert an item in the cache, with an explicit expiration value.+insert' :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Maybe TimeSpec -> k -> v -> Sem r ()++-- | Lookup an item with the given key, and delete it if it is expired.+--+-- The function will only return a value if it is present in the cache and if the item is not expired.+--+-- The function will eagerly delete the item from the cache if it is expired.+lookup :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => k -> Sem r (Maybe v)++-- | Lookup an item with the given key, but don't delete it if it is expired.+--+-- The function will only return a value if it is present in the cache and if the item is not expired.+--+-- The function will not delete the item from the cache.+lookup' :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => k -> Sem r (Maybe v)++-- | Return all keys present in the cache.+keys :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r [k]++-- | Delete an item from the cache. Won't do anything if the item is not present.+delete :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => k -> Sem r ()++-- | Keeps elements that satify a predicate (used for cache invalidation). Note that the predicate might be called for expired items.+filterWithKey :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => (k -> v -> Bool) -> Sem r ()++-- | Delete all elements (cache invalidation).+purge :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r ()++-- | Delete all items that are expired.+--+-- This is one big atomic operation.+purgeExpired :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r ()++-- | Return the size of the cache, including expired items.+size :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r Int++-- | Get the default expiration value of newly added cache items.+defaultExipration :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Sem r (Maybe TimeSpec)++-- | Change the default expiration value of newly added cache items.+setDefaultExpiration :: forall k v r. (Eq k, Hashable k, Member (Cache k v) r) => Maybe TimeSpec -> Sem r ()++-- | Run a 'Cache' using 'AtomicState'+runCacheAtomicState ::+  Members '[Embed IO, AtomicState (C.Cache k v)] r =>+  Sem (Cache k v ': r) a ->+  Sem r a+runCacheAtomicState = interpret $ \case+  Insert k v -> do+    cache <- atomicGet+    embed $ C.insert cache k v+  Insert' ts k v -> do+    cache <- atomicGet+    embed $ C.insert' cache ts k v+  Lookup k -> do+    cache <- atomicGet+    embed $ C.lookup cache k+  Lookup' k -> do+    cache <- atomicGet+    embed $ C.lookup cache k+  Keys -> do+    cache <- atomicGet+    embed $ C.keys cache+  Delete k -> do+    cache <- atomicGet+    embed $ C.delete cache k+  FilterWithKey pred -> do+    cache <- atomicGet+    embed $ C.filterWithKey pred cache+  Purge -> do+    cache <- atomicGet+    embed $ C.purge cache+  PurgeExpired -> do+    cache <- atomicGet+    embed $ C.purgeExpired cache+  Size -> do+    cache <- atomicGet+    embed $ C.size cache+  DefaultExipration -> do+    cache <- atomicGet+    pure $ C.defaultExpiration cache+  SetDefaultExpiration ts -> do+    cache <- atomicGet+    atomicPut $ C.setDefaultExpiration cache ts++-- | Run a 'Cache', given a default expiration time.+runCache ::+  Members '[Embed IO] r =>+  Maybe TimeSpec ->+  Sem (Cache k v ': AtomicState (C.Cache k v) ': r) a ->+  Sem r a+runCache ts eff = do+  cache <- embed $ C.newCache ts+  ref <- embed $ newIORef cache+  eff+    & runCacheAtomicState+    & runAtomicStateIORef ref

@@ -0,0 +1,3 @@+module Main where++main = pure ()