{-# LINE 1 "System/Unix/FilePath.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module System.Unix.FilePath
(dirName,
baseName,
realpath,
(<++>))
where
import Data.List
import System.FilePath (makeRelative, (</>), takeFileName, dropFileName)
import Foreign.C
import Foreign.Marshal.Array
FilePath
a <++> :: FilePath -> FilePath -> FilePath
<++> FilePath
b = FilePath
a FilePath -> FilePath -> FilePath
</> (FilePath -> FilePath -> FilePath
makeRelative FilePath
"" FilePath
b)
dirName :: FilePath -> FilePath
dirName :: FilePath -> FilePath
dirName = FilePath -> FilePath
dropFileName
baseName :: FilePath -> String
baseName :: FilePath -> FilePath
baseName = FilePath -> FilePath
takeFileName
realpath :: FilePath -> IO FilePath
realpath :: FilePath -> IO FilePath
realpath FilePath
fp =
FilePath -> (CString -> IO FilePath) -> IO FilePath
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
fp ((CString -> IO FilePath) -> IO FilePath)
-> (CString -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \CString
cfp ->
Int -> (CString -> IO FilePath) -> IO FilePath
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Int
4096) ((CString -> IO FilePath) -> IO FilePath)
-> (CString -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \CString
res ->
{-# LINE 38 "System/Unix/FilePath.hsc" #-}
FilePath -> IO CString -> IO CString
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull FilePath
"realpath" (CString -> CString -> IO CString
c_realpath CString
cfp CString
res) IO CString -> (CString -> IO FilePath) -> IO FilePath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO FilePath
peekCString
foreign import ccall unsafe "realpath" c_realpath :: CString -> CString -> IO CString