-- | Produce a 'LogSettings' by reading environment variables
--
-- - @LOG_LEVEL@: a known log level (case insensitive) and optional levels by
--   source. See "Logging.LogSettings.LogLevels".
--
-- - @LOG_DESTINATION@: the string @stderr@, @stdout@ or @null@, (case
--   sensitive), or @\@{path}@ to log to the file at @path@. Unrecognized values
--   will produce an error.
--
-- - @LOG_FORMAT@: the string @tty@ or @json@. Unrecognized values will produce
--   an error.
--
-- - @LOG_COLOR@: the string @auto@, @always@, or @never@. Other values may be
--   recognized (e.g. @yes@ or @no@) but should not be relied on. Unrecognized
--   values will produce an error
--
-- - @LOG_BREAKPOINT@: a number representing the column-width at which to break
--   into multi-line format.
--
-- - @LOG_CONCURRENCY@: number of log buffers to use. More will perform faster
--   but result in out-of-order delivery. This is automatically disabled for
--   @LOG_FORMAT=tty@ and set to /number-of-cores/ for @LOG_FORMAT=json@.
--
-- - @NO_COLOR@: if present and non-empty, behave as if @LOG_COLOR=never@
--
-- - @TERM@: if present and the value @dumb@, behave as if @LOG_COLOR=never@.
--
-- - @GITHUB_ACTIONS@: if present and the value @true@, adjust some colors for
--   better behavior on GitHub Actions.
--
-- This module is meant to be imported @qualified@.
--
-- @
-- import Blammo.Logging
-- import qualified Logging.LogSettings.Env as Env
--
-- main :: IO ()
-- main = do
--   logger <- 'newLogger' =<< Env.'parse'
--   'runLoggerLoggingT' logger $ -- ...
-- @
module Blammo.Logging.LogSettings.Env
  ( parse
  , parser
    -- | Specifying defaults other than 'defaultLogSettings'
    --
    -- For example, if you want logging to go to @stderr@ by default, but still
    -- support @LOG_DESTINATION@,
    --
    -- @
    -- settings <- Env.'parseWith'
    --   $ 'setLogSettingsDestination' 'LogDestinationStderr' 'defaultLogSettings'
    -- @
  , parseWith
  , parserWith
  ) where

import Prelude

import Blammo.Logging.Colors (Colors (..))
import Blammo.Logging.LogSettings
import Data.Bifunctor (first)
import Data.Bool (bool)
import Data.Semigroup (Endo (..))
import Data.Text (Text)
import Env hiding (parse)
import qualified Env
import Text.Read (readEither)

parse :: IO LogSettings
parse :: IO LogSettings
parse = LogSettings -> IO LogSettings
parseWith LogSettings
defaultLogSettings

parser :: Parser Error LogSettings
parser :: Parser Error LogSettings
parser = LogSettings -> Parser Error LogSettings
parserWith LogSettings
defaultLogSettings

parseWith :: LogSettings -> IO LogSettings
parseWith :: LogSettings -> IO LogSettings
parseWith = (Info Error -> Info Error)
-> Parser Error LogSettings -> IO LogSettings
forall e a.
AsUnset e =>
(Info Error -> Info e) -> Parser e a -> IO a
Env.parse Info Error -> Info Error
forall a. a -> a
id (Parser Error LogSettings -> IO LogSettings)
-> (LogSettings -> Parser Error LogSettings)
-> LogSettings
-> IO LogSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSettings -> Parser Error LogSettings
parserWith

parserWith :: LogSettings -> Parser Error LogSettings
parserWith :: LogSettings -> Parser Error LogSettings
parserWith LogSettings
defaults =
  ([Endo LogSettings] -> LogSettings -> LogSettings)
-> LogSettings -> [Endo LogSettings] -> LogSettings
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Endo LogSettings -> LogSettings -> LogSettings
forall a. Endo a -> a -> a
appEndo (Endo LogSettings -> LogSettings -> LogSettings)
-> ([Endo LogSettings] -> Endo LogSettings)
-> [Endo LogSettings]
-> LogSettings
-> LogSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Endo LogSettings] -> Endo LogSettings
forall a. Monoid a => [a] -> a
mconcat) LogSettings
defaults
    ([Endo LogSettings] -> LogSettings)
-> Parser Error [Endo LogSettings] -> Parser Error LogSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Error (Endo LogSettings)]
-> Parser Error [Endo LogSettings]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
      [ (String -> Either String LogLevels)
-> (LogLevels -> LogSettings -> LogSettings)
-> String
-> Parser Error (Endo LogSettings)
forall e a b.
(AsUnset e, AsUnread e) =>
(String -> Either String a)
-> (a -> b -> b) -> String -> Parser e (Endo b)
endoVar String -> Either String LogLevels
readLogLevels LogLevels -> LogSettings -> LogSettings
setLogSettingsLevels String
"LOG_LEVEL"
      , (String -> Either String LogDestination)
-> (LogDestination -> LogSettings -> LogSettings)
-> String
-> Parser Error (Endo LogSettings)
forall e a b.
(AsUnset e, AsUnread e) =>
(String -> Either String a)
-> (a -> b -> b) -> String -> Parser e (Endo b)
endoVar String -> Either String LogDestination
readLogDestination LogDestination -> LogSettings -> LogSettings
setLogSettingsDestination String
"LOG_DESTINATION"
      , (String -> Either String LogColor)
-> (LogColor -> LogSettings -> LogSettings)
-> String
-> Parser Error (Endo LogSettings)
forall e a b.
(AsUnset e, AsUnread e) =>
(String -> Either String a)
-> (a -> b -> b) -> String -> Parser e (Endo b)
endoVar String -> Either String LogColor
readLogColor LogColor -> LogSettings -> LogSettings
setLogSettingsColor String
"LOG_COLOR"
      , (String -> Either String Int)
-> (Int -> LogSettings -> LogSettings)
-> String
-> Parser Error (Endo LogSettings)
forall e a b.
(AsUnset e, AsUnread e) =>
(String -> Either String a)
-> (a -> b -> b) -> String -> Parser e (Endo b)
endoVar String -> Either String Int
forall a. Read a => String -> Either String a
readEither Int -> LogSettings -> LogSettings
setLogSettingsBreakpoint String
"LOG_BREAKPOINT"
      , (String -> Either String Int)
-> (Int -> LogSettings -> LogSettings)
-> String
-> Parser Error (Endo LogSettings)
forall e a b.
(AsUnset e, AsUnread e) =>
(String -> Either String a)
-> (a -> b -> b) -> String -> Parser e (Endo b)
endoVar String -> Either String Int
forall a. Read a => String -> Either String a
readEither (Maybe Int -> LogSettings -> LogSettings
setLogSettingsConcurrency (Maybe Int -> LogSettings -> LogSettings)
-> (Int -> Maybe Int) -> Int -> LogSettings -> LogSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just) String
"LOG_CONCURRENCY"
      , (String -> Either String LogFormat)
-> (LogFormat -> LogSettings -> LogSettings)
-> String
-> Parser Error (Endo LogSettings)
forall e a b.
(AsUnset e, AsUnread e) =>
(String -> Either String a)
-> (a -> b -> b) -> String -> Parser e (Endo b)
endoVar String -> Either String LogFormat
readLogFormat LogFormat -> LogSettings -> LogSettings
setLogSettingsFormat String
"LOG_FORMAT"
      , (LogSettings -> LogSettings)
-> String -> Parser Error (Endo LogSettings)
forall a e. (a -> a) -> String -> Parser e (Endo a)
endoSwitch (LogColor -> LogSettings -> LogSettings
setLogSettingsColor LogColor
LogColorNever) String
"NO_COLOR"
      , Text
-> (LogSettings -> LogSettings)
-> String
-> Parser Error (Endo LogSettings)
forall e a.
AsUnset e =>
Text -> (a -> a) -> String -> Parser e (Endo a)
endoOn Text
"dumb" (LogColor -> LogSettings -> LogSettings
setLogSettingsColor LogColor
LogColorNever) String
"TERM"
      , Text
-> (LogSettings -> LogSettings)
-> String
-> Parser Error (Endo LogSettings)
forall e a.
AsUnset e =>
Text -> (a -> a) -> String -> Parser e (Endo a)
endoOn Text
"true" ((Colors -> Colors) -> LogSettings -> LogSettings
setLogSettingsColors Colors -> Colors
fixGitHubActions) String
"GITHUB_ACTIONS"
      ]

endoVar
  :: (AsUnset e, AsUnread e)
  => (String -> Either String a)
  -- ^ How to parse the value
  -> (a -> b -> b)
  -- ^ How to turn the parsed value into a setter
  -> String
  -> Parser e (Endo b)
endoVar :: forall e a b.
(AsUnset e, AsUnread e) =>
(String -> Either String a)
-> (a -> b -> b) -> String -> Parser e (Endo b)
endoVar String -> Either String a
reader a -> b -> b
setter String
x = Reader e (Endo b)
-> String -> Mod Var (Endo b) -> Parser e (Endo b)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var ((String -> Either String a) -> (a -> b -> b) -> Reader e (Endo b)
forall e a b.
AsUnread e =>
(String -> Either String a) -> (a -> b -> b) -> Reader e (Endo b)
endo String -> Either String a
reader a -> b -> b
setter) String
x (Mod Var (Endo b) -> Parser e (Endo b))
-> Mod Var (Endo b) -> Parser e (Endo b)
forall a b. (a -> b) -> a -> b
$ Endo b -> Mod Var (Endo b)
forall a. a -> Mod Var a
def Endo b
forall a. Monoid a => a
mempty

endo
  :: AsUnread e
  => (String -> Either String a)
  -- ^ How to parse the value
  -> (a -> b -> b)
  -- ^ How to turn the parsed value into a setter
  -> Reader e (Endo b)
endo :: forall e a b.
AsUnread e =>
(String -> Either String a) -> (a -> b -> b) -> Reader e (Endo b)
endo String -> Either String a
reader a -> b -> b
setter String
x = (String -> e) -> Either String (Endo b) -> Either e (Endo b)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> e
forall e. AsUnread e => String -> e
unread (Either String (Endo b) -> Either e (Endo b))
-> Either String (Endo b) -> Either e (Endo b)
forall a b. (a -> b) -> a -> b
$ (b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo ((b -> b) -> Endo b) -> (a -> b -> b) -> a -> Endo b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> b
setter (a -> Endo b) -> Either String a -> Either String (Endo b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String a
reader String
x

endoSwitch :: (a -> a) -> String -> Parser e (Endo a)
endoSwitch :: forall a e. (a -> a) -> String -> Parser e (Endo a)
endoSwitch a -> a
f String
x = (a -> a) -> Bool -> Endo a
forall a. (a -> a) -> Bool -> Endo a
endoWhen a -> a
f (Bool -> Endo a) -> Parser e Bool -> Parser e (Endo a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Mod Flag Bool -> Parser e Bool
forall e. String -> Mod Flag Bool -> Parser e Bool
switch String
x Mod Flag Bool
forall a. Monoid a => a
mempty

endoOn :: AsUnset e => Text -> (a -> a) -> String -> Parser e (Endo a)
endoOn :: forall e a.
AsUnset e =>
Text -> (a -> a) -> String -> Parser e (Endo a)
endoOn Text
val a -> a
f String
x = (a -> a) -> Bool -> Endo a
forall a. (a -> a) -> Bool -> Endo a
endoWhen a -> a
f (Bool -> Endo a) -> (Maybe Text -> Bool) -> Maybe Text -> Endo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val) (Maybe Text -> Endo a)
-> Parser e (Maybe Text) -> Parser e (Endo a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e Text -> Parser e (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader e Text -> String -> Mod Var Text -> Parser e Text
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader e Text
forall s e. IsString s => Reader e s
str String
x Mod Var Text
forall a. Monoid a => a
mempty)

endoWhen
  :: (a -> a)
  -> Bool
  -> Endo a
endoWhen :: forall a. (a -> a) -> Bool -> Endo a
endoWhen a -> a
f = Endo a -> Endo a -> Bool -> Endo a
forall a. a -> a -> Bool -> a
bool Endo a
forall a. Monoid a => a
mempty ((a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo a -> a
f)

-- |
--
-- GitHub Actions doesn't support 'dim' (such content just appears white). But
-- if you use 'gray', it looks like 'dim' should. But one shouldn't just use
-- 'gray' all the time because that won't look right /not/ in GitHub Actions.
--
-- We can help by automatically substituting 'gray' for 'dim', only in the
-- GitHub Actions environment. We take on this extra complexity because:
--
-- 1. It's trivial and zero dependency
-- 2. It's lower complexity overall to do here, vs from the outside
-- 3. GitHub Actions is a very common logging environment, and
-- 4. I suspect we'll encounter more cases where GitHub Actions can be improved
--    though such means, increasing its usefulness
fixGitHubActions :: Colors -> Colors
fixGitHubActions :: Colors -> Colors
fixGitHubActions Colors
colors = Colors
colors {dim = gray colors}