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
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
Either UINT WindowsString
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
UINT
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 UINT
r UINT -> UINT -> Bool
forall a. Ord a => a -> a -> Bool
> UINT
n then Either UINT WindowsString -> IO (Either UINT WindowsString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UINT -> Either UINT WindowsString
forall a b. a -> Either a b
Left UINT
r) else do
WindowsString
str <- LPTSTR -> IO WindowsString
peekTString LPTSTR
lptstr
Either UINT WindowsString -> IO (Either UINT WindowsString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowsString -> Either UINT WindowsString
forall a b. b -> Either a b
Right WindowsString
str)
case Either UINT WindowsString
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
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
CInt
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 :: Int
len = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_len
Int -> ((LPTSTR, Int) -> IO WindowsString) -> IO WindowsString
forall a. Int -> ((LPTSTR, Int) -> IO a) -> IO a
withTStringBufferLen Int
len (((LPTSTR, Int) -> IO WindowsString) -> IO WindowsString)
-> ((LPTSTR, Int) -> IO WindowsString) -> IO WindowsString
forall a b. (a -> b) -> a -> b
$ \(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'
CInt
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'' :: Int
len'' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_len''
(LPTSTR, Int) -> IO WindowsString
peekTStringLen (LPTSTR
buf', Int
len'' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)