{-# LINE 1 "System/Directory/Internal/Posix.hsc" #-}

{-# LINE 2 "System/Directory/Internal/Posix.hsc" #-}


{-# LINE 4 "System/Directory/Internal/Posix.hsc" #-}

{-# LINE 5 "System/Directory/Internal/Posix.hsc" #-}

{-# LINE 6 "System/Directory/Internal/Posix.hsc" #-}

module System.Directory.Internal.Posix where

{-# LINE 9 "System/Directory/Internal/Posix.hsc" #-}
import Control.Monad ((>=>))
import Control.Exception (bracket)
import Foreign
import Foreign.C

-- we use the 'free' from the standard library here since it's not entirely
-- clear whether Haskell's 'free' corresponds to the same one
foreign import ccall unsafe "free" c_free :: Ptr a -> IO ()

c_PATH_MAX :: Maybe Int

{-# LINE 20 "System/Directory/Internal/Posix.hsc" #-}
c_PATH_MAX | c_PATH_MAX' > toInteger maxValue = Nothing
           | otherwise                        = Just (fromInteger c_PATH_MAX')
  where c_PATH_MAX' = (4096)
{-# LINE 23 "System/Directory/Internal/Posix.hsc" #-}
        maxValue    = maxBound `asTypeOf` case c_PATH_MAX of ~(Just x) -> x

{-# LINE 27 "System/Directory/Internal/Posix.hsc" #-}

foreign import ccall "realpath" c_realpath
  :: CString -> CString -> IO CString

withRealpath :: CString -> (CString -> IO a) -> IO a
withRealpath path action = case c_PATH_MAX of
  Nothing ->
    -- newer versions of POSIX support cases where the 2nd arg is NULL;
    -- hopefully that is the case here, as there is no safer way
    bracket (realpath nullPtr) c_free action
  Just pathMax ->
    -- allocate one extra just to be safe
    allocaBytes (pathMax + 1) (realpath >=> action)
  where realpath = throwErrnoIfNull "" . c_realpath path


{-# LINE 43 "System/Directory/Internal/Posix.hsc" #-}