keyed-vals-hspec-tests 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+498/−127 lines, 7 filesdep +aesondep +http-api-datadep +textdep ~keyed-valsPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, http-api-data, text

Dependency ranges changed: keyed-vals

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• keyed-vals-hspec-tests.cabal +10/−3
• test/Test/KeyedVals/CheckHandle.hs +126/−0
• test/Test/KeyedVals/CheckTypedHandle.hs +188/−0
• test/Test/KeyedVals/Hspec.hs +12/−124
• test/Test/KeyedVals/Prelude.hs +51/−0
• test/Test/KeyedVals/Types.hs +105/−0

@@ -2,8 +2,14 @@  `keyed-vals-hspec-tests` uses [PVP Versioning][1]. +## 0.2.0.0 -- 2022-12-15++* add tests that verify [KeyedVal.Handle.Typed][]+* reduce the number of functions exposed for external use+ ## 0.1.0.0 -- 2022-11-28  * Initial version.  [1]: https://pvp.haskell.org+[KeyedVals.Handle.Typed]: https://hackage.haskell.org/package/keyed-vals/docs/KeyedVals-Handle.Typed.html

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               keyed-vals-hspec-tests-version:            0.1.0.0+version:            0.2.0.0 license:            BSD-3-Clause license-file:       LICENSE maintainer:         adetokunbo@emio.la@@ -26,13 +26,20 @@  library   exposed-modules:  Test.KeyedVals.Hspec+                    Test.KeyedVals.Types+  other-modules:    Test.KeyedVals.CheckHandle+                    Test.KeyedVals.CheckTypedHandle+                    Test.KeyedVals.Prelude   hs-source-dirs:   test   default-language: Haskell2010   ghc-options:      -Wall -Wincomplete-uni-patterns -fwarn-tabs   build-depends:+    , aeson          >=1.5.1    && <2.2     , base           >=4.11     && <5.0     , bytestring     >=0.10.8.2 && <0.11 || >=0.11.3.1 && <0.12-    , containers     >=0.6.5    && <0.7-    , keyed-vals     >=0.1      && <0.2     , benri-hspec    >=0.1      && <0.2+    , containers     >=0.6.5    && <0.7     , hspec          >=2.7      && <2.12+    , http-api-data  >=0.5      && <0.6+    , keyed-vals     >=0.2      && <0.3+    , text           >=1.2.4    && <1.3  || >=2.0

@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Module      : Test.KeyedVals.CheckHandle+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetcorrectlyunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module Test.KeyedVals.CheckHandle (+  -- * a test fixture+  spec,++  -- * setup/teardown hspec tests+  setupFixture,+  closeFixture,+) where++import qualified Data.Map.Strict as Map+import KeyedVals.Handle+import Test.KeyedVals.Prelude+++spec :: SpecWith (Handle IO)+spec = do+  context "with simple values" $ do+    it "should load correctly" $ \h -> do+      loadVal h key1 `endsRight` Just simple1++    it "should update correctly" $ \h -> do+      endsRight_ $ saveVal h key1 "changed"+      loadVal h key1 `endsRight` Just "changed"++    it "should delete matching keys correctly " $ \h -> do+      loadVal h key2 `endsRight` Just simple2+      withGlobOf "*2" $ \patt -> do+        endsRight_ $ deleteMatches h patt+        loadVal h key2 `endsRight` Nothing++    it "should delete correctly" $ \h -> do+      deleteKeys h (key1 :| []) `endsRight` ()+      loadVal h key1 `endsRight` Nothing++  context "with keyed values" $ do+    let mKey1Of h = loadFrom h mKey1++    it "should load correctly" $ \h -> do+      loadKVs h mKey1 `endsRight` d1++    checkLength mKey1 4++    it "should update an indexed value correctly" $ \h -> do+      endsRight_ $ saveTo h mKey1 key1 "changed"+      mKey1Of h key1 `endsRight` Just "changed"++    checkLength mKey1 4++    it "should add an indexed value correctly" $ \h -> do+      mKey1Of h "foo" `endsRight` Nothing+      endsRight_ $ saveTo h mKey1 "foo" "bar"+      mKey1Of h "foo" `endsRight` Just "bar"++    checkLength mKey1 5++    it "should delete key-values correctly" $ \h -> do+      endsRight_ $ deleteKeysFrom h mKey1 (key1 :| [key2])+      mKey1Of h "foo" `endsRight` Just "bar"+      mKey1Of h key1 `endsRight` Nothing+      mKey1Of h key2 `endsRight` Nothing++    checkLength mKey1 3++    it "should update the key-values correctly" $ \h -> do+      endsRight_ $ updateKVs h mKey1 d2+      mKey1Of h key1 `endsRight` Just simple3+      mKey1Of h key2 `endsRight` Nothing+      mKey1Of h key5 `endsRight` Just simple3++    it "should fetch a subset of the key-values correctly" $ \h -> do+      let want = Map.fromList [("foo", "bar"), (key5, simple3)]+      loadSlice h mKey1 (AllOf ("foo" :| [key5])) `endsRight` want++    it "should delete correctly" $ \h -> do+      endsRight_ $ deleteKeys h (mKey1 :| [])+      loadKVs h mKey1 `endsRight` Map.empty+      mKey1Of h "foo" `endsRight` Nothing++    checkLength mKey1 0+++setupFixture :: Handle IO -> IO (Handle IO)+setupFixture h = do+  orThrowHandleErr $ saveVal h key1 simple1+  orThrowHandleErr $ saveVal h key2 simple2+  orThrowHandleErr $ saveKVs h mKey1 d1+  pure h+++closeFixture :: Handle IO -> IO ()+closeFixture = close+++checkLength :: Key -> Natural -> SpecWith (Handle IO)+checkLength aKey n = context "and the reported length" $ do+  it "should be correct " $ \h -> do+    countKVs h aKey `endsRight` n+++key1, key2, key3, key4, key5, mKey1 :: Key+key1 = "a-simple-key-1"+key2 = "a-simple-key-2"+key3 = "another-key-1"+key4 = "another_key-2"+key5 = "yet-another-key"+mKey1 = "a-map-key-1"+++simple1, simple2, simple3 :: Val+simple1 = "a-simple-value-1"+simple2 = "a-simple-value-2"+simple3 = "a-simple-value-3"+++d1, d2 :: ValsByKey+d1 = Map.fromList [(key1, simple1), (key2, simple2), (key3, simple1), (key4, simple2)]+d2 = Map.fromList [(key1, simple3), (key5, simple3)]

@@ -0,0 +1,188 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Module      : Test.KeyedVals.CheckHandle+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetcorrectlyunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module Test.KeyedVals.CheckTypedHandle (+  -- * a test fixture+  spec,++  -- * setup/teardown hspec tests+  setupFixture,+  closeFixture,+) where++import qualified Data.Map.Strict as Map+import KeyedVals.Handle.Typed+import Test.KeyedVals.Prelude+++spec :: SpecWith (Handle IO)+spec = do+  checkFixedPathed+  checkVarPathed+++checkFixedPathed :: SpecWith (Handle IO)+checkFixedPathed = do+  context "with typed key-values stored in fixed paths" $ do+    it "should load correctly" $ \h -> do+      loadKVs h Fixed `endsRight` fixedKVs++    checkLength @FixedDemo Fixed 2++    it "should update an indexed value correctly" $ \h -> do+      let k = key fixedK1+          want = FixedDemo (1, "changed")+      endsRight_ $ saveTo h k want+      loadFrom h k `endsRight` want+      mayLoadFrom h k `endsRight` Just want++    checkLength @FixedDemo Fixed 2++    it "should add an indexed value correctly" $ \h -> do+      let added = key fixedK3+          want = FixedDemo (3, "added")+      mayLoadFrom h added `endsRight` Nothing+      endsRight_ $ saveTo h added want+      mayLoadFrom h added `endsRight` Just want++    checkLength @FixedDemo Fixed 3++    it "should update the key-values correctly" $ \h -> do+      endsRight_ $ updateKVs h Fixed moreFixedKVs+      mayLoadFrom h (key fixedK1) `endsRight` Just fixedV3+      mayLoadFrom h (key fixedK4) `endsRight` Just fixedV4++    it "should fetch a subset of the key-values as a dict correctly" $ \h -> do+      let selection = fixedK1 :| [fixedK4]+      loadSlice h Fixed selection `endsRight` moreFixedKVs+++checkVarPathed :: SpecWith (Handle IO)+checkVarPathed = do+  context "with typed key-values stored in variable paths" $ do+    it "should load correctly" $ \h -> do+      loadKVs h path1 `endsRight` varKVs+      loadKVs h path2 `endsRight` varKVs++    checkLength path1 2+    checkLength path2 2++    it "should update an indexed value correctly" $ \h -> do+      let k = id1 // varK1+          want = VarDemo $ Right False+      endsRight_ $ saveTo h k want+      loadFrom h k `endsRight` want+      mayLoadFrom h k `endsRight` Just want++    it "should add an indexed value correctly" $ \h -> do+      let added = id2 // varK3+          want = VarDemo $ Left "added"+      mayLoadFrom h added `endsRight` Nothing+      endsRight_ $ saveTo h added want+      mayLoadFrom h added `endsRight` Just want++    checkLength path1 2+    checkLength path2 3++    it "should update the key-values correctly" $ \h -> do+      endsRight_ $ updateKVs h path1 moreVarKVs+      mayLoadFrom h (id1 // varK1) `endsRight` Just varV3+      mayLoadFrom h (id1 // varK4) `endsRight` Just varV4++    it "should fetch a subset of the key-values correctly" $ \h -> do+      let selection = varK1 :| [varK4]+      loadSlice h path1 selection `endsRight` moreVarKVs+++setupFixture :: Handle IO -> IO (Handle IO)+setupFixture h = do+  orThrowHandleErr $ saveKVs h Fixed fixedKVs+  orThrowHandleErr $ saveKVs h path1 varKVs+  orThrowHandleErr $ saveKVs h path2 varKVs+  pure h+++closeFixture :: Handle IO -> IO ()+closeFixture = close+++fixedK1, fixedK2, fixedK3, fixedK4 :: FixedDemoKey+fixedK1 = 25+fixedK2 = 49+fixedK3 = 81+fixedK4 = 121+++fixedV1, fixedV2, fixedV3, fixedV4 :: FixedDemo+fixedV1 = FixedDemo (1, "one")+fixedV2 = FixedDemo (2, "two")+fixedV3 = FixedDemo (1, "un")+fixedV4 = FixedDemo (4, "quatre")+++fixedKVs, moreFixedKVs :: TypedKVs FixedDemo+fixedKVs =+  Map.fromList+    [ (fixedK1, fixedV1)+    , (fixedK2, fixedV2)+    ]+moreFixedKVs =+  Map.fromList+    [ (fixedK1, fixedV3)+    , (fixedK4, fixedV4)+    ]+++varK1, varK2, varK3, varK4 :: VarDemoKey+varK1 = 36+varK2 = 64+varK3 = 100+varK4 = 144+++path1, path2 :: TypedPath VarDemo+path1 = Variable id1+path2 = Variable id2+++id1, id2 :: VarDemoID+id1 = "id1"+id2 = "id2"+++varV1, varV2, varV3, varV4 :: VarDemo+varV1 = VarDemo $ Left "one"+varV2 = VarDemo $ Right False+varV3 = VarDemo $ Left "three"+varV4 = VarDemo $ Left "four"+++varKVs, moreVarKVs :: TypedKVs VarDemo+varKVs =+  Map.fromList+    [ (varK1, varV1)+    , (varK2, varV2)+    ]+moreVarKVs =+  Map.fromList+    [ (varK1, varV3)+    , (varK4, varV4)+    ]+++checkLength ::+  (Ord (KeyType v)) =>+  TypedPath v ->+  Natural ->+  SpecWith (Handle IO)+checkLength path n = context "and the reported size" $ do+  it "should be correct " $ \h -> do+    countKVs h path `endsRight` n

@@ -6,150 +6,38 @@ Copyright   : (c) 2022 Tim Emiola Maintainer  : Tim Emiola <adetokunbo@emio.la> SPDX-License-Identifier: BSD3++Uses "Test.Hspec" to validate the behaviour of a 'Handle' implementation -} module Test.KeyedVals.Hspec (   -- * a test fixture   checkHandle, -  -- * functions for extending the fixture-  orThrowHandleErr,-  throwHandleErr,-  withGlobOf,--  -- * setup/teardown hspec te+l fssts+  -- * setup/teardown hspec tests   setupFixture,   closeFixture, -  -- * module re-eports-  module Test.Hspec,-  module Test.Hspec.Benri,+  -- * module re-export+  module Test.KeyedVals.Prelude, ) where -import Control.Exception (throwIO)-import Data.ByteString (ByteString)-import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.Map.Strict as Map-import KeyedVals.Handle-import Numeric.Natural (Natural)-import Test.Hspec-import Test.Hspec.Benri+import qualified Test.KeyedVals.CheckHandle as LessTyped+import qualified Test.KeyedVals.CheckTypedHandle as Typed+import Test.KeyedVals.Prelude   checkHandle :: SpecWith (Handle IO) checkHandle = do-  context "with simple values" $ do-    it "should load ok" $ \h -> do-      loadVal h key1 `endsRight` Just simple1--    it "should update ok" $ \h -> do-      endsRight_ $ saveVal h key1 "changed"-      loadVal h key1 `endsRight` Just "changed"--    it "should delete matching keys correctly " $ \h -> do-      loadVal h key2 `endsRight` Just simple2-      withGlobOf "*2" $ \patt -> do-        endsRight_ $ deleteMatches h patt-        loadVal h key2 `endsRight` Nothing--    it "should delete ok" $ \h -> do-      deleteKeys h (key1 :| []) `endsRight` ()-      loadVal h key1 `endsRight` Nothing--  context "with dict values" $ do-    let mKey1Of h = loadFrom h mKey1--    it "should load ok" $ \h -> do-      loadKVs h mKey1 `endsRight` d1--    checkLength mKey1 4--    it "should update an indexed value ok" $ \h -> do-      endsRight_ $ saveTo h mKey1 key1 "changed"-      mKey1Of h key1 `endsRight` Just "changed"--    checkLength mKey1 4--    it "should add an indexed value ok" $ \h -> do-      mKey1Of h "foo" `endsRight` Nothing-      endsRight_ $ saveTo h mKey1 "foo" "bar"-      mKey1Of h "foo" `endsRight` Just "bar"--    checkLength mKey1 5--    it "should delete indexed values ok" $ \h -> do-      endsRight_ $ deleteKeysFrom h mKey1 (key1 :| [key2])-      mKey1Of h "foo" `endsRight` Just "bar"-      mKey1Of h key1 `endsRight` Nothing-      mKey1Of h key2 `endsRight` Nothing--    checkLength mKey1 3--    it "should update the indexed values using a dict ok" $ \h -> do-      endsRight_ $ updateKVs h mKey1 d2-      mKey1Of h key1 `endsRight` Just simple3-      mKey1Of h key2 `endsRight` Nothing-      mKey1Of h key5 `endsRight` Just simple3--    it "should fetch a subset of the indexed values as a dict ok" $ \h -> do-      let want = Map.fromList [("foo", "bar"), (key5, simple3)]-      loadSlice h mKey1 (AllOf ("foo" :| [key5])) `endsRight` want--    it "should delete ok" $ \h -> do-      endsRight_ $ deleteKeys h (mKey1 :| [])-      loadKVs h mKey1 `endsRight` Map.empty-      mKey1Of h "foo" `endsRight` Nothing--    checkLength mKey1 0---withGlobOf :: ByteString -> (Glob -> IO a) -> IO a-withGlobOf x action = do-  case mkGlob x of-    Nothing -> throwIO $ userError "bad test pattern"-    Just g -> action g---checkLength :: Key -> Natural -> SpecWith (Handle IO)-checkLength aKey n = context "and the reported length" $ do-  it "should be correct " $ \h -> do-    countKVs h aKey `endsRight` n+  LessTyped.spec+  Typed.spec   setupFixture :: Handle IO -> IO (Handle IO) setupFixture h = do-  orThrowHandleErr $ saveVal h key1 simple1-  orThrowHandleErr $ saveVal h key2 simple2-  orThrowHandleErr $ saveKVs h mKey1 d1+  void $ LessTyped.setupFixture h+  void $ Typed.setupFixture h   pure h   closeFixture :: Handle IO -> IO () closeFixture = close---key1, key2, key3, key4, key5, mKey1 :: Key-key1 = "a-simple-key-1"-key2 = "a-simple-key-2"-key3 = "another-key-1"-key4 = "another_key-2"-key5 = "yet-another-key"-mKey1 = "a-map-key-1"---simple1, simple2, simple3 :: Val-simple1 = "a-simple-value-1"-simple2 = "a-simple-value-2"-simple3 = "a-simple-value-3"---d1, d2 :: ValsByKey-d1 = Map.fromList [(key1, simple1), (key2, simple2), (key3, simple1), (key4, simple2)]-d2 = Map.fromList [(key1, simple3), (key5, simple3)]---throwHandleErr :: HandleErr -> IO ()-throwHandleErr = throwIO . userError . show---orThrowHandleErr :: IO (Either HandleErr ()) -> IO ()-orThrowHandleErr action = action >>= either throwHandleErr pure

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Module      : Test.KeyedVals.CheckHandle+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module Test.KeyedVals.Prelude (+  -- * functions+  orThrowHandleErr,+  throwHandleErr,+  withGlobOf,++  -- * module re-eports+  module Control.Monad,+  module Control.Exception,+  module Data.ByteString,+  module Data.List.NonEmpty,+  module Numeric.Natural,+  module KeyedVals.Handle,+  module Test.Hspec,+  module Test.Hspec.Benri,+  module Test.KeyedVals.Types,+) where++import Control.Exception (throwIO)+import Control.Monad (void)+import Data.ByteString (ByteString)+import Data.List.NonEmpty (NonEmpty (..))+import KeyedVals.Handle (Glob, Handle, HandleErr, Key, close, mkGlob)+import Numeric.Natural (Natural)+import Test.Hspec+import Test.Hspec.Benri+import Test.KeyedVals.Types+++withGlobOf :: ByteString -> (Glob -> IO a) -> IO a+withGlobOf x action = do+  case mkGlob x of+    Nothing -> throwIO $ userError "bad test pattern"+    Just g -> action g+++throwHandleErr :: HandleErr -> IO ()+throwHandleErr = throwIO . userError . show+++orThrowHandleErr :: IO (Either HandleErr ()) -> IO ()+orThrowHandleErr action = action >>= either throwHandleErr pure

@@ -0,0 +1,105 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Module      : Test.KeyedVals.Type+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++This module provides types that demonstrate how to use @KeyVals.Handle.Typed@++The declared types are used in hspec tests used to validate implementations of 'Handle'+-}+module Test.KeyedVals.Types (+  -- * data types+  VarDemo (VarDemo),+  VarDemoKey,+  VarDemoID,+  FixedDemo (FixedDemo),+  FixedDemoKey,+) where++import Data.Aeson (FromJSON, ToJSON)+import Data.String (IsString)+import Data.Text (Text)+import KeyedVals.Handle.Codec.Aeson (AesonOf (..))+import KeyedVals.Handle.Codec.HttpApiData (HttpApiDataOf (..))+import KeyedVals.Handle.Typed+import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))+++{- | A simple type to illustrate storing key-values at varying storage paths.++it's just a simple type (Either) wrapped in newtype to avoid orphan+instances.+-}+newtype VarDemo = VarDemo (Either Text Bool)+  deriving (Eq, Show)+  deriving (FromJSON, ToJSON) via (Either Text Bool)+++deriving via (AesonOf (Either Text Bool)) instance DecodeKV VarDemo+++deriving via (AesonOf (Either Text Bool)) instance EncodeKV VarDemo+++-- | The keys for each 'VarDemo' are @Int@s.+newtype VarDemoKey = VarDemoKey Int+  deriving stock (Eq, Show)+  deriving (ToHttpApiData, FromHttpApiData, Num, Ord) via Int+  deriving (DecodeKV, EncodeKV) via HttpApiDataOf Int+++-- | Groups of 'VarDemo' are stored for different 'VarDemoID'.+newtype VarDemoID = VarDemoId Text+  deriving stock (Eq, Show)+  deriving (IsString, ToHttpApiData, FromHttpApiData) via Text+  deriving (DecodeKV, EncodeKV) via HttpApiDataOf Text+++-- | Describe how @'VarDemo's@ are stored in the key-value store+instance PathOf VarDemo where+  type KVPath VarDemo = "/testing/{}/var"+  type KeyType VarDemo = VarDemoKey+++{- | Specify how to derive the path to store @'VarDemo's@ in the key-value store++This instance uses 'expand' to replace the @{}@ in the 'KVPath' with the+variable portion of the key.+-}+instance VaryingPathOf VarDemo where+  type PathVar VarDemo = VarDemoID+  modifyPath _ = expand+++{- | A simple type to illustrate storing key-values at a fixed storage path++it's just a simple type (tuple) wrapped in newtype to avoid orphan instances.+-}+newtype FixedDemo = FixedDemo (Int, Text)+  deriving stock (Eq, Show)+  deriving (FromJSON, ToJSON) via (Int, Text)+  deriving (DecodeKV, EncodeKV) via AesonOf (Int, Text)+++-- | Specify how @'FixedDemo's@ are stored in the key-value store+instance PathOf FixedDemo where+  type KVPath FixedDemo = "/testing/fixed"+  type KeyType FixedDemo = FixedDemoKey+++-- | The keys for each 'FixedDemo' are @Int@s.+newtype FixedDemoKey = FixedDemoKey Int+  deriving stock (Eq, Show)+  deriving (ToHttpApiData, FromHttpApiData, Num, Ord) via Int+  deriving (DecodeKV, EncodeKV) via HttpApiDataOf Int