aboutsummaryrefslogtreecommitdiff
path: root/src/Sproxy/Logging.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Sproxy/Logging.hs')
-rw-r--r--src/Sproxy/Logging.hs69
1 files changed, 38 insertions, 31 deletions
diff --git a/src/Sproxy/Logging.hs b/src/Sproxy/Logging.hs
index 651a73a..93bc355 100644
--- a/src/Sproxy/Logging.hs
+++ b/src/Sproxy/Logging.hs
@@ -1,12 +1,12 @@
-module Sproxy.Logging (
- LogLevel(..)
-, debug
-, error
-, info
-, level
-, start
-, warn
-) where
+module Sproxy.Logging
+ ( LogLevel(..)
+ , debug
+ , error
+ , info
+ , level
+ , start
+ , warn
+ ) where
import Prelude hiding (error)
@@ -15,13 +15,13 @@ import Control.Concurrent (forkIO)
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Control.Monad (forever, when)
import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as JSON
import Data.Char (toLower)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import qualified Data.Text as T
import System.IO (hPrint, stderr)
import System.IO.Unsafe (unsafePerformIO)
import Text.Read (readMaybe)
-import qualified Data.Aeson as JSON
-import qualified Data.Text as T
start :: LogLevel -> IO ()
start None = return ()
@@ -34,16 +34,15 @@ start lvl = do
info :: String -> IO ()
info = send . Message Info
-warn:: String -> IO ()
+warn :: String -> IO ()
warn = send . Message Warning
-error:: String -> IO ()
+error :: String -> IO ()
error = send . Message Error
debug :: String -> IO ()
debug = send . Message Debug
-
send :: Message -> IO ()
send msg@(Message l _) = do
lvl <- level
@@ -62,38 +61,46 @@ logLevel = unsafePerformIO (newIORef None)
level :: IO LogLevel
level = readIORef logLevel
-
-data LogLevel = None | Error | Warning | Info | Debug
+data LogLevel
+ = None
+ | Error
+ | Warning
+ | Info
+ | Debug
deriving (Enum, Ord, Eq)
instance Show LogLevel where
- show None = "NONE"
- show Error = "ERROR"
+ show None = "NONE"
+ show Error = "ERROR"
show Warning = "WARN"
- show Info = "INFO"
- show Debug = "DEBUG"
+ show Info = "INFO"
+ show Debug = "DEBUG"
instance Read LogLevel where
readsPrec _ s
- | l == "none" = [ (None, "") ]
- | l == "error" = [ (Error, "") ]
- | l == "warn" = [ (Warning, "") ]
- | l == "info" = [ (Info, "") ]
- | l == "debug" = [ (Debug, "") ]
- | otherwise = [ ]
- where l = map toLower s
+ | l == "none" = [(None, "")]
+ | l == "error" = [(Error, "")]
+ | l == "warn" = [(Warning, "")]
+ | l == "info" = [(Info, "")]
+ | l == "debug" = [(Debug, "")]
+ | otherwise = []
+ where
+ l = map toLower s
instance ToJSON LogLevel where
toJSON = JSON.String . T.pack . show
instance FromJSON LogLevel where
parseJSON (JSON.String s) =
- maybe (fail $ "unknown log level: " ++ show s) return (readMaybe . T.unpack $ s)
+ maybe
+ (fail $ "unknown log level: " ++ show s)
+ return
+ (readMaybe . T.unpack $ s)
parseJSON _ = empty
-
-data Message = Message LogLevel String
+data Message =
+ Message LogLevel
+ String
instance Show Message where
show (Message lvl str) = show lvl ++ ": " ++ str
-