{-# LINE 1 "src/System/Posix/Syslog/Options.hsc" #-}
{-# LANGUAGE DeriveGeneric #-}

{- |
   Maintainer: simons@cryp.to
   Stability: provisional
   Portability: POSIX

   FFI bindings to @syslog(3)@ from
   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>.
   This module is intended for purposes of low-level implementation. Users of
   this library should prefer safer and more convenient API provided by
   "System.Posix.Syslog".
-}

module System.Posix.Syslog.Options where

import Foreign.C.Types
import GHC.Generics ( Generic )



-- | The function 'openlog' allows one to configure a handful of process-wide
-- options that modify the behavior of the 'syslog' function. These options are
-- 'pid', 'cons', 'odelay', and 'ndelay'.

data Option = LogPID              -- ^ Log the pid with each message.
            | Console             -- ^ Log on the console if errors occur while sending messages.
            | DelayedOpen         -- ^ Delay all initialization until first @syslog()@ call (default).
            | ImmediateOpen       -- ^ Initialize the syslog system immediately.
            | DontWaitForChildren -- ^ The syslog system should not attempt to wait for child
                                  -- process it may have created. This option is required by
                                  -- applications who enable @SIGCHLD@ themselves.
  deriving (Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Option -> ShowS
showsPrec :: Int -> Option -> ShowS
$cshow :: Option -> String
show :: Option -> String
$cshowList :: [Option] -> ShowS
showList :: [Option] -> ShowS
Show, ReadPrec [Option]
ReadPrec Option
Int -> ReadS Option
ReadS [Option]
(Int -> ReadS Option)
-> ReadS [Option]
-> ReadPrec Option
-> ReadPrec [Option]
-> Read Option
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Option
readsPrec :: Int -> ReadS Option
$creadList :: ReadS [Option]
readList :: ReadS [Option]
$creadPrec :: ReadPrec Option
readPrec :: ReadPrec Option
$creadListPrec :: ReadPrec [Option]
readListPrec :: ReadPrec [Option]
Read, Option
Option -> Option -> Bounded Option
forall a. a -> a -> Bounded a
$cminBound :: Option
minBound :: Option
$cmaxBound :: Option
maxBound :: Option
Bounded, Int -> Option
Option -> Int
Option -> [Option]
Option -> Option
Option -> Option -> [Option]
Option -> Option -> Option -> [Option]
(Option -> Option)
-> (Option -> Option)
-> (Int -> Option)
-> (Option -> Int)
-> (Option -> [Option])
-> (Option -> Option -> [Option])
-> (Option -> Option -> [Option])
-> (Option -> Option -> Option -> [Option])
-> Enum Option
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Option -> Option
succ :: Option -> Option
$cpred :: Option -> Option
pred :: Option -> Option
$ctoEnum :: Int -> Option
toEnum :: Int -> Option
$cfromEnum :: Option -> Int
fromEnum :: Option -> Int
$cenumFrom :: Option -> [Option]
enumFrom :: Option -> [Option]
$cenumFromThen :: Option -> Option -> [Option]
enumFromThen :: Option -> Option -> [Option]
$cenumFromTo :: Option -> Option -> [Option]
enumFromTo :: Option -> Option -> [Option]
$cenumFromThenTo :: Option -> Option -> Option -> [Option]
enumFromThenTo :: Option -> Option -> Option -> [Option]
Enum, Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
/= :: Option -> Option -> Bool
Eq, (forall x. Option -> Rep Option x)
-> (forall x. Rep Option x -> Option) -> Generic Option
forall x. Rep Option x -> Option
forall x. Option -> Rep Option x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Option -> Rep Option x
from :: forall x. Option -> Rep Option x
$cto :: forall x. Rep Option x -> Option
to :: forall x. Rep Option x -> Option
Generic)

-- | Translate an 'Option' into the system-dependent identifier that's used by
-- the @syslog(3)@ implementation.

{-# INLINE fromOption #-}
fromOption :: Option -> CInt
fromOption :: Option -> CInt
fromOption Option
LogPID              = CInt
1
{-# LINE 41 "src/System/Posix/Syslog/Options.hsc" #-}
fromOption Console             = 2
{-# LINE 42 "src/System/Posix/Syslog/Options.hsc" #-}
fromOption DelayedOpen         = 4
{-# LINE 43 "src/System/Posix/Syslog/Options.hsc" #-}
fromOption ImmediateOpen       = 8
{-# LINE 44 "src/System/Posix/Syslog/Options.hsc" #-}
fromOption DontWaitForChildren = 16
{-# LINE 45 "src/System/Posix/Syslog/Options.hsc" #-}