Add file logger

hbs2-core/hbs2-core.cabal

@@ -206,6 +206,7 @@ test-suite test
 
     other-modules:  TestFakeMessaging
                   , TestActors
+                  , TestFileLogger
                   -- , TestUniqProtoId
                   , FakeMessaging
                   , HasProtocol
@@ -222,6 +223,7 @@ test-suite test
         , bytestring
         , cache
         , containers
+        , directory
         , hashable
         , microlens-platform
         , mtl

hbs2-core/lib/HBS2/System/Logger/Simple.hs

@@ -17,6 +17,7 @@ module HBS2.System.Logger.Simple
   , loggerTr
   , toStderr
   , toStdout
+  , toFile
   , logPrefix
   , SetLoggerEntry
   , module HBS2.System.Logger.Simple.Class
@@ -39,6 +40,7 @@ import Lens.Micro.Platform
 
 data LoggerType = LoggerStdout
                 | LoggerStderr
+                | LoggerFile FilePath
                 | LoggerNull
 
 data LoggerEntry =
@@ -78,6 +80,9 @@ toStderr = set loggerType LoggerStderr
 toStdout :: SetLoggerEntry
 toStdout = set loggerType LoggerStdout
 
+toFile :: FilePath -> SetLoggerEntry
+toFile filePath = set loggerType (LoggerFile filePath)
+
 setLogging :: forall a m . (MonadIO m, HasLogLevel a)
            => (LoggerEntry -> LoggerEntry)
            -> m ()
@@ -104,6 +109,10 @@ setLogging f = do
         se <- liftIO $ newStdoutLoggerSet 10000 -- FIXME: ??
         pure $ set loggerSet se e
 
+      LoggerFile filePath-> do
+        delLogger (Just e)
+        se <- liftIO $ newFileLoggerSet 10000 filePath -- FIXME: ??
+        pure $ set loggerSet se e
 
 setLoggingOff :: forall a m . (MonadIO m, HasLogLevel a) => m ()
 setLoggingOff = do

hbs2-core/test/Main.hs

@@ -3,6 +3,7 @@ module Main where
 import TestFakeMessaging
 import TestActors
 import DialogSpec
+import TestFileLogger
 
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -14,6 +15,7 @@ main =
       [
         testCase "testFakeMessaging1" testFakeMessaging1
       , testCase "testActorsBasic" testActorsBasic
+      , testCase "testFileLogger" testFileLogger
       , testDialog
       ]
 

hbs2-core/test/TestFileLogger.hs

@@ -0,0 +1,23 @@
+module TestFileLogger where
+
+import HBS2.System.Logger.Simple
+import System.Directory
+import Test.Tasty.HUnit
+
+logFile :: FilePath
+logFile = "/tmp/testFileLogger.log"
+
+debugPrefix :: SetLoggerEntry
+debugPrefix = toFile logFile . logPrefix "[debug] "
+
+testFileLogger :: IO ()
+testFileLogger = do
+  let msg = "Oh hi Mark"
+
+  setLogging @DEBUG debugPrefix
+  debug msg
+  setLoggingOff @DEBUG
+
+  fileContent <- readFile logFile
+  assertEqual "write == read" fileContent ("[debug] " <> msg <> "\n")
+  removeFile logFile