teardown 0.2.0.0 → 0.3.0.0
raw patch · 13 files changed
+979/−151 lines, 13 filesdep +exceptionsdep +safe-exceptionsdep ~Globdep ~QuickCheckdep ~ansi-wl-pprint
Dependencies added: exceptions, safe-exceptions
Dependency ranges changed: Glob, QuickCheck, ansi-wl-pprint, deepseq, doctest, protolude, tasty, tasty-hspec, tasty-hunit, tasty-rerun, tasty-smallcheck, text, time
Files
- CHANGELOG.md +7/−0
- LICENSE +1/−1
- README.md +132/−5
- src/Control/Monad/Component.hs +49/−0
- src/Control/Monad/Component/Internal/Core.hs +75/−0
- src/Control/Monad/Component/Internal/Types.hs +154/−0
- src/Control/Teardown/Internal/Core.hs +4/−0
- src/Control/Teardown/Internal/Printer.hs +7/−2
- src/Control/Teardown/Tutorial.hs +184/−0
- teardown.cabal +50/−30
- test/tasty/ComponentTest.hs +188/−0
- test/tasty/TeardownTest.hs +120/−0
- test/tasty/TestSuite.hs +8/−113
CHANGELOG.md view
@@ -7,6 +7,13 @@ [1]: http://semver.org/spec/v2.0.0.html [2]: https://github.com/roman/Haskell-teardown/libraries/teardown/CHANGELOG.md +## v0.3.0.0++* Bump from lts-9.1 to lts-9.5+* Add `Control.Monad.Component` module+* Add `Control.Teardown.Tutorial` module+* Add `IResource` instance for `[Teardown]`+ ## v0.2.0.0 * Bump from lts-8.21 to lts-9.1
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2017, TODO:<Author name here>+Copyright (c) 2017, Roman Gonzalez Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above
README.md view
@@ -1,7 +1,134 @@-# teardow+[](https://img.shields.io/hackage/v/teardown.svg)+[](http://stackage.org/lts/package/teardown)+[](http://stackage.org/nightly/package/teardown)+# 🗑️ teardown -`teardown` allows the creation of composable, idempotent and transparent-application cleanup sub-routines.+> Composable, idempotent & transparent application resource cleanup sub-routines -For more information about `teardown` API and how to use it, see-the [`teardown` homepage](https://github.com/roman/Haskell-teardown).+## Table Of Contents++* [Raison d'etre](#raison-detre)+* [Development](#development)+* [Documentation](#documentation)+* [License](#license)+* [Report teardown sub-routine results](#report-teardown-sub-routine-tree-with-results)++## Raison d'etre++The _correct_ teardown of a system becomes a crucial matter when running+applications through GHCi while doing REPL driven development; this library+provides a stable API to manage the cleanup process of resources your+application allocates when it starts up.++One could naively implement a teardown sub-routine of an application by doing+something like the following:++```haskell+-- All functions in this example initialize hypothetical resources, the+-- idea stands that there is a way to allocate a system resource+-- using some sort of configuration record, and there is a+-- sub-routine to release those resources once the application+-- shuts down++initDb :: Logger -> DbConnInfo -> IO (DbConn, IO ())+initDb logger connInfo = do+ conn <- newConn connInfo+ return (conn, info logger "Teardown Database" >> closeConn conn)++initTcpServer :: Logger -> ServerInfo -> IO (Socket, IO ())+initTcpServer logger serverInfo = do+ socket <- startServer serverInfo+ return (socket, info logger "Teardown Tcp Server" >> closeSocket socket)++initApp :: Logger -> DbConnInfo -> ServerInfo -> IO (IO ())+initApp logger connInfo serverInfo = do+ (connInfo, teardownDb) <- initDb logger connInfo+ (serverInfo, teardownSocket) <- initTcpServer logger serverInfo+ -- do something with connInfo and serverInfo ...+ return (info logger "Teardown Application"+ >> teardownDb+ >> teardownSocket)+```++The previous implementation does not address a few concerns:++* If for some reason we execute the @IO ()@ sub-routine returned by the+ @initApp@ function more than once, there is likely going to be a runtime+ exception of the "already closed resource" nature. This library ensures that+ teardown sub-routines are executed /exactly/ once, even on the scenario where+ we execute the teardown procedure multiple times.++* The teardown of sub-systems can be built and composed via the @(>>)@ operator,+ what happens if the @teardownDb@ sub-routine in the previous example throws an+ exception? Likely other resource teardown sub-routines are going to be+ affected. This library ensures that errors are isolated from every other+ resource teardown sub-routines.++* All teardown sub-routines use a description argument to keep track of what is+ being cleaned up; By requiring this, we avoid confusion around what is going+ on when shutting down an application. This library makes this documentation a+ /required/ argument when building teardown sub-routines, thus helping+ trace-ability.++* You may notice the structure of teardown sub-routines form a tree shape. This+ library provides a data structure representation of this tree that allows the+ developer to report all teardown sub-routines in hierarchy order, with other+ details around if sub-routines failed (or not).++* Also, this library keeps track how much time every teardown sub-routine takes,+ allowing the developer to learn which parts of the teardown procedure are slow+ and adequately address those on development time (e.g., Faster reload =>+ Faster development feedback loops).++By using this library, you may implement without much effort a good, reliable+and transparent strategy for application resource teardown sub-routines.++## Documentation++To learn more about the library, please refer to the documentation in Hackage for++* [Teardown](http://hackage.haskell.org/package/teardown-0.3.0.0/docs/Control-Teardown-Tutorial.html)++* [ComponentM](#) [pending]++## Development+[](https://travis-ci.org/roman/Haskell-teardown)+[](http://packdeps.haskellers.com/feed?needle=teardown)+[](https://img.shields.io/github/commits-since/roman/haskell-teardown/v0.3.0.0.svg)+++This library is intended to be minimal, providing a few functions that work+reliably among many different kind of projects. If you want to contribute,+Pull Request are very welcome! Please try to follow these simple rules:++* Please create a topic branch for every separate change you make.+* Update the README.md file if necessary.+* Please _do not_ change the version number on your Pull Request.++### Open Commit Bit++This project has an open commit bit policy: Anyone with an accepted pull request+gets added as a repository collaborator. Please try to follow these simple+rules:++* Commit directly onto the master branch only for typos, improvements to the+ README and documentation.+* Create a feature branch and open a pull-request early for any new features to+ get feedback.+* Make sure you adhere to the general pull request rules above.++## License++Copyright (c) 2027, Roman Gonzalez++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.
+ src/Control/Monad/Component.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-|+Module : Control.Monad.Component+Description : Build composable, idempotent & transparent application cleanup sub-routines for an application+Copyright : (c) Roman Gonzalez, 2017+License : MIT+Maintainer : romanandreg@gmail.com+Stability : experimental++Provides functions that help on the creation of Application teardown sub-routines+-}+module Control.Monad.Component+ (++ -- * 'ComponentM' monad and runner+ ComponentM+ , runComponentM++ -- * 'Component' record and functions+ , Component+ , fromComponent++ -- * 'Component' error record+ , ComponentError (..)++ -- * 'Teardown' functions+ , Teardown+ , TeardownResult (..)+ , teardown+ , newTeardown++ -- * Re-exports+ , throwM+ , fail++ -- * Functions to build 'ComponentM' sub-routines+ , buildComponent+ , buildComponentWithCleanup+ , buildComponentWithTeardown+ ) where++import Control.Monad.Catch (throwM)+import Control.Monad.Component.Internal.Core+ (buildComponent, buildComponentWithCleanup, buildComponentWithTeardown, runComponentM)+import Control.Monad.Component.Internal.Types+ (Component, ComponentError (..), ComponentM, fromComponent)+import Control.Monad.Fail (fail)+import Control.Teardown+ (Teardown, TeardownResult (..), newTeardown, teardown)
+ src/Control/Monad/Component/Internal/Core.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE NoImplicitPrelude #-}+module Control.Monad.Component.Internal.Core where++import Protolude++import Control.Monad.Component.Internal.Types+import Control.Teardown (Teardown, newTeardown, teardown)++--------------------------------------------------------------------------------++-- | Given the name and a `ComponentM` sub-routine, this function builds an `IO`+-- sub-routine that returns a `Component` record.+--+-- The name argument is used for trace-ability purposes when executing the+-- `teardown` of a resulting `Component`.+--+-- * A note on error scenarios:+--+-- Sometimes the given `ComponentM` sub-routine may fail on execution, in such+-- cases, this function will teardown all component resources allocated so far+-- and throw a `ComponentStartupFailure` exception.+--+runComponentM :: Text -> ComponentM a -> IO (Component a)+runComponentM !appName (ComponentM ma) = do+ eResult <- ma+ case eResult of+ Left (errList, cleanupActions) -> do+ appTeardown <- newTeardown appName cleanupActions+ -- Cleanup resources allocated so far and throw error+ -- list+ void $ teardown appTeardown+ throwIO (ComponentStartupFailure errList)++ Right (a, cleanupActions) -> do+ appTeardown <- newTeardown appName cleanupActions+ return $! Component a appTeardown++-- | Transforms an `IO` sub-routine into a `ComponentM` sub-routine; the given+-- `IO` sub-routine must return a tuple where:+--+-- * First position represents the resource being returned from+-- the component+--+-- * Second position represents a named cleanup action that tears down+-- allocated resources to create the first element of the tuple+--+buildComponentWithCleanup :: IO (a, (Text, IO ())) -> ComponentM a+buildComponentWithCleanup !ma =+ ComponentM $ do+ (a, (desc, cleanupAction)) <- ma+ teardownAction <- newTeardown desc cleanupAction+ return $ Right (a, [teardownAction])++-- | Transforms an `IO` sub-routine into a `ComponentM` sub-routine; the given+-- `IO` sub-routine must return a tuple where:+--+-- * First position represents the resource being returned from+-- the component+--+-- * Second position represents a `Teardown` record that cleans up allocated+-- resources to create the first element of the tuple+--+buildComponentWithTeardown :: IO (a, Teardown) -> ComponentM a+buildComponentWithTeardown !ma =+ ComponentM $ (\(a, resourceTeardown) ->+ Right (a, [resourceTeardown])) <$> ma++-- | Transforms an `IO` sub-routine into a `ComponentM` sub-routine; the given+-- `IO` sub-routine returns a resource that does not allocate any other+-- resources that would need to be cleaned up on a system shutdown.+--+buildComponent :: IO a -> ComponentM a+buildComponent !ma =+ ComponentM $ (\a -> Right (a, [])) <$> ma
+ src/Control/Monad/Component/Internal/Types.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+module Control.Monad.Component.Internal.Types where++import Protolude hiding (try)++import Control.Exception.Safe (try)+import Control.Monad.Catch (MonadThrow (..))+import Control.Monad.Fail (MonadFail (..))+import qualified Data.Text as T++import Control.Teardown (ITeardown (..), Teardown)++--------------------------------------------------------------------------------++data ComponentError+ = ComponentFailure !Text+ | ComponentStartupFailure ![SomeException]+ deriving (Generic, Show)++instance Exception ComponentError++-- | `ComponentM` is a wrapper of the `IO` monad that automatically deals with+-- the composition of `Teardown` sub-routines from resources allocated in every+-- resource of your application. To build `ComponentM` actions see the+-- `buildComponent`, `buildComponentWithCleanup` and+-- `buildComponentWithTeardown` functions.+newtype ComponentM a+ = ComponentM (IO (Either ([SomeException], [Teardown])+ (a, [Teardown])))++instance Functor ComponentM where+ fmap f (ComponentM action) =+ ComponentM $ do+ result <- action+ return $! case result of+ Left err ->+ Left err+ Right (a, teardownList) ->+ Right (f a, teardownList)++instance Applicative ComponentM where+ pure a =+ ComponentM+ $ return+ $ Right (a, [])++ (ComponentM mf) <*> (ComponentM mm) = ComponentM $ do+ ef <- try mf+ em <- try mm+ case (ef, em) of+ ( Left err1, Left err2 ) ->+ return $ Left ( [err1, err2], [] )++ ( Left err1, Right (Left (err2, cs2)) ) ->+ return $ Left ( [err1] <> err2, cs2 )++ ( Left err1, Right (Right (_, cs2)) ) ->+ return $ Left ( [err1], cs2 )+++ ( Right (Left (err1, cs1)), Left err2 ) ->+ return $ Left ( err1 <> [err2], cs1 )++ ( Right (Right (_, cs1)), Left err2 ) ->+ return $ Left ( [err2], cs1 )++ ( Right (Left (err, cs1)), Right (Right (_, cs2)) ) ->+ return $ Left ( err+ , cs1 <> cs2+ )++ ( Right (Left (err1, cs1)), Right (Left (err2, cs2)) ) ->+ return $ Left ( err1 <> err2+ , cs1 <> cs2+ )++ ( Right (Right (_, cs1)), Right (Left (err, cs2)) ) ->+ return $ Left ( err+ , cs1 <> cs2+ )++ ( Right (Right (f, cs1)), Right (Right (a, cs2)) ) ->+ return $ Right ( f a+ , cs1 <> cs2+ )++instance Monad ComponentM where+ return =+ pure++ (ComponentM action0) >>= f = ComponentM $ do+ eResult0 <- action0+ case eResult0 of+ Right (a, cs0) -> do+ let+ (ComponentM action1) = f a++ eResult1 <- try action1++ case eResult1 of+ -- There was an exception via the IO Monad+ Left err ->+ return $ Left ([err], cs0)++ -- There was an exception either via `fail` or `throwM`+ Right (Left (err, cs1)) ->+ return $ Left (err, cs0 <> cs1)++ Right (Right (b, cs1)) ->+ return $ Right (b, cs0 <> cs1)+++ Left (err, cs0) ->+ return $ Left (err, cs0)++instance MonadFail ComponentM where+ fail str =+ ComponentM+ $ return+ $ Left ([toException $! ComponentFailure (T.pack str)], [])++instance MonadThrow ComponentM where+ throwM e =+ ComponentM+ $ return+ $ Left ([toException e], [])++instance MonadIO ComponentM where+ liftIO action = ComponentM $ do+ result <- action+ return $ Right (result, [])+++-- | Represents the result of a `ComponentM` sub-routine, it contains a resource+-- record which can be recovered using `fromComponent` and a `Teardown`+-- sub-routine that can be executed using the `teardown` function.+data Component a+ = Component { componentResource :: !a+ , componentTeardown :: !Teardown }+ deriving (Generic)++-- | Fetches the resource of a `Component` returned by a `ComponentM`+-- sub-routine.+fromComponent :: Component a -> a+fromComponent =+ componentResource+{-# INLINE fromComponent #-}++instance NFData a => NFData (Component a)++instance ITeardown (Component a) where+ teardown =+ teardown . componentTeardown
src/Control/Teardown/Internal/Core.hs view
@@ -158,6 +158,10 @@ teardownList <- mapM (uncurry newTeardown) actionList return $ concatTeardown desc teardownList +instance IResource [Teardown] where+ newTeardown desc =+ return . concatTeardown desc+ instance IResource (IO [Teardown]) where newTeardown desc getTeardownList = do teardownList <- getTeardownList
src/Control/Teardown/Internal/Printer.hs view
@@ -25,8 +25,13 @@ where renderError start level (SomeException err) = let- (fstErrLine:errLines) =- Text.lines (show err)+ (fstErrLine, errLines) =+ case Text.lines (show err) of+ [] ->+ panic "Expecting reported error to have a line of content, got none"++ (fstErrLine' : errLines') ->+ (fstErrLine', errLines') errorReport = treeTrunk (pred start) (succ level)
+ src/Control/Teardown/Tutorial.hs view
@@ -0,0 +1,184 @@+{-| The /correct/ teardown of a system becomes a crucial matter when running applications through GHCi while doing REPL driven development; this library provides a stable API to manage the cleanup process of resources your application allocates when it starts up.++One could naively implement a teardown sub-routine of an application by doing something like the following:++> -- All functions in this example initialize hypothetical resources, the+> -- idea stands that there is a way to allocate a system resource+> -- using some sort of configuration record, and there is a+> -- sub-routine to release those resources once the application+> -- shuts down+>+> initDb :: Logger -> DbConnInfo -> IO (DbConn, IO ())+> initDb logger connInfo = do+> conn <- newConn connInfo+> return (conn, info logger "Teardown Database" >> closeConn conn)+>+> initTcpServer :: Logger -> ServerInfo -> IO (Socket, IO ())+> initTcpServer logger serverInfo = do+> socket <- startServer serverInfo+> return (socket, info logger "Teardown Tcp Server" >> closeSocket socket)+>+> initApp :: Logger -> DbConnInfo -> ServerInfo -> IO (IO ())+> initApp logger connInfo serverInfo = do+> (connInfo, teardownDb) <- initDb logger connInfo+> (serverInfo, teardownSocket) <- initTcpServer logger serverInfo+> -- do something with connInfo and serverInfo ...+> return (info logger "Teardown Application"+> >> teardownDb+> >> teardownSocket)+++The previous implementation does not address a few concerns:++ * If for some reason we execute the @IO ()@ sub-routine returned by the @initApp@ function more than once, there is likely going to be a runtime exception of the "already closed resource" nature. This library ensures that teardown sub-routines are executed /exactly/ once, even on the scenario where we execute the teardown procedure multiple times.++ * The teardown of sub-systems can be built and composed via the @(>>)@ operator, what happens if the @teardownDb@ sub-routine in the previous example throws an exception? Likely other resource teardown sub-routines are going to be affected. This library ensures that errors are isolated from every other resource teardown sub-routines.++ * All teardown sub-routines use a description argument to keep track of what is being cleaned up; By requiring this, we avoid confusion around what is going on when shutting down an application. This library makes this documentation a /required/ argument when building teardown sub-routines, thus helping trace-ability.++ * You may notice the structure of teardown sub-routines form a tree shape. This library provides a data structure representation of this tree that allows the developer to report all teardown sub-routines in hierarchy order, with other details around if sub-routines failed (or not).++ * Also, this library keeps track how much time every teardown sub-routine takes, allowing the developer to learn which parts of the teardown procedure are slow and adequately address those on development time (e.g., Faster reload => Faster development feedback loops).++ This tutorial shows some examples on how to use the @Control.Teardown@ API and also the rationale behind the typeclasses offered by the library.+-}+module Control.Teardown.Tutorial+ (+ -- * Introduction+ -- $introduction++ -- * The 'Teardown' type+ -- $teardown_type++ -- * The 'IResource' typeclass+ -- $iresource_typeclass++ -- * The 'ITeardown' typeclass+ -- $iteardown_typeclass++ -- * The 'TeardownResult' type+ -- $teardown_result_type++ )+ where++{- $introduction++ The @teardown@ library allows creating cleanup sub-routines for the resources allocated to your application; some of the features it offers are:++ * Idempotent execution of cleanup sub-routines++ * When cleanup sub-routines fail, this library guarantees that it won't stop the cleanup process of other resources++ * On cleanup sub-routine execution, it returns a Tree data structure that reports: what succeeded, what failed and how much time each of those+ sub-routines took to execute.++ * Functions to compose a Tree of 'Teardown' records++ With this features in place, you can ensure the best cleanup effort when reloading a complex runtime application when doing REPL driven development.++-}++{- $teardown_type++ The 'Teardown' type wraps a resource cleanup sub-routine to provides the+ features displayed in the introduction section.++ == How to create a 'Teardown'++ You need to use the 'newTeardown' function to create a 'Teardown' record+ from a cleanup @IO@ sub-routine. An example follows:++ @+initDb :: Logger -> DbConnInfo -> IO (DbConn, Teardown)+initDb logger connInfo = do+ conn <- newConn connInfo+ cleanup <- newTeardown "database connection" (closeConn conn)+ return (conn, cleanup)+ @++ In the previous example, you may notice the 'newTeardown' function receives a 'Text' as its first argument; the purpose of this parameter is to explain what is the resource we want to deallocate. Make sure to make this description as unique as possible, as it will:++ * Help you pinpoint quickly a resource that is flaky at cleanup times+ * Allow you to identify what are the resources that take the longest to clean up; this is essential to help us ensure our development feedback loop is fast when doing REPL driven development.++ The second argument of the 'newTeardown' is an @IO ()@ sub-routine that performs the so-called cleanup procedure; however, the second argument could be other types that implement the 'IResource' typeclass.++-}++{- $iresource_typeclass++ If you look up the signature of the 'newTeardown' function, you will discover the second argument may be any type that implements the 'IResource' typeclass. This typeclass allows us to define which types represent a cleanup sub-routines. Note this __is not__ a public typeclass. Following are some of its instances.++ == @IO ()@++ This instance is the one that has been shown so far in this example.++ == @[Teardown]@++ This typeclass instance is used when creating the 'Teardown' of a resource that creates many other sub-resources that return a 'Teardown' record on their own.++ @+> initApp :: Logger -> DbConnInfo -> ServerInfo -> IO (Server, Teardown))+> initApp logger connInfo serverInfo = do+> (conn, teardownDb) <- initDb logger connInfo+> (server, teardownSocket) <- initTcpServer logger serverInfo conn+> -- do something with connInfo and serverInfo ...+> appTeardown <- newTeardown "application" [teardownDb, teardownSocket]+> return (server, appTeardown)+ @++ == @[(Text, IO ())]@++ This typeclass instance is useful when creating a 'Teardown' of an operation which allocates more than one resource that needs to be torn down++ @+> initWorkerThread :: IO (Worker, Teardown)+> initWorkerThread = do+> workerQueue <- newTBQueue 100+> workerAsync <- async $ workerLoop workerQueue+> workerTeardown <- newTeardown "worker" [("queue", closeTBQueue workerQueue)+> ,("async", cancel workerAsync)]+> return $ (Worker workerQueue workerAsync, workerTeardown)+ @++ This typeclass instances will cover most of the use cases for building cleanup sub-routines.+-}++{- $iteardown_typeclass++ Once you build a 'Teardown' record, the next thing you can do with it besides composing it with other 'Teardown's is to execute its cleanup sub-routine.++ To do this, we use the 'teardown' function, which has the following type signature:++ @+teardown :: ITeardown teardown => teardown -> IO TeardownResult+ @++ 'teardown' returns a 'TeardownResult' record which is a tree-like data structure that contains detailed information on what teardown sub-routines failed (or not) and how much time they took to perform on the resource tree you built using 'newTeardown'.++ Naturally, the 'Teardown' type implements the 'ITeardown' typeclass, Is important to note, this typeclass is a public one, meaning, you are free to extend it with your types. It is __highly__ recommended. However, you implement this typeclass on types that wrap a 'Teardown' record, otherwise, the idempotence guarantees of sub-routines cannot be secured by the library.++-}++{- $teardown_result_type++ As stated on the [ITeardown typeclass](#g:4) section, the 'TeardownResult' record reports the execution of a 'teardown' call. This library provides a few functions that get interesting information out of this record:++ * 'renderTeardownReport' -- returns a 'Doc' that represents the Tree of resources with their outcome and performance time, you can use 'print' to print the report on the terminal. Following example output:++ @+`- ✘ Application (0.000006s)+ |`- ✓ database connection (0.000002s)+ |`- ✘ tcp server (0.000002s)+ FatalError: FatalError {msg = "Some TCP Error Message"}+ @++ * 'toredownCount' -- returns the number of cleanup sub-routines executed.++ * 'failedToredownCount' -- returns the number of cleanup sub-routines that failed with an exception++ * 'didTeardownFail' -- returns a boolean that indicates if any cleanup sub-routine failed with an exception++ This library exports all record constructors of 'TeardownResult' so you may traverse it in any way you find useful.+-}
teardown.cabal view
@@ -3,9 +3,17 @@ -- see: https://github.com/sol/hpack name: teardown-version: 0.2.0.0-synopsis: Build composable, idempotent & transparent application cleanup sub-routines-description: Please see README.md+version: 0.3.0.0+synopsis: Build composable components for your application with clear teardown semantics+description: The teardown library allows you to reliably deallocate resources+ created when initializing your application. It provides:+ .+ - A ComponentM monad that allows you to build and compose resources with+ cleanup semantics+ .+ - An API that composes IO cleanup sub-routines safely+ .+ Check Control.Teardown.Tutorial for more information. category: System stability: alpha (experimental) homepage: https://github.com/roman/Haskell-teardown#readme@@ -15,7 +23,7 @@ copyright: © 2017 Roman Gonzalez license: MIT license-file: LICENSE-tested-with: GHC==7.10.3 GHC==8.0.1 GHC==8.0.2+tested-with: GHC==8.0.1 GHC==8.0.2 GHC==8.2.1 build-type: Simple cabal-version: >= 1.10 @@ -30,20 +38,26 @@ library hs-source-dirs: src- ghc-options: -Wall+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates build-depends: base >=4.8 && <5- , protolude >=0.1 && <0.3- , text >=1.2 && <1.3- , time >=1.5 && <1.9- , ansi-wl-pprint >=0.6 && <0.7- , deepseq >=1.4 && <1.5+ , protolude+ , safe-exceptions+ , text+ , time+ , ansi-wl-pprint+ , exceptions+ , deepseq exposed-modules: Control.Teardown+ Control.Teardown.Tutorial+ Control.Monad.Component other-modules: Control.Teardown.Internal.Types Control.Teardown.Internal.Core Control.Teardown.Internal.Printer+ Control.Monad.Component.Internal.Types+ Control.Monad.Component.Internal.Core default-language: Haskell2010 test-suite teardown-doctest@@ -51,15 +65,16 @@ main-is: DocTest.hs hs-source-dirs: test/doctest- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.8 && <5- , protolude >=0.1 && <0.3- , text >=1.2 && <1.3- , time >=1.5 && <1.9- , doctest >=0.11 && <0.14- , Glob >=0.7 && <0.9- , QuickCheck >=2.8 && <2.11+ , protolude+ , safe-exceptions+ , text+ , time+ , doctest+ , Glob+ , QuickCheck , teardown default-language: Haskell2010 @@ -68,18 +83,22 @@ main-is: TestSuite.hs hs-source-dirs: test/tasty- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.8 && <5- , protolude >=0.1 && <0.3- , text >=1.2 && <1.3- , 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+ , protolude+ , safe-exceptions+ , text+ , time+ , tasty+ , tasty-hunit+ , tasty-hspec+ , tasty-smallcheck+ , tasty-rerun , teardown+ other-modules:+ ComponentTest+ TeardownTest default-language: Haskell2010 benchmark teardown-benchmark@@ -87,12 +106,13 @@ main-is: Main.hs hs-source-dirs: benchmark- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.8 && <5- , protolude >=0.1 && <0.3- , text >=1.2 && <1.3- , time >=1.5 && <1.9+ , protolude+ , safe-exceptions+ , text+ , time , criterion >=1.1 && <1.3 , teardown default-language: Haskell2010
+ test/tasty/ComponentTest.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module ComponentTest where++import Protolude++import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit++import Control.Monad.Component+import Data.IORef (modifyIORef, newIORef, readIORef)+++tests :: TestTree+tests =+ testGroup "component monad"+ [+ testCase "execute aggregation of components' teardown action works" $ do+ callCountRef <- newIORef (0 :: Int)++ let+ componentOne =+ buildComponentWithCleanup $ do+ return ((), ("one", modifyIORef callCountRef succ))++ componentTwo =+ buildComponentWithTeardown $ do+ t <- newTeardown "two" (modifyIORef callCountRef succ)+ return ((), t)++ componentThree =+ buildComponent $ return ()++ componentAction = do+ componentOne+ componentTwo+ componentThree++ result <- runComponentM "test application" componentAction+ void $ teardown result+ callCount <- readIORef callCountRef+ assertEqual "teardown action got called more than once"+ 2 callCount++ , testCase "component construction failure tears down previous components" $ do+ callCountRef <- newIORef (0 :: Int)++ let+ componentOne =+ buildComponentWithCleanup $ do+ return ((), ("one", modifyIORef callCountRef succ))++ componentTwo =+ buildComponent $ throwIO (ErrorCall "failing hard")++ componentThree =+ buildComponentWithTeardown $ do+ t <- newTeardown "three" (modifyIORef callCountRef succ)+ return ((), t)++ componentAction = do+ componentOne+ void componentTwo+ componentThree++ result <- try $ runComponentM "test application" componentAction+ case result of+ Left (ComponentStartupFailure [err]) -> do+ callCount <- readIORef callCountRef+ assertEqual "expected introduced error, got different one"+ (Just $ ErrorCall "failing hard")+ (fromException err)+ assertEqual "teardown action got called more than once" 1 callCount++ Left (err :: ComponentError) -> do+ assertFailure $ "expected ComponentStartupFailure exception, got instead: " <> show err++ Right _ ->+ assertFailure "expected error, but did not happen"++ , testCase "component construction multiple failure reported when using Applicative" $ do+ callCountRef <- newIORef (0 :: Int)++ let+ componentOne =+ buildComponentWithCleanup $ do+ return ((), ("one", modifyIORef callCountRef succ))++ componentTwo =+ buildComponent $ throwIO (ErrorCall "failing two")++ componentThree =+ buildComponent $ throwIO (ErrorCall "failing three")++ componentAction =+ componentOne+ *> componentTwo+ *> componentThree++ result <- try $ runComponentM "test application" componentAction+ case result of+ Left (ComponentStartupFailure [errTwo, errThree]) -> do+ callCount <- readIORef callCountRef+ assertEqual "expected introduced error, got different one"+ (Just $ ErrorCall "failing two")+ (fromException errTwo)+ assertEqual "expected introduced error, got different one"+ (Just $ ErrorCall "failing three")+ (fromException errThree)+ assertEqual "teardown action got called more than once" 1 callCount++ Left (err :: ComponentError) -> do+ assertFailure $ "expected ComponentStartupFailure exception, got instead: " <> show err++ Right _ ->+ assertFailure "expected error, but did not happen"++ , testCase "component construction allows MonadThrow calls" $ do+ callCountRef <- newIORef (0 :: Int)++ let+ componentOne =+ buildComponentWithCleanup $ do+ return ((), ("one", modifyIORef callCountRef succ))++ componentTwo =+ buildComponentWithCleanup $ do+ return ((), ("two", modifyIORef callCountRef succ))++ componentAction = do+ componentOne+ void $ throwM (ErrorCall "failing via MonadThrow")+ componentTwo++ result <- try $ runComponentM "test application" componentAction+ case result of+ Left (ComponentStartupFailure [err]) -> do+ callCount <- readIORef callCountRef+ assertEqual "expected introduced error, got different one"+ (Just $ ErrorCall "failing via MonadThrow")+ (fromException err)+ assertEqual "teardown action got called more than once" 1 callCount++ Left (err :: ComponentError) -> do+ assertFailure $ "expected ComponentStartupFailure exception, got instead: " <> show err++ Right _ ->+ assertFailure "expected error, but did not happen"++ , testCase "component construction allows fail calls" $ do+ callCountRef <- newIORef (0 :: Int)++ let+ componentOne =+ buildComponentWithCleanup $ do+ return ((), ("one", modifyIORef callCountRef succ))++ componentTwo =+ buildComponentWithCleanup $ do+ return ((), ("two", modifyIORef callCountRef succ))++ componentAction = do+ componentOne+ void $ fail "failing via fail"+ componentTwo++ result <- try $ runComponentM "test application" componentAction+ case result of+ Left (ComponentStartupFailure [err]) -> do+ callCount <- readIORef callCountRef+ assertEqual ("expected introduced error, got different one: " <> show err)+ "failing via fail"+ (maybe "" (\res ->+ case res of+ ComponentFailure errMsg ->+ errMsg+ _ ->+ "FAIL - Invalid ComponentException received")+ (fromException err))+ assertEqual "teardown action got called more than once" 1 callCount++ Left (err :: ComponentError) -> do+ assertFailure $ "expected ComponentStartupFailure exception, got instead: " <> show err++ Right _ ->+ assertFailure "expected error, but did not happen"+ ]
+ test/tasty/TeardownTest.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module TeardownTest where++import Protolude++import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit++import Control.Teardown+import Data.IORef (atomicModifyIORef, modifyIORef, newIORef, readIORef)+++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+ ]
test/tasty/TestSuite.hs view
@@ -4,124 +4,19 @@ import Protolude -import Test.Tasty (TestTree, defaultMainWithIngredients, testGroup)-import Test.Tasty.HUnit+import Test.Tasty (defaultMainWithIngredients, testGroup) import Test.Tasty.Ingredients.Rerun (rerunningTests) import Test.Tasty.Runners (consoleTestReporter, listingTests) -import Control.Teardown-import Data.IORef (atomicModifyIORef, modifyIORef, newIORef, readIORef)+import qualified ComponentTest as Component+import qualified TeardownTest as Teardown 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- ]+ (testGroup "teardown library"+ [ Teardown.tests+ , Component.tests+ ]+ )