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 )

----------------------------------------------------------------
-- 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 find \"" ++ name ++ "\" value. "    ++ reason

instance Exception Unsupported

missingLibrary,  missingValue, missingWin32Value :: String -> Unsupported
missingFunction, missingWin32Function            :: FilePath -> Unsupported
missingLibrary  name = MissingLibrary  name ""
missingFunction name = MissingFunction name ""
missingValue    name = MissingValue    name ""
missingWin32Function name = MissingFunction name $ doesn'tSupport ++ '\n':upgradeVista
missingWin32Value    name = MissingValue    name $ doesn'tSupport ++ '\n':upgradeVista

doesn'tSupport, upgradeVista, removed :: String
doesn'tSupport = "Because it's not supported on this OS."
upgradeVista   = "If you want to use this function, please upgrade your OS to Windows Vista or higher."
removed = "This function is removed. "

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