module StringIO where

import Prelude hiding (read)

import Foreign
import Foreign.ForeignPtr
import Foreign.C.Types

import GHC.IO.Handle
import GHC.IO.Buffer
import GHC.IO.BufferedIO
import GHC.IO.Device

import Control.Applicative
import Data.Typeable
import Data.Word
import Data.IORef
import System.IO

data StringIOBuffer = StringIOBuffer (IORef [Word8])
  deriving (Typeable)

instance RawIO StringIOBuffer where
  read (StringIOBuffer ref) ptr len = do
    (w,rest) <- fmap (splitAt len) $ readIORef ref
    pokeArray ptr w
    writeIORef ref rest
    return $ length w

  readNonBlocking buf ptr len = -- TODO
    fmap Just $ read buf ptr len

  write (StringIOBuffer ref) ptr len = do
    r <- peekArray len ptr
    modifyIORef ref (++r)

  writeNonBlocking buf ptr len =
    write buf ptr len >> return len -- TODO

instance BufferedIO StringIOBuffer where
  newBuffer (StringIOBuffer ref) state = do
    let buf_len = 1024
    buf_ptr <- mallocForeignPtrBytes buf_len
    return (emptyBuffer buf_ptr buf_len state)
  fillReadBuffer = readBuf
  fillReadBuffer0 = readBufNonBlocking
  flushWriteBuffer = writeBuf
  flushWriteBuffer0 = writeBufNonBlocking

instance IODevice StringIOBuffer where
  ready _ _ _ = return True
  close _ = return ()
  devType _ = return RawDevice

makeStringIO :: IO Handle
makeStringIO = do
  buffer <- StringIOBuffer <$> newIORef []
  mkFileHandle buffer "string io" ReadWriteMode (Just localeEncoding) nativeNewlineMode