From e411e292461179a83a5fc0a0d78f98233c7323f9 Mon Sep 17 00:00:00 2001
From: Vladimir Krutkin <krutkinvs@gmail.com>
Date: Thu, 12 Oct 2023 12:54:56 +0300
Subject: [PATCH] Add file logger

---
 hbs2-core/hbs2-core.cabal                  |  2 ++
 hbs2-core/lib/HBS2/System/Logger/Simple.hs |  9 +++++++++
 hbs2-core/test/Main.hs                     |  2 ++
 hbs2-core/test/TestFileLogger.hs           | 23 ++++++++++++++++++++++
 4 files changed, 36 insertions(+)
 create mode 100644 hbs2-core/test/TestFileLogger.hs

diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal
index f2614b19..d3be5e3d 100644
--- a/hbs2-core/hbs2-core.cabal
+++ b/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
diff --git a/hbs2-core/lib/HBS2/System/Logger/Simple.hs b/hbs2-core/lib/HBS2/System/Logger/Simple.hs
index 7e4adcc6..b2eb43fb 100644
--- a/hbs2-core/lib/HBS2/System/Logger/Simple.hs
+++ b/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
diff --git a/hbs2-core/test/Main.hs b/hbs2-core/test/Main.hs
index 832a7606..cb54f859 100644
--- a/hbs2-core/test/Main.hs
+++ b/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
       ]
 
diff --git a/hbs2-core/test/TestFileLogger.hs b/hbs2-core/test/TestFileLogger.hs
new file mode 100644
index 00000000..65904566
--- /dev/null
+++ b/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