{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- : dep rainbow
module Biz.Log
  ( Lvl (..),
    good,
    pass,
    info,
    warn,
    fail,
    -- Debugging
    mark,
    -- Operators
    (~&),
    (~?),
    -- | Low-level
    msg,
    br,
  )
where

import Alpha hiding (pass)
import qualified Data.Text as Text
import Rainbow (chunk, fore, green, magenta, red, white, yellow)
import qualified Rainbow
import qualified System.Environment as Env
import qualified System.IO as IO
import System.IO.Unsafe (unsafePerformIO)

data Lvl = Good | Pass | Info | Warn | Fail | Mark

-- | Get the environment. This should probably return 'Biz.Devalloc.Area'
-- instead of 'String'.
area :: String
area =
  Env.lookupEnv "AREA"
    /> maybe "Test" identity
    |> unsafePerformIO

msg :: Lvl -> [Text] -> IO ()
msg lvl labels =
  case area of
    -- systemd doesn't render msgs produced by putChunk, so when live we don't
    -- use rainbow at all
    "Live" -> putStr txt
    _ -> Rainbow.putChunk <| fore color <| clear <> chunk txt <> "\r"
  where
    txt = Text.intercalate gap (label : labels)
    (color, label) = case lvl of
      Good -> (green, "good")
      Pass -> (green, "pass")
      Info -> (white, "info")
      Warn -> (yellow, "warn")
      Fail -> (red, "fail")
      Mark -> (magenta, "mark")
    clear = "\ESC[2K"

gap :: Text
gap = ":  "

br :: IO ()
br = Rainbow.putChunk "\n" >> IO.hFlush stdout

good, pass, info, warn, fail :: [Text] -> IO ()
good = msg Good
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

-- | Pipelined version of 'mark'.
--
-- @
-- mark label val = val ~| label
-- @
(~&) :: Show a => a -> Text -> a
(~&) val label = mark label val

-- | Conditional mark.
(~?) :: Show a => a -> (a -> Bool) -> Text -> a
(~?) val test label = if test val then mark label val else val