From 7a7d56e2480343a94d322c11ad5c23e7541da317 Mon Sep 17 00:00:00 2001 From: drlkf Date: Mon, 26 Oct 2026 00:52:53 +0100 Subject: [PATCH 1/2] chore: fix extra-doc-files --- .../effectful-data-cache-opentelemetry.cabal | 2 ++ effectful-data-cache-opentelemetry/package.yaml | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/effectful-data-cache-opentelemetry/effectful-data-cache-opentelemetry.cabal b/effectful-data-cache-opentelemetry/effectful-data-cache-opentelemetry.cabal index ed16958..79b8920 100644 --- a/effectful-data-cache-opentelemetry/effectful-data-cache-opentelemetry.cabal +++ b/effectful-data-cache-opentelemetry/effectful-data-cache-opentelemetry.cabal @@ -19,6 +19,8 @@ license-file: LICENSE build-type: Simple extra-source-files: README.md +extra-doc-files: + CHANGELOG.md source-repository head type: git diff --git a/effectful-data-cache-opentelemetry/package.yaml b/effectful-data-cache-opentelemetry/package.yaml index 2e18d9a..d082a88 100644 --- a/effectful-data-cache-opentelemetry/package.yaml +++ b/effectful-data-cache-opentelemetry/package.yaml @@ -10,7 +10,7 @@ copyright: 2026 drlkf extra-source-files: - README.md -extra-docs-files: +extra-doc-files: - CHANGELOG.md category: cache From 42a5670abd0bfc3d142b8d448c1b4394e216b6fd Mon Sep 17 00:00:00 2001 From: drlkf Date: Mon, 26 Oct 2026 00:47:56 +0100 Subject: [PATCH 2/2] feat: add memcache backend --- .github/workflows/stack.yml | 8 +- .releaserc.json | 20 +++- AGENTS.md | 4 +- README.md | 5 + effectful-data-cache-memcache/CHANGELOG.md | 1 + effectful-data-cache-memcache/LICENSE | 26 +++++ effectful-data-cache-memcache/README.md | 20 ++++ .../api/effectful-data-cache-memcache.api | 3 + .../effectful-data-cache-memcache.cabal | 70 ++++++++++++ effectful-data-cache-memcache/package.yaml | 62 +++++++++++ .../src/Effectful/Cache/Memcache.hs | 105 ++++++++++++++++++ .../test/Effectful/Cache/MemcacheSpec.hs | 86 ++++++++++++++ effectful-data-cache-memcache/test/Spec.hs | 1 + stack.yaml | 1 + 14 files changed, 408 insertions(+), 4 deletions(-) create mode 100644 effectful-data-cache-memcache/CHANGELOG.md create mode 100644 effectful-data-cache-memcache/LICENSE create mode 100644 effectful-data-cache-memcache/README.md create mode 100644 effectful-data-cache-memcache/api/effectful-data-cache-memcache.api create mode 100644 effectful-data-cache-memcache/effectful-data-cache-memcache.cabal create mode 100644 effectful-data-cache-memcache/package.yaml create mode 100644 effectful-data-cache-memcache/src/Effectful/Cache/Memcache.hs create mode 100644 effectful-data-cache-memcache/test/Effectful/Cache/MemcacheSpec.hs create mode 100644 effectful-data-cache-memcache/test/Spec.hs diff --git a/.github/workflows/stack.yml b/.github/workflows/stack.yml index 01d2f1f..502a4f2 100644 --- a/.github/workflows/stack.yml +++ b/.github/workflows/stack.yml @@ -24,7 +24,7 @@ jobs: - uses: haskell-actions/hlint-run@v2 with: - path: '["src/", "test/", "effectful-data-cache-opentelemetry/src/", "effectful-data-cache-opentelemetry/test/"]' + path: '["src/", "test/", "effectful-data-cache-opentelemetry/src/", "effectful-data-cache-opentelemetry/test/", "effectful-data-cache-memcache/src/", "effectful-data-cache-memcache/test/"]' fail-on: warning format: @@ -39,6 +39,8 @@ jobs: test/**/*.hs effectful-data-cache-opentelemetry/src/**/*.hs effectful-data-cache-opentelemetry/test/**/*.hs + effectful-data-cache-memcache/src/**/*.hs + effectful-data-cache-memcache/test/**/*.hs build: needs: generate-matrix @@ -51,6 +53,10 @@ jobs: steps: - uses: actions/checkout@v6 + # macOS runners have no service containers; memcache tests skip there + - if: runner.os == 'Linux' + run: docker run -d -p 11211:11211 memcached:1.6 + - uses: freckle/stack-action@v5 with: cache-prefix: v2/ diff --git a/.releaserc.json b/.releaserc.json index 6d9e88e..4b5d705 100644 --- a/.releaserc.json +++ b/.releaserc.json @@ -57,6 +57,20 @@ "haddockOutputDir": "effectful-data-cache-opentelemetry/.stack-work" } ], + [ + "semantic-release-haddock-since", + { + "versionFiles": [ + "effectful-data-cache-memcache/package.yaml", + "effectful-data-cache-memcache/*.cabal" + ], + "baseline": "effectful-data-cache-memcache/api/effectful-data-cache-memcache.api", + "srcDir": "effectful-data-cache-memcache/src", + "haddockCommand": ["stack", "haddock", "--no-haddock-deps", "effectful-data-cache-memcache"], + "buildCommand": ["stack", "build", "effectful-data-cache-memcache"], + "haddockOutputDir": "effectful-data-cache-memcache/.stack-work" + } + ], [ "@semantic-release/git", { @@ -69,7 +83,11 @@ "effectful-data-cache-opentelemetry/package.yaml", "effectful-data-cache-opentelemetry/*.cabal", "effectful-data-cache-opentelemetry/src/**/*.hs", - "effectful-data-cache-opentelemetry/api/*.api" + "effectful-data-cache-opentelemetry/api/*.api", + "effectful-data-cache-memcache/package.yaml", + "effectful-data-cache-memcache/*.cabal", + "effectful-data-cache-memcache/src/**/*.hs", + "effectful-data-cache-memcache/api/*.api" ] } ], diff --git a/AGENTS.md b/AGENTS.md index 55ce694..a379941 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -5,8 +5,8 @@ Haskell library (stack + hpack). Edit `package.yaml`, never generated `.cabal`. ## Commands - build and test (GHC 9.10): `stack build --test --ghc-options=-Werror` -- format: `fourmolu -i src test effectful-data-cache-opentelemetry/{src,test}` (fourmolu 0.21.0.0, config in `fourmolu.yaml`) -- lint: `hlint src test effectful-data-cache-opentelemetry/{src,test}` (rules in `.hlint.yaml`; HLS has no hlint plugin on GHC 9.10) +- format: `fourmolu -i src test effectful-data-cache-{opentelemetry,memcache}/{src,test}` (fourmolu 0.21.0.0, config in `fourmolu.yaml`) +- lint: `hlint src test effectful-data-cache-{opentelemetry,memcache}/{src,test}` (rules in `.hlint.yaml`; HLS has no hlint plugin on GHC 9.10) CI (`.github/workflows/stack.yml`) runs all of the above; keep it green. diff --git a/README.md b/README.md index d2d3d96..abdf865 100644 --- a/README.md +++ b/README.md @@ -19,3 +19,8 @@ main = runEff . runCache Nothing $ do See [effectful-data-cache-opentelemetry](effectful-data-cache-opentelemetry) for OpenTelemetry instrumentation. + +## memcached + +See [effectful-data-cache-memcache](effectful-data-cache-memcache) for a +memcached backend. diff --git a/effectful-data-cache-memcache/CHANGELOG.md b/effectful-data-cache-memcache/CHANGELOG.md new file mode 100644 index 0000000..825c32f --- /dev/null +++ b/effectful-data-cache-memcache/CHANGELOG.md @@ -0,0 +1 @@ +# Changelog diff --git a/effectful-data-cache-memcache/LICENSE b/effectful-data-cache-memcache/LICENSE new file mode 100644 index 0000000..e50154f --- /dev/null +++ b/effectful-data-cache-memcache/LICENSE @@ -0,0 +1,26 @@ +Copyright 2026 drlkf + +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. diff --git a/effectful-data-cache-memcache/README.md b/effectful-data-cache-memcache/README.md new file mode 100644 index 0000000..3180ff7 --- /dev/null +++ b/effectful-data-cache-memcache/README.md @@ -0,0 +1,20 @@ +# effectful-data-cache-memcache + +`runCacheMemcache` interprets `Cache` against memcached using the +[memcache](https://hackage.haskell.org/package/memcache) client. + +```haskell +import Database.Memcache.Client (def, newClient) +import Effectful.Cache.Memcache + +codec :: Codec String Int +codec = Codec BC.pack (BC.pack . show) (readMaybe . BC.unpack) + +main = do + c <- newClient [def] def + runEff . runCacheMemcache codec c Nothing $ insert "key" (42 :: Int) +``` + +memcached cannot enumerate items: `keys`, `filterWithKey` and `size` throw +`MemcacheUnsupported`. `lookup'` behaves like `lookup` and `purgeExpired` is +a no-op. Expirations are rounded up to whole seconds. diff --git a/effectful-data-cache-memcache/api/effectful-data-cache-memcache.api b/effectful-data-cache-memcache/api/effectful-data-cache-memcache.api new file mode 100644 index 0000000..fe24400 --- /dev/null +++ b/effectful-data-cache-memcache/api/effectful-data-cache-memcache.api @@ -0,0 +1,3 @@ +Effectful.Cache.Memcache.Codec +Effectful.Cache.Memcache.MemcacheUnsupported +Effectful.Cache.Memcache.runCacheMemcache diff --git a/effectful-data-cache-memcache/effectful-data-cache-memcache.cabal b/effectful-data-cache-memcache/effectful-data-cache-memcache.cabal new file mode 100644 index 0000000..accdc64 --- /dev/null +++ b/effectful-data-cache-memcache/effectful-data-cache-memcache.cabal @@ -0,0 +1,70 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.39.6. +-- +-- see: https://github.com/sol/hpack + +name: effectful-data-cache-memcache +version: 0.1.0.0 +synopsis: memcached backend for effectful-data-cache +description: Please see the README on GitHub at +category: cache +homepage: https://github.com/haskell-github-trust/effectful-data-cache#readme +bug-reports: https://github.com/haskell-github-trust/effectful-data-cache/issues +author: drlkf +maintainer: drlkf +copyright: 2026 drlkf +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md +extra-doc-files: + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/haskell-github-trust/effectful-data-cache + +library + exposed-modules: + Effectful.Cache.Memcache + other-modules: + Paths_effectful_data_cache_memcache + autogen-modules: + Paths_effectful_data_cache_memcache + hs-source-dirs: + src + ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + base >=4.7 && <5 + , bytestring >=0.11 && <0.13 + , clock ==0.8.* + , effectful-core >=2.3 && <3 + , effectful-data-cache ==0.2.* + , memcache ==0.3.* + default-language: Haskell2010 + +test-suite effectful-data-cache-memcache-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Effectful.Cache.MemcacheSpec + Paths_effectful_data_cache_memcache + autogen-modules: + Paths_effectful_data_cache_memcache + hs-source-dirs: + test + ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + base >=4.7 && <5 + , bytestring + , clock + , effectful-core + , effectful-data-cache + , effectful-data-cache-memcache + , hspec + , memcache + default-language: Haskell2010 diff --git a/effectful-data-cache-memcache/package.yaml b/effectful-data-cache-memcache/package.yaml new file mode 100644 index 0000000..7ee4035 --- /dev/null +++ b/effectful-data-cache-memcache/package.yaml @@ -0,0 +1,62 @@ +--- +name: effectful-data-cache-memcache +version: 0.1.0.0 +github: haskell-github-trust/effectful-data-cache +license: BSD-3-Clause +author: drlkf +maintainer: drlkf +copyright: 2026 drlkf + +extra-source-files: + - README.md + +extra-doc-files: + - CHANGELOG.md + +category: cache +synopsis: memcached backend for effectful-data-cache +description: >- + Please see the README on GitHub at + + +dependencies: + - base >= 4.7 && < 5 + - bytestring >= 0.11 && < 0.13 + - clock >= 0.8 && < 0.9 + - effectful-core >= 2.3 && < 3 + - effectful-data-cache >= 0.2 && < 0.3 + - memcache >= 0.3 && < 0.4 + +ghc-options: + - -Wall + - -Wextra + - -Wcompat + - -Widentities + - -Wincomplete-record-updates + - -Wincomplete-uni-patterns + - -Wmissing-export-lists + - -Wmissing-home-modules + - -Wpartial-fields + - -Wredundant-constraints + +library: + source-dirs: src + +tests: + effectful-data-cache-memcache-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - effectful-data-cache-memcache + - effectful-data-cache + - effectful-core + - bytestring + - clock + - hspec + - memcache + build-tools: + - hspec-discover diff --git a/effectful-data-cache-memcache/src/Effectful/Cache/Memcache.hs b/effectful-data-cache-memcache/src/Effectful/Cache/Memcache.hs new file mode 100644 index 0000000..57dd2cf --- /dev/null +++ b/effectful-data-cache-memcache/src/Effectful/Cache/Memcache.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +-- | Interpret 'Cache' against a memcached server via "Database.Memcache.Client". +-- +-- > c <- newClient [def] def +-- > runEff . runCacheMemcache codec c Nothing $ insert "a" (1 :: Int) +-- +-- memcached cannot enumerate its items, so 'Keys', 'FilterWithKey' and 'Size' +-- throw 'MemcacheUnsupported'. Expired items are never returned, so 'Lookup'' +-- behaves like 'Lookup', and 'PurgeExpired' is a no-op. +module Effectful.Cache.Memcache ( + Codec (..), + MemcacheUnsupported (..), + runCacheMemcache, +) where + +import Control.Exception (Exception, throwIO) +import Control.Monad (void) +import Data.ByteString (ByteString) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.Word (Word32) +import qualified Database.Memcache.Client as M +import Effectful (Eff, IOE, MonadIO (liftIO), type (:>)) +import Effectful.Cache (Cache (..)) +import Effectful.Dispatch.Dynamic (interpret) +import System.Clock (Clock (Realtime), TimeSpec (..), getTime, toNanoSecs) + +-- | How keys and values are stored. A value that fails to decode is a miss. +-- +-- @since 0.1.0.0 +data Codec k v = Codec + { encodeKey :: k -> ByteString + , encodeValue :: v -> ByteString + , decodeValue :: ByteString -> Maybe v + } + +-- | Thrown by operations memcached has no equivalent for. +-- +-- @since 0.1.0.0 +newtype MemcacheUnsupported = MemcacheUnsupported String + deriving Show + +instance Exception MemcacheUnsupported + +-- | Run against a memcached client with the given default expiration. +-- +-- @since 0.1.0.0 +runCacheMemcache + :: forall k v es a + . IOE :> es + => Codec k v + -> M.Client + -> Maybe TimeSpec + -> Eff (Cache k v : es) a + -> Eff es a +runCacheMemcache codec c ts eff = do + ref <- liftIO (newIORef ts) + interpret (\_ op -> liftIO (withMemcache codec c ref op)) eff + +withMemcache + :: Codec k v + -> M.Client + -> IORef (Maybe TimeSpec) + -> Cache k v m a + -> IO a +withMemcache codec c ref = \case + Insert k v -> readIORef ref >>= \ts -> set ts k v + Insert' ts k v -> set ts k v + Lookup k -> get k + Lookup' k -> get k + Keys -> unsupported "keys" + Delete k -> del k + FilterWithKey _ -> unsupported "filterWithKey" + Purge -> M.flush c Nothing + PurgeExpired -> pure () + Size -> unsupported "size" + DefaultExpiration -> readIORef ref + SetDefaultExpiration ts -> writeIORef ref ts + where + key = encodeKey codec + get k = (>>= \(v, _, _) -> decodeValue codec v) <$> M.get c (key k) + del k = void (M.delete c (key k) 0) + set ts k v = + expiration ts >>= \case + Nothing -> del k + Just e -> void (M.set c (key k) (encodeValue codec v) 0 e) + unsupported op = throwIO (MemcacheUnsupported op) + +-- | memcached expirations are whole seconds, 0 never expires, and values over +-- 30 days are unix timestamps. 'Nothing' means already expired. +expiration :: Maybe TimeSpec -> IO (Maybe Word32) +expiration Nothing = pure (Just 0) +expiration (Just ts) + | secs <= 0 = pure Nothing + | secs <= thirtyDays = pure (Just (fromInteger secs)) + | otherwise = Just . fromInteger . (+ secs) . toInteger . sec <$> getTime Realtime + where + secs = negate (toNanoSecs ts `div` negate 1_000_000_000) + thirtyDays = 30 * 24 * 3600 diff --git a/effectful-data-cache-memcache/test/Effectful/Cache/MemcacheSpec.hs b/effectful-data-cache-memcache/test/Effectful/Cache/MemcacheSpec.hs new file mode 100644 index 0000000..c4552c5 --- /dev/null +++ b/effectful-data-cache-memcache/test/Effectful/Cache/MemcacheSpec.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE TypeApplications #-} + +module Effectful.Cache.MemcacheSpec (spec) where + +import Control.Concurrent (threadDelay) +import Control.Exception (SomeException, try) +import qualified Data.ByteString.Char8 as BC +import qualified Database.Memcache.Client as M +import Effectful +import Effectful.Cache +import Effectful.Cache.Memcache +import System.Clock (TimeSpec (..)) +import Test.Hspec +import Text.Read (readMaybe) +import Prelude hiding (lookup) + +codec :: Codec String Int +codec = Codec BC.pack (BC.pack . show) (readMaybe . BC.unpack) + +connect :: IO (Maybe M.Client) +connect = do + c <- M.newClient [M.def] M.def + r <- try @SomeException (M.version c) + pure (c <$ either (const Nothing) Just r) + +withClient :: (M.Client -> IO ()) -> Maybe M.Client -> IO () +withClient _ Nothing = pendingWith "memcached not reachable on 127.0.0.1:11211" +withClient f (Just c) = M.flush c Nothing >> f c + +run :: M.Client -> Maybe TimeSpec -> Eff '[Cache String Int, IOE] a -> IO a +run c ts = runEff . runCacheMemcache codec c ts + +spec :: Spec +spec = beforeAll connect $ do + it "looks up what it inserted" . withClient $ \c -> do + r <- run c Nothing $ insert "a" (1 :: Int) >> lookup @String @Int "a" + r `shouldBe` Just 1 + + it "misses on an absent key" . withClient $ \c -> do + r <- run c Nothing $ lookup @String @Int "nope" + r `shouldBe` Nothing + + it "deletes" . withClient $ \c -> do + r <- run c Nothing $ do + insert "a" (1 :: Int) + delete @String @Int "a" + lookup @String @Int "a" + r `shouldBe` Nothing + + it "purges" . withClient $ \c -> do + r <- run c Nothing $ do + insert "a" (1 :: Int) + purge @String @Int + lookup @String @Int "a" + r `shouldBe` Nothing + + it "treats a non-positive expiration as already expired" . withClient $ \c -> do + r <- run c Nothing $ do + insert "a" (1 :: Int) + insert' (Just (TimeSpec (-1) 0)) "a" (2 :: Int) + lookup @String @Int "a" + r `shouldBe` Nothing + + it "expires after the default expiration" . withClient $ \c -> do + (d, r) <- run c (Just (TimeSpec 0 1)) $ do + insert "a" (1 :: Int) + liftIO (threadDelay 2_100_000) + (,) <$> defaultExpiration @String @Int <*> lookup @String @Int "a" + d `shouldBe` Just (TimeSpec 0 1) + r `shouldBe` Nothing + + it "sets the default expiration" . withClient $ \c -> do + d <- run c Nothing $ do + setDefaultExpiration @String @Int (Just (TimeSpec 5 0)) + defaultExpiration @String @Int + d `shouldBe` Just (TimeSpec 5 0) + + it "misses on an undecodable value" . withClient $ \c -> do + _ <- M.set c (BC.pack "a") (BC.pack "junk") 0 0 + r <- run c Nothing $ lookup @String @Int "a" + r `shouldBe` Nothing + + it "rejects keys" . withClient $ \c -> + run c Nothing (keys @String @Int) `shouldThrow` \(MemcacheUnsupported _) -> True diff --git a/effectful-data-cache-memcache/test/Spec.hs b/effectful-data-cache-memcache/test/Spec.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/effectful-data-cache-memcache/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/stack.yaml b/stack.yaml index e24e516..3ed4de6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,6 +3,7 @@ snapshot: lts-24.59 packages: - . - effectful-data-cache-opentelemetry + - effectful-data-cache-memcache extra-deps: - hs-opentelemetry-api-1.0.0.0 - hs-opentelemetry-api-types-1.0.0.0