[commit: packages/Win32] Mistuke-fix-build, depend-os-windows, fix-appveyor-curl-ussue, master, win32-2.5.4.1-ghc-8.2, win32-prepare-release-2.4.0.0: Paths: Added new module and functions (#54) (b4c6102)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/Win32

On branches: Mistuke-fix-build,depend-os-windows,fix-appveyor-curl-ussue,master,win32-2.5.4.1-ghc-8.2,win32-prepare-release-2.4.0.0
Link       : http://git.haskell.org/packages/Win32.git/commitdiff/b4c6102c8c6f2bec3c0c35c6fff88b3027eef87c

>---------------------------------------------------------------

commit b4c6102c8c6f2bec3c0c35c6fff88b3027eef87c
Author: Tamar Christina <Mistuke at users.noreply.github.com>
Date:   Mon Oct 24 22:32:07 2016 +0100

    Paths: Added new module and functions (#54)
    
    * Paths: Added new module and functions
    
    * Path: Add new module to cabal and c dependecies updated
    
    * Path: remove trailing whitespace


>---------------------------------------------------------------

b4c6102c8c6f2bec3c0c35c6fff88b3027eef87c
 System/Win32/Info.hsc | 16 +--------------
 System/Win32/Path.hsc | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++
 System/Win32/Types.hs | 15 ++++++++++++++
 Win32.cabal           |  3 ++-
 changelog.md          |  2 ++
 5 files changed, 77 insertions(+), 16 deletions(-)

diff --git a/System/Win32/Info.hsc b/System/Win32/Info.hsc
index f9df863..58051d5 100644
--- a/System/Win32/Info.hsc
+++ b/System/Win32/Info.hsc
@@ -27,7 +27,7 @@ import Foreign.Ptr (Ptr, nullPtr)
 import Foreign.Storable (Storable(..))
 import System.IO.Error (isDoesNotExistError)
 import System.Win32.Types (DWORD, LPDWORD, LPCTSTR, LPTSTR, LPVOID, UINT, WORD)
-import System.Win32.Types (failIfZero, failIfFalse_, peekTStringLen, withTString)
+import System.Win32.Types (failIfFalse_, peekTStringLen, withTString, try)
 
 #if !MIN_VERSION_base(4,6,0)
 import Prelude hiding (catch)
@@ -144,20 +144,6 @@ searchPath path filename ext =
                        then return Nothing
                        else ioError e
 
--- Support for API calls that are passed a fixed-size buffer and tell
--- you via the return value if the buffer was too small.  In that
--- case, we double the buffer size and try again.
-try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
-try loc f n = do
-   e <- allocaArray (fromIntegral n) $ \lptstr -> do
-          r <- failIfZero loc $ f lptstr n
-          if (r > n) then return (Left r) else do
-            str <- peekTStringLen (lptstr, fromIntegral r)
-            return (Right str)
-   case e of
-        Left n    -> try loc f n
-        Right str -> return str
-
 foreign import WINDOWS_CCONV unsafe "GetWindowsDirectoryW"
   c_getWindowsDirectory :: LPTSTR -> UINT -> IO UINT
 
diff --git a/System/Win32/Path.hsc b/System/Win32/Path.hsc
new file mode 100644
index 0000000..4be9f42
--- /dev/null
+++ b/System/Win32/Path.hsc
@@ -0,0 +1,57 @@
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.Path
+-- Copyright   :  (c) Tamar Christina, 1997-2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  Tamar Christina <tamar at zhox.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for interfacing with Win32.
+--
+-----------------------------------------------------------------------------
+
+module System.Win32.Path (
+   filepathRelativePathTo
+ , pathRelativePathTo
+ ) where
+
+import System.Win32.Types
+import System.Win32.File
+
+import Foreign
+
+##include "windows_cconv.h"
+
+#include <windows.h>
+
+filepathRelativePathTo :: FilePath -> FilePath -> IO FilePath
+filepathRelativePathTo from to =
+  withTString from $ \p_from ->
+  withTString to   $ \p_to   ->
+  allocaArray ((#const MAX_PATH) * (#size TCHAR)) $ \p_AbsPath -> do
+    _ <- failIfZero "PathRelativePathTo" (c_pathRelativePathTo p_AbsPath p_from fILE_ATTRIBUTE_DIRECTORY
+                                                                         p_to   fILE_ATTRIBUTE_NORMAL)
+    path <- peekTString p_AbsPath
+    _ <- localFree p_AbsPath
+    return path
+
+pathRelativePathTo :: FilePath -> FileAttributeOrFlag -> FilePath -> FileAttributeOrFlag -> IO FilePath
+pathRelativePathTo from from_attr to to_attr =
+  withTString from $ \p_from ->
+  withTString to   $ \p_to   ->
+  allocaArray ((#const MAX_PATH) * (#size TCHAR)) $ \p_AbsPath -> do
+    _ <- failIfZero "PathRelativePathTo" (c_pathRelativePathTo p_AbsPath p_from from_attr
+                                                                         p_to   to_attr)
+    path <- peekTString p_AbsPath
+    _ <- localFree p_AbsPath
+    return path
+
+foreign import WINDOWS_CCONV unsafe "Shlwapi.h PathRelativePathToW" 
+         c_pathRelativePathTo :: LPTSTR -> LPCTSTR -> DWORD -> LPCTSTR -> DWORD -> IO UINT
diff --git a/System/Win32/Types.hs b/System/Win32/Types.hs
index 094a594..7b53370 100755
--- a/System/Win32/Types.hs
+++ b/System/Win32/Types.hs
@@ -32,6 +32,7 @@ import Foreign.C.String (peekCWString, peekCWStringLen, withCWString)
 import Foreign.C.Types (CChar, CUChar, CWchar)
 import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, newForeignPtr_)
 import Foreign.Ptr (FunPtr, Ptr, nullPtr)
+import Foreign (allocaArray)
 import Numeric (showHex)
 import System.IO.Error (ioeSetErrorString)
 import System.IO.Unsafe (unsafePerformIO)
@@ -264,6 +265,20 @@ ddwordToDwords n =
 dwordsToDdword:: (DWORD,DWORD) -> DDWORD
 dwordsToDdword (hi,low) = (fromIntegral low) .|. (fromIntegral hi `shiftL` finiteBitSize hi)
 
+-- Support for API calls that are passed a fixed-size buffer and tell
+-- you via the return value if the buffer was too small.  In that
+-- case, we double the buffer size and try again.
+try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
+try loc f n = do
+   e <- allocaArray (fromIntegral n) $ \lptstr -> do
+          r <- failIfZero loc $ f lptstr n
+          if (r > n) then return (Left r) else do
+            str <- peekTStringLen (lptstr, fromIntegral r)
+            return (Right str)
+   case e of
+        Left n    -> try loc f n
+        Right str -> return str
+  
 ----------------------------------------------------------------
 -- Primitives
 ----------------------------------------------------------------
diff --git a/Win32.cabal b/Win32.cabal
index 6e8a4c8..dc5fc4c 100644
--- a/Win32.cabal
+++ b/Win32.cabal
@@ -49,6 +49,7 @@ Library
         System.Win32.File
         System.Win32.FileMapping
         System.Win32.Info
+        System.Win32.Path
         System.Win32.Mem
         System.Win32.NLS
         System.Win32.Process
@@ -63,7 +64,7 @@ Library
     if impl(ghc >= 7.1)
         extensions: NondecreasingIndentation
     extra-libraries:
-        "user32", "gdi32", "winmm", "advapi32", "shell32", "shfolder"
+        "user32", "gdi32", "winmm", "advapi32", "shell32", "shfolder", "shlwapi"
     include-dirs: 	include
     includes:	"HsWin32.h", "HsGDI.h", "WndProc.h"
     install-includes:	"HsWin32.h", "HsGDI.h", "WndProc.h", "windows_cconv.h"
diff --git a/changelog.md b/changelog.md
index a7eacd8..303dee5 100644
--- a/changelog.md
+++ b/changelog.md
@@ -16,3 +16,5 @@
 * Added file attribute `fILE_ATTRIBUTE_REPARSE_POINT`
 * Added more [`File Access Rights` constants](https://msdn.microsoft.com/en-us/library/windows/desktop/gg258116%28v=vs.85%29.aspx)
 * Added function `getCurrentProcessId`
+* Added function `filepathRelativePathTo`
+* Added function `pathRelativePathTo`