{-# LANGUAGE CPP #-}
module Distribution.Compat.GetShortPathName ( getShortPathName )
where
import Prelude ()
import Distribution.Compat.Prelude
#ifdef mingw32_HOST_OS
import qualified Prelude
import qualified System.Win32 as Win32
import System.Win32 (LPCTSTR, LPTSTR, DWORD)
import Foreign.Marshal.Array (allocaArray)
#ifdef x86_64_HOST_ARCH
#define WINAPI ccall
#else
#define WINAPI stdcall
#endif
foreign import WINAPI unsafe "windows.h GetShortPathNameW"
c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> Prelude.IO DWORD
getShortPathName :: FilePath -> IO FilePath
getShortPathName path =
Win32.withTString path $ \c_path -> do
c_len <- Win32.failIfZero "GetShortPathName #1 failed!" $
c_GetShortPathName c_path Win32.nullPtr 0
let arr_len = fromIntegral c_len
allocaArray arr_len $ \c_out -> do
void $ Win32.failIfZero "GetShortPathName #2 failed!" $
c_GetShortPathName c_path c_out c_len
Win32.peekTString c_out
#else
getShortPathName :: FilePath -> IO FilePath
getShortPathName :: FilePath -> IO FilePath
getShortPathName FilePath
path = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
#endif