{-# 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