content: -- |
  -- Module      : Stream.Exceptions
  -- Copyright   : (c) 2019 Composewell Technologies
  -- License     : BSD-3-Clause
  -- Maintainer  : streamly@composewell.com
  -- Stability   : experimental
  -- Portability : GHC
  
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  #ifdef USE_PRELUDE
  #endif
  
  #ifdef __HADDOCK_VERSION__
  #undef INSPECTION
  #endif
  
  #ifdef INSPECTION
  {-# LANGUAGE TemplateHaskell #-}
  {-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
  #endif
  
  module Stream.Exceptions (benchmarks) where
  
  import Control.Exception (Exception, throwIO)
  import Stream.Common (drain)
  
  import qualified Data.IORef as Ref
  import qualified Data.Map.Strict as Map
  
  import Control.Exception (SomeException)
  import System.IO (Handle, hClose, hPutChar)
  import qualified Streamly.FileSystem.Handle as FH
  import qualified Streamly.Internal.FileSystem.Handle as IFH
  import qualified Streamly.Internal.Data.Unfold as IUF
  import qualified Streamly.Internal.Data.Unfold.Prelude as IUF
  
  #ifdef USE_PRELUDE
  import qualified Streamly.Internal.Data.Stream.IsStream as Stream
  #else
  import qualified Streamly.Internal.Data.Stream as Stream
  import qualified Streamly.Internal.Data.Stream.Prelude as Stream
  #endif
  
  import Test.Tasty.Bench hiding (env)
  import Prelude hiding (last, length)
  import Streamly.Benchmark.Common
  import Streamly.Benchmark.Common.Handle
  
  #ifdef INSPECTION
  import Control.Monad.Catch (MonadCatch)
  import Test.Inspection
  
  import qualified Streamly.Internal.Data.Stream as D
  #endif
  
  #ifdef USE_PRELUDE
  type Stream = Stream.SerialT
  toStreamD = Stream.toStream
  fromStreamD = Stream.fromStream
  #else
  type Stream = Stream.Stream
  toStreamD :: a -> a
  toStreamD = id
  fromStreamD :: a -> a
  fromStreamD = id
  #endif
  
  afterUnsafe :: IO b -> Stream IO a -> Stream IO a
  finallyUnsafe :: IO b -> Stream IO a -> Stream IO a
  bracketUnsafe :: IO b -> (b -> IO c) -> (b -> Stream IO a) -> Stream IO a
  #ifdef USE_PRELUDE
  afterUnsafe = Stream.after_
  finallyUnsafe = Stream.finally_
  bracketUnsafe = Stream.bracket_
  #else
  afterUnsafe = Stream.afterUnsafe
  finallyUnsafe = Stream.finallyUnsafe
  bracketUnsafe = Stream.bracketUnsafe
  #endif
  
  -------------------------------------------------------------------------------
  -- stream exceptions
  -------------------------------------------------------------------------------
  
  data BenchException
      = BenchException1
      | BenchException2
      deriving (Show, Eq, Ord)
  
  instance Exception BenchException
  
  retryNoneSimple :: Int -> Int -> IO ()
  retryNoneSimple length from =
      drain
          $ Stream.retry
              (Map.singleton BenchException1 length)
              (const Stream.nil)
              source
  
      where
  
      source = Stream.enumerateFromTo from (from + length)
  
  retryNone :: Int -> Int -> IO ()
  retryNone length from = do
      ref <- Ref.newIORef (0 :: Int)
      drain
          $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
          $ source ref
  
      where
  
      source ref =
          Stream.replicateM (from + length)
              $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
  
  retryAll :: Int -> Int -> IO ()
  retryAll length from = do
      ref <- Ref.newIORef 0
      drain
          $ Stream.retry
              (Map.singleton BenchException1 (length + from)) (const Stream.nil)
          $ source ref
  
      where
  
      source ref =
          Stream.fromEffect
              $ do
                  Ref.modifyIORef' ref (+ 1)
                  val <- Ref.readIORef ref
                  if val >= length
                  then return length
                  else throwIO BenchException1
  
  retryUnknown :: Int -> Int -> IO ()
  retryUnknown length from = do
      drain
          $ Stream.retry (Map.singleton BenchException1 length) (const source)
          $ throwIO BenchException2 `Stream.before` Stream.nil
  
      where
  
      source = Stream.enumerateFromTo from (from + length)
  
  
  o_1_space_serial_exceptions :: Int -> [Benchmark]
  o_1_space_serial_exceptions length =
      [ bgroup
            "exceptions/serial"
            [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length)
            , benchIOSrc1 "retryNone" (retryNone length)
            , benchIOSrc1 "retryAll" (retryAll length)
            , benchIOSrc1 "retryUnknown" (retryUnknown length)
            ]
      ]
  
  -- XXX Move these to FileSystem.Handle benchmarks
  
  -------------------------------------------------------------------------------
  -- copy stream exceptions
  -------------------------------------------------------------------------------
  
  -- | Send the file contents to /dev/null with exception handling
  readWriteOnExceptionStream :: Handle -> Handle -> IO ()
  readWriteOnExceptionStream inh devNull =
      let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)
      in Stream.fold (FH.write devNull) readEx
  
  #ifdef INSPECTION
  inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
  #endif
  
  -- | Send the file contents to /dev/null with exception handling
  readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
  readWriteHandleExceptionStream inh devNull =
      let handler (_e :: SomeException) =
  #ifndef USE_PRELUDE
              return $ Stream.fromEffect (hClose inh >> return 10)
  #else
              Stream.fromEffect (hClose inh >> return 10)
  #endif
          readEx = Stream.handle handler (Stream.unfold FH.reader inh)
      in Stream.fold (FH.write devNull) readEx
  
  #ifdef INSPECTION
  inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
  #endif
  
  -- | Send the file contents to /dev/null with exception handling
  readWriteFinally_Stream :: Handle -> Handle -> IO ()
  readWriteFinally_Stream inh devNull =
      let readEx =
              finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)
      in Stream.fold (FH.write devNull) readEx
  
  #ifdef INSPECTION
  inspect $ hasNoTypeClasses 'readWriteFinally_Stream
  #endif
  
  readWriteFinallyStream :: Handle -> Handle -> IO ()
  readWriteFinallyStream inh devNull =
      let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
      in Stream.fold (FH.write devNull) readEx
  
  -- | Send the file contents to /dev/null with exception handling
  fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
  fromToBytesBracket_Stream inh devNull =
      let readEx = bracketUnsafe (return ()) (\_ -> hClose inh)
                      (\_ -> fromStreamD $ IFH.read inh)
      in IFH.putBytes devNull (toStreamD readEx)
  
  #ifdef INSPECTION
  inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
  #endif
  
  fromToBytesBracketStream :: Handle -> Handle -> IO ()
  fromToBytesBracketStream inh devNull =
      let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
                      (\_ -> fromStreamD $ IFH.read inh)
      in IFH.putBytes devNull (toStreamD readEx)
  
  readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
  readWriteBeforeAfterStream inh devNull =
      let readEx =
              Stream.after (hClose inh)
                  $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)
       in Stream.fold (FH.write devNull) readEx
  
  #ifdef INSPECTION
  inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
  #endif
  
  readWriteAfterStream :: Handle -> Handle -> IO ()
  readWriteAfterStream inh devNull =
      let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
       in Stream.fold (FH.write devNull) readEx
  
  #ifdef INSPECTION
  inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
  #endif
  
  readWriteAfter_Stream :: Handle -> Handle -> IO ()
  readWriteAfter_Stream inh devNull =
      let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)
       in Stream.fold (FH.write devNull) readEx
  
  #ifdef INSPECTION
  inspect $ hasNoTypeClasses 'readWriteAfter_Stream
  inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
  #endif
  
  o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
  o_1_space_copy_stream_exceptions env =
      [ bgroup "exceptions"
         [ mkBenchSmall "Stream.onException" env $ \inh _ ->
             readWriteOnExceptionStream inh (nullH env)
         , mkBenchSmall "Stream.handle" env $ \inh _ ->
             readWriteHandleExceptionStream inh (nullH env)
         , mkBenchSmall "Stream.finally_" env $ \inh _ ->
             readWriteFinally_Stream inh (nullH env)
         , mkBenchSmall "Stream.finally" env $ \inh _ ->
             readWriteFinallyStream inh (nullH env)
         , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
             readWriteBeforeAfterStream inh (nullH env)
         , mkBenchSmall "Stream.after" env $ \inh _ ->
             readWriteAfterStream inh (nullH env)
         , mkBenchSmall "Stream.after_" env $ \inh _ ->
             readWriteAfter_Stream inh (nullH env)
         ]
      , bgroup "exceptions/fromToBytes"
         [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
             fromToBytesBracket_Stream inh (nullH env)
         , mkBenchSmall "Stream.bracket" env $ \inh _ ->
             fromToBytesBracketStream inh (nullH env)
          ]
      ]
  
   -------------------------------------------------------------------------------
  -- Exceptions readChunks
  -------------------------------------------------------------------------------
  
  -- | Send the file contents to /dev/null with exception handling
  readChunksOnException :: Handle -> Handle -> IO ()
  readChunksOnException inh devNull =
      let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
      in IUF.fold (IFH.writeChunks devNull) readEx inh
  
  #ifdef INSPECTION
  #if __GLASGOW_HASKELL__ >= 906
  inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch]
  #else
  inspect $ hasNoTypeClasses 'readChunksOnException
  #endif
  #endif
  
  -- | Send the file contents to /dev/null with exception handling
  readChunksBracket_ :: Handle -> Handle -> IO ()
  readChunksBracket_ inh devNull =
      let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
      in IUF.fold (IFH.writeChunks devNull) readEx inh
  
  #ifdef INSPECTION
  #if __GLASGOW_HASKELL__ >= 906
  inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch]
  #else
  inspect $ hasNoTypeClasses 'readChunksBracket_
  #endif
  #endif
  
  readChunksBracket :: Handle -> Handle -> IO ()
  readChunksBracket inh devNull =
      let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
      in IUF.fold (IFH.writeChunks devNull) readEx inh
  
  o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
  o_1_space_copy_exceptions_readChunks env =
      [ bgroup "exceptions/readChunks"
          [ mkBench "UF.onException" env $ \inH _ ->
              readChunksOnException inH (nullH env)
          , mkBench "UF.bracket_" env $ \inH _ ->
              readChunksBracket_ inH (nullH env)
          , mkBench "UF.bracket" env $ \inH _ ->
              readChunksBracket inH (nullH env)
          ]
      ]
  
  -------------------------------------------------------------------------------
  -- Exceptions toChunks
  -------------------------------------------------------------------------------
  
  -- | Send the file contents to /dev/null with exception handling
  toChunksBracket_ :: Handle -> Handle -> IO ()
  toChunksBracket_ inh devNull =
      let readEx = bracketUnsafe
              (return ())
              (\_ -> hClose inh)
              (\_ -> fromStreamD $ IFH.readChunks inh)
      in Stream.fold (IFH.writeChunks devNull) readEx
  
  #ifdef INSPECTION
  inspect $ hasNoTypeClasses 'toChunksBracket_
  #endif
  
  toChunksBracket :: Handle -> Handle -> IO ()
  toChunksBracket inh devNull =
      let readEx = Stream.bracket
              (return ())
              (\_ -> hClose inh)
              (\_ -> fromStreamD $ IFH.readChunks inh)
      in Stream.fold (IFH.writeChunks devNull) readEx
  
  o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
  o_1_space_copy_exceptions_toChunks env =
      [ bgroup "exceptions/toChunks"
          [ mkBench "Stream.bracket_" env $ \inH _ ->
              toChunksBracket_ inH (nullH env)
          , mkBench "Stream.bracket" env $ \inH _ ->
              toChunksBracket inH (nullH env)
          ]
      ]
  
  benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
  benchmarks moduleName _env size =
          [ bgroup (o_1_space_prefix moduleName) $ concat
              [ o_1_space_serial_exceptions size
              , o_1_space_copy_exceptions_readChunks _env
              , o_1_space_copy_exceptions_toChunks _env
              , o_1_space_copy_stream_exceptions _env
              ]
          ]
  