From 093ab5b791c07442d819ee295900136e213f4c8e Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 5 Feb 2021 22:02:20 -0500
Subject: Add Log.mark and convert some putTexts into Log.infos

---
 Biz/Devalloc.hs | 13 +++++++------
 Biz/Log.hs      | 20 +++++++++++++++++---
 Biz/Pie.hs      |  1 +
 Biz/Que/Host.hs |  1 +
 Biz/Que/Site.hs |  1 +
 5 files changed, 27 insertions(+), 9 deletions(-)

(limited to 'Biz')

diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 9bc8bd0..cad343b 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -33,6 +33,7 @@
 -- : dep ixset
 -- : dep lucid
 -- : dep protolude
+-- : dep rainbow
 -- : dep req
 -- : dep safecopy
 -- : dep servant
@@ -56,6 +57,7 @@ import Alpha hiding (rem, (<.>))
 import Biz.App (CSS (..), HtmlApp (..))
 import qualified Biz.Cli as Cli
 import qualified Biz.Id as Id
+import qualified Biz.Log as Log
 import qualified Biz.Look
 import Biz.Test ((@=?), (@?!=))
 import qualified Biz.Test as Test
@@ -418,12 +420,11 @@ startup = do
   oAuthArgs <- Envy.decodeWithDefaults Envy.defConfig
   kp <- Acid.openLocalStateFrom (keep cfg) init :: IO (Acid.AcidState Keep)
   jwk <- Auth.generateKey
-  putText "@"
-  putText "devalloc"
-  putText <| "area: " <> (show <| area cfg)
-  putText <| "port: " <> (show <| port cfg)
-  putText <| "depo: " <> (Text.pack <| depo cfg)
-  putText <| "keep: " <> (Text.pack <| keep cfg)
+  Log.info ["@", "devalloc"] >> Log.br
+  Log.info ["area", show <| area cfg] >> Log.br
+  Log.info ["port", show <| port cfg] >> Log.br
+  Log.info ["depo", Text.pack <| depo cfg] >> Log.br
+  Log.info ["keep", Text.pack <| keep cfg] >> Log.br
   let jwtCfg = Auth.defaultJWTSettings jwk
   let cooks = case area cfg of
         Test -> testCookieSettings
diff --git a/Biz/Log.hs b/Biz/Log.hs
index c713946..a4d6253 100644
--- a/Biz/Log.hs
+++ b/Biz/Log.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
+-- : dep rainbow
 module Biz.Log
   ( Lvl (..),
     good,
@@ -8,6 +9,8 @@ module Biz.Log
     info,
     warn,
     fail,
+    -- Debugging
+    mark,
     -- | Low-level
     msg,
     br,
@@ -16,9 +19,10 @@ where
 
 import Alpha hiding (pass)
 import qualified Data.Text as Text
-import Rainbow (chunk, fore, green, putChunk, red, white, yellow)
+import Rainbow (chunk, fore, green, magenta, putChunk, red, white, yellow)
+import System.IO.Unsafe (unsafePerformIO)
 
-data Lvl = Good | Pass | Info | Warn | Fail
+data Lvl = Good | Pass | Info | Warn | Fail | Mark
 
 msg :: Lvl -> [Text] -> IO ()
 msg lvl labels = putChunk <| fore color <| clear <> txt <> "\r"
@@ -30,9 +34,12 @@ msg lvl labels = putChunk <| fore color <| clear <> txt <> "\r"
       Info -> (white, "info")
       Warn -> (yellow, "warn")
       Fail -> (red, "fail")
-    gap = ":  "
+      Mark -> (magenta, "mark")
     clear = "\ESC[2K"
 
+gap :: Text
+gap = ":  "
+
 br :: IO ()
 br = putChunk "\n"
 
@@ -42,3 +49,10 @@ pass = msg Pass
 info = msg Info
 warn = msg Warn
 fail = msg Fail
+
+-- | Like 'Debug.trace' but follows the patterns in this module
+mark :: Show a => Text -> a -> a
+mark label val =
+  unsafePerformIO <| do
+    msg Mark [label, tshow val]
+    pure val
diff --git a/Biz/Pie.hs b/Biz/Pie.hs
index 9c78258..15e5949 100644
--- a/Biz/Pie.hs
+++ b/Biz/Pie.hs
@@ -39,6 +39,7 @@
 -- : dep haskeline
 -- : dep protolude
 -- : dep parsec
+-- : dep rainbow
 -- : dep tasty
 -- : dep tasty-hunit
 -- : dep tasty-quickcheck
diff --git a/Biz/Que/Host.hs b/Biz/Que/Host.hs
index 57507ae..fda9835 100644
--- a/Biz/Que/Host.hs
+++ b/Biz/Que/Host.hs
@@ -18,6 +18,7 @@
 -- : dep docopt
 -- : dep envy
 -- : dep protolude
+-- : dep rainbow
 -- : dep scotty
 -- : dep stm
 -- : dep tasty
diff --git a/Biz/Que/Site.hs b/Biz/Que/Site.hs
index 77498b4..43441df 100644
--- a/Biz/Que/Site.hs
+++ b/Biz/Que/Site.hs
@@ -13,6 +13,7 @@
 -- : dep config-ini
 -- : dep process
 -- : dep protolude
+-- : dep rainbow
 -- : dep req
 -- : dep tasty
 -- : dep tasty-hunit
-- 
cgit v1.2.3