packages feed

simple-log 0.1.6 → 0.2.0

raw patch · 7 files changed

+31/−118 lines, 7 filesdep ~base

Dependency ranges changed: base

Files

simple-log.cabal view
@@ -1,5 +1,5 @@ Name:                 simple-log
-Version:              0.1.6
+Version:              0.2.0
 Synopsis:             Simple log for Haskell
 Description:          Log library for Haskell with removing unnecessary traces
 License:              BSD3
@@ -15,7 +15,7 @@ Library
   HS-Source-Dirs: src
   Build-Depends:
-    base >= 4.0 && < 5,
+    base >= 4.0 && < 6,
     containers >= 0.3 && < 0.6,
     deepseq >= 1.3 && < 1.4,
     directory >= 1.1 && < 1.3,
@@ -23,7 +23,7 @@     MonadCatchIO-transformers >= 0.2 && < 0.4,
     mtl >= 2.0 && < 2.2,
     old-locale >= 1.0 && < 1.1,
-    text >= 0.11 && < 0.12,
+    text == 0.11.*,
     time >= 1.3 && < 1.5,
     transformers >= 0.2 && < 0.4
   Exposed-Modules:
@@ -32,7 +32,6 @@     System.Log.Config
     System.Log.Monad
     System.Log.Text
-    System.Log.HTML
     System.Log.Console
     System.Log.File
src/System/Log.hs view
@@ -203,7 +203,6 @@     module System.Log.Config,
     module System.Log.Monad,
     module System.Log.Text,
-    module System.Log.HTML,
     module System.Log.Console,
     module System.Log.File
     ) where
@@ -212,6 +211,5 @@ import System.Log.Config
 import System.Log.Monad
 import System.Log.Text
-import System.Log.HTML
 import System.Log.Console
 import System.Log.File
src/System/Log/Base.hs view
@@ -8,10 +8,10 @@     (%=),
     politics, use, low, high,
     Message(..),
-    Converter(..), Consumer(..),
+    Converter, Consumer(..),
     Entry(..), Command(..),
     entries, flatten, rules,
-    Logger(..), logger,
+    Logger, logger,
     RulesLoad,
     Log(..), noLog,
     newLog,
@@ -141,27 +141,19 @@     rnf (Message t l p m) = t `seq` l `seq` rnf p `seq` rnf m
 
 -- | Converts message some representation
-data Converter a = Converter {
-    initial :: a,
-    convert :: Message -> a }
+type Converter a = Message -> a
 
 -- Stores message
 data Consumer a = Consumer {
-    consumerNew :: Bool,
-    consume :: a -> IO (),
-    consumerClose :: IO () }
+    withConsumer :: ((a -> IO ()) -> IO ()) -> IO () }
 
 -- | Logger
-data Logger = Logger {
-    loggerLog :: Message -> IO (),
-    loggerClose :: IO () }
+type Logger = Consumer Message
 
 -- | Convert consumer creater to logger creater
-logger :: Converter a -> IO (Consumer a) -> IO Logger
-logger converter consumer = do
-    c <- consumer
-    when (consumerNew c) $ consume c (initial converter)
-    return $ Logger (consume c . convert converter) (consumerClose c)
+logger :: Converter a -> Consumer a -> Consumer Message
+logger conv (Consumer withCons) = Consumer withCons' where
+    withCons' f = withCons $ \logMsg -> f (logMsg . conv)
 
 -- | Log
 data Log = Log {
@@ -179,7 +171,7 @@ --
 -- Messages from distinct threads are splitted in several chans, where they are processed, and then messages combined back and sent to log-thread
 --
-newLog :: RulesLoad -> [IO Logger] -> IO Log
+newLog :: RulesLoad -> [Logger] -> IO Log
 newLog _ [] = return noLog
 newLog rsInit ls = do
     ch <- newChan :: IO (Chan (ThreadId, Command))
@@ -210,19 +202,19 @@         uncommand = flatten . rules r [] . entries
 
         -- | Perform log
-        loggerLog' :: Logger -> Message -> IO ()
-        loggerLog' l m = E.handle onError (m `deepseq` loggerLog l m) where
+        tryLog :: (Message -> IO ()) -> Message -> IO ()
+        tryLog logMsg m = E.handle onError (m `deepseq` logMsg m) where
             onError :: E.SomeException -> IO ()
             onError e = E.handle ignoreError $ do
                 tm <- getZonedTime
-                loggerLog l $ Message tm Error ["*"] $ fromString $ "Exception during logging message: " ++ show e
+                logMsg $ Message tm Error ["*"] $ fromString $ "Exception during logging message: " ++ show e
             ignoreError :: E.SomeException -> IO ()
             ignoreError _ = return ()
 
         -- | Initialize all loggers
-        startLog :: IO Logger -> IO ()
-        startLog l = E.bracket l loggerClose rootScope where
-            rootScope l' = mapM_ (loggerLog' l') msgs
+        startLog :: Logger -> IO ()
+        startLog (Consumer withCons) = withCons $ \logMsg -> do
+            mapM_ (tryLog logMsg) msgs
 
         -- | Write command with myThreadId
         writeCommand :: Command -> IO ()
src/System/Log/Console.hs view
@@ -7,7 +7,8 @@ import System.Log.Base
 import System.IO
 
-console :: IO (Consumer Text)
-console = do
-    hSetEncoding stdout utf8
-    return $ Consumer True T.putStrLn (return ())
+console :: Consumer Text
+console = Consumer withConsole where
+    withConsole f = do
+        hSetEncoding stdout utf8
+        f T.putStrLn
src/System/Log/File.hs view
@@ -9,12 +9,10 @@ import System.Directory
 import System.IO
 
-file :: FilePath -> IO (Consumer Text)
-file f = do
-    createDirectoryIfMissing True $ takeDirectory f
-    ex <- doesFileExist f
-    let
-        putText txt = withFile f AppendMode $ \h -> do
+file :: FilePath -> Consumer Text
+file fileName = Consumer withFileLog where
+    withFileLog f = do
+        createDirectoryIfMissing True $ takeDirectory fileName
+        f $ \txt -> withFile fileName AppendMode $ \h -> do
             hSetEncoding h utf8
             T.hPutStrLn h txt
-    return $ Consumer (not ex) putText (return ())
− src/System/Log/HTML.hs 
@@ -1,74 +0,0 @@-module System.Log.HTML (
-    defaultTimeLocale,
-
-    htmlFmt, html
-    ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time
-import System.Locale
-import System.Log.Base
-import System.Log.Text
-
-htmlFmt :: String -> String -> Converter Text
-htmlFmt fmt title = Converter header c where
-    c (Message tm l p msg) = T.unlines [
-        T.pack $ "<div class=\"common " ++ typeClass l ++ "\">",
-        T.pack $ "<span class=\"date\">" ++ formatTm tm ++ "</span>",
-        T.pack $ "<b>" ++ classMsg l ++ "</b>.",
-        T.concat [T.pack "<i>", T.intercalate (T.pack "/") p, T.pack "&gt;</i>"],
-        msg,
-        T.pack "</div>"]
-
-    typeClass Trace = "trace"
-    typeClass Debug = "except debug"
-    typeClass Info = "div1 except info"
-    typeClass Warning = "div0 except warning"
-    typeClass Error = "div0 except error"
-    typeClass Fatal = "div0 critical"
-
-    classMsg Trace = "Trace info"
-    classMsg Debug = "Debug info"
-    classMsg Info = "Information"
-    classMsg Warning = "Warning"
-    classMsg Error = "Error"
-    classMsg Fatal = "Critical error"
-
-    formatTm tm = formatTime defaultTimeLocale fmt tm
-    header = T.unlines $ map T.pack [
-        "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"",
-        "\"http://www.w3.org/TR/html4/loose.dtd\">",
-        "<html>",
-        "<head>",
-        "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">",
-        "<title>" ++ title ++ "</title>",
-        "",
-        "<style type=\"text/css\">",
-        "body { font-family:Arial, Helvetica, sans-serif; font-size:13px; }",
-        "",
-        ".title { font-size:18px; }",
-        "",
-        ".date { font-size:10px; padding-right:5px; padding-left:20px; float: right; }",
-        "",
-        ".common {\npadding-left:20px;\npadding-top:5px;\nmargin-top:1px;\npadding-bottom:10px;\nmargin-bottom:10px;\n}",
-        "",
-        ".except {\nborder-width:3px;\nborder-style:solid;\ncolor:#000000;\n}",
-        "",
-        ".logfail { background-color:#1469E1; color:#FFFFFF; }",
-        ".critical { background:#DD4400; color:#FFFFFF; }",
-        ".error { border-color:#FF0033; }",
-        ".warning { border-color:#FF9900; }",
-        ".info { border-color:#339933; }",
-        ".debug { border-color:#999966; }",
-        ".trace { padding-bottom: 0px; padding-top: 0px; color: #666666; }",
-        ".div0 { background-color: #F7F7FF; padding-top:10px; padding-bottom:5px; margin-top:15px; margin-bottom:10px; }",
-        ".div1 { background-color: #F7FFF7; padding-top:10px; padding-bottom:5px; margin-top:15px; margin-bottom:10px; }",
-        "</style>",
-        "",
-        "</head>",
-        "<body>",
-        "<p align=\"center\" class=\"title\">" ++ title ++ "</p>"]
-
-html :: String -> Converter Text
-html = htmlFmt defaultTimeFormat
src/System/Log/Text.hs view
@@ -15,10 +15,9 @@ 
 -- | Text log converter with time format
 textFmt :: String -> Converter Text
-textFmt fmt = Converter T.empty c where
-    c (Message tm l p msg) = T.intercalate (T.pack "\t") [T.pack s, T.pack (toStr l), msg'] where
-        s = formatTime defaultTimeLocale fmt tm
-        msg' = T.concat [T.intercalate (T.pack "/") p, T.pack "> ", msg]
+textFmt fmt (Message tm l p msg) = T.intercalate (T.pack "\t") [T.pack s, T.pack (toStr l), msg'] where
+    s = formatTime defaultTimeLocale fmt tm
+    msg' = T.concat [T.intercalate (T.pack "/") p, T.pack "> ", msg]
     toStr Trace = "TRACE"
     toStr Debug = "DEBUG"
     toStr Info = "INFO"