-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Handle
-- Copyright   :  © Anders Kaseorg, 2010
-- License     :  BSD-style
--
-- Maintainer  :  andersk@mit.edu
-- Stability   :  experimental
-- Portability :  non-portable (requires POSIX)
--
-- This module provides versions of functions from
-- "System.Posix.Files" that operate on 'Handle' instead of 'FilePath'
-- or 'Fd'.  This is useful to prevent race conditions that may arise
-- from looking up the same path twice.
--
-----------------------------------------------------------------------------

module System.Posix.Handle (
    hSetMode,
    hGetStatus,
    hSetOwnerAndGroup,
    hSetSize,
    hGetPathVar
  ) where

import System.IO
import System.Posix.Files
import System.Posix.Handle.Internals
import System.Posix.Types

hSetMode :: Handle -> FileMode -> IO ()
-- ^ @hSetMode h mode@ acts like 'setFileMode' or 'setFdMode' on a
-- 'Handle'.
--
-- Note: calls @fchmod@.
hSetMode h mode =
    withHandleFd "hSetMode" h $ \fd -> setFdMode fd mode

hGetStatus :: Handle -> IO FileStatus
-- ^ @hGetStatus h@ acts like 'getFileStatus' or 'getFdStatus' on a
-- 'Handle'.
--
-- Note: calls @fstat@.
hGetStatus h =
    withHandleFd "hGetStatus" h getFdStatus

hSetOwnerAndGroup :: Handle -> UserID -> GroupID -> IO ()
-- ^ @hSetOwnerAndGroup h uid gid@ acts like 'setOwnerAndGroup' or
-- 'setFdOwnerAndGroup' on a 'Handle'.
--
-- Note: calls @fchown@.
hSetOwnerAndGroup h uid gid =
    withHandleFd "hSetOwnerAndGroup" h $ \fd -> setFdOwnerAndGroup fd uid gid

hSetSize :: Handle -> FileOffset -> IO ()
-- ^ @hSetSize h size@ acts like 'setFileSize' or 'setFdSize' on a
-- 'Handle'.  It is equivalent to 'hSetFileSize' but is provided here
-- for completeness.
hSetSize h size = hSetFileSize h (fromIntegral size)

hGetPathVar :: PathVar -> Handle -> IO Limit
-- ^ @hGetPathVar var h@ acts like 'getPathVar' or 'getFdPathVar' on a
-- 'Handle'.
--
-- Note: calls @fpathconf@.
hGetPathVar var h =
    withHandleFd "hGetPathVar" h $ \fd -> getFdPathVar fd var