Distribution/Compat/GetShortPathName.hs

    {-# LANGUAGE CPP #-}

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

    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

    -- | On Windows, retrieves the short path form of the specified path. On
    -- non-Windows, does nothing. See https://github.com/haskell/cabal/issues/3185.
    --
    -- 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.
    --
    getShortPathName :: FilePath -> NoCallStackIO 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 -> NoCallStackIO FilePath
    getShortPathName path = return path

    #endif