    {-# 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
      v <- IO (Ptr a)
    act
      if v /= nullPtr then return v else throwIO 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
      cv <- IO Bool
    checkVer
      if cv then return val else throwIO $ MissingValue name reason