adhoc-fixtures-hspec (empty) → 0.1.0.0
raw patch · 5 files changed
+243/−0 lines, 5 filesdep +adhoc-fixturesdep +adhoc-fixtures-hspecdep +base
Dependencies added: adhoc-fixtures, adhoc-fixtures-hspec, base, hspec, hspec-core, hspec-discover, safe-exceptions, yarl
Files
- LICENSE +15/−0
- adhoc-fixtures-hspec.cabal +94/−0
- src/Data/Fixtures/Adhoc/Hspec.hs +48/−0
- test/Data/Fixtures/Adhoc/HspecSpec.hs +85/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,15 @@+ISC License++Copyright (c) 2022 Gautier DI FOLCO++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY+AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM+LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR+PERFORMANCE OF THIS SOFTWARE.
+ adhoc-fixtures-hspec.cabal view
@@ -0,0 +1,94 @@+cabal-version: 3.0+name: adhoc-fixtures-hspec+version: 0.1.0.0+author: Gautier DI FOLCO+maintainer: gautier.difolco@gmail.com+category: Data+build-type: Simple+license: ISC+license-file: LICENSE+synopsis: Manage fine grained fixtures+description: Helps improves tests crafting per-test fixtures (hspec support)+Homepage: http://github.com/blackheaven/adhoc-fixtures-hspec+tested-with: GHC==9.2.4++library+ default-language: Haskell2010+ build-depends:+ base == 4.*+ , adhoc-fixtures >= 0.1.0.0 && < 1+ , hspec >= 2.7.0 && < 2.11+ , yarl >= 0.1.0.0 && < 1+ hs-source-dirs: src+ exposed-modules:+ Data.Fixtures.Adhoc.Hspec+ other-modules:+ Paths_adhoc_fixtures_hspec+ autogen-modules:+ Paths_adhoc_fixtures_hspec+ default-extensions:+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveGeneric+ DerivingStrategies+ DerivingVia+ DuplicateRecordFields+ FlexibleContexts+ GADTs+ GeneralizedNewtypeDeriving+ KindSignatures+ LambdaCase+ OverloadedLists+ OverloadedStrings+ OverloadedRecordDot+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ TypeApplications+ TypeFamilies+ TypeOperators+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints++test-suite adhoc-fixtures-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules:+ Data.Fixtures.Adhoc.HspecSpec+ Paths_adhoc_fixtures_hspec+ autogen-modules:+ Paths_adhoc_fixtures_hspec+ default-extensions:+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveGeneric+ DerivingStrategies+ DerivingVia+ DuplicateRecordFields+ FlexibleContexts+ GADTs+ GeneralizedNewtypeDeriving+ KindSignatures+ LambdaCase+ OverloadedLists+ OverloadedStrings+ OverloadedRecordDot+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ TypeApplications+ TypeFamilies+ TypeOperators+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+ build-depends:+ base+ , adhoc-fixtures+ , adhoc-fixtures-hspec+ , hspec+ , hspec-core+ , hspec-discover+ , safe-exceptions+ , yarl+ default-language: Haskell2010
+ src/Data/Fixtures/Adhoc/Hspec.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE ConstraintKinds #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- |+-- Module : Data.Fixtures.Adhoc.Hspec+-- Copyright : Gautier DI FOLCO+-- License : ISC+--+-- Maintainer : Gautier DI FOLCO <gautier.difolco@gmail.com>+-- Stability : Unstable+-- Portability : not portable+--+-- Fixtures builder and runner+--+-- Example:+--+-- > aroundAllWith (withFixtureAppendLift @"tracker" @_ @"box" boxFixture) $ do+-- > it "Tracker should have one key (added)" $ \fixture ->+-- > readIORef fixture.tracker `shouldReturn` [("box00", 42)]+module Data.Fixtures.Adhoc.Hspec+ ( withFixtureAppendLift,+ withFixtureAppend,+ )+where++import Data.Fixtures.Adhoc+import Data.Records.Yarl.LinkedList+import GHC.TypeLits+import Test.Hspec++-- | Fixture builder (should be used directly with care)+withFixtureAppendLift ::+ forall (name :: Symbol) a (builderName :: Symbol) b.+ HasNotField builderName '[Field name a] =>+ BuilderWith '[Field name a] IO builderName b ->+ ActionWith (Record '[Field builderName b, Field name a]) ->+ ActionWith a+withFixtureAppendLift builderWith runTest previousArgs =+ runWithFixtures (builderWith &: build @name (return previousArgs) &: nullBuilder) runTest++withFixtureAppend ::+ forall (builderName :: Symbol) b items.+ HasNotField builderName items =>+ BuilderWith items IO builderName b ->+ ActionWith (Record (Field builderName b ': items)) ->+ ActionWith (Record items)+withFixtureAppend builderWith runTest previousArgs =+ runWithFixtures (builderWith &> previousArgs) runTest
+ test/Data/Fixtures/Adhoc/HspecSpec.hs view
@@ -0,0 +1,85 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++module Data.Fixtures.Adhoc.HspecSpec (main, spec) where++import Control.Exception.Safe (bracket)+import Data.Fixtures.Adhoc+import Data.Fixtures.Adhoc.Hspec+import Data.IORef+import GHC.Exts (IsString (..))+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "Adhoc fixtures" $+ aroundAll (withIORef @[(Key, Int)] mempty) $ do+ it "Tracker should be empty (start blank)" $ \tracker ->+ readIORef tracker `shouldReturn` []+ aroundAllWith (withFixtureAppendLift @"tracker" @_ @"box" boxFixture) $ do+ it "Tracker should have one key (added)" $ \fixture ->+ readIORef fixture.tracker `shouldReturn` [("box00", 42)]+ aroundAllWith (withFixtureAppend @"book" bookFixture) $ do+ it "Tracker should have two keys (added)" $ \fixture ->+ readIORef fixture.tracker `shouldReturn` [("book00", 42), ("box00", 42)]+ it "Tracker should have one key (cleaned)" $ \fixture ->+ readIORef fixture.tracker `shouldReturn` [("box00", 42)]+ it "Tracker should be empty (start cleaned)" $ \tracker ->+ readIORef tracker `shouldReturn` []++newtype Key = Key {getKey :: String}+ deriving stock (Eq, Ord, Show)+ deriving newtype (IsString)++data Box = Box+ { boxId :: Int,+ boxKey :: Key+ }+ deriving stock (Eq, Show)++data Book = Book+ { bookId :: Int,+ bookBox :: Int,+ bookKey :: Key+ }+ deriving stock (Eq, Show)++type Tracker = IORef [(Key, Int)]++addId :: Key -> Int -> Tracker -> IO ()+addId k i t = modifyIORef' t ((k, i) :)++rmId :: Key -> Tracker -> IO ()+rmId k t = modifyIORef' t $ filter ((/= k) . fst)++unsafeGetId :: Key -> Tracker -> IO Int+unsafeGetId k t = snd . head . filter ((== k) . fst) <$> readIORef t++boxFixture ::+ HasFixture items "tracker" Tracker =>+ BuilderWith items IO "box" Box+boxFixture =+ buildWithClean+ (\prev -> let box = Box 42 "box00" in addId box.boxKey box.boxId prev.tracker >> return box)+ (\prev box -> rmId box.boxKey prev.tracker)++bookFixture ::+ (HasFixture items "tracker" Tracker, HasFixture items "box" Box) =>+ BuilderWith items IO "book" Book+bookFixture =+ buildWithClean+ ( \prev -> do+ box <- unsafeGetId "book00" prev.tracker+ let book = Book 42 box "book00"+ addId book.bookKey book.bookId prev.tracker+ return book+ )+ (\prev book -> rmId book.bookKey prev.tracker)++withIORef :: a -> (IORef a -> IO ()) -> IO ()+withIORef x =+ bracket+ (newIORef x)+ (const $ return ())
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}