GetShortPathName.hs 1.68 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2
3
4
5
6
7
8
9
10
11
12
13
14

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

module Distribution.Compat.GetShortPathName ( getShortPathName )
    where

15
16
17
import Prelude ()
import Distribution.Compat.Prelude

18
19
#ifdef mingw32_HOST_OS

20
import qualified Prelude
21
22
23
24
25
26
27
28
29
30
31
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"
32
  c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> Prelude.IO DWORD
33
34
35

-- | On Windows, retrieves the short path form of the specified path. On
-- non-Windows, does nothing. See https://github.com/haskell/cabal/issues/3185.
36
37
38
39
40
41
42
--
-- From MS's GetShortPathName docs:
--
--      Passing NULL for [the second] parameter and zero for cchBuffer
--      will always return the required buffer size for a
--      specified lpszLongPath.
--
43
getShortPathName :: FilePath -> NoCallStackIO FilePath
44
getShortPathName path =
45
46
47
48
  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
49
    allocaArray arr_len $ \c_out -> do
50
      void $ Win32.failIfZero "GetShortPathName #2 failed!" $
51
52
53
54
55
        c_GetShortPathName c_path c_out c_len
      Win32.peekTString c_out

#else

56
getShortPathName :: FilePath -> NoCallStackIO FilePath
57
58
59
getShortPathName path = return path

#endif