{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DeriveGeneric #-}
#endif

{- |
   Module     : System.Log
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   License    : BSD3

   Portability: portable

Haskell Logging Framework

Written by John Goerzen, jgoerzen\@complete.org

This module defines basic types used for logging.

Extensive documentation is available in
"System.Log.Logger".

-}



module System.Log(-- * Types
                        Priority(..),
                        LogRecord
)

    where

import Control.DeepSeq (NFData(rnf))
import Data.Data (Data, Typeable)
#if __GLASGOW_HASKELL__ >= 702
import  GHC.Generics (Generic)
#endif

{- | Priorities are used to define how important a log message is.
Users can filter log messages based on priorities.

These have their roots on the traditional syslog system.  The standard
definitions are given below, but you are free to interpret them however you
like.  They are listed here in ascending importance order.
-}

data Priority =
            DEBUG                   -- ^ Debug messages
          | INFO                    -- ^ Information
          | NOTICE                  -- ^ Normal runtime conditions
          | WARNING                 -- ^ General Warnings
          | ERROR                   -- ^ General Errors
          | CRITICAL                -- ^ Severe situations
          | ALERT                   -- ^ Take immediate action
          | EMERGENCY               -- ^ System is unusable
#if __GLASGOW_HASKELL__ >= 702
          deriving (Priority -> Priority -> Bool
(Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool) -> Eq Priority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq, Eq Priority
Eq Priority
-> (Priority -> Priority -> Ordering)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Priority)
-> (Priority -> Priority -> Priority)
-> Ord Priority
Priority -> Priority -> Bool
Priority -> Priority -> Ordering
Priority -> Priority -> Priority
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Priority -> Priority -> Priority
$cmin :: Priority -> Priority -> Priority
max :: Priority -> Priority -> Priority
$cmax :: Priority -> Priority -> Priority
>= :: Priority -> Priority -> Bool
$c>= :: Priority -> Priority -> Bool
> :: Priority -> Priority -> Bool
$c> :: Priority -> Priority -> Bool
<= :: Priority -> Priority -> Bool
$c<= :: Priority -> Priority -> Bool
< :: Priority -> Priority -> Bool
$c< :: Priority -> Priority -> Bool
compare :: Priority -> Priority -> Ordering
$ccompare :: Priority -> Priority -> Ordering
$cp1Ord :: Eq Priority
Ord, Int -> Priority
Priority -> Int
Priority -> [Priority]
Priority -> Priority
Priority -> Priority -> [Priority]
Priority -> Priority -> Priority -> [Priority]
(Priority -> Priority)
-> (Priority -> Priority)
-> (Int -> Priority)
-> (Priority -> Int)
-> (Priority -> [Priority])
-> (Priority -> Priority -> [Priority])
-> (Priority -> Priority -> [Priority])
-> (Priority -> Priority -> Priority -> [Priority])
-> Enum Priority
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Priority -> Priority -> Priority -> [Priority]
$cenumFromThenTo :: Priority -> Priority -> Priority -> [Priority]
enumFromTo :: Priority -> Priority -> [Priority]
$cenumFromTo :: Priority -> Priority -> [Priority]
enumFromThen :: Priority -> Priority -> [Priority]
$cenumFromThen :: Priority -> Priority -> [Priority]
enumFrom :: Priority -> [Priority]
$cenumFrom :: Priority -> [Priority]
fromEnum :: Priority -> Int
$cfromEnum :: Priority -> Int
toEnum :: Int -> Priority
$ctoEnum :: Int -> Priority
pred :: Priority -> Priority
$cpred :: Priority -> Priority
succ :: Priority -> Priority
$csucc :: Priority -> Priority
Enum, Priority
Priority -> Priority -> Bounded Priority
forall a. a -> a -> Bounded a
maxBound :: Priority
$cmaxBound :: Priority
minBound :: Priority
$cminBound :: Priority
Bounded, Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
(Int -> Priority -> ShowS)
-> (Priority -> String) -> ([Priority] -> ShowS) -> Show Priority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Priority] -> ShowS
$cshowList :: [Priority] -> ShowS
show :: Priority -> String
$cshow :: Priority -> String
showsPrec :: Int -> Priority -> ShowS
$cshowsPrec :: Int -> Priority -> ShowS
Show, ReadPrec [Priority]
ReadPrec Priority
Int -> ReadS Priority
ReadS [Priority]
(Int -> ReadS Priority)
-> ReadS [Priority]
-> ReadPrec Priority
-> ReadPrec [Priority]
-> Read Priority
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Priority]
$creadListPrec :: ReadPrec [Priority]
readPrec :: ReadPrec Priority
$creadPrec :: ReadPrec Priority
readList :: ReadS [Priority]
$creadList :: ReadS [Priority]
readsPrec :: Int -> ReadS Priority
$creadsPrec :: Int -> ReadS Priority
Read, Typeable Priority
DataType
Constr
Typeable Priority
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Priority -> c Priority)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Priority)
-> (Priority -> Constr)
-> (Priority -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Priority))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Priority))
-> ((forall b. Data b => b -> b) -> Priority -> Priority)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Priority -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Priority -> r)
-> (forall u. (forall d. Data d => d -> u) -> Priority -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Priority -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Priority -> m Priority)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Priority -> m Priority)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Priority -> m Priority)
-> Data Priority
Priority -> DataType
Priority -> Constr
(forall b. Data b => b -> b) -> Priority -> Priority
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Priority -> c Priority
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Priority
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Priority -> u
forall u. (forall d. Data d => d -> u) -> Priority -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Priority
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Priority -> c Priority
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Priority)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Priority)
$cEMERGENCY :: Constr
$cALERT :: Constr
$cCRITICAL :: Constr
$cERROR :: Constr
$cWARNING :: Constr
$cNOTICE :: Constr
$cINFO :: Constr
$cDEBUG :: Constr
$tPriority :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Priority -> m Priority
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
gmapMp :: (forall d. Data d => d -> m d) -> Priority -> m Priority
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
gmapM :: (forall d. Data d => d -> m d) -> Priority -> m Priority
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Priority -> m Priority
gmapQi :: Int -> (forall d. Data d => d -> u) -> Priority -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Priority -> u
gmapQ :: (forall d. Data d => d -> u) -> Priority -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Priority -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Priority -> r
gmapT :: (forall b. Data b => b -> b) -> Priority -> Priority
$cgmapT :: (forall b. Data b => b -> b) -> Priority -> Priority
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Priority)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Priority)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Priority)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Priority)
dataTypeOf :: Priority -> DataType
$cdataTypeOf :: Priority -> DataType
toConstr :: Priority -> Constr
$ctoConstr :: Priority -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Priority
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Priority
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Priority -> c Priority
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Priority -> c Priority
$cp1Data :: Typeable Priority
Data, Typeable, (forall x. Priority -> Rep Priority x)
-> (forall x. Rep Priority x -> Priority) -> Generic Priority
forall x. Rep Priority x -> Priority
forall x. Priority -> Rep Priority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Priority x -> Priority
$cfrom :: forall x. Priority -> Rep Priority x
Generic)
#else
          deriving (Eq, Ord, Enum, Bounded, Show, Read, Data, Typeable)
#endif

-- | @since 1.3.1.0
instance NFData Priority where rnf :: Priority -> ()
rnf = (Priority -> () -> ()
`seq` ())

{- | Internal type of log records -}

type LogRecord = (Priority, String)