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