System\Win32\Exception\Unsupported.hs

    {-# 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 (MissingLibrary  name reason)
        = "Can't load library \"" ++ name ++ "\". "  ++ reason
      show (MissingFunction name reason)
        = "Can't find \"" ++ name ++ "\" function. " ++ reason
      show (MissingValue    name reason)
        = "Can't use \""  ++ name ++ "\" value. "    ++ reason

    instance Exception Unsupported

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

    missingWin32Function, missingWin32Value :: String -> String -> Unsupported
    missingWin32Function name reason = MissingFunction name $ doesn'tSupport ++ '\n':reason
    missingWin32Value    name reason = MissingValue    name $ doesn'tSupport ++ '\n':reason

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

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

    unsupportedIfNull :: Unsupported -> IO (Ptr a) -> IO (Ptr a)
    unsupportedIfNull wh act = do
      v <- act
      if v /= nullPtr then return v else throwIO wh

    unsupportedVal :: String -> IO Bool -> String -> a -> a
    unsupportedVal name checkVer reason val = unsafeLocalState $ do
      cv <- checkVer
      if cv then return val else throwIO $ MissingValue name reason