eventsource-store-specs 1.0.1 → 1.1.0

raw patch · 5 files changed

+129/−95 lines, 5 filesdep +asyncdep +textdep +transformers-basedep −protoludePVP ok

version bump matches the API change (PVP)

Dependencies added: async, text, transformers-base

Dependencies removed: protolude

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• eventsource-store-specs.cabal +12/−8
• library/Test/EventSource/Store/Specification.hs +109/−15
• package.yaml +4/−5
• stack.yaml +0/−67

@@ -1,3 +1,7 @@+1.1.0+=====+    * Add Aggregate API specifications.+ 1.0.1 =====     * Fix Stackage build.

@@ -1,9 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.17.1.+-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack+--+-- hash: a73245d0b01b4f489e3877e705b0ec44226d71819dfeb9e1e05bf013a17152ea  name:           eventsource-store-specs-version:        1.0.1+version:        1.1.0 synopsis:       Provides common test specification for Store implementation. description:    Provides common test specification for Store implementation. category:       Eventsourcing, Testing@@ -21,7 +23,6 @@     LICENSE.md     package.yaml     README.md-    stack.yaml  source-repository head   type: git@@ -30,17 +31,20 @@ library   hs-source-dirs:       library-  default-extensions: NoImplicitPrelude   ghc-options: -Wall   build-depends:-      base >=4.9 && <5-    , protolude >= 0.1.10 && <0.3+      aeson+    , async+    , base >=4.9 && <5     , eventsource-api ==1.*+    , mtl     , tasty     , tasty-hspec-    , mtl-    , aeson+    , text+    , transformers-base     , uuid   exposed-modules:       Test.EventSource.Store.Specification+  other-modules:+      Paths_eventsource_store_specs   default-language: Haskell2010

@@ -1,6 +1,8 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-} -------------------------------------------------------------------------------- -- | -- Module : Test.EventSource.Store.Specification@@ -15,16 +17,24 @@ module Test.EventSource.Store.Specification (specification) where  ---------------------------------------------------------------------------------import Prelude (Show(..))+import Control.Exception (Exception, toException, fromException)+import Control.Monad (unless)+import Data.Foldable (for_, traverse_)+import Data.Semigroup ((<>))  ---------------------------------------------------------------------------------import Control.Monad.Except-import Data.Aeson.Types-import Data.UUID-import Data.UUID.V4-import EventSource-import Protolude hiding (show)-import Test.Tasty.Hspec+import           Control.Concurrent.Async (wait)+import           Control.Monad.Except (runExceptT, mapExceptT)+import           Control.Monad.Base (MonadBase, liftBase)+import           Control.Monad.State (evalStateT, get, modify)+import           Data.Aeson.Types (object, withObject, (.=), (.:))+import           Data.Text (Text)+import           Data.UUID (toText)+import           Data.UUID.V4 (nextRandom)+import           EventSource+import           EventSource.Aggregate (StreamId(..))+import qualified EventSource.Aggregate.Simple as Simple+import           Test.Tasty.Hspec  -------------------------------------------------------------------------------- newtype TestEvent = TestEvent Int deriving (Eq, Show)@@ -45,10 +55,42 @@       fmap TestEvent (o .: "value")  ---------------------------------------------------------------------------------freshStreamName :: MonadIO m => m StreamName-freshStreamName = liftIO $ fmap (StreamName . toText) nextRandom+newtype Test = Test Int deriving (Eq, Show)  --------------------------------------------------------------------------------+data TestCmd+  = TestIncr Int+  | TestCmdError++--------------------------------------------------------------------------------+data TestError = TestError deriving (Eq, Show)++--------------------------------------------------------------------------------+instance Exception TestError++--------------------------------------------------------------------------------+newtype TestId = TestId Text++--------------------------------------------------------------------------------+instance StreamId TestId where+  toStreamName (TestId i) = StreamName $ "test:stream:" <> i++--------------------------------------------------------------------------------+instance Simple.AggregateIO TestEvent Test where+  applyIO (Test x) (TestEvent i) = pure (Test (x+i))++--------------------------------------------------------------------------------+instance Simple.ValidateIO TestCmd TestEvent Test where+  validateIO _ cmd =+    case cmd of+      TestIncr i   -> pure (Right $ TestEvent i)+      TestCmdError -> pure (Left $ toException TestError)++--------------------------------------------------------------------------------+freshStreamName :: MonadBase IO m => m StreamName+freshStreamName = liftBase $ fmap (StreamName . toText) nextRandom++-------------------------------------------------------------------------------- incr :: Int -> Int incr = (+1) @@ -147,7 +189,7 @@     let values = [0..9]         events = fmap TestEvent values         seed   = Right (0, EventNumber 0)-        +         testFold (Left e) _           = Left e         testFold (Right (a, n)) saved =           let n' = eventNumber saved@@ -155,7 +197,7 @@           case ee of             Left t               -> Left t             Right (TestEvent a') -> Right (a + a', max n n')-        +     name <- freshStreamName     _ <- wait =<< appendEvents store name AnyVersion events @@ -177,3 +219,55 @@      got <- iteratorReadAllEvents i     got `shouldBe` events++  specify "API/Aggregate - submit event" $ do+    agg <- Simple.newAgg (toStore store) (TestId "submit:event") (Test 0)+    let events = replicate 10 (TestEvent 1)++    traverse_ (Simple.submitEvt agg) events+    got <- Simple.snapshot agg++    got `shouldBe` Test 10++  specify "API/Aggregate - submit commands" $ do+    agg <- Simple.newAgg (toStore store) (TestId "submit:command") (Test 0)++    res1 <- Simple.submitCmd agg (TestIncr 1)+    let go1 (Right evt) = evt == TestEvent 1+        go1 Left{}      = False+    res1 `shouldSatisfy` go1++    s1 <- Simple.snapshot agg+    s1 `shouldBe` Test 1++    res2 <- Simple.submitCmd agg TestCmdError+    let go2 Right{}  = False+        go2 (Left e) = fromException e == Just TestError+    res2 `shouldSatisfy` go2++  specify "API/Aggregate - loading" $ do+    agg1 <- Simple.newAgg (toStore store) (TestId "submit:load") (Test 0)++    let commands = replicate 10 (TestIncr 1)++    traverse_ (Simple.submitCmd agg1) commands++    res1 <- Simple.snapshot agg1+    res1 `shouldBe` Test 10++    outcome <- Simple.loadAgg (toStore store) (TestId "submit:load") (Test 0)++    case outcome of+      Left{}     -> error "We should be able to load an aggregate."+      Right agg2 ->+        do res2 <- Simple.snapshot agg2+           res2 `shouldBe` res1++           res3 <- Simple.submitCmd agg2 (TestIncr 1)+           let go3 Left{} = False+               go3 Right{} = True+           res3 `shouldSatisfy` go3++           res4 <- Simple.snapshot agg2+           res4 `shouldBe` Test 11+

@@ -8,21 +8,20 @@ - LICENSE.md - package.yaml - README.md-- stack.yaml ghc-options: -Wall github: YoEight/eventsource-api library:-  default-extensions:-    - NoImplicitPrelude   dependencies:   - base >=4.9 && <5-  - protolude >= 0.1.10 && <0.3   - eventsource-api ==1.*   - tasty   - tasty-hspec   - mtl   - aeson   - uuid+  - async+  - transformers-base+  - text   source-dirs: library license: BSD3 license-file: LICENSE.md@@ -30,4 +29,4 @@ maintainer: yo.eight@gmail.com name: eventsource-store-specs synopsis: Provides common test specification for Store implementation.-version: '1.0.1'+version: '1.1.0'

@@ -1,67 +0,0 @@-# This file was automatically generated by 'stack init'-#-# Some commonly used options have been documented as comments in this file.-# For advanced use and comprehensive documentation of the format, please see:-# http://docs.haskellstack.org/en/stable/yaml_configuration/--# Resolver to choose a 'specific' stackage snapshot or a compiler version.-# A snapshot resolver dictates the compiler version and the set of packages-# to be used for project dependencies. For example:-#-# resolver: lts-3.5-# resolver: nightly-2015-09-21-# resolver: ghc-7.10.2-# resolver: ghcjs-0.1.0_ghc-7.10.2-# resolver:-#  name: custom-snapshot-#  location: "./custom-snapshot.yaml"-resolver: nightly-2017-08-15-compiler: ghc-8.2.1--# User packages to be built.-# Various formats can be used as shown in the example below.-#-# packages:-# - some-directory-# - https://example.com/foo/bar/baz-0.0.2.tar.gz-# - location:-#    git: https://github.com/commercialhaskell/stack.git-#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a-# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a-#   extra-dep: true-#  subdirs:-#  - auto-update-#  - wai-#-# A package marked 'extra-dep: true' will only be built if demanded by a-# non-dependency (i.e. a user package), and its test suites and benchmarks-# will not be run. This is useful for tweaking upstream packages.-packages:-- '.'-# Dependency packages to be pulled from upstream that are not in the resolver-# (e.g., acme-missiles-0.3)-extra-deps: []--# Override default flag values for local packages and extra-deps-flags: {}--# Extra package databases containing global packages-extra-package-dbs: []--# Control whether we use the GHC we find on the path-# system-ghc: true-#-# Require a specific version of stack, using version ranges-# require-stack-version: -any # Default-# require-stack-version: ">=1.2"-#-# Override the architecture used by stack, especially useful on Windows-# arch: i386-# arch: x86_64-#-# Extra directories used by stack for building-# extra-include-dirs: [/path/to/dir]-# extra-lib-dirs: [/path/to/dir]-#-# Allow a newer minor version of GHC than the snapshot specifies-# compiler-check: newer-minor