learn to correctly handle excepetions

CopyFile.hs

module Main where

import System.IO

main = do
    h1 <- openFile "file1" ReadMode
    h2 <- openFile "file2" ReadMode
    h3 <- openFile "file3" AppendMode
    copy h1 h2 h3
    hClose h1
    hClose h2
    hClose h3

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

CopyFile10.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Exception (catch, try, onException)
import Control.Concurrent (threadDelay)
import Prelude hiding (catch)
import System.IO
import Data.IORef

main = do
   (h1, h2, h3) <- runUntilAvailable openFiles 100000
   copy h1 h2 h3
   mapM_ hClose [h1, h2, h3]

openFiles = do
    (register, release, runWithFinalizer) <- newFinalizer
    runWithFinalizer $ do
        h1 <- openFile "file1" ReadMode
        register (hClose h1 >> print "close h1")

        h2 <- openFile "file2" ReadMode
        register (hClose h2 >> print "close h2")

        h3 <- openFile "file3" AppendMode
        register (hClose h3 >> print "close h3")

        return (h1, h2, h3)

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

{-- use try instead of catch --}
runUntilAvailable act time = do
    r <- try act
    case r of
      Left err -> do
          print (err::IOError)
          print "Not available"
          threadDelay time
          runUntilAvailable act time
      Right r  -> return r

{-- use  onException instead of finally --}
newFinalizer = do
    finIORef <- newIORef []
    let register = \finalizer -> modifyIORef finIORef (finalizer:)
        release = readIORef finIORef >>= sequence_ >> modifyIORef finIORef (\x -> [])
        runWithFinalizer = \act -> act `onException` release
    return (register, release, runWithFinalizer)

CopyFile2.hs

module Main where

import Control.Exception (catch)
import Prelude hiding (catch)
import System.IO

main = fileCopy `catch` (\err -> do
                             print (err::IOError)
                             print "wtf"
                             fileCopy)

fileCopy = do
    h1 <- openFile "file1" ReadMode
    h2 <- openFile "file2" ReadMode
    h3 <- openFile "file3" AppendMode
    copy h1 h2 h3
    mapM_ hClose [h1, h2, h3]

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

CopyFile3.hs

module Main where

import Control.Exception (catch)
import Control.Concurrent (threadDelay)
import Prelude hiding (catch)
import System.IO

main = do
    h1 <- runUntilAvailable (openFile "file1" ReadMode) 1000000
    h2 <- runUntilAvailable (openFile "file2" ReadMode) 1000000
    h3 <- runUntilAvailable (openFile "file3" AppendMode) 1000000
    runUntilAvailable (copy h1 h2 h3) 1000000
    mapM_ hClose [h1, h2, h3]

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

runUntilAvailable act time = do
    act `catch` (\err -> do
        print (err::IOError)
        print "Not available"
        threadDelay time
        runUntilAvailable act time)

CopyFile4.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Exception (catch)
import Control.Concurrent (threadDelay)
import Prelude hiding (catch)
import System.IO

main = do
    (h1, h2, h3) <- runUntilAvailable openFiles 1000000
    copy h1 h2 h3
    mapM_ hClose [h1, h2, h3]

{-- forget to close file handler--}
openFiles = do
    h1 <- openFile "file1" ReadMode
    h2 <- openFile "file2" ReadMode
    h3 <- openFile "file3" AppendMode
    return (h1, h2, h3)

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

runUntilAvailable act time = do
    act `catch` (\(err::IOError) -> do
        print "Not available"
        threadDelay time
        runUntilAvailable act time)

CopyFile5.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Exception (catch, finally)
import Control.Concurrent (threadDelay)
import Prelude hiding (catch)
import System.IO

main = do
    (h1, h2, h3) <- runUntilAvailable openFiles 1000000
    copy h1 h2 h3
    mapM_ hClose [h1, h2, h3]

openFiles = do
    h1 <- openFile "file1" ReadMode
    h2 <- openFile "file2" ReadMode `finally` (hClose h1)
    h3 <- openFile "file3" AppendMode
    return (h1, h2, h3)

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

runUntilAvailable act time = do
    act `catch` (\(err::IOError) -> do
        print err
        print "Not available"
        threadDelay time
        runUntilAvailable act time)

CopyFile7.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Exception (catch, finally)
import Control.Concurrent (threadDelay)
import Prelude hiding (catch)
import System.IO
import Data.IORef

main = do
   (h1, h2, h3) <- runUntilAvailable openFiles 1000000
   copy h1 h2 h3
   mapM_ hClose [h1, h2, h3]

openFiles = do
    (register, runWithFinalizer) <- newFinalizer
    runWithFinalizer $ do
        h1 <- openFile "file1" ReadMode
        register (hClose h1)

        h2 <- openFile "file2" ReadMode
        register (hClose h2)

        h3 <- openFile "file3" AppendMode
        register (hClose h3)

        return (h1, h2, h3)

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

runUntilAvailable act time = do
    act `catch` (\(err::IOError) -> do
        print err
        print "Not available"
        threadDelay time
        runUntilAvailable act time)

{-- finally will free resource even not exception war raised --}
newFinalizer = do
    finIORef <- newIORef []
    let register = (\finalizer -> modifyIORef finIORef (finalizer:))
        runWithFinalizer = (\act ->
            act `finally` do
                    finalizers <- readIORef finIORef
                    sequence_ finalizers
                    modifyIORef finIORef (\x -> []))
    return (register, runWithFinalizer)

CopyFile8.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Exception (catch, finally, try)
import Control.Concurrent (threadDelay)
import Prelude hiding (catch)
import System.IO
import Data.IORef

main = do
   (h1, h2, h3) <- runUntilAvailable openFiles 1000000
   copy h1 h2 h3
   mapM_ hClose [h1, h2, h3]

openFiles = do
    (register, runWithFinalizer) <- newFinalizer
    runWithFinalizer $ do
        h1 <- openFile "file1" ReadMode
        register (hClose h1)

        h2 <- openFile "file2" ReadMode
        register (hClose h2)

        h3 <- openFile "file3" AppendMode
        register (hClose h3)

        return (h1, h2, h3)

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

{-- use try instead of catch --}
runUntilAvailable act time = do
    r <- try act
    case r of
      Left err -> do
          print (err::IOError)
          print "Not available"
          threadDelay time
          runUntilAvailable act time
      Right r  -> return r

{-- finally will free resource even not exception war raised --}
newFinalizer = do
    finIORef <- newIORef []
    let register = (\finalizer -> modifyIORef finIORef (finalizer:))
        runWithFinalizer = (\act ->
            act `finally` do
                    finalizers <- readIORef finIORef
                    sequence_ finalizers
                    modifyIORef finIORef (\x -> []))
    return (register, runWithFinalizer)

CopyFile9.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Exception (catch, try, bracketOnError)
import Control.Concurrent (threadDelay)
import Prelude hiding (catch)
import System.IO
import Data.IORef

main = do
   (h1, h2, h3) <- runUntilAvailable openFiles 100
   copy h1 h2 h3
   mapM_ hClose [h1, h2, h3]

openFiles = do
    (register, release, runWithFinalizer) <- newFinalizer
    runWithFinalizer $ do
        h1 <- openFile "file1" ReadMode
        register (hClose h1)

        h2 <- openFile "file2" ReadMode
        register (hClose h2)

        h3 <- openFile "file3" AppendMode
        register (hClose h3)

        return (h1, h2, h3)

copy h1 h2 h3 = do
    s1 <- hGetContents h1
    s2 <- hGetContents h2
    hPutStr h3 s1
    hPutStr h3 s2

{-- use try instead of catch --}

runUntilAvailable act time = do
    r <- try act
    case r of
      Left err -> do
          print (err::IOError)
          print "Not available"
          threadDelay time
          runUntilAvailable act time
      Right r  -> return r

{-- use  bracketOnError instead of finally --}
newFinalizer = do
    finIORef <- newIORef []
    let register = \finalizer -> modifyIORef finIORef (finalizer:)
        release = readIORef finIORef >>= sequence_ >> modifyIORef finIORef (\x -> [])
        finalize = \res -> release
        runWithFinalizer = (\act -> bracketOnError act finalize (\x -> return x))
    return (register, release, runWithFinalizer)