{-# 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 Distribution.Compat.Prelude
import 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)

{- FOURMOLU_DISABLE -}
#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 -> IO FilePath
getShortPathName :: FilePath -> IO FilePath
getShortPathName FilePath
path =
  FilePath -> (LPTSTR -> IO FilePath) -> IO FilePath
forall a. FilePath -> (LPTSTR -> IO a) -> IO a
Win32.withTString FilePath
path ((LPTSTR -> IO FilePath) -> IO FilePath)
-> (LPTSTR -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \LPTSTR
c_path -> do
    DWORD
c_len <- FilePath -> IO DWORD -> IO DWORD
forall a. (Eq a, Num a) => FilePath -> IO a -> IO a
Win32.failIfZero FilePath
"GetShortPathName #1 failed!" (IO DWORD -> IO DWORD) -> IO DWORD -> IO DWORD
forall a b. (a -> b) -> a -> b
$
      LPTSTR -> LPTSTR -> DWORD -> IO DWORD
c_GetShortPathName LPTSTR
c_path LPTSTR
forall a. Ptr a
Win32.nullPtr DWORD
0
    let arr_len :: Int
arr_len = DWORD -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DWORD
c_len
    Int -> (LPTSTR -> IO FilePath) -> IO FilePath
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
arr_len ((LPTSTR -> IO FilePath) -> IO FilePath)
-> (LPTSTR -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \LPTSTR
c_out -> do
      IO DWORD -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO DWORD -> IO ()) -> IO DWORD -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO DWORD -> IO DWORD
forall a. (Eq a, Num a) => FilePath -> IO a -> IO a
Win32.failIfZero FilePath
"GetShortPathName #2 failed!" (IO DWORD -> IO DWORD) -> IO DWORD -> IO DWORD
forall a b. (a -> b) -> a -> b
$
        LPTSTR -> LPTSTR -> DWORD -> IO DWORD
c_GetShortPathName LPTSTR
c_path LPTSTR
c_out DWORD
c_len
      LPTSTR -> IO FilePath
Win32.peekTString LPTSTR
c_out

#else

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

#endif
{- FOURMOLU_ENABLE -}