{- |
   Module      :  System.Win32.Utils
   Copyright   :  2009 Balazs Komuves, 2013 shelarcy
   License     :  BSD-style

   Maintainer  :  shelarcy@gmail.com
   Stability   :  Provisional
   Portability :  Non-portable (Win32 API)

   Utilities for calling Win32 API
-}
module System.Win32.WindowsString.Utils
  ( module System.Win32.WindowsString.Utils
  , module System.Win32.Utils
  ) where

import Foreign.C.Types             ( CInt )
import Foreign.Marshal.Array       ( allocaArray )
import Foreign.Ptr                 ( nullPtr )

import System.Win32.Utils hiding
  ( try
  , tryWithoutNull
  , trySized
  )
import System.Win32.WindowsString.String         ( LPTSTR, peekTString, peekTStringLen
                                   , withTStringBufferLen )
import System.Win32.WindowsString.Types          ( UINT
                                   , failIfZero
                                  )
import qualified System.Win32.WindowsString.Types ( try )
import System.OsString.Windows


-- | 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 extend the buffer size and try again.

try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
try = String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
System.Win32.WindowsString.Types.try
{-# INLINE try #-}

tryWithoutNull :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
tryWithoutNull :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
tryWithoutNull String
loc LPTSTR -> UINT -> IO UINT
f UINT
n = do
   e <- Int
-> (LPTSTR -> IO (Either UINT WindowsString))
-> IO (Either UINT WindowsString)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (UINT -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UINT
n) ((LPTSTR -> IO (Either UINT WindowsString))
 -> IO (Either UINT WindowsString))
-> (LPTSTR -> IO (Either UINT WindowsString))
-> IO (Either UINT WindowsString)
forall a b. (a -> b) -> a -> b
$ \LPTSTR
lptstr -> do
          r <- String -> IO UINT -> IO UINT
forall a. (Eq a, Num a) => String -> IO a -> IO a
failIfZero String
loc (IO UINT -> IO UINT) -> IO UINT -> IO UINT
forall a b. (a -> b) -> a -> b
$ LPTSTR -> UINT -> IO UINT
f LPTSTR
lptstr UINT
n
          if r > n then return (Left r) else do
            str <- peekTString lptstr
            return (Right str)
   case e of
        Left UINT
r'   -> String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
tryWithoutNull String
loc LPTSTR -> UINT -> IO UINT
f UINT
r'
        Right WindowsString
str -> WindowsString -> IO WindowsString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WindowsString
str

-- | Support for API calls that return the required size, in characters

-- including a null character, of the buffer when passed a buffer size of zero.

trySized :: String -> (LPTSTR -> CInt -> IO CInt) -> IO WindowsString
trySized :: String -> (LPTSTR -> CInt -> IO CInt) -> IO WindowsString
trySized String
wh LPTSTR -> CInt -> IO CInt
f = do
    c_len <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
failIfZero String
wh (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ LPTSTR -> CInt -> IO CInt
f LPTSTR
forall a. Ptr a
nullPtr CInt
0
    let len = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_len
    withTStringBufferLen len $ \(LPTSTR
buf', Int
len') -> do
        let c_len' :: CInt
c_len' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len'
        c_len'' <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
failIfZero String
wh (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ LPTSTR -> CInt -> IO CInt
f LPTSTR
buf' CInt
c_len'
        let len'' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_len''
        peekTStringLen (buf', len'' - 1) -- Drop final null character