{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}

-- |
-- Module     : Simulation.Aivika.Distributed.Optimistic.Internal.Priority
-- Copyright  : Copyright (c) 2015-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 7.10.3
--
-- This module defines the logging 'Priority'.
--
module Simulation.Aivika.Distributed.Optimistic.Internal.Priority
       (Priority(..),
        embracePriority) where

import Data.Typeable
import Data.Binary

import GHC.Generics

-- | The logging priority.
data Priority = DEBUG
                -- ^ Debug messages
              | INFO
                -- ^ Information
              | NOTICE
                -- ^ Normal runtime conditions
              | WARNING
                -- ^ Warnings
              | ERROR
                -- ^ Errors
              deriving (Priority -> Priority -> Bool
(Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool) -> Eq Priority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
/= :: 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
$ccompare :: Priority -> Priority -> Ordering
compare :: Priority -> Priority -> Ordering
$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
>= :: Priority -> Priority -> Bool
$cmax :: Priority -> Priority -> Priority
max :: Priority -> Priority -> Priority
$cmin :: Priority -> Priority -> Priority
min :: Priority -> Priority -> Priority
Ord, 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
$cshowsPrec :: Int -> Priority -> ShowS
showsPrec :: Int -> Priority -> ShowS
$cshow :: Priority -> String
show :: Priority -> String
$cshowList :: [Priority] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Priority
readsPrec :: Int -> ReadS Priority
$creadList :: ReadS [Priority]
readList :: ReadS [Priority]
$creadPrec :: ReadPrec Priority
readPrec :: ReadPrec Priority
$creadListPrec :: ReadPrec [Priority]
readListPrec :: ReadPrec [Priority]
Read, 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
$cfrom :: forall x. Priority -> Rep Priority x
from :: forall x. Priority -> Rep Priority x
$cto :: forall x. Rep Priority x -> Priority
to :: forall x. Rep Priority x -> Priority
Generic)

instance Binary Priority

-- | Embrace the priority in brackets.
embracePriority :: Priority -> String
embracePriority :: Priority -> String
embracePriority Priority
p = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Priority -> String
forall a. Show a => a -> String
show Priority
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"