From b0c7e55fcf4dc67b3caeb1b61ab8f55527d8b835 Mon Sep 17 00:00:00 2001
From: Daniel Brice <danielbrice@gmail.com>
Date: Tue, 18 Aug 2020 10:12:46 -0700
Subject: [PATCH] Add example for threadsafe logging.

---
 outputs/threadsafe-logging.txt | 37 +++++++++++++++++++++++++
 threadsafe-logging.hs          | 50 ++++++++++++++++++++++++++++++++++
 2 files changed, 87 insertions(+)
 create mode 100644 outputs/threadsafe-logging.txt
 create mode 100644 threadsafe-logging.hs

diff --git a/outputs/threadsafe-logging.txt b/outputs/threadsafe-logging.txt
new file mode 100644
index 0000000..783dec3
--- /dev/null
+++ b/outputs/threadsafe-logging.txt
@@ -0,0 +1,37 @@
+λ> :main
+Do Re Mi
+Fa Sol
+La Ti Do
+Fa SolL
+Dao  TRie  DMoi
+
+Fa Sol
+La Ti Do
+Do Re Mi
+Do Re Mi
+Fa Sol
+FaD LoSa o RlTe
+i  MDio
+
+La Ti Do
+
+λ> import System.Environment (setEnv)
+
+λ> setEnv "MAX_QUEUE" "100"
+
+λ> :main
+Fa Sol
+La Ti Do
+Do Re Mi
+La Ti Do
+Fa Sol
+Do Re Mi
+Fa Sol
+Do Re Mi
+La Ti Do
+La Ti Do
+Do Re Mi
+Fa Sol
+Fa Sol
+Do Re Mi
+La Ti Do
diff --git a/threadsafe-logging.hs b/threadsafe-logging.hs
new file mode 100644
index 0000000..84979ae
--- /dev/null
+++ b/threadsafe-logging.hs
@@ -0,0 +1,50 @@
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Monad.STM (atomically)
+import Data.Foldable (for_)
+import System.Environment (lookupEnv)
+import System.Random (randomRIO)
+import Text.Read (readMaybe)
+
+import qualified Control.Concurrent.STM.TBQueue as TBQ
+
+
+seconds n = 1000000 * n
+
+
+threadsafeLog maxQueue = do
+  queue <- atomically (TBQ.newTBQueue maxQueue)
+
+  let
+    logToQueue msg = atomically (TBQ.writeTBQueue queue msg)
+
+    printFromQueue = do
+      threadDelay (seconds 1 `div` 2)
+      emptyQueue <- atomically (TBQ.isEmptyTBQueue queue)
+      if emptyQueue then
+        return ()
+      else do
+        msg <- atomically (TBQ.readTBQueue queue)
+        putStrLn msg
+        printFromQueue
+
+  return (logToQueue, printFromQueue)
+
+
+sing phrase log =
+  for_ [1..5] $ \n -> do
+    i <- randomRIO (1, 10000)
+    threadDelay (seconds 1 `div` i + n)
+    log phrase
+
+
+main = do
+  (log, print) <- do
+    maxQueue <- (readMaybe =<<) <$> lookupEnv "MAX_QUEUE"
+    case maxQueue of
+      Nothing -> return (putStrLn, threadDelay (seconds 3))
+      Just n -> threadsafeLog n
+
+  for_ [sing "Do Re Mi", sing "Fa Sol", sing "La Ti Do"] $
+    \singPhrase -> forkIO (singPhrase log)
+
+  print