aboutsummaryrefslogtreecommitdiff
path: root/src/Sproxy/Logging.hs
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2016-10-27 22:57:34 +0300
committerIgor Pashev <pashev.igor@gmail.com>2016-11-19 23:29:43 +0300
commit4a9f329a6ea9bfa03352ca0d9dd1d556b93bec36 (patch)
treeec49e853364a61eb4c7c64b5f13b0153d21a4cc1 /src/Sproxy/Logging.hs
downloadsproxy2-4a9f329a6ea9bfa03352ca0d9dd1d556b93bec36.tar.gz
Initial release (1.90.0)1.90.0
Diffstat (limited to 'src/Sproxy/Logging.hs')
-rw-r--r--src/Sproxy/Logging.hs99
1 files changed, 99 insertions, 0 deletions
diff --git a/src/Sproxy/Logging.hs b/src/Sproxy/Logging.hs
new file mode 100644
index 0000000..651a73a
--- /dev/null
+++ b/src/Sproxy/Logging.hs
@@ -0,0 +1,99 @@
+module Sproxy.Logging (
+ LogLevel(..)
+, debug
+, error
+, info
+, level
+, start
+, warn
+) where
+
+import Prelude hiding (error)
+
+import Control.Applicative (empty)
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
+import Control.Monad (forever, when)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Char (toLower)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+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 ()
+start lvl = do
+ writeIORef logLevel lvl
+ ch <- readIORef chanRef
+ _ <- forkIO . forever $ readChan ch >>= hPrint stderr
+ return ()
+
+info :: String -> IO ()
+info = send . Message Info
+
+warn:: String -> IO ()
+warn = send . Message Warning
+
+error:: String -> IO ()
+error = send . Message Error
+
+debug :: String -> IO ()
+debug = send . Message Debug
+
+
+send :: Message -> IO ()
+send msg@(Message l _) = do
+ lvl <- level
+ when (l <= lvl) $ do
+ ch <- readIORef chanRef
+ writeChan ch msg
+
+{-# NOINLINE chanRef #-}
+chanRef :: IORef (Chan Message)
+chanRef = unsafePerformIO (newChan >>= newIORef)
+
+{-# NOINLINE logLevel #-}
+logLevel :: IORef LogLevel
+logLevel = unsafePerformIO (newIORef None)
+
+level :: IO LogLevel
+level = readIORef logLevel
+
+
+data LogLevel = None | Error | Warning | Info | Debug
+ deriving (Enum, Ord, Eq)
+
+instance Show LogLevel where
+ show None = "NONE"
+ show Error = "ERROR"
+ show Warning = "WARN"
+ 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
+
+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)
+ parseJSON _ = empty
+
+
+data Message = Message LogLevel String
+
+instance Show Message where
+ show (Message lvl str) = show lvl ++ ": " ++ str
+