FDIO.hs

#!/usr/bin/env stack
-- stack --resolver lts-13.0 --install-ghc runghc

-- see https://stackoverflow.com/questions/53978597/haskell-openfile-for-multiple-handles-wrrr-w-o-file-is-locked

module FDIO (Fd, open, read, write, seek, close, with) where

import           Control.Exception        (bracket)
import           Data.ByteString          (ByteString)
import qualified Data.ByteString.Char8    as C
import qualified Data.ByteString.Internal as BSI
import           Foreign.ForeignPtr       (withForeignPtr)
import           Foreign.Ptr              (plusPtr)
import           Prelude                  hiding (read)
import           System.IO
import qualified System.Posix.Files       as P
import qualified System.Posix.IO          as P
import           System.Posix.Types       (Fd, FileOffset)

open :: FilePath -> IOMode -> IO Fd
open path mode = do
  let (m, f) = case mode of
                 ReadMode  -> (P.ReadOnly, Nothing)
                 WriteMode -> (P.WriteOnly, Just $ P.unionFileModes P.ownerReadMode P.ownerWriteMode)
                 _         -> error $ "Unsupported mode" ++ show mode

  P.openFd path m f P.defaultFileFlags

write :: Fd -> ByteString -> IO ()
write fd bs = do
  let (fptr, off, len) = BSI.toForeignPtr bs
  -- TODO assert len == ret
  withForeignPtr fptr $
    \wptr -> P.fdWriteBuf fd (plusPtr wptr off) (fromIntegral len)
  return ()

read :: Fd -> Int -> IO ByteString
read fd n = do
  -- TODO assert n == ret
  BSI.create n $
    \wptr -> P.fdReadBuf fd wptr (fromIntegral n) >> return ()

close :: Fd -> IO ()
close = P.closeFd

seek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
seek = P.fdSeek

with :: FilePath -> IOMode -> (Fd -> IO a) -> IO a
with path m f = do
  bracket (open path m)
          close
          f

main :: IO ()
main = do
  let path = "file.txt"

  a <- do
    fd <- open path WriteMode
    let s = "hello"
    write fd $ C.pack s
    putStrLn $ "Wrote: " ++ s
    return fd

  b <- do
    fd <- open path ReadMode
    bs <- read fd 4
    putStrLn $ "Read: " ++ C.unpack bs
    return fd

  c <- do
    fd <- open path ReadMode
    bs <- read fd 4
    putStrLn $ "Read: " ++ C.unpack bs
    return fd

  P.closeFd a
  P.closeFd b
  P.closeFd c

  return ()