Cabal/src/Distribution/Compat/GetShortPathName.hs

   1 {-# LANGUAGE CPP #-}
   2
   3 -----------------------------------------------------------------------------
   4
   5 -- |
   6 -- Module      :  Distribution.Compat.GetShortPathName
   7 --
   8 -- Maintainer  :  cabal-devel@haskell.org
   9 -- Portability :  Windows-only
  10 --
  11 -- Win32 API 'GetShortPathName' function.
  12 module Distribution.Compat.GetShortPathName (getShortPathName)
  13 where
  14
  15 import Distribution.Compat.Prelude
  16 import Prelude ()
  17
  18 #ifdef mingw32_HOST_OS
  19
  20 import qualified Prelude
  21 import qualified System.Win32 as Win32
  22 import System.Win32          (LPCTSTR, LPTSTR, DWORD)
  23 import Foreign.Marshal.Array (allocaArray)
  24
  25 {- FOURMOLU_DISABLE -}
  26 #ifdef x86_64_HOST_ARCH
  27 #define WINAPI ccall
  28 #else
  29 #define WINAPI stdcall
  30 #endif
  31
  32 foreign import WINAPI unsafe "windows.h GetShortPathNameW"
  33   c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> Prelude.IO DWORD
  34
  35 -- | On Windows, retrieves the short path form of the specified path. On
  36 -- non-Windows, does nothing. See https://github.com/haskell/cabal/issues/3185.
  37 --
  38 -- From MS's GetShortPathName docs:
  39 --
  40 --      Passing NULL for [the second] parameter and zero for cchBuffer
  41 --      will always return the required buffer size for a
  42 --      specified lpszLongPath.
  43 --
  44 getShortPathName :: FilePath -> IO FilePath
  45 getShortPathName path =
  46   Win32.withTString path $ \c_path -> do
  47     c_len <- Win32.failIfZero "GetShortPathName #1 failed!" $
  48       c_GetShortPathName c_path Win32.nullPtr 0
  49     let arr_len = fromIntegral c_len
  50     allocaArray arr_len $ \c_out -> do
  51       void $ Win32.failIfZero "GetShortPathName #2 failed!" $
  52         c_GetShortPathName c_path c_out c_len
  53       Win32.peekTString c_out
  54
  55 #else
  56
  57 getShortPathName :: FilePath -> IO FilePath
  58 getShortPathName path = return path
  59
  60 #endif
  61 {- FOURMOLU_ENABLE -}