pipes-safe-finalizer-not-called.hs

{- | File "tmp2" fails to close in this example
 - ghci> runSafeT . runEffect $ readFile' "tmp" >-> writeFile' "tmp2"
 - {tmp2 open}
 - {tmp open}
 - {tmp closed}
 -}
{-# language RankNTypes #-}
{-# language NoMonomorphismRestriction #-}


import           Pipes as Pipes
import qualified Pipes.Prelude as P

import Pipes.Safe
import qualified Pipes.Safe.Prelude as PSP


import qualified System.IO as IO
import Prelude hiding (readFile)

import Control.Monad

readFile :: (MonadSafe m) => FilePath -> Producer' String m ()
readFile file = bracket
    (do h <- liftIO $ IO.openFile file IO.ReadMode
        liftIO $ putStrLn $ "{" ++ file ++ " open}"
        return h )
    (\h -> do
        liftIO $ IO.hClose h
        liftIO $ putStrLn $ "{" ++ file ++ " closed}" )
    P.fromHandle

writeFile :: (MonadSafe m) => FilePath -> Consumer' String m ()
writeFile file = bracket
    (do h <- liftIO $ IO.openFile file IO.WriteMode
        liftIO $ putStrLn $ "{" ++ file ++ " open}"
        return h )
    (\h -> do
        liftIO $ IO.hClose h
        liftIO $ putStrLn $ "{" ++ file ++ " closed}" )
    P.toHandle



readFile' fileName = runEffect
                   . runSafeP $ readFile fileName
                 >-> forever (await >>= lift . lift . yield)

writeFile' fileName  = runEffect
                     . runSafeP
                     $ forever ((lift . lift) await >>= yield)
                   >-> Main.writeFile fileName