never executed always true always false
    1 {-|
    2 Module: Flaw.Book
    3 Description: Book is a helper structure for resource management.
    4 License: MIT
    5 -}
    6 
    7 module Flaw.Book
    8   ( Book
    9   , newBook
   10   , newBookSTM
   11   , freeBook
   12   , releaseBook
   13   , newDynamicBook
   14   , book
   15   , withBook
   16   , withSpecialBook
   17   ) where
   18 
   19 import Control.Concurrent.STM
   20 import Control.Exception
   21 import Control.Monad
   22 
   23 newtype Book = Book (TVar [IO ()])
   24 
   25 {-# INLINE newBook #-}
   26 newBook :: IO Book
   27 newBook = Book <$> newTVarIO []
   28 
   29 {-# INLINE newBookSTM #-}
   30 newBookSTM :: STM Book
   31 newBookSTM = Book <$> newTVar []
   32 
   33 -- | Free the book.
   34 {-# INLINE freeBook #-}
   35 freeBook :: Book -> IO ()
   36 freeBook = join . releaseBook
   37 
   38 -- | Return IO action freeing everything, and clear the book.
   39 -- Returned action captures state of the book at the moment of call,
   40 -- so it won't free resources added after.
   41 {-# INLINE releaseBook #-}
   42 releaseBook :: Book -> IO (IO ())
   43 releaseBook (Book var) = do
   44   finalizers <- atomically $ do
   45     finalizers <- readTVar var
   46     writeTVar var []
   47     return finalizers
   48   return $ sequence_ finalizers
   49 
   50 -- | Create a dynamic book which could be safely freed multiple times.
   51 {-# INLINE newDynamicBook #-}
   52 newDynamicBook :: IO (Book, IO ())
   53 newDynamicBook = do
   54   bk <- newBook
   55   return (bk, freeBook bk)
   56 
   57 {-# INLINE book #-}
   58 book :: Book -> IO (a, IO ()) -> IO a
   59 book (Book var) q = do
   60   (a, r) <- q
   61   atomically $ modifyTVar' var (r :)
   62   return a
   63 
   64 {-# INLINE withBook #-}
   65 withBook :: (Book -> IO a) -> IO a
   66 withBook f = do
   67   bk <- newBook
   68   finally (f bk) $ freeBook bk
   69 
   70 -- | Helper method for dealing with possible exceptions during construction of objects.
   71 -- User function uses separate book for construction, and if exception is thrown, book got freed.
   72 {-# INLINE withSpecialBook #-}
   73 withSpecialBook :: (Book -> IO a) -> IO (a, IO ())
   74 withSpecialBook f = do
   75   bk <- newBook
   76   r <- onException (f bk) (freeBook bk)
   77   return (r, freeBook bk)