{-# LANGUAGE DeriveDataTypeable #-}
{- |
   Module      :  System.Win32.Exception.Unsupported
   Copyright   :  2012 shelarcy
   License     :  BSD-style

   Maintainer  :  shelarcy@gmail.com
   Stability   :  Provisional
   Portability :  Non-portable (Win32 API)

   Exception handling if using unsupported Win32 API.
-}

module System.Win32.Exception.Unsupported
  ( module System.Win32.Exception.Unsupported
  ) where

import Control.Exception      ( Exception(..), throwIO )
import Data.Typeable          ( Typeable )
import Foreign.Ptr            ( Ptr, nullPtr )
import Foreign.Marshal.Unsafe ( unsafeLocalState )

----------------------------------------------------------------

-- Exception type of Unsupported

----------------------------------------------------------------

data Unsupported = MissingLibrary  FilePath String
                 | MissingFunction String   String
                 | MissingValue    String   String
                 deriving Typeable

instance Show Unsupported where
  show :: Unsupported -> String
show (MissingLibrary  String
name String
reason)
    = String
"Can't load library \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\". "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
reason
  show (MissingFunction String
name String
reason)
    = String
"Can't find \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" function. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
reason
  show (MissingValue    String
name String
reason)
    = String
"Can't use \""  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" value. "    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
reason

instance Exception Unsupported

missingLibrary                          :: FilePath -> Unsupported
missingFunction,      missingValue      :: String -> Unsupported
missingLibrary :: String -> Unsupported
missingLibrary  String
name = String -> String -> Unsupported
MissingLibrary  String
name String
""
missingFunction :: String -> Unsupported
missingFunction String
name = String -> String -> Unsupported
MissingFunction String
name String
""
missingValue :: String -> Unsupported
missingValue    String
name = String -> String -> Unsupported
MissingValue    String
name String
""

missingWin32Function, missingWin32Value :: String -> String -> Unsupported
missingWin32Function :: String -> String -> Unsupported
missingWin32Function String
name String
reason = String -> String -> Unsupported
MissingFunction String
name (String -> Unsupported) -> String -> Unsupported
forall a b. (a -> b) -> a -> b
$ String
doesn'tSupport String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:String
reason
missingWin32Value :: String -> String -> Unsupported
missingWin32Value    String
name String
reason = String -> String -> Unsupported
MissingValue    String
name (String -> Unsupported) -> String -> Unsupported
forall a b. (a -> b) -> a -> b
$ String
doesn'tSupport String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:String
reason

doesn'tSupport, upgradeVista, removed :: String
doesn'tSupport :: String
doesn'tSupport = String
"Because it's not supported on this OS."
upgradeVista :: String
upgradeVista   = ShowS
upgradeWindowsOS String
"Windows Vista"
removed :: String
removed = String
"It's removed. "

upgradeWindowsOS :: String -> String
upgradeWindowsOS :: ShowS
upgradeWindowsOS String
ver
  =  String
"If you want to use it, please upgrade your OS to "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ver String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or higher."

unsupportedIfNull :: Unsupported -> IO (Ptr a) -> IO (Ptr a)
unsupportedIfNull :: forall a. Unsupported -> IO (Ptr a) -> IO (Ptr a)
unsupportedIfNull Unsupported
wh IO (Ptr a)
act = do
  Ptr a
v <- IO (Ptr a)
act
  if Ptr a
v Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr a
forall a. Ptr a
nullPtr then Ptr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
v else Unsupported -> IO (Ptr a)
forall e a. Exception e => e -> IO a
throwIO Unsupported
wh

unsupportedVal :: String -> IO Bool -> String -> a -> a
unsupportedVal :: forall a. String -> IO Bool -> String -> a -> a
unsupportedVal String
name IO Bool
checkVer String
reason a
val = IO a -> a
forall a. IO a -> a
unsafeLocalState (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
  Bool
cv <- IO Bool
checkVer
  if Bool
cv then a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val else Unsupported -> IO a
forall e a. Exception e => e -> IO a
throwIO (Unsupported -> IO a) -> Unsupported -> IO a
forall a b. (a -> b) -> a -> b
$ String -> String -> Unsupported
MissingValue String
name String
reason