Closed friedbrice closed 4 years ago
I've been rolling this around mostly splitting things up into smaller functions and trying to get the log output to look simple. I think the Level
and Event
types help make it a little more concise. The logAction
function here can return a result, which makes the code a little longer but it means we can now use it to wrap up the entire log file setup.
I really don't think it's too convoluted, but I think to present it more palatably I want to split it up into two parts -
consoleLog
and formattedLog
and give an extremely basic demo that does nothing other than apply the record
function a handful of times;{-# LANGUAGE LambdaCase #-}
import Control.Exception.Safe (displayException, tryAny)
import Data.Foldable (fold)
import System.Directory (getPermissions, writable)
import System.Environment (getEnv)
import System.IO (hPutStr, stdout, stderr)
data Level = Info | Error
data Event = Event Level String
data Log = Log { record :: Event -> IO () }
standardStream = \case Info -> stdout; Error -> stderr
consoleLog = Log $ \(Event level message) ->
hPutStr (standardStream level) (message <> "\n")
fileLog :: (Level -> FilePath) -> Log
fileLog path = Log $ \(Event level message) ->
appendFile (path level) (message <> "\n")
multiLog log1 log2 = Log $ \event ->
do
record log1 event
record log2 event
nullLog = Log (\_ -> return ())
formatEvent topic (Event level msg) = Event level msg'
where
msg' = paren (topic ! levelString level) ! msg
paren x = "(" <> x <> ")"
x ! y = x <> " " <> y
levelString = \case Info -> "info"; Error -> "error"
formattedLog topic log = Log $ \event ->
record log (formatEvent topic event)
instance Semigroup Log where (<>) = multiLog
instance Monoid Log where mempty = nullLog
logFunc log functionName f x =
do
record log (Event Info msg)
return (f x)
where
msg = functionName ! show x ! "=" ! show (f x)
exceptionEvent ex = Event Error (displayException ex)
logAction log taskDescription action =
do
record log (event Info "Starting")
result <- tryAny action >>=
\case
Left e ->
do
record log (exceptionEvent e)
return Nothing
Right x ->
return (Just x)
record log (event Info "Done")
return result
where
event level message = Event level (taskDescription ! "-" ! message)
envLogPath varName =
do
path <- getEnv varName
assertWritable path
return path
assertWritable path =
do
permissions <- getPermissions path
case writable permissions of
True -> return ()
False -> fail ("Log path" ! path ! "is not writable")
initFileLog :: IO Log
initFileLog =
do
infoPath <- envLogPath "INFO_LOG"
errorPath <- envLogPath "ERROR_LOG"
return (fileLog (\case Info -> infoPath; Error -> errorPath))
main =
do
let bootLog = formattedLog "Boot" consoleLog
record bootLog (Event Info "Starting ...")
fileLog <- logAction bootLog "initFileLog" initFileLog
let appLog = formattedLog "App" consoleLog <> fold fileLog
record appLog (Event Info "Application started")
let double = logFunc appLog "double" (* 2)
x <- double (5 :: Int)
y <- double (6 :: Int)
z <- double (7 :: Int)
record appLog (Event Info ("Results: " <> show [x, y, z]))
λ> :! touch /tmp/info.txt /tmp/error.txt
λ> setEnv "INFO_LOG" "/tmp/info.txt"
λ> setEnv "ERROR_LOG" "/tmp/err.txt"
λ> main
(Boot info) Starting ...
(Boot info) initFileLog - Starting
(Boot info) initFileLog - Done
(App info) Application started
(App info) double 5 = 10
(App info) double 6 = 12
(App info) double 7 = 14
(App info) Results: [10,12,14]
λ> setEnv "INFO_LOG" "/tmp/info.tt"
λ> main
(Boot info) Starting ...
(Boot info) initFileLog - Starting
(Boot error) /tmp/info.tt: getPermissions:getFileStatus: does not exist (No such file or directory)
(Boot info) initFileLog - Done
(App info) Application started
(App info) double 5 = 10
(App info) double 6 = 12
(App info) double 7 = 14
(App info) Results: [10,12,14]
λ> :! cat /tmp/info.txt
Application started
double 5 = 10
double 6 = 12
double 7 = 14
Results: [10,12,14]
I just glanced back at #15 and remembered that I had wanted to address using a queue to safely combine logs from multiple threads - but that puts us way over the complexity budget for this example... so I think that original example I wrote in the issue actually just needs to be turned into a page about queues.
This looks great! I like how your dilemma (checking for write permissions) is a lot less contrived than my dilemma (warning about modifying an existing files). I’ll try to find a logical way to split it, like you suggested.
Been doing some writing, should be ready to merge soon. Oh, how should we list you in the contributor list, and for the record is the CC BY-NC 4.0 license agreeable?
Jeez, I'm sorry I missed this comment. The license is agreeable. - [Daniel Brice](https://github.com/friedbrice)
is good. Thank you very much.
How is this (https://gist.github.com/friedbrice/70666e9fe4c053a40936a47c5d77cafc) for queues?
Cool, I subsequently missed your comment as well. Will get this out soon! Made a note on #14 to get back around to the queue example.
Addresses issue https://github.com/typeclasses/haskell-phrasebook/issues/15
I want the logging to be somewhat realistic (even though I'm completely ignoring time), and I want to have nice things like log combinators, so I have stuff like formatting and combining logs. But now that I'm looking at it, I can't help but think that this is way too convoluted.
What are the essential features you'd like to see?