{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module System.Win32.Services.Accept
( ServiceAccept (..)
, pokeServiceAccept
, peekServiceAccept
) where
import Data.Bits
import Data.Maybe
import Text.Printf
import Import
import qualified System.Win32.Services.Control as C
data ServiceAccept
= AcceptNetBindChange
| AcceptParamChange
| AcceptPauseContinue
| AcceptPreshutdown
| AcceptShutdown
| AcceptStop
deriving (Show)
peekServiceAccept :: Ptr DWORD -> IO [ServiceAccept]
peekServiceAccept ptr = unflag <$> peek ptr
pokeServiceAccept :: Ptr DWORD -> [ServiceAccept] -> IO ()
pokeServiceAccept ptr sas = poke ptr . flag $ sas
marshOut :: ServiceAccept -> DWORD
marshOut AcceptNetBindChange = 0x00000010
marshOut AcceptParamChange = 0x00000008
marshOut AcceptPauseContinue = 0x00000002
marshOut AcceptPreshutdown = 0x00000100
marshOut AcceptShutdown = 0x00000004
marshOut AcceptStop = 0x00000001
marshIn :: DWORD -> Either String ServiceAccept
marshIn 0x00000010 = Right AcceptNetBindChange
marshIn 0x00000008 = Right AcceptParamChange
marshIn 0x00000002 = Right AcceptPauseContinue
marshIn 0x00000100 = Right AcceptPreshutdown
marshIn 0x00000004 = Right AcceptShutdown
marshIn 0x00000001 = Right AcceptStop
marshIn 0x00000020 = unsupported "SERVICE_ACCEPT_HARDWAREPROFILECHANGE"
marshIn 0x00000040 = unsupported "SERVICE_ACCEPT_POWEREVENT"
marshIn 0x00000080 = unsupported "SERVICE_ACCEPT_SESSIONCHANGE"
marshIn 0x00000200 = unsupported "SERVICE_ACCEPT_TIMECHANGE"
marshIn 0x00000400 = unsupported "SERVICE_ACCEPT_TRIGGEREVENT"
marshIn 0x00000800 = unsupported "SERVICE_ACCEPT_USERMODEREBOOT"
marshIn x = Left $ "The " ++ printf "%x" x ++ " control code is undocumented."
unsupported :: String -> Either String a
unsupported name = Left $ "The " ++ name ++ " control code is unsupported by this binding."
unflag :: DWORD -> [ServiceAccept]
unflag f = mapMaybe (hush . marshIn . (.&. f)) masks
where
masks = take 32 $ iterate (`shiftL` 1) 1
flag :: [ServiceAccept] -> DWORD
flag fs = foldl (\flag' f -> flag' .|. marshOut f) 0 fs