diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,14 @@ [1]: http://semver.org/spec/v2.0.0.html [2]: https://github.com/roman/Haskell-teardown/libraries/teardown/CHANGELOG.md +## v0.2.0.0 + +* Bump from lts-8.21 to lts-9.1 +* Re-organize test files to support nightly (GHC-8.2) +* Drop support for lts-6 (GHC-7.10) +* Bump dependencies for `time`, `QuickCheck`, `protolude` and `doctest` +* Add NFData instance for `TeardownResult` record +* Add travisCI builder for nightly ## v0.1.0.1 diff --git a/src/Control/Teardown.hs b/src/Control/Teardown.hs --- a/src/Control/Teardown.hs +++ b/src/Control/Teardown.hs @@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} {-| Module : Control.Teardown Description : Build composable, idempotent & transparent application cleanup sub-routines diff --git a/src/Control/Teardown/Internal/Core.hs b/src/Control/Teardown/Internal/Core.hs --- a/src/Control/Teardown/Internal/Core.hs +++ b/src/Control/Teardown/Internal/Core.hs @@ -1,7 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} module Control.Teardown.Internal.Core where import Protolude hiding (first) diff --git a/src/Control/Teardown/Internal/Types.hs b/src/Control/Teardown/Internal/Types.hs --- a/src/Control/Teardown/Internal/Types.hs +++ b/src/Control/Teardown/Internal/Types.hs @@ -49,6 +49,16 @@ } deriving (Generic, Show) +instance NFData TeardownResult where + rnf result = + case result of + EmptyResult !_desc -> + () + LeafResult !_desc !_time !_err -> + () + BranchResult !_desc !_time !_didFail listing -> + rnf listing + -- | Sub-routine that performs a resource cleanup operation newtype Teardown = Teardown (IO TeardownResult) diff --git a/teardown.cabal b/teardown.cabal --- a/teardown.cabal +++ b/teardown.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: teardown -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Build composable, idempotent & transparent application cleanup sub-routines description: Please see README.md category: System @@ -33,9 +33,9 @@ ghc-options: -Wall build-depends: base >=4.8 && <5 - , protolude >=0.1 && <0.2 + , protolude >=0.1 && <0.3 , text >=1.2 && <1.3 - , time >=1.5 && <1.7 + , time >=1.5 && <1.9 , ansi-wl-pprint >=0.6 && <0.7 , deepseq >=1.4 && <1.5 exposed-modules: @@ -50,40 +50,36 @@ type: exitcode-stdio-1.0 main-is: DocTest.hs hs-source-dirs: - test + test/doctest ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.8 && <5 - , protolude >=0.1 && <0.2 + , protolude >=0.1 && <0.3 , text >=1.2 && <1.3 - , time >=1.5 && <1.7 - , doctest >=0.11 && <0.12 + , time >=1.5 && <1.9 + , doctest >=0.11 && <0.14 , Glob >=0.7 && <0.9 - , QuickCheck >=2.8 && <2.10 + , QuickCheck >=2.8 && <2.11 , teardown - other-modules: - TestSuite default-language: Haskell2010 test-suite teardown-test type: exitcode-stdio-1.0 main-is: TestSuite.hs hs-source-dirs: - test + test/tasty ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.8 && <5 - , protolude >=0.1 && <0.2 + , protolude >=0.1 && <0.3 , text >=1.2 && <1.3 - , time >=1.5 && <1.7 + , time >=1.5 && <1.9 , tasty >=0.11 && <0.12 , tasty-hunit >=0.9 && <0.10 , tasty-hspec >=1.1 && <1.2 , tasty-smallcheck >=0.8 && <0.9 , tasty-rerun >=1.1 && <1.2 , teardown - other-modules: - DocTest default-language: Haskell2010 benchmark teardown-benchmark @@ -94,9 +90,9 @@ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.8 && <5 - , protolude >=0.1 && <0.2 + , protolude >=0.1 && <0.3 , text >=1.2 && <1.3 - , time >=1.5 && <1.7 + , time >=1.5 && <1.9 , criterion >=1.1 && <1.3 , teardown default-language: Haskell2010 diff --git a/test/DocTest.hs b/test/DocTest.hs deleted file mode 100644 --- a/test/DocTest.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Main where - -import System.FilePath.Glob -import Test.DocTest - -main :: IO () -main = glob "src/**/*.hs" >>= doctest diff --git a/test/TestSuite.hs b/test/TestSuite.hs deleted file mode 100644 --- a/test/TestSuite.hs +++ /dev/null @@ -1,127 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Main where - -import Protolude - -import Test.Tasty (TestTree, defaultMainWithIngredients, testGroup) -import Test.Tasty.HUnit -import Test.Tasty.Ingredients.Rerun (rerunningTests) -import Test.Tasty.Runners (consoleTestReporter, listingTests) - -import Control.Teardown -import Data.IORef (atomicModifyIORef, modifyIORef, newIORef, readIORef) - -main :: IO () -main = - defaultMainWithIngredients - [ rerunningTests [listingTests, consoleTestReporter] ] - tests - -tests :: TestTree -tests = - testGroup "teardown" - [ - testCase "idempotent execution of teardown action" $ do - callCountRef <- newIORef (0 :: Int) - teardownAction <- newTeardown "test cleanup" $ - atomicModifyIORef callCountRef (\a -> (succ a, ())) - - replicateM_ 10 (teardown teardownAction) - callCount <- readIORef callCountRef - assertEqual "teardown action got called more than once" - 1 callCount - - , testCase "failing teardown action does not stop execution" $ do - teardownAction <- newTeardown "failing teardown" - (panic "failing teardown" :: IO ()) - - result <- teardown teardownAction - replicateM_ 9 (teardown teardownAction) - - assertBool "result should report an error" - (didTeardownFail result) - - , testCase "thread safe idempotent execution of teardown action" $ do - callCountRef <- newIORef (0 :: Int) - teardownAction <- newTeardown "test cleanup" $ - atomicModifyIORef callCountRef (\a -> (succ a, ())) - - asyncList <- - replicateM 10 (async - -- each async executes teardown 3 times - $ replicateM_ 3 - $ void $ teardown teardownAction) - - mapM_ wait asyncList - callCount <- readIORef callCountRef - assertEqual "teardown action must not be called more than once" - 1 callCount - - , testCase "teardown tree keeps idempotent guarantees around execution" $ do - callCountRefs <- replicateM 10 $ newIORef (0 :: Int) - - teardownAction <- - newTeardown "bigger system" $ - forM callCountRefs $ \callCountRef -> - newTeardown "test cleanup" - (atomicModifyIORef callCountRef (\a -> (succ a, ()))) - - replicateM_ 10 (teardown teardownAction) - - countRefs <- mapM readIORef callCountRefs - assertEqual "teardown action must not be called more than once" - (replicate 10 1) - countRefs - - , testCase "teardown action that returns Teardown list returns correct count" $ do - failedTeardownActions <- - replicateM 5 (newTeardown "test cleanup with failures" (panic "nope" :: IO ())) - - teardownActions <- - replicateM 5 (newTeardown "test cleanup" (return () :: IO ())) - - teardownAction <- - newTeardown "bigger system" - (return (failedTeardownActions <> teardownActions) :: IO [Teardown]) - - toredownResult <- teardown teardownAction - replicateM_ 9 (teardown teardownAction) - - assertEqual "teardown action count must be correct" - 10 (toredownCount toredownResult) - - assertEqual "failed teardown action must be correct" - 5 (failedToredownCount toredownResult) - - , testCase "teardown with list of description and actions executes correctly" $ do - callCountRef <- newIORef (0 :: Int) - teardownAction <- - newTeardown "bigger-system" - [ - ("1" :: Text, modifyIORef callCountRef (+1)) - , ("2", modifyIORef callCountRef (+1)) - , ("3", modifyIORef callCountRef (+1)) - , ("4", modifyIORef callCountRef (+1)) - , ("5", modifyIORef callCountRef (+1)) - , ("6", panic "nope") - , ("7", panic "nope") - , ("8", panic "nope") - , ("9", panic "nope") - ] - - - -- Execute multiple times to assert idempotency - toredownResult <- teardown teardownAction - replicateM_ 9 (teardown teardownAction) - - assertEqual "teardown action count must be correct" - 9 (toredownCount toredownResult) - - assertEqual "failed teardown must be correct" - 4 (failedToredownCount toredownResult) - - callCount <- readIORef callCountRef - assertEqual "side-effects were executed despite errors on other teardown operations" - 5 callCount - ] diff --git a/test/doctest/DocTest.hs b/test/doctest/DocTest.hs new file mode 100644 --- /dev/null +++ b/test/doctest/DocTest.hs @@ -0,0 +1,7 @@ +module Main where + +import System.FilePath.Glob +import Test.DocTest + +main :: IO () +main = glob "src/**/*.hs" >>= doctest diff --git a/test/tasty/TestSuite.hs b/test/tasty/TestSuite.hs new file mode 100644 --- /dev/null +++ b/test/tasty/TestSuite.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Protolude + +import Test.Tasty (TestTree, defaultMainWithIngredients, testGroup) +import Test.Tasty.HUnit +import Test.Tasty.Ingredients.Rerun (rerunningTests) +import Test.Tasty.Runners (consoleTestReporter, listingTests) + +import Control.Teardown +import Data.IORef (atomicModifyIORef, modifyIORef, newIORef, readIORef) + +main :: IO () +main = + defaultMainWithIngredients + [ rerunningTests [listingTests, consoleTestReporter] ] + tests + +tests :: TestTree +tests = + testGroup "teardown" + [ + testCase "idempotent execution of teardown action" $ do + callCountRef <- newIORef (0 :: Int) + teardownAction <- newTeardown "test cleanup" $ + atomicModifyIORef callCountRef (\a -> (succ a, ())) + + replicateM_ 10 (teardown teardownAction) + callCount <- readIORef callCountRef + assertEqual "teardown action got called more than once" + 1 callCount + + , testCase "failing teardown action does not stop execution" $ do + teardownAction <- newTeardown "failing teardown" + (panic "failing teardown" :: IO ()) + + result <- teardown teardownAction + replicateM_ 9 (teardown teardownAction) + + assertBool "result should report an error" + (didTeardownFail result) + + , testCase "thread safe idempotent execution of teardown action" $ do + callCountRef <- newIORef (0 :: Int) + teardownAction <- newTeardown "test cleanup" $ + atomicModifyIORef callCountRef (\a -> (succ a, ())) + + asyncList <- + replicateM 10 (async + -- each async executes teardown 3 times + $ replicateM_ 3 + $ void $ teardown teardownAction) + + mapM_ wait asyncList + callCount <- readIORef callCountRef + assertEqual "teardown action must not be called more than once" + 1 callCount + + , testCase "teardown tree keeps idempotent guarantees around execution" $ do + callCountRefs <- replicateM 10 $ newIORef (0 :: Int) + + teardownAction <- + newTeardown "bigger system" $ + forM callCountRefs $ \callCountRef -> + newTeardown "test cleanup" + (atomicModifyIORef callCountRef (\a -> (succ a, ()))) + + replicateM_ 10 (teardown teardownAction) + + countRefs <- mapM readIORef callCountRefs + assertEqual "teardown action must not be called more than once" + (replicate 10 1) + countRefs + + , testCase "teardown action that returns Teardown list returns correct count" $ do + failedTeardownActions <- + replicateM 5 (newTeardown "test cleanup with failures" (panic "nope" :: IO ())) + + teardownActions <- + replicateM 5 (newTeardown "test cleanup" (return () :: IO ())) + + teardownAction <- + newTeardown "bigger system" + (return (failedTeardownActions <> teardownActions) :: IO [Teardown]) + + toredownResult <- teardown teardownAction + replicateM_ 9 (teardown teardownAction) + + assertEqual "teardown action count must be correct" + 10 (toredownCount toredownResult) + + assertEqual "failed teardown action must be correct" + 5 (failedToredownCount toredownResult) + + , testCase "teardown with list of description and actions executes correctly" $ do + callCountRef <- newIORef (0 :: Int) + teardownAction <- + newTeardown "bigger-system" + [ + ("1" :: Text, modifyIORef callCountRef (+1)) + , ("2", modifyIORef callCountRef (+1)) + , ("3", modifyIORef callCountRef (+1)) + , ("4", modifyIORef callCountRef (+1)) + , ("5", modifyIORef callCountRef (+1)) + , ("6", panic "nope") + , ("7", panic "nope") + , ("8", panic "nope") + , ("9", panic "nope") + ] + + + -- Execute multiple times to assert idempotency + toredownResult <- teardown teardownAction + replicateM_ 9 (teardown teardownAction) + + assertEqual "teardown action count must be correct" + 9 (toredownCount toredownResult) + + assertEqual "failed teardown must be correct" + 4 (failedToredownCount toredownResult) + + callCount <- readIORef callCountRef + assertEqual "side-effects were executed despite errors on other teardown operations" + 5 callCount + ]