{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}

module System.IO.Streams.Tests.Handle (tests) where

------------------------------------------------------------------------------
import           Control.Exception
import           Control.Monad                  hiding (mapM)
import qualified Data.ByteString.Char8          as S
import           Data.List
import           Foreign.Marshal.Alloc          (allocaBytes)
import           Foreign.Marshal.Utils          (copyBytes)
import           Foreign.Ptr                    (castPtr)
import qualified GHC.IO.Buffer                  as HB
import qualified GHC.IO.BufferedIO              as H
import qualified GHC.IO.Device                  as H
import           Prelude                        hiding (mapM, read)
import           System.Directory
import           System.FilePath
import           System.IO                      hiding (stderr, stdin, stdout)
import qualified System.IO                      as IO
import           System.IO.Streams              (OutputStream)
import qualified System.IO.Streams              as Streams
import qualified System.IO.Streams.Internal     as Streams
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit                     hiding (Test)
------------------------------------------------------------------------------
import           System.IO.Streams.Tests.Common

tests :: [Test]
tests = [ testHandle
        , testStdHandles
        , testInputStreamToHandle
        , testOutputStreamToHandle
        , testStreamPairToHandle
        , testHandleInstances
        , testHandleBadnesses
        ]


------------------------------------------------------------------------------
testHandle :: Test
testHandle = testCase "handle/files" $ do
    createDirectoryIfMissing False "tmp"
    tst `finally` eatException (removeFile fn >> removeDirectory "tmp")

  where
    fn = "tmp" </> "data"

    tst = do
        withBinaryFile fn WriteMode $ \h -> do
            let l = "" : (intersperse " " ["the", "quick", "brown", "fox"])
            os <- Streams.handleToOutputStream h
            Streams.fromList l >>= Streams.connectTo os

        withBinaryFile fn ReadMode $ \h -> do
            l <- liftM S.concat (Streams.handleToInputStream h >>=
                                 Streams.toList)
            assertEqual "testFiles" "the quick brown fox" l


------------------------------------------------------------------------------
testStdHandles :: Test
testStdHandles = testCase "handle/stdHandles" $ do
    hClose IO.stdin
    -- Should generate exception: handle is closed.
    expectExceptionH (Streams.toList Streams.stdin)
    Streams.write (Just "") Streams.stdout
    Streams.write (Just "") Streams.stderr
    return ()


------------------------------------------------------------------------------
testInputStreamToHandle :: Test
testInputStreamToHandle = testCase "handle/inputStreamToHandle" $ do
    h <- Streams.fromList ["foo", "bar", "baz"] >>=
         Streams.inputStreamToHandle
    S.hGetContents h >>= assertEqual "inputStreamToHandle" "foobarbaz"


------------------------------------------------------------------------------
testOutputStreamToHandle :: Test
testOutputStreamToHandle = testCase "handle/outputStreamToHandle" $ do
    (os, getInput) <- Streams.listOutputStream
    h <- Streams.outputStreamToHandle os
    S.hPutStrLn h "foo"
    liftM S.concat getInput >>= assertEqual "outputStreamToHandle" "foo\n"


------------------------------------------------------------------------------
testStreamPairToHandle :: Test
testStreamPairToHandle = testCase "handle/streamPairToHandle" $ do
    is             <- Streams.fromList ["foo", "bar", "baz"]
    (os, getInput) <- Streams.listOutputStream

    h <- Streams.streamPairToHandle is os
    S.hPutStrLn h "foo"
    S.hGetContents h >>= assertEqual "input stream" "foobarbaz"
    liftM S.concat getInput >>= assertEqual "output stream" "foo\n"


------------------------------------------------------------------------------
testHandleBadnesses :: Test
testHandleBadnesses = testCase "handle/badness" $ do
    h <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle
    _ <- S.hGetContents h
    expectExceptionH $ S.hGetContents h

    h' <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle
    expectExceptionH $ S.hPutStrLn h' "foo"

    (os, _) <- Streams.listOutputStream
    h'' <- Streams.outputStreamToHandle os
    expectExceptionH $ S.hGetContents h''

    is <- Streams.fromList ["foo"]
    h''' <- Streams.streamPairToHandle is os
    _ <- S.hGetContents h'''
    expectExceptionH $ S.hGetContents h'''


------------------------------------------------------------------------------
testHandleInstances :: Test
testHandleInstances = testCase "handle/ghc-instances" $ do
    is            <- Streams.fromList ["foo", "bar", "baz" :: S.ByteString]
    (os, getList) <- Streams.listOutputStream
    let sp   = Streams.SP is (os :: OutputStream S.ByteString)
    expectExceptionH $ H.write is undefined undefined
    expectExceptionH $ H.writeNonBlocking is undefined undefined
    expectExceptionH $ H.flushWriteBuffer is undefined
    expectExceptionH $ H.flushWriteBuffer0 is undefined

    expectExceptionH $ H.read os undefined undefined
    expectExceptionH $ H.writeNonBlocking os undefined undefined

    expectExceptionH $ H.fillReadBuffer0 is undefined
    expectExceptionH $ H.fillReadBuffer0 os undefined
    expectExceptionH $ H.fillReadBuffer0 sp undefined

    H.ready is False 0 >>= assertEqual "ready input" True
    H.ready os False 0 >>= assertEqual "ready output" True
    H.ready sp False 0 >>= assertEqual "ready pair" True

    H.devType is >>= assertBool "devtype input"  . (== H.Stream)
    H.devType os >>= assertBool "devtype output" . (== H.Stream)
    H.devType sp >>= assertBool "devtype pair"   . (== H.Stream)

    expectExceptionH $ H.readNonBlocking is undefined undefined
    expectExceptionH $ H.readNonBlocking os undefined undefined
    expectExceptionH $ H.readNonBlocking sp undefined undefined
    expectExceptionH $ H.writeNonBlocking is undefined undefined
    expectExceptionH $ H.writeNonBlocking os undefined undefined
    expectExceptionH $ H.writeNonBlocking sp undefined undefined

    S.useAsCStringLen "foo" $ \(cstr, l) -> do
        H.write os (castPtr cstr) l
        liftM S.concat getList >>= assertEqual "H.write 1" "foo"
        H.write sp (castPtr cstr) l
        liftM S.concat getList >>= assertEqual "H.write 2" "foo"
        buf <- H.newBuffer sp HB.WriteBuffer
        HB.withBuffer buf $ \ptr -> copyBytes ptr (castPtr cstr) 3
        (l', !buf') <- H.flushWriteBuffer0 sp $ buf { HB.bufR = 3 }
        assertEqual "flushWriteBuffer0" 3 l'
        assertEqual "bufR" 0 $ HB.bufR buf'
        liftM S.concat getList >>= assertEqual "write 3" "foo"


    allocaBytes 3 $ \buf -> do
        l <- H.read is buf 3
        assertEqual "3 byte read" 3 l
        S.packCStringLen (castPtr buf, l) >>= assertEqual "first read" "foo"
        l' <- H.read sp buf 3
        assertEqual "3 byte read #2" 3 l'
        S.packCStringLen (castPtr buf, l') >>= assertEqual "second read" "bar"
        expectExceptionH $ H.read os buf 3