Add Log.mark and convert some putTexts into Log.infos

1 files changed, 17 insertions, 3 deletions

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