diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/keyed-vals-hspec-tests.cabal b/keyed-vals-hspec-tests.cabal --- a/keyed-vals-hspec-tests.cabal +++ b/keyed-vals-hspec-tests.cabal @@ -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 diff --git a/test/Test/KeyedVals/CheckHandle.hs b/test/Test/KeyedVals/CheckHandle.hs new file mode 100644 --- /dev/null +++ b/test/Test/KeyedVals/CheckHandle.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK prune not-home #-} + +{- | +Module : Test.KeyedVals.CheckHandle +Copyright : (c) 2022 Tim Emiola +Maintainer : Tim Emiola +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)] diff --git a/test/Test/KeyedVals/CheckTypedHandle.hs b/test/Test/KeyedVals/CheckTypedHandle.hs new file mode 100644 --- /dev/null +++ b/test/Test/KeyedVals/CheckTypedHandle.hs @@ -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 +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 diff --git a/test/Test/KeyedVals/Hspec.hs b/test/Test/KeyedVals/Hspec.hs --- a/test/Test/KeyedVals/Hspec.hs +++ b/test/Test/KeyedVals/Hspec.hs @@ -6,150 +6,38 @@ Copyright : (c) 2022 Tim Emiola Maintainer : Tim Emiola 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 diff --git a/test/Test/KeyedVals/Prelude.hs b/test/Test/KeyedVals/Prelude.hs new file mode 100644 --- /dev/null +++ b/test/Test/KeyedVals/Prelude.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK prune not-home #-} + +{- | +Module : Test.KeyedVals.CheckHandle +Copyright : (c) 2022 Tim Emiola +Maintainer : Tim Emiola +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 diff --git a/test/Test/KeyedVals/Types.hs b/test/Test/KeyedVals/Types.hs new file mode 100644 --- /dev/null +++ b/test/Test/KeyedVals/Types.hs @@ -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 +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