{-# LINE 1 "System\\Win32\\Semaphore.hsc" #-}

{-# LINE 2 "System\\Win32\\Semaphore.hsc" #-}
{-# LANGUAGE Safe #-}

{-# LINE 6 "System\\Win32\\Semaphore.hsc" #-}

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

-- |

-- Module      :  System.Win32.Semaphore

-- Copyright   :  (c) Sam Derbyshire, 2022

-- License     :  BSD-style (see the file libraries/base/LICENSE)

--

-- Maintainer  :  Sam Derbyshire

-- Stability   :  provisional

-- Portability :  portable

--

-- Windows Semaphore objects and operations

--

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


module System.Win32.Semaphore
    ( -- * Semaphores

      Semaphore(..)

      -- * Access modes

    , AccessMode
    , sEMAPHORE_ALL_ACCESS
    , sEMAPHORE_MODIFY_STATE

      -- * Managing semaphores

    , createSemaphore
    , openSemaphore
    , releaseSemaphore
    ) where

import System.Win32.File
import System.Win32.Types

import Data.Maybe (fromMaybe)
import Foreign hiding (void)
import Foreign.C (withCAString)

#include "windows_cconv.h"



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

-- Semaphore access modes

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


sEMAPHORE_ALL_ACCESS    :: AccessMode
sEMAPHORE_ALL_ACCESS    =  2031619
sEMAPHORE_MODIFY_STATE  :: AccessMode
sEMAPHORE_MODIFY_STATE  =  2

{-# LINE 55 "System\\Win32\\Semaphore.hsc" #-}

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

-- Semaphores

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


-- | A Windows semaphore.

--

-- To obtain a 'Semaphore', use 'createSemaphore' to create a new one,

-- or 'openSemaphore' to open an existing one.

--

-- To wait on a semaphore, use 'System.Win32.Event.waitForSingleObject'.

--

-- To release resources on a semaphore, use 'releaseSemaphore'.

--

-- To free a semaphore, use 'System.Win32.File.closeHandle'.

-- The semaphore object is destroyed when its last handle has been closed.

-- Closing the handle does not affect the semaphore count; therefore, be sure to call

-- 'releaseSemaphore' before closing the handle or before the process terminates.

-- Otherwise, pending wait operations will either time out or continue indefinitely,

-- depending on whether a time-out value has been specified.

newtype Semaphore = Semaphore { semaphoreHandle :: HANDLE }

-- | Open a 'Semaphore' with the given name, or create a new semaphore

-- if no such semaphore exists, with initial count @i@ and maximum count @m@.

--

-- The counts must satisfy @i >= 0@, @m > 0@ and @i <= m@.

--

-- The returned 'Bool' is 'True' if the function found an existing semaphore

-- with the given name, in which case a handle to that semaphore is returned

-- and the counts are ignored.

--

-- Use 'openSemaphore' if you don't want to create a new semaphore.

createSemaphore :: Maybe SECURITY_ATTRIBUTES
                -> LONG         -- ^ initial count @i@ with @0 <= i <= m@

                -> LONG         -- ^ maximum count @m > 0@

                -> Maybe String -- ^ (optional) semaphore name

                                -- (case-sensitive, limited to MAX_PATH characters)

                -> IO (Semaphore, Bool)
createSemaphore mb_sec initial_count max_count mb_name =
  maybeWith with mb_sec $ \ c_sec -> do
  maybeWith withCAString mb_name $ \ c_name -> do
  handle <- c_CreateSemaphore c_sec initial_count max_count c_name
  err_code <- getLastError
  already_exists <-
    case err_code of
      (6) ->
{-# LINE 101 "System\\Win32\\Semaphore.hsc" #-}
        errorWin $ "createSemaphore: semaphore name '"
                ++ fromMaybe "" mb_name
                ++ "' matches non-semaphore"
      (183) ->
{-# LINE 105 "System\\Win32\\Semaphore.hsc" #-}
        return True
      _                              ->
        return False
  if handle == nullPtr
  then errorWin "createSemaphore"
  else return (Semaphore handle, already_exists)

foreign import WINDOWS_CCONV unsafe "windows.h CreateSemaphoreA"
  c_CreateSemaphore :: LPSECURITY_ATTRIBUTES -> LONG -> LONG -> LPCSTR -> IO HANDLE

-- | Open an existing 'Semaphore'.

openSemaphore :: AccessMode -- ^ desired access mode

              -> Bool       -- ^ should child processes inherit the handle?

              -> String     -- ^ name of the semaphore to open (case-sensitive)

              -> IO Semaphore
openSemaphore amode inherit name =
  withTString name $ \c_name -> do
    handle <- failIfNull ("openSemaphore: '" ++ name ++ "'") $
              c_OpenSemaphore (fromIntegral amode) inherit c_name
    return (Semaphore handle)

foreign import WINDOWS_CCONV unsafe "windows.h OpenSemaphoreW"
  c_OpenSemaphore :: DWORD -> BOOL -> LPCWSTR -> IO HANDLE

-- | Increase the count of the 'Semaphore' by the specified amount.

--

-- Returns the count of the semaphore before the increase.

--

-- Throws an error if the count would exceeded the maximum count

-- of the semaphore.

releaseSemaphore :: Semaphore -> LONG -> IO LONG
releaseSemaphore (Semaphore handle) count =
  with 0 $ \ ptr_prevCount -> do
  failIfFalse_ "releaseSemaphore" $ c_ReleaseSemaphore handle count ptr_prevCount
  peek ptr_prevCount

foreign import WINDOWS_CCONV unsafe "windows.h ReleaseSemaphore"
  c_ReleaseSemaphore :: HANDLE -> LONG -> Ptr LONG -> IO BOOL

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

-- End

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