diff options
| -rw-r--r-- | Biz/Devalloc.hs | 13 | ||||
| -rw-r--r-- | Biz/Log.hs | 20 | ||||
| -rw-r--r-- | Biz/Pie.hs | 1 | ||||
| -rw-r--r-- | Biz/Que/Host.hs | 1 | ||||
| -rw-r--r-- | Biz/Que/Site.hs | 1 |
5 files changed, 27 insertions, 9 deletions
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 @@ -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 @@ -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 |