System\Win32\Utils.hs

    {- |
       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.Utils
      ( try, tryWithoutNull, try'
      -- * Maybe values
      , maybePtr, ptrToMaybe, maybeNum, numToMaybe
      , peekMaybe, withMaybe
      ) where
    import Control.Monad               ( unless )
    import Foreign.Marshal.Array       ( allocaArray, peekArray )
    import Foreign.Marshal.Utils       ( with )
    import Foreign.Ptr                 ( Ptr, nullPtr )
    import Foreign.Storable            ( Storable(..) )
    import System.Win32.Types          ( failIfZero
                                       , failWith, getLastError, eRROR_INSUFFICIENT_BUFFER )
    import qualified System.Win32.Types ( try )
    import System.Win32.String         ( LPTSTR, peekTString )
    import System.Win32.Types          ( BOOL, UINT, maybePtr, ptrToMaybe, maybeNum, numToMaybe )
    import System.Win32.Word           ( DWORD, PDWORD )

    -- | 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 String
    try = System.Win32.Types.try
    {-# INLINE try #-}

    tryWithoutNull :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
    tryWithoutNull 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 <- peekTString lptstr
                return (Right str)
       case e of
            Left r'   -> tryWithoutNull loc f r'
            Right str -> return str

    try' :: Storable a => String -> (Ptr a -> PDWORD -> IO BOOL) -> DWORD -> IO [a]
    try' loc f n =
       with n $ \n' -> do
       e <- allocaArray (fromIntegral n) $ \lptstr -> do
              flg <- f lptstr n'
              unless flg $ do
                err_code <- getLastError
                unless (err_code == eRROR_INSUFFICIENT_BUFFER)
                  $ failWith loc err_code
              r   <- peek n'
              if (r > n) then return (Left r) else do
                str <- peekArray (fromIntegral r) lptstr
                return (Right str)
       case e of
            Left r'   -> try' loc f r'
            Right str -> return str

    -- | See also: 'Foreign.Marshal.Utils.maybePeek' function.
    peekMaybe :: Storable a => Ptr a -> IO (Maybe a)
    peekMaybe p =
      if p == nullPtr
        then return Nothing
        else Just `fmap` peek p

    -- | See also: 'Foreign.Marshal.Utils.maybeWith' function.
    withMaybe :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
    withMaybe Nothing  action = action nullPtr
    withMaybe (Just x) action = with x action