Adds basic logging example

[friedbrice]

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?

[chris-martin]

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 -

1. "Look how simple this can be" - where we define just consoleLog and formattedLog and give an extremely basic demo that does nothing other than apply the record function a handful of times;
2. "Look how powerful this can be" - where we introduce the file logger and the other combinators, and give the full example that uses the boot log while setting up the app log.

{-# 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]

[chris-martin]

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.

[friedbrice]

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.

[chris-martin]

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?

[friedbrice]

Jeez, I'm sorry I missed this comment. The license is agreeable. - [Daniel Brice](https://github.com/friedbrice) is good. Thank you very much.

[friedbrice]

How is this (https://gist.github.com/friedbrice/70666e9fe4c053a40936a47c5d77cafc) for queues?

[chris-martin]

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.