logger-thread (empty) → 0.1.0.0

raw patch · 5 files changed

+189/−0 lines, 5 filesdep +basedep +fast-loggerdep +logger-threadsetup-changed

Dependencies added: base, fast-logger, logger-thread, protolude, safe-exceptions, stm, text, time

Files

LICENSE +30/−0
Setup.hs +2/−0
app/Main.hs +26/−0
logger-thread.cabal +51/−0
src/LoggerThread.hs +80/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,26 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Concurrent            (threadDelay)+import Control.Concurrent.STM.TQueue+import Protolude                     hiding (bracket)++import LoggerThread++main :: IO ()+main = do+  args <- getArgs+  putText ("command line arguments: " <> show args)+  numCapabilities <- getNumCapabilities+  putText ("number of cores: " <> show numCapabilities)+  withLoggerThread mainThread++mainThread :: Logger -> IO ()+mainThread logger = do+  logger "logginng stuff"+  threadDelay (1000 * 1000)+  logger "logginng stuff again"+  threadDelay (1000 * 1000)+  logger "final logginng, exiting after this"

+ logger-thread.cabal view

@@ -0,0 +1,51 @@+name:                logger-thread+version:             0.1.0.0+synopsis:            Run FastLogger in a thread and direct all queued messages to it.+description:         Please see README.md+homepage:            https://github.com/joe9/logger-thread#readme+license:             BSD3+license-file:        LICENSE+author:              joe9+maintainer:          joe9mail@gmail.com+copyright:           2016 Joe9+category:            Web+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     LoggerThread+  build-depends:       base < 6+                     , protolude+                     , fast-logger+                     , safe-exceptions+                     , stm+                     , text+                     , time+  default-language:    Haskell2010+  default-extensions:  NoImplicitPrelude+  other-extensions:    OverloadedStrings++executable logger-thread-exe+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base < 6+                     , logger-thread+                     , protolude+                     , stm+  default-language:    Haskell2010++-- test-suite logger-thread-test+--   type:                exitcode-stdio-1.0+--   hs-source-dirs:      test+--   main-is:             Spec.hs+--   build-depends:       base+--                      , logger-thread+--   ghc-options:         -threaded -rtsopts -with-rtsopts=-N+--   default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/joe9/logger-thread

+ src/LoggerThread.hs view

@@ -0,0 +1,80 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module LoggerThread+  ( withLoggerThread+  , Logger+  ) where++import Control.Concurrent.STM.TQueue+import Control.Exception.Safe+import Control.Monad.STM             (atomically)+import Data.Text+import Protolude                     hiding (bracket)+import System.Log.FastLogger++type Logger = Text -> IO ()++toLog :: TQueue Text -> Text -> IO ()+toLog chan s = atomically (writeTQueue chan (s <> singleton '\n'))++withLoggerThread :: (Logger -> IO ()) -> IO ()+withLoggerThread mainThread = do+  logChannel <- atomically newTQueue+  bracket+    (async (loggerThread logChannel))+    (\loggerThreadAsync -> do+       putText "after the main thread, stop the loggerThread"+       -- dummy text to unblock the logger channel+       threadDelay (1000 * 1000)+       cancel loggerThreadAsync+       putText "cancelled the loggerThread"+       wait loggerThreadAsync)+    (\loggerThreadAsync -> do+       link loggerThreadAsync+       withException+         (mainThread (toLog logChannel))+         (\e -> do+            putText "exception in main thread"+            (print :: SomeException -> IO ()) e+            putText "main thread exiting"))++--   1 MiB = 1 mebibyte = 1,0242 bytes = 1,048,576 bytes+--   100 MiB = 1,048,576 * 100 bytes+loggerThread :: TQueue Text -> IO ()+loggerThread chan =+  withFastLogger+    (LogStderr 1048576)+    (\f ->+       withException+         (readAndLog chan f)+         (\e -> do+            putText "exception in logger thread"+            (print :: SomeException -> IO ()) e+            shutdownLogging chan f))++shutdownLogging :: TQueue Text -> (LogStr -> IO a) -> IO ()+shutdownLogging chan f = do+  putText "in shutdownLogging"+  maybeValue <- atomically (tryReadTQueue chan)+  case maybeValue of+    Just t -> (f . (toLogStr :: Text -> LogStr)) t >> shutdownLogging chan f+    Nothing -> putText "LoggerThread stopped reading, exiting" >> return ()++readAndLog :: TQueue Text -> (LogStr -> IO a) -> IO ()+readAndLog chan f =+  atomically (readTQueue chan) >>= f . (toLogStr :: Text -> LogStr) >>+  readAndLog chan f+-- log rotation is a system function, not an application function+-- should not be doing this here+-- not sure how to use this. If I use it readAndLog, it gives this+-- message+-- GetMarketsServer: /home/j/var/betfair//log/aping-20160820-betfair.log: openFile: resource busy (file is locked)+-- checkAndRotate :: FileLogSpec -> IO ()+-- checkAndRotate spec =+--   do size <- getFileSize (log_file spec)+--      when (size > log_file_size spec)+--           (rotate spec)+-- getFileSize+--   :: BasicPrelude.FilePath -> IO Integer+-- getFileSize path = withFile path ReadMode hFileSize