log4hs 0.1.0.0 → 0.2.0.0

raw patch · 17 files changed

+146/−281 lines, 17 filesdep +vformatPVP ok

version bump matches the API change (PVP)

Dependencies added: vformat

API changes (from Hackage documentation)

Files

• bench/Main.hs +3/−4
• log4hs.cabal +5/−4
• src/Logging/Aeson.hs +25/−32
• src/Logging/Internal.hs +14/−5
• src/Logging/Types.hs +0/−2
• src/Logging/Types/Class.hs +0/−2
• src/Logging/Types/Class/Formattable.hs +0/−9
• src/Logging/Types/Class/Handler.hs +5/−9
• src/Logging/Types/Formatter.hs +0/−79
• src/Logging/Types/Handlers/FileHandler.hs +8/−9
• src/Logging/Types/Handlers/StreamHandler.hs +7/−9
• src/Logging/Types/Level.hs +4/−0
• src/Logging/Types/Record.hs +48/−9
• src/Logging/Utils.hs +11/−0
• test/Logging/AesonSpec.hs +8/−23
• test/Logging/TypesSpec.hs +1/−79
• test/LoggingSpec.hs +7/−6

@@ -104,9 +104,8 @@       }     },     "formatters": {-      "simple": "%(message)s",-      "normal": "%(asctime)s - %(level)s - %(logger)s] %(message)s",-      "full": "%(asctime)s - %(level)s - %(logger)s - %(pathname)s/%(filename)s:%(lineno)d] %(message)s"+      "simple": "{message}",+      "normal": "{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger}] {message}",+      "full": "{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger} - {pathname}:{lineno}] {message}"     }   }|]-

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a647fb460a908fafb35b6663c643cc259815b41a600dce95f217343328a72f6c+-- hash: 8d633b37fcc55dd17512ea7e3f2351a1e6b89b9fb459303951dd3039c1bb8bed  name:           log4hs-version:        0.1.0.0+version:        0.2.0.0 synopsis:       A python logging style log library description:    Please see the http://hackage.haskell.org/package/log4hs category:       logging@@ -32,10 +32,8 @@       Logging.TH       Logging.Types.Class       Logging.Types.Class.Filterable-      Logging.Types.Class.Formattable       Logging.Types.Class.Handler       Logging.Types.Filter-      Logging.Types.Formatter       Logging.Types.Handlers       Logging.Types.Handlers.FileHandler       Logging.Types.Handlers.StreamHandler@@ -60,6 +58,7 @@     , template-haskell >=2.0 && <3.0     , text >=1.2 && <2.0     , time >=1.4 && <2.0+    , vformat >=0.9.1 && <1.0   default-language: Haskell2010  test-suite log4hs-test@@ -91,6 +90,7 @@     , template-haskell >=2.0 && <3.0     , text >=1.2 && <2.0     , time >=1.4 && <2.0+    , vformat >=0.9.1 && <1.0   default-language: Haskell2010  benchmark log4hs-bench@@ -116,4 +116,5 @@     , template-haskell >=2.0 && <3.0     , text >=1.2 && <2.0     , time >=1.4 && <2.0+    , vformat >=0.9.1 && <1.0   default-language: Haskell2010

@@ -1,3 +1,5 @@+{-# OPTIONS_HADDOCK prune, ignore-exports #-}+ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE OverloadedStrings     #-}@@ -19,9 +21,11 @@ import           Data.Generics.Product.Typed import           Data.IORef import qualified Data.Map.Lazy               as M+import           Data.String import           System.Directory import           System.FilePath import           System.IO+import           Text.Format  import           Logging.Internal import           Logging.Types@@ -38,7 +42,7 @@   {     \"loggers\": {\"root\": {}, \"MyLogger\": {}},     \"handlers\": {\"console\": {}, \"file\": {}},-    \"formatters\": {\"default\": {}, \"simple\": {}},+    \"formatters\": {\"default\": "format", \"simple\": "format"},     \"disabled\": false,     \"catchUncaughtException\": true   }@@ -51,24 +55,16 @@  So as handlers, sinks may share same handlers. -__Examples of 'Formatter' json__--@-  -- a standard format-  {-    \"fmt\": \"%(message)s\",-    \"datefmt\": \"%Y-%m-%dT%H:%M:%S\"-  }+__Examples of Formatter json__ -  -- missing field will use default value-  {-    \"fmt": "%(message)s\",-    \"datefmt\": \"%Y-%m-%dT%H:%M:%S\"-  }+See 'Text.Format' of vformat package for more information about formatting. -  -- it works as well, just a string-  \"%(message)s\" @+  "{message}"+  "{logger} {level}: {message}"+  "{logger:<20.20s} {level:<8s}: {message}"+  "{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger}] {message}"+@  __Examples of 'Handler' json__ @@ -130,19 +126,16 @@   parseJSON v = Filter <$> parseJSON v  -instance FromJSON Formatter where-  parseJSON (Object v) = Formatter <$> v .:? "fmt" .!= (fmt def)-                                   <*> v .:? "datefmt" .!= (datefmt def)-  parseJSON (String v) = (\fmt -> def {fmt = fmt}) <$> parseJSON (String v)-  parseJSON invalid = typeMismatch "Object" invalid+instance FromJSON Format1 where+  parseJSON v = fromString <$> parseJSON v   instance FromJSON StreamHandler where   parseJSON = withObject "StreamHandler" $ \v ->-      StreamHandler <$> (parseStream <$> (v .:? "stream" .!= "stderr"))-                    <*> v .:? "level" .!= def+      StreamHandler <$> v .:? "level" .!= def                     <*> v .:? "filterer" .!= []-                    <*> v .:? "formatter" .!= def+                    <*> v .:? "formatter" .!= "{message}"+                    <*> (parseStream <$> (v .:? "stream" .!= "stderr"))     where       parseStream :: String -> Handle       parseStream "stderr" = stderr@@ -152,15 +145,15 @@  instance FromJSON (IO FileHandler) where   parseJSON = withObject "FileHandler" $ \v -> do-    file <- v .:? "file" .!= "log4hs.log"-    encoding <- v .:? "encoding" .!= (show utf8)     level <- v .:? "level" .!= def     filterer <- v .:? "filterer" .!= []-    formatter <- v .:? "formatter" .!= def+    formatter <- v .:? "formatter" .!= "{message}"+    file <- v .:? "file" .!= "log4hs.log"+    encoding <- v .:? "encoding" .!= (show utf8)     return $ do       stream <- newIORef undefined       encoding' <- mkTextEncoding encoding-      return $ FileHandler stream file encoding' level filterer formatter+      return $ FileHandler level filterer formatter file encoding' stream   instance FromJSON (IO SomeHandler) where@@ -175,12 +168,12 @@         return $ toHandler <$> (hdlIo :: IO FileHandler)  -instance FromJSON (M.Map String Formatter -> IO SomeHandler) where+instance FromJSON (M.Map String Format1 -> IO SomeHandler) where   parseJSON = withObject "Handler" $ \v -> do     hdlio <- parseJSON (Object v)-    key <- v .:? "formatter" .!= ""+    key <- v .:? "formatter" .!= "{message}"     return $ \fs -> hdlio >>= \hdl -> return $-      set (typed @Formatter) (M.findWithDefault def key fs) hdl+      set (typed @Format1) (M.findWithDefault "" key fs) hdl   instance FromJSON (Sink) where@@ -202,7 +195,7 @@                              }  -type Formatters = M.Map String Formatter+type Formatters = M.Map String Format1 type HandlersMakerIO = M.Map String (Formatters -> IO SomeHandler) type SinksMaker = M.Map String (String -> M.Map String SomeHandler -> Sink) 

@@ -22,13 +22,16 @@ import           Data.List                   (dropWhileEnd, group) import           Data.Map.Lazy               (elems, (!?)) import           Data.Time.Clock+import           Data.Time.Clock.POSIX import           Data.Time.LocalTime import           GHC.Conc                    (setUncaughtExceptionHandler) import           Prelude                     hiding (filter, log)+import           System.FilePath import           System.IO                   (stderr, stdout) import           System.IO.Unsafe            (unsafePerformIO)  import           Logging.Types+import           Logging.Utils  {-# NOINLINE _mgr #-} _mgr :: IORef Manager@@ -72,12 +75,18 @@      => Logger -> Level -> String -> (String, String, String, Int) -> m () log logger level message location = liftIO $ do     mgr@Manager{..} <- readIORef _mgr-    created <- getZonedTime+    asctime <- getZonedTime -    let (file, package, modulename, lineno) = location+    let (pathname, pkgname, modulename, lineno) = location+        filename = takeFileName pathname+        utctime = zonedTimeToUTC asctime+        diffTime = utcTimeToPOSIXSeconds utctime+        created = timestamp diffTime+        msecs = microseconds diffTime      when (not disabled) $ process logger mgr $-      LogRecord logger level message file package modulename lineno created+      LogRecord logger level message pathname filename pkgname modulename+                lineno asctime utctime created msecs   where     process :: Logger -> Manager -> LogRecord -> IO ()     process logger mgr rcd =@@ -115,11 +124,11 @@  -- |A 'StreamHandler' bound to 'stderr' stderrHandler :: StreamHandler-stderrHandler = StreamHandler stderr def [] def+stderrHandler = StreamHandler def [] "" stderr  -- |A 'StreamHandler' bound to 'stdout' stdoutHandler :: StreamHandler-stdoutHandler = StreamHandler stdout def [] def+stdoutHandler = StreamHandler def [] "" stdout  {-# NOINLINE defaultRoot #-} -- |Default root sink which is used by 'jsonToManager' when __root__ is missed.

@@ -2,7 +2,6 @@   ( module Logging.Types.Logger   , module Logging.Types.Level   , module Logging.Types.Filter-  , module Logging.Types.Formatter   , module Logging.Types.Record   , module Logging.Types.Handlers   , module Logging.Types.Sink@@ -12,7 +11,6 @@  import           Logging.Types.Class import           Logging.Types.Filter-import           Logging.Types.Formatter import           Logging.Types.Handlers import           Logging.Types.Level import           Logging.Types.Logger

@@ -1,10 +1,8 @@ module Logging.Types.Class   ( module Logging.Types.Class.Filterable-  , module Logging.Types.Class.Formattable   , module Logging.Types.Class.Handler   ) where   import           Logging.Types.Class.Filterable-import           Logging.Types.Class.Formattable import           Logging.Types.Class.Handler

@@ -1,9 +0,0 @@-module Logging.Types.Class.Formattable ( Formattable(..) ) where--import           Logging.Types.Record----- |A class represents a common trait of formatting 'LogRecord' as 'String'.-class Formattable a where-  format :: a -> LogRecord -> String-  formatTime :: a -> LogRecord -> String

@@ -11,10 +11,10 @@ import           Data.Generics.Product.Typed import           Data.Typeable import           Prelude                        hiding (filter)+import           Text.Format  import           Logging.Types.Class.Filterable import           Logging.Types.Filter-import           Logging.Types.Formatter import           Logging.Types.Level import           Logging.Types.Record @@ -32,9 +32,9 @@   getTyped (SomeHandler h) = view (typed @Filterer) h   setTyped v (SomeHandler h) = SomeHandler $ set (typed @Filterer) v h -instance {-# OVERLAPPING #-} HasType Formatter SomeHandler where-  getTyped (SomeHandler h) = view (typed @Formatter) h-  setTyped v (SomeHandler h) = SomeHandler $ set (typed @Formatter) v h+instance {-# OVERLAPPING #-} HasType Format1 SomeHandler where+  getTyped (SomeHandler h) = view (typed @Format1) h+  setTyped v (SomeHandler h) = SomeHandler $ set (typed @Format1) v h  instance Eq SomeHandler where   (SomeHandler h1) == h2 = Just h1 == fromHandler h2@@ -42,7 +42,6 @@ instance Handler SomeHandler where   open (SomeHandler h) = open h   emit (SomeHandler h) = emit h-  flush (SomeHandler h) = flush h   close (SomeHandler h) = close h   handle (SomeHandler h) = handle h   fromHandler = Just . id@@ -55,7 +54,7 @@ -- handle operations. class ( HasType Level a       , HasType Filterer a-      , HasType Formatter a+      , HasType Format1 a       , Typeable a       , Eq a       ) => Handler a where@@ -63,9 +62,6 @@   open _ = return ()    emit :: a -> LogRecord -> IO ()--  flush :: a -> IO ()-  flush _ = return ()    close :: a -> IO ()   close _ = return ()

@@ -1,79 +0,0 @@-{-# LANGUAGE RecordWildCards #-}--module Logging.Types.Formatter ( Formatter(..) ) where--import           Data.Default-import qualified Data.Time.Format                as TF-import           System.FilePath-import           Text.Printf--import           Logging.Types.Class.Formattable-import           Logging.Types.Record-import           Logging.Utils----- |'Formatter's are used to convert a LogRecord to text.------ 'Formatter's need to know how a 'LogRecord' is constructed. They are--- responsible for converting a 'LogRecord' to (usually) a string which can--- be interpreted by either a human or an external system. The base 'Formatter'--- allows a formatting string to be specified. If none is supplied, the--- default value, "%(message)s" is used.--------- The 'Formatter' can be initialized with a format string which makes use of--- knowledge of the 'LogRecord' attributes - e.g. the default value mentioned--- above makes use of a 'LogRecord''s message attribute. Currently, the useful--- attributes in a 'LogRecord' are described by:------ [@%(logger)s@]     Name of the logger (logging channel)--- [@%(level)s@]      Numeric logging level for the message (DEBUG, INFO, WARN,---                    ERROR, FATAL, LEVEL v)--- [@%(pathname)s@]   Full pathname of the source file where the logging---                    call was issued (if available)--- [@%(filename)s@]   Filename portion of pathname--- [@%(module)s@]     Module (name portion of filename)--- [@%(lineno)d@]     Source line number where the logging call was issued---                    (if available)--- [@%(created)f@]    Time when the LogRecord was created (picoseconds---                    since '1970-01-01 00:00:00')--- [@%(asctime)s@]    Textual time when the 'LogRecord' was created--- [@%(msecs)d@]      Millisecond portion of the creation time--- [@%(message)s@]    The main message passed to 'logv' 'debug' 'info' ..----data Formatter = Formatter { fmt     :: String-                           , datefmt :: String -- ^ see "Data.Time.Format"-                           } deriving (Eq)--instance Default Formatter where-  def = Formatter "%(message)s" "%Y-%m-%dT%H:%M:%S%6Q%z"--instance Formattable Formatter where-  format f@Formatter{..} rcd@LogRecord{..} = formats fmt-    where-      diffTime = zonedTimeToPOSIXSeconds created--      formats :: String -> String-      formats ('%':'%':cs) = ('%' :) $ formats cs-      formats ('%':'(':cs) =-        case break (== ')') cs of-          (attr, ')':c:cs') -> (formatAttr attr c) ++ (formats cs')-          _ -> error "Logging.Types.Formattable: no parse (Formatter)"-      formats (c:cs) = (c :) $ formats cs-      formats ""           = ""--      formatAttr :: String -> Char -> String-      formatAttr "logger" fc   = printf ['%', fc] logger -- %(logger)s-      formatAttr "level" fc    = printf ['%', fc] $ show level -- %(level)s-      formatAttr "pathname" fc = printf ['%', fc] $ takeDirectory filename -- %(pathname)s-      formatAttr "filename" fc = printf ['%', fc] $ takeFileName filename -- %(filename)s-      formatAttr "module" fc   = printf ['%', fc] modulename -- %(module)s-      formatAttr "lineno" fc   = printf ['%', fc] lineno -- %(lineno)d-      formatAttr "created" fc  = printf ['%', fc] $ timestamp diffTime -- %(created)f-      formatAttr "asctime" fc  = printf ['%', fc] $ formatTime f rcd -- %(asctime)s-      formatAttr "msecs" fc    = printf ['%', fc] $ microseconds diffTime -- %(msecs)d-      formatAttr "message" fc  = printf ['%', fc] message -- %(message)s-      formatAttr _ _           = "unknown"--  formatTime Formatter{..} LogRecord{..} =-    TF.formatTime TF.defaultTimeLocale datefmt created

@@ -9,10 +9,10 @@ import           Data.IORef import           GHC.Generics import           System.IO+import           Text.Format  import           Logging.Types.Class import           Logging.Types.Filter-import           Logging.Types.Formatter import           Logging.Types.Level import           Logging.Utils import           System.IO.Extra@@ -21,21 +21,20 @@ -- | A handler type which writes logging records, appropriately formatted, -- to a file. ---data FileHandler = FileHandler { stream    :: IORef Handle+data FileHandler = FileHandler { level     :: Level+                               , filterer  :: Filterer+                               , formatter :: Format1                                , file      :: FilePath                                , encoding  :: TextEncoding-                               , level     :: Level-                               , filterer  :: Filterer-                               , formatter :: Formatter+                               , stream    :: IORef Handle                                } deriving (Generic, Eq)  instance Handler FileHandler where   open FileHandler{..} = atomicWriteIORef stream =<< openLogFile file encoding    emit self@FileHandler{..} rcd = do-    flip hPutStrLn (format formatter rcd) =<< readIORef stream-    flush self--  flush FileHandler{..}= hFlush =<< readIORef stream+    stream' <- readIORef stream+    flip hPutStrLn (format1 formatter rcd) stream'+    hFlush stream'    close FileHandler{..} = hClose =<< readIORef stream

@@ -4,28 +4,26 @@  module Logging.Types.Handlers.StreamHandler ( StreamHandler(..) ) where -import           Control.Monad           (unless)+import           Control.Monad        (unless) import           GHC.Generics import           System.IO+import           Text.Format  import           Logging.Types.Class import           Logging.Types.Filter-import           Logging.Types.Formatter import           Logging.Types.Level   -- | A handler type which writes logging records, appropriately formatted, -- to a stream. ---data StreamHandler = StreamHandler { stream    :: Handle-                                   , level     :: Level+data StreamHandler = StreamHandler { level     :: Level                                    , filterer  :: Filterer-                                   , formatter :: Formatter+                                   , formatter :: Format1+                                   , stream    :: Handle                                    } deriving (Generic, Eq)  instance Handler StreamHandler where   emit hdl@StreamHandler{..} rcd = do-    hPutStrLn stream $ format formatter rcd-    flush hdl--  flush = hFlush . stream+    hPutStrLn stream $ format1 formatter rcd+    hFlush stream

@@ -5,6 +5,7 @@ import           Data.Default import           Data.List    (stripPrefix) import           Data.String+import           Text.Format   -- |'Level' also known as severity, a higher 'Level' means a bigger 'Int'.@@ -24,6 +25,9 @@ -- True -- newtype Level = Level Int deriving (Eq, Ord)++instance FormatArg Level where+  formatArg = formatArg . show  instance Show Level where   show (Level 0)  = "NOTSET"

@@ -1,8 +1,12 @@+{-# LANGUAGE DeriveGeneric         #-} {-# LANGUAGE DuplicateRecordFields #-}  module Logging.Types.Record ( LogRecord(..) ) where +import           Data.Time.Clock import           Data.Time.LocalTime+import           GHC.Generics+import           Text.Format  import           Logging.Types.Level import           Logging.Types.Logger@@ -16,12 +20,47 @@ -- It includes the main message as well as information such as -- when the record was created, the source line where the logging call was made. ---data LogRecord = LogRecord { logger      :: Logger-                           , level       :: Level-                           , message     :: String-                           , filename    :: String-                           , packagename :: String-                           , modulename  :: String-                           , lineno      :: Int-                           , created     :: ZonedTime-                           }+-- 'LogRecord' can be formatted into string by 'Text.Format'+-- from 'vformat' package, see 'Text.Format.format1' for more information.+--+-- Currently, the useful attributes in a LogRecord are described by:+--+-- @+--  logger        name of the logger, see 'Logger'+--  level         logging level for the message, see 'Level'+--  message       the main message passed to logv debug info ..+--  pathname      full pathname of the source file where the logging call was issued (if available)+--  filename      filename portion of pathname+--  pkgname       package name where the logging call was issued (if available)+--  modulename    module name (e.g. Main, Logging.Types)+--  lineno        source line number where the logging call was issued (if available)+--  asctime       'ZonedTime' when the LogRecord was created+--  utctime       'UTCTime' when the LogRecord was created+--  created       timestamp when the LogRecord was created+--  msecs         millisecond portion of the creation time+-- @+--+-- Format examples:+--+-- @+--  "{message}"+--  "{logger} {level}: {message}"+--  "{logger:<20.20s} {level:<8s}: {message}"+--  "{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger}] {message}"+-- @+--+data LogRecord = LogRecord { logger     :: Logger+                           , level      :: Level+                           , message    :: String+                           , pathname   :: String+                           , filename   :: String+                           , pkgname    :: String+                           , modulename :: String+                           , lineno     :: Int+                           , asctime    :: ZonedTime+                           , utctime    :: UTCTime+                           , created    :: Double+                           , msecs      :: Integer+                           } deriving Generic++instance FormatArg LogRecord

@@ -7,8 +7,11 @@   , milliseconds   , microseconds   , openLogFile+  , rotateFile+  , modifyBaseName   ) where +import           Control.Monad import           Data.Time.Clock import           Data.Time.Clock.POSIX import           Data.Time.LocalTime@@ -57,3 +60,11 @@   stream <- openFile file AppendMode   hSetEncoding stream encoding   return stream+++rotateFile :: FilePath -> FilePath -> IO ()+rotateFile src dest = doesFileExist src >>= (flip when $ renameFile src dest)+++modifyBaseName :: FilePath -> (String -> String) -> FilePath+modifyBaseName file modify = replaceBaseName file $ modify $ takeBaseName file

@@ -24,13 +24,13 @@ import           System.IO.Unsafe import           Test.Hspec import           Test.Hspec.QuickCheck+import           Text.Format  import           Logging import           Logging.Aeson  spec :: Spec-spec = levelSpec >> filterSpec >> formatterSpec >> handlerSpec >>-       sinkSpec >>  managerSpec+spec = levelSpec >> filterSpec >> handlerSpec >> sinkSpec >> managerSpec   levelSpec :: Spec@@ -45,19 +45,6 @@     in (decode $ encode logger) == Just (Filter logger)  -formatterSpec :: Spec-formatterSpec = describe "Formatter" $ modifyMaxSize (const 1000) $ do-  prop "decode standard" $ \(fmt, datefmt) ->-    let formatter = Formatter fmt datefmt-        obj = object [("fmt", toJSON fmt), ("datefmt", toJSON datefmt)]-    in (decode $ encode obj) == Just formatter--  prop "decode missing filed" $ \fmt ->-    decode (encode $ object [("fmt", toJSON fmt)]) == Just (def {fmt = fmt})--  prop "decode string" $ \fmt -> decode (encode fmt) == Just (def {fmt = fmt})-- handlerSpec :: Spec handlerSpec = describe "Handler" $ modifyMaxSize (const 1000) $ do   it "decode StreamHandler simple" $ do@@ -66,7 +53,7 @@     stream == stderr `shouldBe` True     level == def `shouldBe` True     filterer == [] `shouldBe` True-    formatter == def `shouldBe` True+    formatter == "{message}" `shouldBe` True    it "decode StreamHandler standard" $ do     let StreamHandler{..} = fromJust $ decode $ encode $@@ -83,7 +70,7 @@     stream == stdout `shouldBe` True     level == "DEBUG" `shouldBe` True     filterer == [Filter "Module.Submodule"] `shouldBe` True-    formatter == def {fmt = "default"} `shouldBe` True+    formatter == "default" `shouldBe` True    it "decode FileHandler" $ do     FileHandler{..} <- fromJust $ decode $ encode $@@ -102,10 +89,10 @@     encoding `shouldBe` utf16     level `shouldBe` "INFO"     filterer == [Filter "Module.Submodule"] `shouldBe` True-    formatter == def {fmt = "default"} `shouldBe` True+    formatter == "default" `shouldBe` True    it "decode (formatters -> SomeHandler)" $ do-    let simple = def {fmt = "%(logger)s: %(message)s"}+    let simple = "{logger}: {message}"         func = fromJust $ decode $ encode           [aesonQQ|             {@@ -119,7 +106,7 @@     handler@(SomeHandler _) <- func $ M.singleton ("simple" :: String) simple     view (typed @Level) handler == "DEBUG" `shouldBe` True     view (typed @Filterer) handler == ["Module.Submodule"] `shouldBe` True-    view (typed @Formatter) handler == simple `shouldBe` True+    view (typed @Format1) handler == simple `shouldBe` True   sinkSpec :: Spec@@ -230,8 +217,6 @@       }     },     "formatters": {-      "default": {-        "fmt": "%(asctime)s - %(level)s - %(logger)s:%(lineno)d] %(message)s"-      }+      "default": "{asctime} - {level} - {logger}:{lineno}] {message}"     } }|]

@@ -3,97 +3,19 @@  module Logging.TypesSpec ( spec ) where -import           Data.Default import           Data.String           (fromString)-import           Data.Time.Clock-import           Data.Time.Format      as TF-import           Data.Time.LocalTime-import           System.FilePath import           Test.Hspec import           Test.Hspec.QuickCheck import           Test.QuickCheck-import           Text.Printf  import           Logging.Types import           Logging.Utils  spec :: Spec-spec = levelSpec >> formatterSpec+spec = levelSpec   levelSpec :: Spec levelSpec = describe "Level" $ modifyMaxSize (const 1000) $ do   prop "read and show" $ \x -> (read . show) (Level x) == (Level x)   prop "overload string" $ \x -> fromString (show (Level x)) == (Level x)---formatterSpec :: Spec-formatterSpec = describe "Formatter" $ modifyMaxSize (const 1000) $ do-    -- one field only-    fmtProp "%(logger)s" "LogRecord's logger record" loggerFmt-    fmtProp "%(level)s" "LogRecord's level record" levelFmt-    fmtProp "%(message)s" "LogRecord's message record" message-    fmtProp "%(pathname)s" "LogRecord's filename (dir) record" pathnameFmt-    fmtProp "%(filename)s" "LogRecord's filename (no dir) record" filenameFmt-    fmtProp "%(module)s" "LogRecord's modulename record" modulename-    fmtProp "%(lineno)d" "LogRecord's lineno record" $ show . lineno-    fmtProp "%(created)f"-          "LogRecord's created (decimal second timestamp) record"-          createdFmt-    fmtProp "%(msecs)d"-          "LogRecord's created (millisecond timestamp) record"-          msecsFmt-    dateProp "%(asctime)s" "%Y-%m-%dT%H:%M:%S"-              "LogRecord's created (human friendly) record"-              asctimeFmt-    -- mixed fields-    dateProp-      "%(asctime)s - %(level)s - %(logger)s" "%Y-%m-%dT%H:%M:%S"-      "LogRecord's created (human friendly) - level - logger records"-      asctimeLevelLoggerFmt-    fmtProp "%(pathname)s/%(filename)s" "LogRecord's filename (/ split) record"-      pathnameFilenameFmt-    fmtProp "%(lineno)d] %(message)s" "LogRecord's lineno] message records"-      linenoMessageFmt-  where-    fmtProp :: String -> String -> (LogRecord -> String)-          -> SpecWith (Arg Property)-    fmtProp fmt desc manualFmt = prop (printf "format %s to %s" fmt desc) $-      \rcd -> format (def {fmt = fmt}) rcd == manualFmt rcd--    dateProp :: String -> String -> String -> (LogRecord -> String)-              -> SpecWith (Arg Property)-    dateProp fmt datefmt desc manualFmt =-      prop (printf "format %s(%s) to %s" fmt datefmt desc) $-        \rcd -> format (Formatter fmt datefmt) rcd == manualFmt rcd--    loggerFmt = \LogRecord{..} -> logger-    levelFmt = \LogRecord{..} -> show level-    pathnameFmt = takeDirectory . filename-    filenameFmt = takeFileName . filename-    createdFmt = (printf "%f") . timestamp . zonedTimeToPOSIXSeconds . created-    msecsFmt = show . milliseconds . zonedTimeToPOSIXSeconds . created-    asctimeFmt = TF.formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" . created-    asctimeLevelLoggerFmt rcd =-      asctimeFmt rcd ++ " - " ++ (levelFmt rcd) ++ " - " ++(loggerFmt rcd)-    pathnameFilenameFmt rcd = pathnameFmt rcd ++ "/" ++ (filenameFmt rcd)-    linenoMessageFmt rcd = (show $ lineno rcd) ++ "] " ++ (message rcd)---deriving instance Show LogRecord---instance Arbitrary LogRecord where-  arbitrary = LogRecord-           <$> arbitrary-           <*> (Level <$> arbitrary)-           <*> arbitrary-           <*> arbitrary-           <*> arbitrary-           <*> arbitrary-           <*> arbitrary-           <*> (((`addZonedTime` zeroTime) . toEnum) <$> arbitrary)---zeroTime :: ZonedTime-zeroTime = read "1970-01-01 00:00:00"

@@ -18,6 +18,7 @@ import           Test.Hspec.QuickCheck import           Test.QuickCheck         hiding (run) import qualified Test.QuickCheck.Monadic as Q+import           Text.Format  import           Logging @@ -134,20 +135,20 @@   return (Manager root sinks disabled False, streams)  -formatters :: M.Map String Formatter+formatters :: M.Map String Format1 formatters = M.fromList-  [ ("simple", def {fmt = "%(message)s"})-  , ("logger", def {fmt = "%(logger)s: %(message)s"})-  , ("level", def {fmt = "%(logger)s %(level)s] %(message)s"})+  [ ("simple", "{message}")+  , ("logger", "{logger}: {message}")+  , ("level", "{logger} {level}] {message}")   ]  -createPipeHandler :: Level -> Filterer -> Formatter -> IO (SomeHandler, Handle)+createPipeHandler :: Level -> Filterer -> Format1 -> IO (SomeHandler, Handle) createPipeHandler level filterer formatter = do   (read, write) <- createPipe   hSetEncoding read utf8   hSetEncoding write utf8-  return $ ( toHandler $ StreamHandler write level filterer formatter+  return $ ( toHandler $ StreamHandler level filterer formatter write            , read            )