{-# LANGUAGE UndecidableInstances #-}

module Shrun.Configuration.Data.CommonLogging
  ( -- * Types
    Debug (..),
    CommonLoggingP (..),
    CommonLoggingArgs,
    CommonLoggingToml,
    CommonLoggingMerged,
    CommonLoggingEnv,

    -- * Functions
    mergeCommonLogging,
    toEnv,
  )
where

import Shrun.Configuration.Data.CommonLogging.KeyHideSwitch (KeyHideSwitch)
import Shrun.Configuration.Data.ConfigPhase
  ( ConfigPhase
      ( ConfigPhaseArgs,
        ConfigPhaseEnv,
        ConfigPhaseMerged,
        ConfigPhaseToml
      ),
    SwitchF,
    parseSwitch,
  )
import Shrun.Configuration.Default (Default (def), (<.>))
import Shrun.Prelude

newtype Debug = MkDebug {Debug -> Bool
unDebug :: Bool}
  deriving stock (Debug -> Debug -> Bool
(Debug -> Debug -> Bool) -> (Debug -> Debug -> Bool) -> Eq Debug
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Debug -> Debug -> Bool
== :: Debug -> Debug -> Bool
$c/= :: Debug -> Debug -> Bool
/= :: Debug -> Debug -> Bool
Eq, Int -> Debug -> ShowS
[Debug] -> ShowS
Debug -> String
(Int -> Debug -> ShowS)
-> (Debug -> String) -> ([Debug] -> ShowS) -> Show Debug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Debug -> ShowS
showsPrec :: Int -> Debug -> ShowS
$cshow :: Debug -> String
show :: Debug -> String
$cshowList :: [Debug] -> ShowS
showList :: [Debug] -> ShowS
Show)
  deriving ((forall ann. Debug -> Doc ann)
-> (forall ann. [Debug] -> Doc ann) -> Pretty Debug
forall ann. [Debug] -> Doc ann
forall ann. Debug -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. Debug -> Doc ann
pretty :: forall ann. Debug -> Doc ann
$cprettyList :: forall ann. [Debug] -> Doc ann
prettyList :: forall ann. [Debug] -> Doc ann
Pretty) via PrettySwitch

instance
  (k ~ An_Iso, a ~ Bool, b ~ Bool) =>
  LabelOptic "unDebug" k Debug Debug a b
  where
  labelOptic :: Optic k NoIx Debug Debug a b
labelOptic = (Debug -> a) -> (b -> Debug) -> Iso Debug Debug a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(MkDebug Bool
b) -> a
Bool
b) b -> Debug
Bool -> Debug
MkDebug
  {-# INLINE labelOptic #-}

instance Default Debug where
  def :: Debug
def = Bool -> Debug
MkDebug Bool
False

instance DecodeTOML Debug where
  tomlDecoder :: Decoder Debug
tomlDecoder = Bool -> Debug
MkDebug (Bool -> Debug) -> Decoder Bool -> Decoder Debug
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Text -> (Text -> Decoder Bool) -> Decoder Bool
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Decoder Bool
forall (m :: Type -> Type). MonadFail m => Text -> m Bool
parseSwitch)

-- | Holds command logging config.
type CommonLoggingP :: ConfigPhase -> Type
data CommonLoggingP p = MkCommonLoggingP
  { -- | Whether debug logs are on.
    forall (p :: ConfigPhase). CommonLoggingP p -> SwitchF p Debug
debug :: SwitchF p Debug,
    -- | Whether to display command by (key) name or command.
    forall (p :: ConfigPhase).
CommonLoggingP p -> SwitchF p KeyHideSwitch
keyHide :: SwitchF p KeyHideSwitch
  }

instance
  (k ~ A_Lens, a ~ SwitchF p Debug, b ~ SwitchF p Debug) =>
  LabelOptic "debug" k (CommonLoggingP p) (CommonLoggingP p) a b
  where
  labelOptic :: Optic k NoIx (CommonLoggingP p) (CommonLoggingP p) a b
labelOptic =
    LensVL (CommonLoggingP p) (CommonLoggingP p) a b
-> Lens (CommonLoggingP p) (CommonLoggingP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (CommonLoggingP p) (CommonLoggingP p) a b
 -> Lens (CommonLoggingP p) (CommonLoggingP p) a b)
-> LensVL (CommonLoggingP p) (CommonLoggingP p) a b
-> Lens (CommonLoggingP p) (CommonLoggingP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkCommonLoggingP SwitchF p Debug
a1 SwitchF p KeyHideSwitch
a2) ->
      (b -> CommonLoggingP p) -> f b -> f (CommonLoggingP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\b
b -> SwitchF p Debug -> SwitchF p KeyHideSwitch -> CommonLoggingP p
forall (p :: ConfigPhase).
SwitchF p Debug -> SwitchF p KeyHideSwitch -> CommonLoggingP p
MkCommonLoggingP b
SwitchF p Debug
b SwitchF p KeyHideSwitch
a2)
        (a -> f b
f a
SwitchF p Debug
a1)
  {-# INLINE labelOptic #-}

instance
  (k ~ A_Lens, a ~ SwitchF p KeyHideSwitch, b ~ SwitchF p KeyHideSwitch) =>
  LabelOptic "keyHide" k (CommonLoggingP p) (CommonLoggingP p) a b
  where
  labelOptic :: Optic k NoIx (CommonLoggingP p) (CommonLoggingP p) a b
labelOptic =
    LensVL (CommonLoggingP p) (CommonLoggingP p) a b
-> Lens (CommonLoggingP p) (CommonLoggingP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (CommonLoggingP p) (CommonLoggingP p) a b
 -> Lens (CommonLoggingP p) (CommonLoggingP p) a b)
-> LensVL (CommonLoggingP p) (CommonLoggingP p) a b
-> Lens (CommonLoggingP p) (CommonLoggingP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkCommonLoggingP SwitchF p Debug
a1 SwitchF p KeyHideSwitch
a2) ->
      (b -> CommonLoggingP p) -> f b -> f (CommonLoggingP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\b
b -> SwitchF p Debug -> SwitchF p KeyHideSwitch -> CommonLoggingP p
forall (p :: ConfigPhase).
SwitchF p Debug -> SwitchF p KeyHideSwitch -> CommonLoggingP p
MkCommonLoggingP SwitchF p Debug
a1 b
SwitchF p KeyHideSwitch
b)
        (a -> f b
f a
SwitchF p KeyHideSwitch
a2)
  {-# INLINE labelOptic #-}

instance Semigroup CommonLoggingToml where
  CommonLoggingToml
l <> :: CommonLoggingToml -> CommonLoggingToml -> CommonLoggingToml
<> CommonLoggingToml
r =
    MkCommonLoggingP
      { debug :: SwitchF 'ConfigPhaseToml Debug
debug = CommonLoggingToml
l CommonLoggingToml
-> Optic' A_Lens NoIx CommonLoggingToml (Maybe Debug)
-> Maybe Debug
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingToml (Maybe Debug)
#debug Maybe Debug -> Maybe Debug -> Maybe Debug
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> CommonLoggingToml
r CommonLoggingToml
-> Optic' A_Lens NoIx CommonLoggingToml (Maybe Debug)
-> Maybe Debug
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingToml (Maybe Debug)
#debug,
        keyHide :: SwitchF 'ConfigPhaseToml KeyHideSwitch
keyHide = CommonLoggingToml
l CommonLoggingToml
-> Optic' A_Lens NoIx CommonLoggingToml (Maybe KeyHideSwitch)
-> Maybe KeyHideSwitch
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingToml (Maybe KeyHideSwitch)
#keyHide Maybe KeyHideSwitch -> Maybe KeyHideSwitch -> Maybe KeyHideSwitch
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> CommonLoggingToml
r CommonLoggingToml
-> Optic' A_Lens NoIx CommonLoggingToml (Maybe KeyHideSwitch)
-> Maybe KeyHideSwitch
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingToml (Maybe KeyHideSwitch)
#keyHide
      }

instance Monoid CommonLoggingToml where
  mempty :: CommonLoggingToml
mempty =
    MkCommonLoggingP
      { debug :: SwitchF 'ConfigPhaseToml Debug
debug = Maybe Debug
SwitchF 'ConfigPhaseToml Debug
forall a. Maybe a
Nothing,
        keyHide :: SwitchF 'ConfigPhaseToml KeyHideSwitch
keyHide = Maybe KeyHideSwitch
SwitchF 'ConfigPhaseToml KeyHideSwitch
forall a. Maybe a
Nothing
      }

instance Pretty CommonLoggingMerged where
  pretty :: forall ann. CommonLoggingMerged -> Doc ann
pretty CommonLoggingMerged
c =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
      [ Doc ann
"debug: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Debug -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Debug -> Doc ann
pretty (CommonLoggingMerged
c CommonLoggingMerged
-> Optic' A_Lens NoIx CommonLoggingMerged Debug -> Debug
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingMerged Debug
#debug),
        Doc ann
"key-hide: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> KeyHideSwitch -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. KeyHideSwitch -> Doc ann
pretty (CommonLoggingMerged
c CommonLoggingMerged
-> Optic' A_Lens NoIx CommonLoggingMerged KeyHideSwitch
-> KeyHideSwitch
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingMerged KeyHideSwitch
#keyHide)
      ]

type CommonLoggingArgs = CommonLoggingP ConfigPhaseArgs

type CommonLoggingToml = CommonLoggingP ConfigPhaseToml

type CommonLoggingMerged = CommonLoggingP ConfigPhaseMerged

type CommonLoggingEnv = CommonLoggingP ConfigPhaseEnv

deriving stock instance Eq (CommonLoggingP ConfigPhaseArgs)

deriving stock instance Show (CommonLoggingP ConfigPhaseArgs)

deriving stock instance Eq (CommonLoggingP ConfigPhaseToml)

deriving stock instance Show (CommonLoggingP ConfigPhaseToml)

deriving stock instance Eq (CommonLoggingP ConfigPhaseMerged)

deriving stock instance Show (CommonLoggingP ConfigPhaseMerged)

instance Default CommonLoggingArgs where
  def :: CommonLoggingArgs
def = SwitchF 'ConfigPhaseArgs Debug
-> SwitchF 'ConfigPhaseArgs KeyHideSwitch -> CommonLoggingArgs
forall (p :: ConfigPhase).
SwitchF p Debug -> SwitchF p KeyHideSwitch -> CommonLoggingP p
MkCommonLoggingP Maybe Debug
SwitchF 'ConfigPhaseArgs Debug
forall a. Maybe a
Nothing Maybe KeyHideSwitch
SwitchF 'ConfigPhaseArgs KeyHideSwitch
forall a. Maybe a
Nothing

-- | Merges args and toml configs.
mergeCommonLogging ::
  CommonLoggingArgs ->
  Maybe CommonLoggingToml ->
  CommonLoggingMerged
mergeCommonLogging :: CommonLoggingArgs -> Maybe CommonLoggingToml -> CommonLoggingMerged
mergeCommonLogging CommonLoggingArgs
args Maybe CommonLoggingToml
mToml =
  MkCommonLoggingP
    { debug :: SwitchF 'ConfigPhaseMerged Debug
debug =
        (CommonLoggingArgs
args CommonLoggingArgs
-> Optic' A_Lens NoIx CommonLoggingArgs (Maybe Debug)
-> Maybe Debug
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingArgs (Maybe Debug)
#debug) Maybe Debug -> Maybe Debug -> Debug
forall a. Default a => Maybe a -> Maybe a -> a
<.> (CommonLoggingToml
toml CommonLoggingToml
-> Optic' A_Lens NoIx CommonLoggingToml (Maybe Debug)
-> Maybe Debug
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingToml (Maybe Debug)
#debug),
      keyHide :: SwitchF 'ConfigPhaseMerged KeyHideSwitch
keyHide =
        (CommonLoggingArgs
args CommonLoggingArgs
-> Optic' A_Lens NoIx CommonLoggingArgs (Maybe KeyHideSwitch)
-> Maybe KeyHideSwitch
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingArgs (Maybe KeyHideSwitch)
#keyHide) Maybe KeyHideSwitch -> Maybe KeyHideSwitch -> KeyHideSwitch
forall a. Default a => Maybe a -> Maybe a -> a
<.> (CommonLoggingToml
toml CommonLoggingToml
-> Optic' A_Lens NoIx CommonLoggingToml (Maybe KeyHideSwitch)
-> Maybe KeyHideSwitch
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingToml (Maybe KeyHideSwitch)
#keyHide)
    }
  where
    toml :: CommonLoggingToml
toml = CommonLoggingToml -> Maybe CommonLoggingToml -> CommonLoggingToml
forall a. a -> Maybe a -> a
fromMaybe CommonLoggingToml
forall a. Monoid a => a
mempty Maybe CommonLoggingToml
mToml

instance DecodeTOML CommonLoggingToml where
  tomlDecoder :: Decoder CommonLoggingToml
tomlDecoder =
    Maybe Debug -> Maybe KeyHideSwitch -> CommonLoggingToml
SwitchF 'ConfigPhaseToml Debug
-> SwitchF 'ConfigPhaseToml KeyHideSwitch -> CommonLoggingToml
forall (p :: ConfigPhase).
SwitchF p Debug -> SwitchF p KeyHideSwitch -> CommonLoggingP p
MkCommonLoggingP
      (Maybe Debug -> Maybe KeyHideSwitch -> CommonLoggingToml)
-> Decoder (Maybe Debug)
-> Decoder (Maybe KeyHideSwitch -> CommonLoggingToml)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Debug -> Text -> Decoder (Maybe Debug)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder Debug
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"debug"
      Decoder (Maybe KeyHideSwitch -> CommonLoggingToml)
-> Decoder (Maybe KeyHideSwitch) -> Decoder CommonLoggingToml
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe KeyHideSwitch)
decodeKeyHideSwitch

decodeKeyHideSwitch :: Decoder (Maybe KeyHideSwitch)
decodeKeyHideSwitch :: Decoder (Maybe KeyHideSwitch)
decodeKeyHideSwitch = Decoder KeyHideSwitch -> Text -> Decoder (Maybe KeyHideSwitch)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder KeyHideSwitch
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"key-hide"

-- | Creates env version from merged.
toEnv :: CommonLoggingMerged -> CommonLoggingEnv
toEnv :: CommonLoggingMerged -> CommonLoggingEnv
toEnv CommonLoggingMerged
merged =
  MkCommonLoggingP
    { debug :: SwitchF 'ConfigPhaseEnv Debug
debug = CommonLoggingMerged
merged CommonLoggingMerged
-> Optic' A_Lens NoIx CommonLoggingMerged Debug -> Debug
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingMerged Debug
#debug,
      keyHide :: SwitchF 'ConfigPhaseEnv KeyHideSwitch
keyHide = CommonLoggingMerged
merged CommonLoggingMerged
-> Optic' A_Lens NoIx CommonLoggingMerged KeyHideSwitch
-> KeyHideSwitch
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommonLoggingMerged KeyHideSwitch
#keyHide
    }