polysemy-kvstore (empty) → 0.1.0.0

raw patch · 5 files changed

+191/−0 lines, 5 filesdep +basedep +containersdep +polysemy

Dependencies added: base, containers, polysemy

Files

• ChangeLog.md +5/−0
• LICENSE +31/−0
• README.md +4/−0
• polysemy-kvstore.cabal +37/−0
• src/Polysemy/KVStore.hs +114/−0

@@ -0,0 +1,5 @@+# Changelog for polysemy-methodology++## v0.1.0.0++* Imported `KVStore` effect from polysemy-zoo.

@@ -0,0 +1,31 @@+Copyright Sandy Maguire (c) 2019+Copyright Daniel Firth (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Sandy Maguire nor the names of other+      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+OWNER 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,4 @@+# polysemy-kvstore++KVStore effect for polysemy, originally taken from+[polysemy-zoo](https://hackage.haskell.org/package/polysemy-zoo).

@@ -0,0 +1,37 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           polysemy-kvstore+version:        0.1.0.0+synopsis:       KVStore effect for polysemy+category:       Polysemy+author:         Daniel Firth+maintainer:     dan.firth@homotopic.tech+copyright:      2020 Daniel Firth+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/homotopic-tech/polysemy-kvstore++library+  exposed-modules:+      Polysemy.KVStore+  other-modules:+      Paths_polysemy_kvstore+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , containers+    , polysemy >=1.3.0.0 && <1.7+  default-language: Haskell2010

@@ -0,0 +1,114 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module Polysemy.KVStore+  ( -- * Effect+    KVStore (..),++    -- * Actions+    lookupKV,+    lookupOrThrowKV,+    existsKV,+    writeKV,+    deleteKV,+    updateKV,+    modifyKV,++    -- * Interpretations+    runKVStoreAsState,+    runKVStorePure,+  )+where++import qualified Data.Map as M+import Data.Maybe (isJust)+import Polysemy+import Polysemy.Error+import Polysemy.State++-- | Models things like Redis, HTTP GET/POST, etc. Things that are keyed, have+-- a value, and may or may not be there.+data KVStore k v m a where+  LookupKV :: k -> KVStore k v m (Maybe v)+  UpdateKV :: k -> Maybe v -> KVStore k v m ()++makeSem ''KVStore++-- |+--+-- @since 0.1.0.0+writeKV :: Member (KVStore k v) r => k -> v -> Sem r ()+writeKV k = updateKV k . Just+{-# INLINE writeKV #-}++-- |+--+-- @since 0.1.0.0+deleteKV :: forall k v r. Member (KVStore k v) r => k -> Sem r ()+deleteKV k = updateKV k (Nothing @v)+{-# INLINE deleteKV #-}++-- |+--+-- @since 0.1.0.0+lookupOrThrowKV ::+  Members+    '[ KVStore k v,+       Error e+     ]+    r =>+  (k -> e) ->+  k ->+  Sem r v+lookupOrThrowKV f k =+  fromEither . maybe (Left $ f k) Right =<< lookupKV k++-- |+--+-- @since 0.1.0.0+existsKV :: forall k v r. Member (KVStore k v) r => k -> Sem r Bool+existsKV = fmap isJust . lookupKV @k @v++-- |+--+-- @since 0.1.0.0+modifyKV ::+  Member (KVStore k v) r =>+  -- | Default value if the key isn't present+  v ->+  (v -> v) ->+  k ->+  Sem r ()+modifyKV d f k =+  lookupKV k >>= \case+    Just v -> writeKV k $ f v+    Nothing -> writeKV k $ f d++-- | Run a `KVStore` as a `State` effect containing a `Map`.+--+-- @since 0.1.0.0+runKVStoreAsState :: Ord k => Sem (KVStore k v ': r) a -> Sem (State (M.Map k v) ': r) a+runKVStoreAsState = reinterpret $ \case+  LookupKV k -> gets $ M.lookup k+  UpdateKV k v -> modify $ M.alter (const v) k+{-# INLINE runKVStoreAsState #-}++-- | Run a `KVStore` purely as a `Map`.+--+-- @since 0.1.0.0+runKVStorePure ::+  Ord k =>+  M.Map k v ->+  Sem (KVStore k v ': r) a ->+  Sem r (M.Map k v, a)+runKVStorePure m = runState m . runKVStoreAsState+{-# INLINE runKVStorePure #-}