{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}

module Tonatona.Logger
  ( Config(..)
  , DeployMode(..)
  , Verbose(..)
  , defaultVerbosity
    -- * Standard logging functions
  , Tonatona.Logger.logDebug
  , Tonatona.Logger.logInfo
  , Tonatona.Logger.logWarn
  , Tonatona.Logger.logError
  , Tonatona.Logger.logOther
    -- * Advanced logging functions
    -- ** Sticky logging
  , Tonatona.Logger.logSticky
  , Tonatona.Logger.logStickyDone
    -- ** With source
  , Tonatona.Logger.logDebugS
  , Tonatona.Logger.logInfoS
  , Tonatona.Logger.logWarnS
  , Tonatona.Logger.logErrorS
  , Tonatona.Logger.logOtherS
    -- ** Generic log function
  , Tonatona.Logger.logGeneric
    -- * Data types
  , LogLevel (..)
  , LogSource
  ) where

import RIO

import Tonatona (HasConfig(..), HasParser(..))
import TonaParser
  ( Var(..)
  , (.||)
  , argLong
  , envVar
  , liftWith
  , optionalEnum
  )


-- Standard logging functions


{- | Log a debug level message with no source.
-}
logDebug :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logDebug :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logDebug = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logDebug

{- | Log an info level message with no source.
-}
logInfo :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logInfo :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logInfo = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logInfo

{- | Log a warn level message with no source.
-}
logWarn :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logWarn :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logWarn = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logWarn

{- | Log an error level message with no source.
-}
logError :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logError :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logError = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logError

{- | Log a message with the specified textual level and no source.
-}
logOther :: (HasConfig env Config)
  => Text -- ^ level
  -> Utf8Builder -> RIO env ()
logOther :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logOther Text
level = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logOther Text
level



-- With source


{- | Log a debug level message with the given source.
-}
logDebugS
  :: (HasConfig env Config)
  => LogSource
  -> Utf8Builder
  -> RIO env ()
logDebugS :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logDebugS Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logDebugS Text
src

{- | Log an info level message with the given source.
-}
logInfoS
  :: (HasConfig env Config)
  => LogSource
  -> Utf8Builder
  -> RIO env ()
logInfoS :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logInfoS Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logInfoS Text
src

{- | Log a warn level message with the given source.
-}
logWarnS
  :: (HasConfig env Config)
  => LogSource
  -> Utf8Builder
  -> RIO env ()
logWarnS :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logWarnS Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logWarnS Text
src

{- | Log an error level message with the given source.
-}
logErrorS
  :: (HasConfig env Config)
  => LogSource
  -> Utf8Builder
  -> RIO env ()
logErrorS :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logErrorS Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logErrorS Text
src

{- | Log a message with the specified textual level and the given source.
-}
logOtherS
  :: (HasConfig env Config)
  => Text -- ^ level
  -> LogSource
  -> Utf8Builder
  -> RIO env ()
logOtherS :: forall env.
HasConfig env Config =>
Text -> Text -> Utf8Builder -> RIO env ()
logOtherS Text
level Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Text -> Utf8Builder -> m ()
RIO.logOtherS Text
level Text
src

{- | Write a "sticky" line to the terminal. Any subsequent lines will
  overwrite this one, and that same line will be repeated below
  again. In other words, the line sticks at the bottom of the output
  forever. Running this function again will replace the sticky line
  with a new sticky line. When you want to get rid of the sticky
  line, run 'logStickyDone'.

  Note that not all 'LogFunc' implementations will support sticky
  messages as described. However, the 'withLogFunc' implementation
  provided by this module does.
-}
logSticky :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logSticky :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logSticky = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
RIO.logSticky

{- | This will print out the given message with a newline and disable
  any further stickiness of the line until a new call to 'logSticky'
  happens.
-}
logStickyDone :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logStickyDone :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logStickyDone = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
RIO.logStickyDone



-- Generic log function


{- | Generic, basic function for creating other logging functions.
-}
logGeneric ::
     (HasConfig env Config)
  => LogSource
  -> LogLevel
  -> Utf8Builder
  -> RIO env ()
logGeneric :: forall env.
HasConfig env Config =>
Text -> LogLevel -> Utf8Builder -> RIO env ()
logGeneric Text
src LogLevel
level Utf8Builder
str = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> LogLevel -> Utf8Builder -> m ()
RIO.logGeneric Text
src LogLevel
level Utf8Builder
str


unwrap :: RIO (InnerEnv env) () -> RIO env ()
unwrap :: forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap RIO (InnerEnv env) ()
action = do
  env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO (forall env. env -> InnerEnv env
InnerEnv env
env) RIO (InnerEnv env) ()
action


newtype InnerEnv env = InnerEnv { forall env. InnerEnv env -> env
unInnerEnv :: env }


instance (HasConfig env Config) => HasLogFunc (InnerEnv env) where
  logFuncL :: Lens' (InnerEnv env) LogFunc
logFuncL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Config -> LogFunc
logFunc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env config. HasConfig env config => env -> config
config forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. InnerEnv env -> env
unInnerEnv) forall a b. (a -> b) -> a -> b
$
    forall a. HasCallStack => [Char] -> a
error [Char]
"Setter for logFuncL is not defined"


-- Config


data Config = Config
  { Config -> DeployMode
mode :: DeployMode
  , Config -> Verbose
verbose :: Verbose
  , Config -> LogOptions
logOptions :: LogOptions
  , Config -> LogFunc
logFunc :: LogFunc
  }


instance HasParser Config where
  parser :: Parser Config
parser = do
    DeployMode
mode <- forall a. HasParser a => Parser a
parser
    Verbose
verbose <- forall a. HasParser a => Parser a
parser
    forall a. ((a -> IO ()) -> IO ()) -> Parser a
liftWith forall a b. (a -> b) -> a -> b
$ \Config -> IO ()
action -> do
      LogOptions
options <- forall (m :: * -> *).
MonadIO m =>
DeployMode -> Verbose -> m LogOptions
defaultLogOptions DeployMode
mode Verbose
verbose
      forall (m :: * -> *) a.
MonadUnliftIO m =>
LogOptions -> (LogFunc -> m a) -> m a
withLogFunc LogOptions
options forall a b. (a -> b) -> a -> b
$ \LogFunc
lf ->
        Config -> IO ()
action forall a b. (a -> b) -> a -> b
$ DeployMode -> Verbose -> LogOptions -> LogFunc -> Config
Config DeployMode
mode Verbose
verbose LogOptions
options LogFunc
lf


-- Verbose


newtype Verbose = Verbose { Verbose -> Bool
unVerbose :: Bool }
  deriving (Int -> Verbose -> ShowS
[Verbose] -> ShowS
Verbose -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Verbose] -> ShowS
$cshowList :: [Verbose] -> ShowS
show :: Verbose -> [Char]
$cshow :: Verbose -> [Char]
showsPrec :: Int -> Verbose -> ShowS
$cshowsPrec :: Int -> Verbose -> ShowS
Show, ReadPrec [Verbose]
ReadPrec Verbose
Int -> ReadS Verbose
ReadS [Verbose]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Verbose]
$creadListPrec :: ReadPrec [Verbose]
readPrec :: ReadPrec Verbose
$creadPrec :: ReadPrec Verbose
readList :: ReadS [Verbose]
$creadList :: ReadS [Verbose]
readsPrec :: Int -> ReadS Verbose
$creadsPrec :: Int -> ReadS Verbose
Read, Verbose -> Verbose -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbose -> Verbose -> Bool
$c/= :: Verbose -> Verbose -> Bool
== :: Verbose -> Verbose -> Bool
$c== :: Verbose -> Verbose -> Bool
Eq)

instance HasParser Verbose where
  parser :: Parser Verbose
parser = Bool -> Verbose
Verbose forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall a.
(Var a, Enum a, Bounded a) =>
Description -> Source -> a -> Parser a
optionalEnum
      Description
"Make the operation more talkative"
      ([Char] -> Source
argLong [Char]
"verbose" Source -> Source -> Source
.|| [Char] -> Source
envVar [Char]
"VERBOSE")
      Bool
False


-- DeployMode


data DeployMode
  = Development
  | Production
  | Staging
  | Test
  deriving (DeployMode -> DeployMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeployMode -> DeployMode -> Bool
$c/= :: DeployMode -> DeployMode -> Bool
== :: DeployMode -> DeployMode -> Bool
$c== :: DeployMode -> DeployMode -> Bool
Eq, forall x. Rep DeployMode x -> DeployMode
forall x. DeployMode -> Rep DeployMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeployMode x -> DeployMode
$cfrom :: forall x. DeployMode -> Rep DeployMode x
Generic, Int -> DeployMode -> ShowS
[DeployMode] -> ShowS
DeployMode -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DeployMode] -> ShowS
$cshowList :: [DeployMode] -> ShowS
show :: DeployMode -> [Char]
$cshow :: DeployMode -> [Char]
showsPrec :: Int -> DeployMode -> ShowS
$cshowsPrec :: Int -> DeployMode -> ShowS
Show, ReadPrec [DeployMode]
ReadPrec DeployMode
Int -> ReadS DeployMode
ReadS [DeployMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeployMode]
$creadListPrec :: ReadPrec [DeployMode]
readPrec :: ReadPrec DeployMode
$creadPrec :: ReadPrec DeployMode
readList :: ReadS [DeployMode]
$creadList :: ReadS [DeployMode]
readsPrec :: Int -> ReadS DeployMode
$creadsPrec :: Int -> ReadS DeployMode
Read, DeployMode
forall a. a -> a -> Bounded a
maxBound :: DeployMode
$cmaxBound :: DeployMode
minBound :: DeployMode
$cminBound :: DeployMode
Bounded, Int -> DeployMode
DeployMode -> Int
DeployMode -> [DeployMode]
DeployMode -> DeployMode
DeployMode -> DeployMode -> [DeployMode]
DeployMode -> DeployMode -> DeployMode -> [DeployMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DeployMode -> DeployMode -> DeployMode -> [DeployMode]
$cenumFromThenTo :: DeployMode -> DeployMode -> DeployMode -> [DeployMode]
enumFromTo :: DeployMode -> DeployMode -> [DeployMode]
$cenumFromTo :: DeployMode -> DeployMode -> [DeployMode]
enumFromThen :: DeployMode -> DeployMode -> [DeployMode]
$cenumFromThen :: DeployMode -> DeployMode -> [DeployMode]
enumFrom :: DeployMode -> [DeployMode]
$cenumFrom :: DeployMode -> [DeployMode]
fromEnum :: DeployMode -> Int
$cfromEnum :: DeployMode -> Int
toEnum :: Int -> DeployMode
$ctoEnum :: Int -> DeployMode
pred :: DeployMode -> DeployMode
$cpred :: DeployMode -> DeployMode
succ :: DeployMode -> DeployMode
$csucc :: DeployMode -> DeployMode
Enum)

instance Var DeployMode where
  toVar :: DeployMode -> [Char]
toVar = forall a. Show a => a -> [Char]
show
  fromVar :: [Char] -> Maybe DeployMode
fromVar = forall a. Read a => [Char] -> Maybe a
readMaybe

instance HasParser DeployMode where
  parser :: Parser DeployMode
parser =
    forall a.
(Var a, Enum a, Bounded a) =>
Description -> Source -> a -> Parser a
optionalEnum
      Description
"Application deployment mode to run"
      ([Char] -> Source
argLong [Char]
"env" Source -> Source -> Source
.|| [Char] -> Source
envVar [Char]
"ENV")
      DeployMode
Development


-- Logger options


{-| Default way to create 'LogOptions'.
-}
defaultLogOptions :: (MonadIO m) => DeployMode -> Verbose -> m LogOptions
defaultLogOptions :: forall (m :: * -> *).
MonadIO m =>
DeployMode -> Verbose -> m LogOptions
defaultLogOptions DeployMode
env Verbose
verbose = do
  forall (m :: * -> *). MonadIO m => Handle -> Bool -> m LogOptions
logOptionsHandle Handle
stderr forall a b. (a -> b) -> a -> b
$ DeployMode -> Verbose -> Bool
defaultVerbosity DeployMode
env Verbose
verbose


{-| Default setting for verbosity.
-}
defaultVerbosity :: DeployMode -> Verbose -> Bool
defaultVerbosity :: DeployMode -> Verbose -> Bool
defaultVerbosity DeployMode
env (Verbose Bool
v) =
  case (Bool
v, DeployMode
env) of
    (Bool
False, DeployMode
Development) -> Bool
True
    (Bool, DeployMode)
_ -> Bool
v