module Mensam.Server.Application.LoggerCustom.Class where

import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Control.Monad.Trans.Compose
import Control.Monad.Trans.Elevator
import Data.Foldable
import Data.Kind
import Data.List qualified as L
import Data.String
import GHC.Generics

type MonadLoggerCustom :: (Type -> Type) -> Constraint
class MonadLogger m => MonadLoggerCustom m where
  colorfulLogCapability :: m Bool

instance
  ( MonadTrans t
  , MonadLoggerCustom m
  ) =>
  MonadLoggerCustom (Elevator t m)
  where
  colorfulLogCapability :: Elevator t m Bool
colorfulLogCapability = m Bool -> Elevator t m Bool
forall (m :: * -> *) a. Monad m => m a -> Elevator t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
forall (m :: * -> *). MonadLoggerCustom m => m Bool
colorfulLogCapability

deriving via
  Elevator t1 ((t2 :: (Type -> Type) -> Type -> Type) m)
  instance
  {-# OVERLAPPABLE #-}
    ( MonadTrans t1
    , MonadLoggerCustom (t2 m)
    ) =>
    MonadLoggerCustom (ComposeT t1 t2 m)

withoutFontEffects :: LogStr -> LogStrWithFontEffects
withoutFontEffects :: LogStr -> LogStrWithFontEffects
withoutFontEffects LogStr
logStr = [Either LogStr (LogStr, FontEffects)] -> LogStrWithFontEffects
MkLogStrWithFontEffectsUnsafe [LogStr -> Either LogStr (LogStr, FontEffects)
forall a b. a -> Either a b
Left LogStr
logStr]

withFontEffects :: FontEffects -> LogStr -> LogStrWithFontEffects
withFontEffects :: FontEffects -> LogStr -> LogStrWithFontEffects
withFontEffects FontEffects
fontEffects LogStr
logStr = [Either LogStr (LogStr, FontEffects)] -> LogStrWithFontEffects
MkLogStrWithFontEffectsUnsafe [(LogStr, FontEffects) -> Either LogStr (LogStr, FontEffects)
forall a b. b -> Either a b
Right (LogStr
logStr, FontEffects
fontEffects)]

type LogStrWithFontEffects :: Type
newtype LogStrWithFontEffects = MkLogStrWithFontEffectsUnsafe {LogStrWithFontEffects -> [Either LogStr (LogStr, FontEffects)]
unLogStrWithFontEffects :: [Either LogStr (LogStr, FontEffects)]}
  deriving stock (LogStrWithFontEffects -> LogStrWithFontEffects -> Bool
(LogStrWithFontEffects -> LogStrWithFontEffects -> Bool)
-> (LogStrWithFontEffects -> LogStrWithFontEffects -> Bool)
-> Eq LogStrWithFontEffects
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogStrWithFontEffects -> LogStrWithFontEffects -> Bool
== :: LogStrWithFontEffects -> LogStrWithFontEffects -> Bool
$c/= :: LogStrWithFontEffects -> LogStrWithFontEffects -> Bool
/= :: LogStrWithFontEffects -> LogStrWithFontEffects -> Bool
Eq, Int -> LogStrWithFontEffects -> ShowS
[LogStrWithFontEffects] -> ShowS
LogStrWithFontEffects -> String
(Int -> LogStrWithFontEffects -> ShowS)
-> (LogStrWithFontEffects -> String)
-> ([LogStrWithFontEffects] -> ShowS)
-> Show LogStrWithFontEffects
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogStrWithFontEffects -> ShowS
showsPrec :: Int -> LogStrWithFontEffects -> ShowS
$cshow :: LogStrWithFontEffects -> String
show :: LogStrWithFontEffects -> String
$cshowList :: [LogStrWithFontEffects] -> ShowS
showList :: [LogStrWithFontEffects] -> ShowS
Show)
  deriving newtype (NonEmpty LogStrWithFontEffects -> LogStrWithFontEffects
LogStrWithFontEffects
-> LogStrWithFontEffects -> LogStrWithFontEffects
(LogStrWithFontEffects
 -> LogStrWithFontEffects -> LogStrWithFontEffects)
-> (NonEmpty LogStrWithFontEffects -> LogStrWithFontEffects)
-> (forall b.
    Integral b =>
    b -> LogStrWithFontEffects -> LogStrWithFontEffects)
-> Semigroup LogStrWithFontEffects
forall b.
Integral b =>
b -> LogStrWithFontEffects -> LogStrWithFontEffects
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: LogStrWithFontEffects
-> LogStrWithFontEffects -> LogStrWithFontEffects
<> :: LogStrWithFontEffects
-> LogStrWithFontEffects -> LogStrWithFontEffects
$csconcat :: NonEmpty LogStrWithFontEffects -> LogStrWithFontEffects
sconcat :: NonEmpty LogStrWithFontEffects -> LogStrWithFontEffects
$cstimes :: forall b.
Integral b =>
b -> LogStrWithFontEffects -> LogStrWithFontEffects
stimes :: forall b.
Integral b =>
b -> LogStrWithFontEffects -> LogStrWithFontEffects
Semigroup, Semigroup LogStrWithFontEffects
LogStrWithFontEffects
Semigroup LogStrWithFontEffects =>
LogStrWithFontEffects
-> (LogStrWithFontEffects
    -> LogStrWithFontEffects -> LogStrWithFontEffects)
-> ([LogStrWithFontEffects] -> LogStrWithFontEffects)
-> Monoid LogStrWithFontEffects
[LogStrWithFontEffects] -> LogStrWithFontEffects
LogStrWithFontEffects
-> LogStrWithFontEffects -> LogStrWithFontEffects
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: LogStrWithFontEffects
mempty :: LogStrWithFontEffects
$cmappend :: LogStrWithFontEffects
-> LogStrWithFontEffects -> LogStrWithFontEffects
mappend :: LogStrWithFontEffects
-> LogStrWithFontEffects -> LogStrWithFontEffects
$cmconcat :: [LogStrWithFontEffects] -> LogStrWithFontEffects
mconcat :: [LogStrWithFontEffects] -> LogStrWithFontEffects
Monoid)

instance IsString LogStrWithFontEffects where
  fromString :: String -> LogStrWithFontEffects
fromString = [Either LogStr (LogStr, FontEffects)] -> LogStrWithFontEffects
MkLogStrWithFontEffectsUnsafe ([Either LogStr (LogStr, FontEffects)] -> LogStrWithFontEffects)
-> (String -> [Either LogStr (LogStr, FontEffects)])
-> String
-> LogStrWithFontEffects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either LogStr (LogStr, FontEffects)
-> [Either LogStr (LogStr, FontEffects)]
-> [Either LogStr (LogStr, FontEffects)]
forall a. a -> [a] -> [a]
: []) (Either LogStr (LogStr, FontEffects)
 -> [Either LogStr (LogStr, FontEffects)])
-> (String -> Either LogStr (LogStr, FontEffects))
-> String
-> [Either LogStr (LogStr, FontEffects)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogStr -> Either LogStr (LogStr, FontEffects)
forall a b. a -> Either a b
Left (LogStr -> Either LogStr (LogStr, FontEffects))
-> (String -> LogStr)
-> String
-> Either LogStr (LogStr, FontEffects)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr

type FontEffects :: Type
newtype FontEffects = MkFontEffects {FontEffects -> [Int]
unFontEffects :: [Int]}
  deriving stock (FontEffects -> FontEffects -> Bool
(FontEffects -> FontEffects -> Bool)
-> (FontEffects -> FontEffects -> Bool) -> Eq FontEffects
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontEffects -> FontEffects -> Bool
== :: FontEffects -> FontEffects -> Bool
$c/= :: FontEffects -> FontEffects -> Bool
/= :: FontEffects -> FontEffects -> Bool
Eq, (forall x. FontEffects -> Rep FontEffects x)
-> (forall x. Rep FontEffects x -> FontEffects)
-> Generic FontEffects
forall x. Rep FontEffects x -> FontEffects
forall x. FontEffects -> Rep FontEffects x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FontEffects -> Rep FontEffects x
from :: forall x. FontEffects -> Rep FontEffects x
$cto :: forall x. Rep FontEffects x -> FontEffects
to :: forall x. Rep FontEffects x -> FontEffects
Generic, Eq FontEffects
Eq FontEffects =>
(FontEffects -> FontEffects -> Ordering)
-> (FontEffects -> FontEffects -> Bool)
-> (FontEffects -> FontEffects -> Bool)
-> (FontEffects -> FontEffects -> Bool)
-> (FontEffects -> FontEffects -> Bool)
-> (FontEffects -> FontEffects -> FontEffects)
-> (FontEffects -> FontEffects -> FontEffects)
-> Ord FontEffects
FontEffects -> FontEffects -> Bool
FontEffects -> FontEffects -> Ordering
FontEffects -> FontEffects -> FontEffects
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FontEffects -> FontEffects -> Ordering
compare :: FontEffects -> FontEffects -> Ordering
$c< :: FontEffects -> FontEffects -> Bool
< :: FontEffects -> FontEffects -> Bool
$c<= :: FontEffects -> FontEffects -> Bool
<= :: FontEffects -> FontEffects -> Bool
$c> :: FontEffects -> FontEffects -> Bool
> :: FontEffects -> FontEffects -> Bool
$c>= :: FontEffects -> FontEffects -> Bool
>= :: FontEffects -> FontEffects -> Bool
$cmax :: FontEffects -> FontEffects -> FontEffects
max :: FontEffects -> FontEffects -> FontEffects
$cmin :: FontEffects -> FontEffects -> FontEffects
min :: FontEffects -> FontEffects -> FontEffects
Ord, ReadPrec [FontEffects]
ReadPrec FontEffects
Int -> ReadS FontEffects
ReadS [FontEffects]
(Int -> ReadS FontEffects)
-> ReadS [FontEffects]
-> ReadPrec FontEffects
-> ReadPrec [FontEffects]
-> Read FontEffects
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FontEffects
readsPrec :: Int -> ReadS FontEffects
$creadList :: ReadS [FontEffects]
readList :: ReadS [FontEffects]
$creadPrec :: ReadPrec FontEffects
readPrec :: ReadPrec FontEffects
$creadListPrec :: ReadPrec [FontEffects]
readListPrec :: ReadPrec [FontEffects]
Read, Int -> FontEffects -> ShowS
[FontEffects] -> ShowS
FontEffects -> String
(Int -> FontEffects -> ShowS)
-> (FontEffects -> String)
-> ([FontEffects] -> ShowS)
-> Show FontEffects
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontEffects -> ShowS
showsPrec :: Int -> FontEffects -> ShowS
$cshow :: FontEffects -> String
show :: FontEffects -> String
$cshowList :: [FontEffects] -> ShowS
showList :: [FontEffects] -> ShowS
Show)

renderLogStrWithFontEffectsUnsafe :: Bool -> LogStrWithFontEffects -> LogStr
renderLogStrWithFontEffectsUnsafe :: Bool -> LogStrWithFontEffects -> LogStr
renderLogStrWithFontEffectsUnsafe Bool
colorCapability = \case
  MkLogStrWithFontEffectsUnsafe [] -> LogStr
""
  MkLogStrWithFontEffectsUnsafe (Either LogStr (LogStr, FontEffects)
part : [Either LogStr (LogStr, FontEffects)]
parts) ->
    let
      renderedPart :: LogStr
renderedPart =
        case Either LogStr (LogStr, FontEffects)
part of
          Left LogStr
logStr -> LogStr
logStr
          Right (LogStr
logStr, FontEffects
fontEffects) ->
            if Bool
colorCapability
              then FontEffects -> LogStr -> LogStr
wrapLogStrWithFontEffects FontEffects
fontEffects LogStr
logStr
              else LogStr
logStr
      renderedParts :: LogStr
renderedParts = Bool -> LogStrWithFontEffects -> LogStr
renderLogStrWithFontEffectsUnsafe Bool
colorCapability (LogStrWithFontEffects -> LogStr)
-> LogStrWithFontEffects -> LogStr
forall a b. (a -> b) -> a -> b
$ [Either LogStr (LogStr, FontEffects)] -> LogStrWithFontEffects
MkLogStrWithFontEffectsUnsafe [Either LogStr (LogStr, FontEffects)]
parts
     in
      LogStr
renderedPart LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
renderedParts
 where
  wrapLogStrWithFontEffects :: FontEffects -> LogStr -> LogStr
  wrapLogStrWithFontEffects :: FontEffects -> LogStr -> LogStr
wrapLogStrWithFontEffects FontEffects
fontEffects LogStr
str =
    [LogStr] -> LogStr
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
      [ LogStr
"\ESC[" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
fontEffectsRendered LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"m"
      , LogStr
str
      , LogStr
"\ESC[0m"
      ]
   where
    fontEffectsRendered :: LogStr
fontEffectsRendered = String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (String -> LogStr) -> String -> LogStr
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
L.intersperse String
";" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: FontEffects -> [Int]
unFontEffects FontEffects
fontEffects