1{-# LANGUAGE DeriveDataTypeable #-} 2{- | 3 Module : System.Win32.Exception.Unsupported 4 Copyright : 2012 shelarcy 5 License : BSD-style 6 7 Maintainer : shelarcy@gmail.com 8 Stability : Provisional 9 Portability : Non-portable (Win32 API) 10 11 Exception handling if using unsupported Win32 API. 12-} 13 14module System.Win32.Exception.Unsupported 15 ( module System.Win32.Exception.Unsupported 16 ) where 17 18import Control.Exception ( Exception(..), throwIO ) 19import Data.Typeable ( Typeable ) 20import Foreign.Ptr ( Ptr, nullPtr ) 21import Foreign.Marshal.Unsafe ( unsafeLocalState ) 22 23---------------------------------------------------------------- 24-- Exception type of Unsupported 25---------------------------------------------------------------- 26data Unsupported = MissingLibrary FilePath String 27 | MissingFunction String String 28 | MissingValue String String 29 deriving Typeable 30 31instance Show Unsupported where 32 show (MissingLibrary name reason) 33 = "Can't load library \"" ++ name ++ "\". " ++ reason 34 show (MissingFunction name reason) 35 = "Can't find \"" ++ name ++ "\" function. " ++ reason 36 show (MissingValue name reason) 37 = "Can't use \"" ++ name ++ "\" value. " ++ reason 38 39instance Exception Unsupported 40 41missingLibrary :: FilePath -> Unsupported 42missingFunction, missingValue :: String -> Unsupported 43missingLibrary name = MissingLibrary name "" 44missingFunction name = MissingFunction name "" 45missingValue name = MissingValue name "" 46 47missingWin32Function, missingWin32Value :: String -> String -> Unsupported 48missingWin32Function name reason = MissingFunction name $ doesn'tSupport ++ '\n':reason 49missingWin32Value name reason = MissingValue name $ doesn'tSupport ++ '\n':reason 50 51doesn'tSupport, upgradeVista, removed :: String 52doesn'tSupport = "Because it's not supported on this OS." 53upgradeVista = upgradeWindowsOS "Windows Vista" 54removed = "It's removed. " 55 56upgradeWindowsOS :: String -> String 57upgradeWindowsOS ver 58 = "If you want to use it, please upgrade your OS to " 59 ++ ver ++ " or higher." 60 61unsupportedIfNull :: Unsupported -> IO (Ptr a) -> IO (Ptr a) 62unsupportedIfNull wh act = do 63 v <- act 64 if v /= nullPtr then return v else throwIO wh 65 66unsupportedVal :: String -> IO Bool -> String -> a -> a 67unsupportedVal name checkVer reason val = unsafeLocalState $ do 68 cv <- checkVer 69 if cv then return val else throwIO $ MissingValue name reason 70 71