GetShortPathName.hs

{-# LANGUAGE CPP, ForeignFunctionInterface #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Compat.GetShortPathName
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  Windows-only
--
-- Win32 API 'GetShortPathName' function.

module Distribution.Compat.GetShortPathName ( getShortPathName )
    where

#ifdef mingw32_HOST_OS
import Control.Monad         (void)

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 -> IO DWORD

-- | On Windows, retrieves the short path form of the specified path. On
-- non-Windows, does nothing. See https://github.com/haskell/cabal/issues/3185.
getShortPathName :: FilePath -> IO FilePath
getShortPathName path =
  Win32.withTString path $ \c_path ->
    allocaArray arr_len $ \c_out -> do
      void $ Win32.failIfZero "GetShortPathName failed!" $
        c_GetShortPathName c_path c_out c_len
      Win32.peekTString c_out
  where
    arr_len = length path + 1
    c_len   = fromIntegral arr_len

#else

getShortPathName :: FilePath -> IO FilePath
getShortPathName path = return path

#endif