{-# LINE 1 "libraries\\Win32\\System\\Win32\\Path.hsc" #-}
{-# LINE 2 "libraries\\Win32\\System\\Win32\\Path.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LINE 6 "libraries\\Win32\\System\\Win32\\Path.hsc" #-}
module System.Win32.Path (
filepathRelativePathTo
, pathRelativePathTo
) where
import System.Win32.Types
import System.Win32.File
import Foreign
#include "windows_cconv.h"
filepathRelativePathTo :: FilePath -> FilePath -> IO FilePath
filepathRelativePathTo from to =
withTString from $ \p_from ->
withTString to $ \p_to ->
allocaArray ((260) * ((1))) $ \p_AbsPath -> do
{-# LINE 39 "libraries\\Win32\\System\\Win32\\Path.hsc" #-}
_ <- failIfZero "PathRelativePathTo" (c_pathRelativePathTo p_AbsPath p_from fILE_ATTRIBUTE_DIRECTORY
p_to fILE_ATTRIBUTE_NORMAL)
path <- peekTString p_AbsPath
_ <- localFree p_AbsPath
return path
pathRelativePathTo :: FilePath -> FileAttributeOrFlag -> FilePath -> FileAttributeOrFlag -> IO FilePath
pathRelativePathTo from from_attr to to_attr =
withTString from $ \p_from ->
withTString to $ \p_to ->
allocaArray ((260) * ((1))) $ \p_AbsPath -> do
{-# LINE 50 "libraries\\Win32\\System\\Win32\\Path.hsc" #-}
_ <- failIfZero "PathRelativePathTo" (c_pathRelativePathTo p_AbsPath p_from from_attr
p_to to_attr)
path <- peekTString p_AbsPath
_ <- localFree p_AbsPath
return path
foreign import WINDOWS_CCONV unsafe "Shlwapi.h PathRelativePathToW"
c_pathRelativePathTo :: LPTSTR -> LPCTSTR -> DWORD -> LPCTSTR -> DWORD -> IO UINT