hspec-effectful (empty) → 0.1.0.0
raw patch · 6 files changed
+873/−0 lines, 6 filesdep +basedep +effectfuldep +hspecsetup-changed
Dependencies added: base, effectful, hspec, hspec-core, hspec-effectful, hspec-expectations, hspec-expectations-pretty-diff, hunit-effectful
Files
- CHANGELOG.md +12/−0
- LICENCE +287/−0
- Setup.hs +2/−0
- hspec-effectful.cabal +75/−0
- src/Effectful/Hspec.hs +446/−0
- test/Main.hs +51/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),+and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).++## [1.0.0] - 2026-07-10++### Added++- Initial release.
+ LICENCE view
@@ -0,0 +1,287 @@+ EUROPEAN UNION PUBLIC LICENCE v. 1.2+ EUPL © the European Union 2007, 2016++This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined+below) which is provided under the terms of this Licence. Any use of the Work,+other than as authorised under this Licence is prohibited (to the extent such+use is covered by a right of the copyright holder of the Work).++The Work is provided under the terms of this Licence when the Licensor (as+defined below) has placed the following notice immediately following the+copyright notice for the Work:++ Licensed under the EUPL++or has expressed by any other means his willingness to license under the EUPL.++1. Definitions++In this Licence, the following terms have the following meaning:++- ‘The Licence’: this Licence.++- ‘The Original Work’: the work or software distributed or communicated by the+ Licensor under this Licence, available as Source Code and also as Executable+ Code as the case may be.++- ‘Derivative Works’: the works or software that could be created by the+ Licensee, based upon the Original Work or modifications thereof. This Licence+ does not define the extent of modification or dependence on the Original Work+ required in order to classify a work as a Derivative Work; this extent is+ determined by copyright law applicable in the country mentioned in Article 15.++- ‘The Work’: the Original Work or its Derivative Works.++- ‘The Source Code’: the human-readable form of the Work which is the most+ convenient for people to study and modify.++- ‘The Executable Code’: any code which has generally been compiled and which is+ meant to be interpreted by a computer as a program.++- ‘The Licensor’: the natural or legal person that distributes or communicates+ the Work under the Licence.++- ‘Contributor(s)’: any natural or legal person who modifies the Work under the+ Licence, or otherwise contributes to the creation of a Derivative Work.++- ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of+ the Work under the terms of the Licence.++- ‘Distribution’ or ‘Communication’: any act of selling, giving, lending,+ renting, distributing, communicating, transmitting, or otherwise making+ available, online or offline, copies of the Work or providing access to its+ essential functionalities at the disposal of any other natural or legal+ person.++2. Scope of the rights granted by the Licence++The Licensor hereby grants You a worldwide, royalty-free, non-exclusive,+sublicensable licence to do the following, for the duration of copyright vested+in the Original Work:++- use the Work in any circumstance and for all usage,+- reproduce the Work,+- modify the Work, and make Derivative Works based upon the Work,+- communicate to the public, including the right to make available or display+ the Work or copies thereof to the public and perform publicly, as the case may+ be, the Work,+- distribute the Work or copies thereof,+- lend and rent the Work or copies thereof,+- sublicense rights in the Work or copies thereof.++Those rights can be exercised on any media, supports and formats, whether now+known or later invented, as far as the applicable law permits so.++In the countries where moral rights apply, the Licensor waives his right to+exercise his moral right to the extent allowed by law in order to make effective+the licence of the economic rights here above listed.++The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to+any patents held by the Licensor, to the extent necessary to make use of the+rights granted on the Work under this Licence.++3. Communication of the Source Code++The Licensor may provide the Work either in its Source Code form, or as+Executable Code. If the Work is provided as Executable Code, the Licensor+provides in addition a machine-readable copy of the Source Code of the Work+along with each copy of the Work that the Licensor distributes or indicates, in+a notice following the copyright notice attached to the Work, a repository where+the Source Code is easily and freely accessible for as long as the Licensor+continues to distribute or communicate the Work.++4. Limitations on copyright++Nothing in this Licence is intended to deprive the Licensee of the benefits from+any exception or limitation to the exclusive rights of the rights owners in the+Work, of the exhaustion of those rights or of other applicable limitations+thereto.++5. Obligations of the Licensee++The grant of the rights mentioned above is subject to some restrictions and+obligations imposed on the Licensee. Those obligations are the following:++Attribution right: The Licensee shall keep intact all copyright, patent or+trademarks notices and all notices that refer to the Licence and to the+disclaimer of warranties. The Licensee must include a copy of such notices and a+copy of the Licence with every copy of the Work he/she distributes or+communicates. The Licensee must cause any Derivative Work to carry prominent+notices stating that the Work has been modified and the date of modification.++Copyleft clause: If the Licensee distributes or communicates copies of the+Original Works or Derivative Works, this Distribution or Communication will be+done under the terms of this Licence or of a later version of this Licence+unless the Original Work is expressly distributed only under this version of the+Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee+(becoming Licensor) cannot offer or impose any additional terms or conditions on+the Work or Derivative Work that alter or restrict the terms of the Licence.++Compatibility clause: If the Licensee Distributes or Communicates Derivative+Works or copies thereof based upon both the Work and another work licensed under+a Compatible Licence, this Distribution or Communication can be done under the+terms of this Compatible Licence. For the sake of this clause, ‘Compatible+Licence’ refers to the licences listed in the appendix attached to this Licence.+Should the Licensee's obligations under the Compatible Licence conflict with+his/her obligations under this Licence, the obligations of the Compatible+Licence shall prevail.++Provision of Source Code: When distributing or communicating copies of the Work,+the Licensee will provide a machine-readable copy of the Source Code or indicate+a repository where this Source will be easily and freely available for as long+as the Licensee continues to distribute or communicate the Work.++Legal Protection: This Licence does not grant permission to use the trade names,+trademarks, service marks, or names of the Licensor, except as required for+reasonable and customary use in describing the origin of the Work and+reproducing the content of the copyright notice.++6. Chain of Authorship++The original Licensor warrants that the copyright in the Original Work granted+hereunder is owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each Contributor warrants that the copyright in the modifications he/she brings+to the Work are owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each time You accept the Licence, the original Licensor and subsequent+Contributors grant You a licence to their contributions to the Work, under the+terms of this Licence.++7. Disclaimer of Warranty++The Work is a work in progress, which is continuously improved by numerous+Contributors. It is not a finished work and may therefore contain defects or+‘bugs’ inherent to this type of development.++For the above reason, the Work is provided under the Licence on an ‘as is’ basis+and without warranties of any kind concerning the Work, including without+limitation merchantability, fitness for a particular purpose, absence of defects+or errors, accuracy, non-infringement of intellectual property rights other than+copyright as stated in Article 6 of this Licence.++This disclaimer of warranty is an essential part of the Licence and a condition+for the grant of any rights to the Work.++8. Disclaimer of Liability++Except in the cases of wilful misconduct or damages directly caused to natural+persons, the Licensor will in no event be liable for any direct or indirect,+material or moral, damages of any kind, arising out of the Licence or of the use+of the Work, including without limitation, damages for loss of goodwill, work+stoppage, computer failure or malfunction, loss of data or any commercial+damage, even if the Licensor has been advised of the possibility of such damage.+However, the Licensor will be liable under statutory product liability laws as+far such laws apply to the Work.++9. Additional agreements++While distributing the Work, You may choose to conclude an additional agreement,+defining obligations or services consistent with this Licence. However, if+accepting obligations, You may act only on your own behalf and on your sole+responsibility, not on behalf of the original Licensor or any other Contributor,+and only if You agree to indemnify, defend, and hold each Contributor harmless+for any liability incurred by, or claims asserted against such Contributor by+the fact You have accepted any warranty or additional liability.++10. Acceptance of the Licence++The provisions of this Licence can be accepted by clicking on an icon ‘I agree’+placed under the bottom of a window displaying the text of this Licence or by+affirming consent in any other similar way, in accordance with the rules of+applicable law. Clicking on that icon indicates your clear and irrevocable+acceptance of this Licence and all of its terms and conditions.++Similarly, you irrevocably accept this Licence and all of its terms and+conditions by exercising any rights granted to You by Article 2 of this Licence,+such as the use of the Work, the creation by You of a Derivative Work or the+Distribution or Communication by You of the Work or copies thereof.++11. Information to the public++In case of any Distribution or Communication of the Work by means of electronic+communication by You (for example, by offering to download the Work from a+remote location) the distribution channel or media (for example, a website) must+at least provide to the public the information requested by the applicable law+regarding the Licensor, the Licence and the way it may be accessible, concluded,+stored and reproduced by the Licensee.++12. Termination of the Licence++The Licence and the rights granted hereunder will terminate automatically upon+any breach by the Licensee of the terms of the Licence.++Such a termination will not terminate the licences of any person who has+received the Work from the Licensee under the Licence, provided such persons+remain in full compliance with the Licence.++13. Miscellaneous++Without prejudice of Article 9 above, the Licence represents the complete+agreement between the Parties as to the Work.++If any provision of the Licence is invalid or unenforceable under applicable+law, this will not affect the validity or enforceability of the Licence as a+whole. Such provision will be construed or reformed so as necessary to make it+valid and enforceable.++The European Commission may publish other linguistic versions or new versions of+this Licence or updated versions of the Appendix, so far this is required and+reasonable, without reducing the scope of the rights granted by the Licence. New+versions of the Licence will be published with a unique version number.++All linguistic versions of this Licence, approved by the European Commission,+have identical value. Parties can take advantage of the linguistic version of+their choice.++14. Jurisdiction++Without prejudice to specific agreement between parties,++- any litigation resulting from the interpretation of this License, arising+ between the European Union institutions, bodies, offices or agencies, as a+ Licensor, and any Licensee, will be subject to the jurisdiction of the Court+ of Justice of the European Union, as laid down in article 272 of the Treaty on+ the Functioning of the European Union,++- any litigation arising between other parties and resulting from the+ interpretation of this License, will be subject to the exclusive jurisdiction+ of the competent court where the Licensor resides or conducts its primary+ business.++15. Applicable Law++Without prejudice to specific agreement between parties,++- this Licence shall be governed by the law of the European Union Member State+ where the Licensor has his seat, resides or has his registered office,++- this licence shall be governed by Belgian law if the Licensor has no seat,+ residence or registered office inside a European Union Member State.++Appendix++‘Compatible Licences’ according to Article 5 EUPL are:++- GNU General Public License (GPL) v. 2, v. 3+- GNU Affero General Public License (AGPL) v. 3+- Open Software License (OSL) v. 2.1, v. 3.0+- Eclipse Public License (EPL) v. 1.0+- CeCILL v. 2.0, v. 2.1+- Mozilla Public Licence (MPL) v. 2+- GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3+- Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for+ works other than software+- European Union Public Licence (EUPL) v. 1.1, v. 1.2+- Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong+ Reciprocity (LiLiQ-R+).++The European Commission may update this Appendix to later versions of the above+licences without producing a new version of the EUPL, as long as they provide+the rights granted in Article 2 of this Licence and protect the covered Source+Code from exclusive appropriation.++All other changes or additions to this Appendix require the production of a new+EUPL version.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hspec-effectful.cabal view
@@ -0,0 +1,75 @@+cabal-version: 3.0+name: hspec-effectful+version: 0.1.0.0+synopsis: Effectful driver for Hspec+category: Test+description:+ Adaptation of the @<https://hackage.haskell.org/package/hspec Hspec>@ library for the @<https://hackage.haskell.org/package/effectful effectful>@ ecosystem.++license: EUPL-1.2+license-file: LICENCE+author: IDA+maintainer: IDA+homepage: https://digital-autonomy.institute+bug-reports: https://issues.digital-autonomy.institute+build-type: Simple+extra-doc-files:+ CHANGELOG.md++common common+ default-language: GHC2021+ ghc-options:+ -Weverything+ -Wno-unsafe+ -Wno-missing-safe-haskell-mode+ -Wno-missing-export-lists+ -Wno-missing-import-lists+ -Wno-missing-kind-signatures+ -Wno-all-missed-specialisations++ default-extensions:+ ApplicativeDo+ BlockArguments+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveGeneric+ DerivingStrategies+ DerivingVia+ ExplicitNamespaces+ GeneralizedNewtypeDeriving+ LambdaCase+ NoImplicitPrelude+ OverloadedLabels+ OverloadedRecordDot+ OverloadedStrings+ RecordWildCards+ RecursiveDo+ TypeFamilies+ ViewPatterns++ build-depends:+ base >=4.16 && <5,+ effectful >=2.6 && <2.7,++library+ import: common+ hs-source-dirs: src+ build-depends:+ hspec >=2.11 && <2.12,+ hspec-core >=2.11 && <2.12,+ hspec-expectations >=0.8 && <0.9,+ hspec-expectations-pretty-diff >=0.7 && <0.8,+ hunit-effectful >=1.0 && <1.1,++ exposed-modules:+ Effectful.Hspec++test-suite test+ import: common+ type: exitcode-stdio-1.0+ ghc-options: -threaded+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ hspec-effectful
+ src/Effectful/Hspec.hs view
@@ -0,0 +1,446 @@+{-# LANGUAGE ImpredicativeTypes #-}+{-# OPTIONS_GHC -Wno-missing-role-annotations #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module : Effectful.Hspec+-- Copyright : (c) 2026 Institute for Digital Autonomy+-- License : EUPL-1.2+-- Maintainer : IDA+--+-- Effectful bindings for the <http://hackage.haskell.org/package/hspec Hspec library>+-- built on top of @<http://hackage.haskell.org/package/hunit-effectful hunit-effectful>@.+--+-- = Overview+--+-- This library provides @Hspec@'s test combinators expressed in terms of the 'Hspec' effect.+-- This effect allows you to intersperse test assertions with arbitrary other effects.+--+-- = Example usage+--+-- Suppose we wish to test stateful operations on an account balance:+--+-- > deposit :: (State Int :> es) => Int -> Eff es ()+-- > deposit amount = modify (+ amount)+-- >+-- > balance :: (State Int :> es) => Eff es Int+-- > balance = get+--+-- > withdraw :: (State Int :> es) => Int -> Eff es Bool+-- > withdraw amount = do+-- > funds <- balance+-- > if funds < amount+-- > then pure False+-- > else do+-- > put $ funds - amount+-- > pure True+--+-- Use 'describe' to group related examples, 'it' to state individual expectations,+-- and setup/teardown combinators such as 'before_', 'after_', or 'around_' to+-- run the examples from a known initial state:+--+-- > accountSpec :: (State Int :> es, Hspec :> es) => Eff es ()+-- > accountSpec = describe "account" . before_ (put @Int 0) $ do+-- > it "accumulates deposits" $ do+-- > deposit 100+-- > deposit 50+-- > balance `shouldReturn` 150+-- >+-- > it "checks for sufficient funds before withdrawing" $ do+-- > deposit 100+-- > withdraw 30 `shouldReturn` True+-- > withdraw 1000 `shouldReturn` False+-- > balance `shouldReturn` 70+--+-- Finally, run the spec with 'runHspec', which also resolves the underlying 'HUnit' effect:+--+-- > main :: IO ()+-- > main = runEff . runHspec . evalState @Int 0 $ accountSpec+module Effectful.Hspec+ ( -- * Effect+ Hspec+ , Expectation+ , runHspecWith'+ , runHspecWith+ , runHspec'+ , runHspec++ -- * Spec construction+ , describe+ , context+ , it+ , specify+ , pending+ , pendingWith++ -- * Skipping+ , xit+ , xspecify+ , xdescribe+ , xcontext++ -- * Focusing+ , focus+ , fit+ , fspecify+ , fdescribe+ , fcontext++ -- * Setup / Teardown+ , before_+ , beforeAll_+ , after_+ , afterAll_+ , around_+ , aroundAll_++ -- * Expectations+ , expectationFailure+ , shouldBe+ , shouldSatisfy+ , shouldStartWith+ , shouldEndWith+ , shouldContain+ , shouldMatchList+ , shouldReturn+ , shouldNotBe+ , shouldNotSatisfy+ , shouldNotContain+ , shouldNotReturn+ , shouldThrow+ , anyException+ , Config (..)+ , defaultConfig+ , Hspec.Spec+ , HasCallStack+ )+where++import Control.Monad (unless)+import Data.List qualified as List+import Data.Typeable (typeOf)+import Effectful+import Effectful.Dispatch.Static+import Effectful.Environment (runEnvironment, withArgs)+import Effectful.Exception (Exception, throwIO, try)+import Effectful.HUnit as HUnit+import Test.Hspec qualified as Hspec+import Test.Hspec.Core.Spec (ResultStatus (..))+import Test.Hspec.Expectations (Selector, anyException)+import Test.Hspec.Expectations.Pretty.Matcher (matchList)+import Test.Hspec.Runner (Config (..), defaultConfig)+import Test.Hspec.Runner qualified as Hspec+import Prelude++data Hspec :: Effect++type instance DispatchOf Hspec = 'Static 'WithSideEffects++data instance StaticRep Hspec = Hspec+ { spec :: Hspec.Spec+ , unlift :: forall r. Eff '[HUnit] r -> IO r+ }++type Expectation es = Assertion es++runHspecWith' :: (IOE :> es, HUnit :> es) => Config -> Eff (Hspec ': es) a -> Eff es a+runHspecWith' config action = do+ (a, Hspec{spec}) <- withEffToIO (ConcUnlift Ephemeral Unlimited) \unlift ->+ unlift+ . runStaticRep+ Hspec+ { spec = pure ()+ , unlift = unlift . inject+ }+ . inject+ $ action+ runEnvironment . withArgs [] . liftIO $ Hspec.hspecWith config spec+ pure a++runHspecWith :: (IOE :> es) => Config -> Eff (Hspec ': es) a -> Eff es a+runHspecWith = (runHUnit .) . (. inject) . runHspecWith'++runHspec' :: (IOE :> es, HUnit :> es) => Eff (Hspec ': es) a -> Eff es a+runHspec' = runHspecWith' defaultConfig . inject++runHspec :: (IOE :> es) => Eff (Hspec ': es) a -> Eff es a+runHspec = runHUnit . runHspec' . inject++hunit :: (Hspec :> es) => Eff '[HUnit] r -> Eff es r+hunit action = do+ Hspec{unlift} <- getStaticRep+ unsafeEff_ . unlift . inject $ action++-- | Lifted 'Hspec.describe'+describe :: (HasCallStack, Hspec :> es) => String -> Eff es a -> Eff es a+describe label action =+ stateStaticRepM \before -> do+ putStaticRep before{spec = pure ()}+ result <- action+ after <- getStaticRep+ pure (result, before{spec = spec before >> Hspec.describe label (spec after)})++-- | Lifted 'Hspec.it'+it :: (HasCallStack, Hspec :> es) => String -> Eff es () -> Eff es ()+it label action = do+ ioAction <-+ unsafeConcUnliftIO Ephemeral Unlimited \runInIO ->+ pure (runInIO action)+ stateStaticRep \hspec -> ((), hspec{spec = spec hspec >> Hspec.it label ioAction})++-- | Lifted 'Hspec.specify'+specify :: (HasCallStack, Hspec :> es) => String -> Eff es () -> Eff es ()+specify = it++-- | Lifted 'Hspec.context'+context :: (HasCallStack, Hspec :> es) => String -> Eff es a -> Eff es a+context = describe++-- | Lifted 'Hspec.pending'+pending :: (HasCallStack, Hspec :> es) => Eff es ()+pending = getStaticRep @Hspec >> unsafeEff_ Hspec.pending++pending_ :: Eff es ()+pending_ = throwIO $ Pending Nothing Nothing++-- | Lifted 'Hspec.pendingWith'+pendingWith :: (HasCallStack, Hspec :> es) => String -> Eff es ()+pendingWith = (getStaticRep @Hspec >>) . unsafeEff_ . Hspec.pendingWith++-- | Lifted 'Hspec.xit'+xit :: (HasCallStack, Hspec :> es) => String -> Eff es () -> Eff es ()+xit = (before_ pending_ .) . it++-- | Lifted 'Hspec.xspecify'+xspecify :: (HasCallStack, Hspec :> es) => String -> Eff es () -> Eff es ()+xspecify = xit++-- | Lifted 'Hspec.xdescribe'+xdescribe :: (HasCallStack, Hspec :> es) => String -> Eff es a -> Eff es a+xdescribe = (before_ pending_ .) . describe++-- | Lifted 'Hspec.xcontext'+xcontext :: (HasCallStack, Hspec :> es) => String -> Eff es a -> Eff es a+xcontext = xdescribe++-- | Lifted 'Hspec.focus'+focus :: (HasCallStack, Hspec :> es) => Eff es a -> Eff es a+focus action =+ stateStaticRepM \before -> do+ putStaticRep before{spec = pure ()}+ result <- action+ after <- getStaticRep+ pure (result, before{spec = spec before >> Hspec.focus (spec after)})++-- | Lifted 'Hspec.fit'+fit :: (HasCallStack, Hspec :> es) => String -> Eff es () -> Eff es ()+fit = fmap focus . it++-- | Lifted 'Hspec.fspecify'+fspecify :: (HasCallStack, Hspec :> es) => String -> Eff es () -> Eff es ()+fspecify = fit++-- | Lifted 'Hspec.fdescribe'+fdescribe :: (HasCallStack, Hspec :> es) => String -> Eff es a -> Eff es a+fdescribe = fmap focus . describe++-- | Lifted 'Hspec.fcontext'+fcontext :: (HasCallStack, Hspec :> es) => String -> Eff es a -> Eff es a+fcontext = fdescribe++-- | Lifted 'Hspec.before_'+before_ :: (HasCallStack, Hspec :> es) => Eff es () -> Eff es a -> Eff es a+before_ setup action = do+ ioSetup <-+ unsafeConcUnliftIO Ephemeral Unlimited \unlift ->+ pure (unlift setup)+ stateStaticRepM \prev -> do+ putStaticRep prev{spec = pure ()}+ result <- action+ after <- getStaticRep+ pure (result, prev{spec = spec prev >> Hspec.before_ ioSetup (spec after)})++-- | Lifted 'Hspec.beforeAll_'+beforeAll_ :: (HasCallStack, Hspec :> es) => Eff es () -> Eff es a -> Eff es a+beforeAll_ setup action = do+ ioSetup <-+ unsafeConcUnliftIO Ephemeral Unlimited \unlift ->+ pure (unlift setup)+ stateStaticRepM \prev -> do+ putStaticRep prev{spec = pure ()}+ result <- action+ after <- getStaticRep+ pure (result, prev{spec = spec prev >> Hspec.beforeAll_ ioSetup (spec after)})++-- | Lifted 'Hspec.after_'+after_ :: (HasCallStack, Hspec :> es) => Eff es () -> Eff es a -> Eff es a+after_ teardown action = do+ ioTeardown <-+ unsafeConcUnliftIO Ephemeral Unlimited \unlift ->+ pure (unlift teardown)+ stateStaticRepM \prev -> do+ putStaticRep prev{spec = pure ()}+ result <- action+ after <- getStaticRep+ pure (result, prev{spec = spec prev >> Hspec.after_ ioTeardown (spec after)})++-- | Lifted 'Hspec.afterAll_'+afterAll_ :: (HasCallStack, Hspec :> es) => Eff es () -> Eff es a -> Eff es a+afterAll_ teardown action = do+ ioTeardown <-+ unsafeConcUnliftIO Ephemeral Unlimited \unlift ->+ pure (unlift teardown)+ stateStaticRepM \prev -> do+ putStaticRep prev{spec = pure ()}+ result <- action+ after <- getStaticRep+ pure (result, prev{spec = spec prev >> Hspec.afterAll_ ioTeardown (spec after)})++-- | Lifted 'Hspec.around_'+around_ :: (HasCallStack, Hspec :> es) => (Eff es () -> Eff es ()) -> Eff es a -> Eff es a+around_ wrapper action = do+ ioWrapper <-+ unsafeConcUnliftIO Ephemeral Unlimited \unlift ->+ pure (unlift . wrapper . unsafeEff_)+ stateStaticRepM \prev -> do+ putStaticRep prev{spec = pure ()}+ result <- action+ after <- getStaticRep+ pure (result, prev{spec = spec prev >> Hspec.around_ ioWrapper (spec after)})++-- | Lifted 'Hspec.aroundAll_'+aroundAll_ :: (HasCallStack, Hspec :> es) => (Eff es () -> Eff es ()) -> Eff es a -> Eff es a+aroundAll_ wrapper action = do+ ioWrapper <-+ unsafeConcUnliftIO Ephemeral Unlimited \unlift ->+ pure (unlift . wrapper . unsafeEff_)+ stateStaticRepM \prev -> do+ putStaticRep prev{spec = pure ()}+ result <- action+ after <- getStaticRep+ pure (result, prev{spec = spec prev >> Hspec.aroundAll_ ioWrapper (spec after)})++expectationFailure :: (HasCallStack, Hspec :> es) => String -> Expectation es+expectationFailure msg = hunit $ HUnit.assertFailure msg++expectTrue+ :: (HasCallStack, Hspec :> es)+ => String+ -> Bool+ -> Expectation es+expectTrue msg b = unless b (expectationFailure msg)++infix 1 `shouldBe`+ , `shouldSatisfy`+ , `shouldStartWith`+ , `shouldEndWith`+ , `shouldContain`+ , `shouldMatchList`+ , `shouldReturn`+ , `shouldThrow`++infix 1 `shouldNotBe`, `shouldNotSatisfy`, `shouldNotContain`, `shouldNotReturn`++-- |+-- @actual \`shouldBe\` expected@ sets the expectation that @actual@ is equal+-- to @expected@.+shouldBe :: (HasCallStack, Show a, Eq a, Hspec :> es) => a -> a -> Expectation es+actual `shouldBe` expected = hunit $ actual @?= expected++-- |+-- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@.+shouldSatisfy :: (HasCallStack, Show a, Hspec :> es) => a -> (a -> Bool) -> Expectation es+v `shouldSatisfy` p = expectTrue ("predicate failed on: " ++ show v) (p v)++compareWith+ :: (HasCallStack, Show a, Hspec :> es)+ => (a -> a -> Bool)+ -> String+ -> a+ -> a+ -> Expectation es+compareWith comparator errorDesc result expected = expectTrue errorMsg (comparator expected result)+ where+ errorMsg = show result ++ " " ++ errorDesc ++ " " ++ show expected++-- |+-- @list \`shouldStartWith\` prefix@ sets the expectation that @list@ starts with @prefix@,+shouldStartWith :: (HasCallStack, Show a, Eq a, Hspec :> es) => [a] -> [a] -> Expectation es+shouldStartWith = compareWith List.isPrefixOf "does not start with"++-- |+-- @list \`shouldEndWith\` suffix@ sets the expectation that @list@ ends with @suffix@,+shouldEndWith :: (HasCallStack, Show a, Eq a, Hspec :> es) => [a] -> [a] -> Expectation es+shouldEndWith = compareWith List.isSuffixOf "does not end with"++-- |+-- @list \`shouldContain\` sublist@ sets the expectation that @sublist@ is contained,+-- wholly and intact, anywhere in @list@.+shouldContain :: (HasCallStack, Show a, Eq a, Hspec :> es) => [a] -> [a] -> Expectation es+shouldContain = compareWith List.isInfixOf "does not contain"++-- |+-- @xs \`shouldMatchList\` ys@ sets the expectation that @xs@ has the same+-- elements that @ys@ has, possibly in another order+shouldMatchList :: (HasCallStack, Show a, Eq a, Hspec :> es) => [a] -> [a] -> Expectation es+xs `shouldMatchList` ys = maybe (return ()) expectationFailure (matchList xs ys)++-- |+-- @action \`shouldReturn\` expected@ sets the expectation that @action@+-- returns @expected@.+shouldReturn :: (HasCallStack, Show a, Eq a, Hspec :> es) => Eff es a -> a -> Expectation es+action `shouldReturn` expected = action >>= (`shouldBe` expected)++-- |+-- @actual \`shouldNotBe\` notExpected@ sets the expectation that @actual@ is not+-- equal to @notExpected@+shouldNotBe :: (HasCallStack, Show a, Eq a, Hspec :> es) => a -> a -> Expectation es+actual `shouldNotBe` notExpected = expectTrue ("not expected: " ++ show actual) (actual /= notExpected)++-- |+-- @v \`shouldNotSatisfy\` p@ sets the expectation that @p v@ is @False@.+shouldNotSatisfy :: (HasCallStack, Show a, Hspec :> es) => a -> (a -> Bool) -> Expectation es+v `shouldNotSatisfy` p = expectTrue ("predicate succeeded on: " ++ show v) ((not . p) v)++-- |+-- @list \`shouldNotContain\` sublist@ sets the expectation that @sublist@ is not+-- contained anywhere in @list@.+shouldNotContain :: (HasCallStack, Show a, Eq a, Hspec :> es) => [a] -> [a] -> Expectation es+list `shouldNotContain` sublist = expectTrue errorMsg (not $ sublist `List.isInfixOf` list)+ where+ errorMsg = show list ++ " does contain " ++ show sublist++-- |+-- @action \`shouldNotReturn\` notExpected@ sets the expectation that @action@+-- does not return @notExpected@.+shouldNotReturn+ :: (HasCallStack, Show a, Eq a, Hspec :> es)+ => Eff es a+ -> a+ -> Expectation es+action `shouldNotReturn` notExpected = action >>= (`shouldNotBe` notExpected)++-- |+-- @action \`shouldThrow\` selector@ sets the expectation that @action@ throws+-- an exception. The precise nature of the expected exception is described+-- with a 'Selector'.+shouldThrow+ :: (HasCallStack, Exception e, Hspec :> es)+ => Eff es a+ -> Selector e+ -> Expectation es+action `shouldThrow` p = do+ r <- try action+ case r of+ Right _ ->+ expectationFailure $+ "did not get expected exception: " ++ exceptionType+ Left e ->+ (`expectTrue` p e) $+ "predicate failed on expected exception: " ++ exceptionType ++ "\n" ++ show e+ where+ -- a string representation of the expected exception's type+ exceptionType = (show . typeOf . instanceOf) p+ where+ instanceOf :: Selector a -> a+ instanceOf _ = error "Effectful.Hspec.shouldThrow: broken Typeable instance"
+ test/Main.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -Wno-missing-local-signatures #-}+{-# OPTIONS_GHC -Wno-monomorphism-restriction #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}++module Main where++import Effectful+import Effectful.Hspec+import Prelude++main :: IO ()+main = runEff . runHspec $ do+ it "shouldBe" $ do+ 10 `shouldBe` 10++ it "shouldSatisfy" $ do+ 10 `shouldSatisfy` (> 5)++ let xs = [1, 2, 3, 4, 5] :: [Int]+ it "shouldStartWith" $ do+ xs `shouldStartWith` [1, 2]++ it "shouldEndWith" $ do+ xs `shouldEndWith` [4, 5]++ it "shouldContain" $ do+ [1, 2, 3] `shouldContain` [2]++ it "shouldMatchList" $ do+ [1, 2, 3] `shouldMatchList` [3, 2, 1]++ it "shouldReturn" $ do+ let action = pure "hello"+ action `shouldReturn` "hello"++ it "shouldThrow" $ do+ let errorAction = error "boom" :: Eff es ()+ errorAction `shouldThrow` anyException++ it "shouldNotBe" do+ 1 `shouldNotBe` 2++ it "shouldNotSatisfy" do+ 1 `shouldNotSatisfy` (> 10)++ it "shouldNotContain" do+ [1, 2] `shouldNotContain` [3]++ it "handles shouldNotReturn" $ do+ let action = pure (1 :: Int) :: Eff es Int+ action `shouldNotReturn` 2