teardown 0.0.0.2 → 0.1.0.0

raw patch · 7 files changed

+149/−122 lines, 7 filesdep ~GlobPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Glob

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• src/Control/Teardown.hs +10/−18
• src/Control/Teardown/Internal/Core.hs +20/−51
• src/Control/Teardown/Internal/Printer.hs +4/−3
• src/Control/Teardown/Internal/Types.hs +64/−0
• teardown.cabal +3/−2
• test/TestSuite.hs +37/−48

@@ -7,6 +7,17 @@ [1]: http://semver.org/spec/v2.0.0.html [2]: https://github.com/roman/Haskell-teardown/libraries/teardown/CHANGELOG.md +## v0.1.0.0++> BREAKING CHANGES++* Relax Glob dependency bounds+* Add `IResource` typeclass and make `newTeardown` part of it+* Remove `concatTeardown` and `newDynTeardown` functions in favor of+  overloades of `IResource`+* Update TestSuite+* Update Example+ ## v0.0.0.2  * Add haddock documentation to modules

@@ -12,39 +12,31 @@ sub-routines -} module Control.Teardown-  ( ITeardown+  (+  -- * Typeclasses for extending teardown functionality+    ITeardown+  , IResource+   -- * Cleanup main type and function   , Teardown+  , TeardownResult (..)   , teardown    -- * Functions to create a 'Teardown' record   , emptyTeardown   , newTeardown-  , newDynTeardown-  , concatTeardown    -- * Functions to deal with results from 'teardown' call-  , TeardownResult (..)   , didTeardownFail   , failedToredownCount   , toredownCount   , renderTeardownReport   ) where -import Control.Teardown.Internal.Core-    ( ITeardown-    , Teardown-    , teardown--    , emptyTeardown-    , newTeardown-    , newDynTeardown-    , concatTeardown+import Control.Teardown.Internal.Types+    (IResource (..), ITeardown (..), Teardown, TeardownResult (..)) -    , TeardownResult (..)-    , didTeardownFail-    , failedToredownCount-    , toredownCount-    )+import Control.Teardown.Internal.Core+    (didTeardownFail, emptyTeardown, failedToredownCount, toredownCount)  import Control.Teardown.Internal.Printer (renderTeardownReport)

@@ -1,60 +1,15 @@-{-# LANGUAGE DeriveGeneric     #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Control.Teardown.Internal.Core where  import Protolude hiding (first) +import Data.IORef      (atomicModifyIORef, newIORef, readIORef, writeIORef) import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime) -import Data.IORef (atomicModifyIORef, newIORef, readIORef, writeIORef)------------------------------------------------------------------------------------type Description = Text---- | Result from a 'Teardown' sub-routine-data TeardownResult-  -- | Result is composed by multiple teardown sub-routines-  = BranchResult-    {-      -- | Text description of parent teardown spec-      resultDescription :: !Description-      -- | Sum of elapsed time on sub-routines execution-    , resultElapsedTime :: !NominalDiffTime-      -- | Tells if any sub-routines failed-    , resultDidFail     :: !Bool-      -- | Results of inner sub-routines-    , resultListing     :: ![TeardownResult]-    }-  -- | Result represents a single teardown sub-routine-  | LeafResult-    {-      -- | Text description of sub-routine-      resultDescription :: !Description-      -- | Elapsed time on sub-routine execution-    , resultElapsedTime :: !NominalDiffTime-      -- | Exception from sub-routine-    , resultError       :: !(Maybe SomeException)-    }-  -- | Represents a stub cleanup operation (for lifting pure values)-  | EmptyResult-    {-      -- | Text description of faked sub-routine-      resultDescription :: !Description-    }-  deriving (Generic, Show)---- | Sub-routine that performs a resource cleanup operation-newtype Teardown-  = Teardown (IO TeardownResult)-  deriving (Generic)---- | A record that __is__ or __contains__ a 'Teardown' sub-routine should--- instantiate this typeclass-class ITeardown d where-  -- | Executes teardown sub-routine returning a "TeardownResult"-  teardown :: d -> IO TeardownResult+import Control.Teardown.Internal.Types  -------------------------------------------------------------------------------- @@ -85,8 +40,8 @@ -- side-effects from this action are guaranteed to be executed only once, and -- also it is guaranteed to be thread-safe in the scenario of multiple threads -- executing the same teardown procedure.-newTeardown :: Description -> IO () -> IO Teardown-newTeardown desc disposingAction = do+newTeardownIO :: Description -> IO () -> IO Teardown+newTeardownIO desc disposingAction = do   teardownResultLock <- newIORef False   teardownResultRef  <- newIORef Nothing   return $ Teardown $ do@@ -194,3 +149,17 @@ instance ITeardown Teardown where   teardown (Teardown action) =     action++instance IResource (IO ()) where+  newTeardown =+    newTeardownIO++instance IResource [(Text, IO ())] where+  newTeardown desc actionList = do+    teardownList <- mapM (uncurry newTeardown) actionList+    return $ concatTeardown desc teardownList++instance IResource (IO [Teardown]) where+  newTeardown desc getTeardownList = do+    teardownList <- getTeardownList+    return $ concatTeardown desc teardownList

@@ -7,9 +7,10 @@ import qualified Data.Text     as Text import           Data.Typeable (typeOf) -import Control.Teardown.Internal.Core-import Data.Monoid                    ((<>))-import Text.PrettyPrint.ANSI.Leijen   hiding ((<>))+import Data.Monoid                  ((<>))+import Text.PrettyPrint.ANSI.Leijen hiding ((<>))++import Control.Teardown.Internal.Types  treeTrunk :: Int -> Int -> Doc treeTrunk start level =

@@ -0,0 +1,64 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE NoImplicitPrelude #-}+module Control.Teardown.Internal.Types where++import Protolude++import Data.Time.Clock (NominalDiffTime)++#if MIN_VERSION_base(4,9,0)+import GHC.Generics (Generic)+#endif++--------------------------------------------------------------------------------++type Description = Text++-- | Result from a 'Teardown' sub-routine+data TeardownResult+  -- | Result is composed by multiple teardown sub-routines+  = BranchResult+    {+      -- | Text description of parent teardown spec+      resultDescription :: !Description+      -- | Sum of elapsed time on sub-routines execution+    , resultElapsedTime :: !NominalDiffTime+      -- | Tells if any sub-routines failed+    , resultDidFail     :: !Bool+      -- | Results of inner sub-routines+    , resultListing     :: ![TeardownResult]+    }+  -- | Result represents a single teardown sub-routine+  | LeafResult+    {+      -- | Text description of sub-routine+      resultDescription :: !Description+      -- | Elapsed time on sub-routine execution+    , resultElapsedTime :: !NominalDiffTime+      -- | Exception from sub-routine+    , resultError       :: !(Maybe SomeException)+    }+  -- | Represents a stub cleanup operation (for lifting pure values)+  | EmptyResult+    {+      -- | Text description of faked sub-routine+      resultDescription :: !Description+    }+  deriving (Generic, Show)++-- | Sub-routine that performs a resource cleanup operation+newtype Teardown+  = Teardown (IO TeardownResult)+  deriving (Generic)++-- | A record that __is__ or __contains__ a 'Teardown' sub-routine should+-- instantiate this typeclass+class ITeardown teardown where+  -- | Executes teardown sub-routine returning a "TeardownResult"+  teardown :: teardown -> IO TeardownResult++-- | A resource or sub-routine that can be transformed into a 'Teardown'+-- operation+class IResource resource where+  newTeardown :: Text -> resource -> IO Teardown

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           teardown-version:        0.0.0.2+version:        0.1.0.0 synopsis:       Build composable, idempotent & transparent application cleanup sub-routines description:    Please see README.md category:       System@@ -40,6 +40,7 @@   exposed-modules:       Control.Teardown   other-modules:+      Control.Teardown.Internal.Types       Control.Teardown.Internal.Core       Control.Teardown.Internal.Printer   default-language: Haskell2010@@ -56,7 +57,7 @@     , text >=1.2 && <1.3     , time >=1.5 && <1.7     , doctest >=0.11 && <0.12-    , Glob >=0.7 && <0.8+    , Glob >=0.7 && <0.9     , QuickCheck >=2.8 && <2.10     , teardown   other-modules:

@@ -10,7 +10,7 @@ import Test.Tasty.Runners           (consoleTestReporter, listingTests)  import Control.Teardown-import Data.IORef       (atomicModifyIORef, newIORef, readIORef)+import Data.IORef       (atomicModifyIORef, modifyIORef, newIORef, readIORef)  main :: IO () main =@@ -33,8 +33,8 @@                   1 callCount    , testCase "failing teardown action does not stop execution" $ do-      teardownAction <- newTeardown "failing teardown" $-        panic "failing teardown"+      teardownAction <- newTeardown "failing teardown"+        (panic "failing teardown" :: IO ())        result <- teardown teardownAction       replicateM_ 9 (teardown teardownAction)@@ -58,15 +58,14 @@       assertEqual "teardown action must not be called more than once"                   1 callCount -  , testCase "concatenated teardown actions keep idempotent guarantees" $ do+  , testCase "teardown tree keeps idempotent guarantees around execution" $ do       callCountRefs <- replicateM 10 $ newIORef (0 :: Int)-      teardownActions <- forM callCountRefs $ \callCountRef ->-        newTeardown "test cleanup"-                    (atomicModifyIORef callCountRef (\a -> (succ a, ()))) -      let-        teardownAction =-          concatTeardown "bigger system" teardownActions+      teardownAction <-+        newTeardown "bigger system" $+          forM callCountRefs $ \callCountRef ->+            newTeardown "test cleanup"+                        (atomicModifyIORef callCountRef (\a -> (succ a, ())))        replicateM_ 10 (teardown teardownAction) @@ -75,31 +74,16 @@                   (replicate 10 1)                   countRefs -  , testCase "concatenated teardown actions return correct count" $ do-      teardownActions <--        replicateM 10 (newTeardown "test cleanup" (return ()))--      let-        teardownAction =-          concatTeardown "bigger system" teardownActions--      toredownResult <- teardown teardownAction-      replicateM_ 9 (teardown teardownAction)--      assertEqual "teardown action must not be called more than once"-                  10 (toredownCount toredownResult)--  , testCase "concatenated failed teardown actions return correct count" $ do+  , testCase "teardown action that returns Teardown list returns correct count" $ do       failedTeardownActions <--        replicateM 5 (newTeardown "test cleanup with failures" (panic "nope"))+        replicateM 5 (newTeardown "test cleanup with failures" (panic "nope" :: IO ()))        teardownActions <--        replicateM 5 (newTeardown "test cleanup" (return ()))+        replicateM 5 (newTeardown "test cleanup" (return () :: IO ())) -      let-        teardownAction =-          concatTeardown "bigger system"-                         (failedTeardownActions <> teardownActions)+      teardownAction <-+        newTeardown "bigger system"+          (return (failedTeardownActions <> teardownActions) :: IO [Teardown])        toredownResult <- teardown teardownAction       replicateM_ 9 (teardown teardownAction)@@ -110,29 +94,34 @@       assertEqual "failed teardown action must be correct"                   5 (failedToredownCount toredownResult) -  , testCase "dynamic teardown behave similar to vanilla teardown" $ do+  , testCase "teardown with list of description and actions executes correctly" $ do       callCountRef <- newIORef (0 :: Int)-      failedTeardownActions <--        replicateM 5 (newTeardown "test cleanup with failures" (panic "nope"))+      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")+              ] -      teardownActions <--        replicateM 5 (newTeardown "test cleanup"-                      (atomicModifyIORef callCountRef (\a -> (succ a, ())))) -      let-        teardownAction =-          newDynTeardown "bigger system" $-            mapM teardown (failedTeardownActions <> teardownActions)--      teardownResult <- teardown teardownAction+      -- Execute multiple times to assert idempotency+      toredownResult <- teardown teardownAction       replicateM_ 9 (teardown teardownAction) -      teardownSuccessCount <- readIORef callCountRef-       assertEqual "teardown action count must be correct"-                  10 (toredownCount teardownResult)+                  9 (toredownCount toredownResult) -      assertEqual "teardown action must be idempotent"-                  5 teardownSuccessCount+      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   ]