{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}

module System.Win32.Error.Types where

import Control.Exception
import Data.Text
import Data.Typeable
import Foreign
import System.Win32.Types (DWORD)

import System.Win32.Error.TH

-- |Win32 actions typically return an error code to indicate success or failure.
-- These codes are intended to be globally unique, though there may be some overlap.
-- MSDN documents which errors may be returned by any given action.
--
-- The naming of errors follows a convention. An error such as ERROR_SUCCESS
-- becomes `Success`, ERROR_FILE_NOT_FOUND becomes `FileNotFound`, and so
-- on. There are thousands of errors, so it would be impractical to add them
-- all. The `Other` constructor is used to represent error codes which are not
-- handled specifically.
--
-- User's of this library are encouraged to submit new error codes. Add new entries to
-- System.Win32.Errors.Mapping. Send your pull requests along with a link to relevent
-- documentation to
-- <https://github.com/mikesteele81/Win32-errors.git https://github.com/mikesteele81/Win32-errors.git>.
Int -> ErrCode -> ShowS
[ErrCode] -> ShowS
ErrCode -> String
ErrCode -> ErrCode -> Bool
(Int -> ErrCode -> ShowS)
-> (ErrCode -> String) -> ([ErrCode] -> ShowS) -> Show ErrCode
(ErrCode -> ErrCode -> Bool)
-> (ErrCode -> ErrCode -> Bool) -> Eq ErrCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrCode] -> ShowS
$cshowList :: [ErrCode] -> ShowS
show :: ErrCode -> String
$cshow :: ErrCode -> String
showsPrec :: Int -> ErrCode -> ShowS
$cshowsPrec :: Int -> ErrCode -> ShowS
/= :: ErrCode -> ErrCode -> Bool
$c/= :: ErrCode -> ErrCode -> Bool
== :: ErrCode -> ErrCode -> Bool
$c== :: ErrCode -> ErrCode -> Bool
genErrCode

-- |Convert an `ErrCode` into a `DWORD`.
ErrCode -> DWORD
gentoDWORD

-- |Convert a `DWORD` into an `ErrCode`. Values which don't have a
-- corresponding constructor will end up becoming an `Other`.
DWORD -> ErrCode
genfromDWORD

-- |Performs marshalling by converting to and from `DWORD`.
instance Storable ErrCode where
  sizeOf :: ErrCode -> Int
sizeOf _ = DWORD -> Int
forall a. Storable a => a -> Int
sizeOf (DWORD
forall a. HasCallStack => a
undefined :: DWORD)
  alignment :: ErrCode -> Int
alignment _ = DWORD -> Int
forall a. Storable a => a -> Int
alignment (DWORD
forall a. HasCallStack => a
undefined :: DWORD)
  peek :: Ptr ErrCode -> IO ErrCode
peek ptr :: Ptr ErrCode
ptr = (Ptr DWORD -> IO DWORD
forall a. Storable a => Ptr a -> IO a
peek (Ptr DWORD -> IO DWORD)
-> (Ptr ErrCode -> Ptr DWORD) -> Ptr ErrCode -> IO DWORD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ErrCode -> Ptr DWORD
forall a b. Ptr a -> Ptr b
castPtr) Ptr ErrCode
ptr IO DWORD -> (DWORD -> IO ErrCode) -> IO ErrCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrCode -> IO ErrCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrCode -> IO ErrCode)
-> (DWORD -> ErrCode) -> DWORD -> IO ErrCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DWORD -> ErrCode
fromDWORD
  poke :: Ptr ErrCode -> ErrCode -> IO ()
poke ptr :: Ptr ErrCode
ptr ec :: ErrCode
ec = Ptr DWORD -> DWORD -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ErrCode -> Ptr DWORD
forall a b. Ptr a -> Ptr b
castPtr Ptr ErrCode
ptr) (ErrCode -> DWORD
toDWORD ErrCode
ec)

-- |Exception type for Win32 errors.
--
-- This type will be thrown as an extensible exception when a foreign call out
-- to part of the Win32 indicates that an error has occurred. In most cases you
-- should wrap an IO computation in a call to `tryWin32`.
--
-- The following example uses the custom 'createFile' function described in
-- "System.Win32.Error.Foreign":
--
-- > eHandle <- do
-- >     h <- E.tryWin32 $ createFile "c:\\missing.txt" gENERIC_READ oPEN_EXISTING
-- >     -- perform other actions
-- >     return h
-- > case eHandle of
-- >   Right handle -> do
-- >     -- do something with the file handle
-- >   Left w32Err -> do
-- >     case E.errCode w32Err of
-- >       E.InvalidHandle -> do
-- >         -- perform cleanup
-- >       -- handle other error codes.
-- >     T.putStrLn $ E.systemMessage w32Err
data Win32Exception = Win32Exception
    { Win32Exception -> Text
function :: Text
    -- ^ The foreign action which triggered this exception.
    , Win32Exception -> ErrCode
errCode  :: ErrCode
    -- ^ The error code
    , Win32Exception -> Text
systemMessage :: Text
    -- ^ The standard system message associated with the error code.
    } deriving (Typeable, Int -> Win32Exception -> ShowS
[Win32Exception] -> ShowS
Win32Exception -> String
(Int -> Win32Exception -> ShowS)
-> (Win32Exception -> String)
-> ([Win32Exception] -> ShowS)
-> Show Win32Exception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Win32Exception] -> ShowS
$cshowList :: [Win32Exception] -> ShowS
show :: Win32Exception -> String
$cshow :: Win32Exception -> String
showsPrec :: Int -> Win32Exception -> ShowS
$cshowsPrec :: Int -> Win32Exception -> ShowS
Show)

instance Exception Win32Exception

-- |Actions calling out to Win32 may throw exceptions. Wrapping the action in
-- `tryWin32` will catch `Win32Exception` exceptions, but will allow any other
-- exception type to pass through.
tryWin32 :: IO a -> IO (Either Win32Exception a)
tryWin32 :: IO a -> IO (Either Win32Exception a)
tryWin32 = IO a -> IO (Either Win32Exception a)
forall e a. Exception e => IO a -> IO (Either e a)
try