    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE Rank2Types            #-}

    {- |
    Module                  : Colog.Core.Class
    Copyright               : (c) 2018-2020 Kowainik, 2021-2025 Co-Log
    SPDX-License-Identifier : MPL-2.0
    Maintainer              : Co-Log <xrom.xkov@gmail.com>
    Stability               : Stable
    Portability             : Portable

    Provides type class for values that has access to 'LogAction'.
    -}

    module Colog.Core.Class
           ( HasLog (..)

             -- * Lens
             -- $lens
           , Lens'
           ) where

    import Colog.Core.Action  (LogAction)
    import Data.Functor.Const (Const (..))

    -- to inline lens better
    {- HLINT ignore "Redundant lambda" -}

    {- | This types class contains simple pair of getter-setter and related
    functions.
    It also provides the useful lens 'logActionL' with the default implementation using type
    class methods. The default one could be easily overritten under your instances.

    Every instance of the this typeclass should satisfy the following laws:

    1. __Set-Get:__ @'getLogAction' ('setLogAction' l env) ≡ l@
    2. __Get-Set:__ @'setLogAction' ('getLogAction' env) env ≡ env@
    3. __Set-Set:__ @'setLogAction' l2 ('setLogAction' l1 env) ≡ 'setLogAction' l2 env@
    4. __Set-Over:__ @'overLogAction' f env ≡ 'setLogAction' (f $ 'getLogAction' env) env@
    -}
    class HasLog env msg m where
        {-# MINIMAL logActionL | (getLogAction , (setLogAction | overLogAction)) #-}

        -- | Extracts 'LogAction' from the environment.
        getLogAction :: env -> LogAction m msg
        getLogAction = Const (LogAction m msg) env -> LogAction m msg
    forall {k} a (b :: k). Const a b -> a
    getConst (Const (LogAction m msg) env -> LogAction m msg)
    -> (env -> Const (LogAction m msg) env) -> env -> LogAction m msg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LogAction m msg -> Const (LogAction m msg) (LogAction m msg))
    -> env -> Const (LogAction m msg) env
    forall env msg (m :: * -> *).
    HasLog env msg m =>
    Lens' env (LogAction m msg)
    Lens' env (LogAction m msg)
    logActionL LogAction m msg -> Const (LogAction m msg) (LogAction m msg)
    forall {k} a (b :: k). a -> Const a b
    Const
        {-# INLINE getLogAction #-}

        -- | Sets 'LogAction' to the given one inside the environment.
        setLogAction :: LogAction m msg -> env -> env
        setLogAction = (LogAction m msg -> LogAction m msg) -> env -> env
    forall env msg (m :: * -> *).
    HasLog env msg m =>
    (LogAction m msg -> LogAction m msg) -> env -> env
    overLogAction ((LogAction m msg -> LogAction m msg) -> env -> env)
    -> (LogAction m msg -> LogAction m msg -> LogAction m msg)
    -> LogAction m msg
    -> env
    -> env
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogAction m msg -> LogAction m msg -> LogAction m msg
    forall a b. a -> b -> a
    const
        {-# INLINE setLogAction #-}

        -- | Applies function to the 'LogAction' inside the environment.
        overLogAction :: (LogAction m msg -> LogAction m msg) -> env -> env
        overLogAction LogAction m msg -> LogAction m msg
    f env
    env = LogAction m msg -> env -> env
    forall env msg (m :: * -> *).
    HasLog env msg m =>
    LogAction m msg -> env -> env
    setLogAction (LogAction m msg -> LogAction m msg
    f (LogAction m msg -> LogAction m msg)
    -> LogAction m msg -> LogAction m msg
    forall a b. (a -> b) -> a -> b
    $ env -> LogAction m msg
    forall env msg (m :: * -> *).
    HasLog env msg m =>
    env -> LogAction m msg
    getLogAction env
    env) env
    env
        {-# INLINE overLogAction #-}

        -- | Lens for 'LogAction' inside the environment.
        logActionL :: Lens' env (LogAction m msg)
        logActionL = (env -> LogAction m msg)
    -> (env -> LogAction m msg -> env) -> Lens' env (LogAction m msg)
    forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
    lens env -> LogAction m msg
    forall env msg (m :: * -> *).
    HasLog env msg m =>
    env -> LogAction m msg
    getLogAction ((LogAction m msg -> env -> env) -> env -> LogAction m msg -> env
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip LogAction m msg -> env -> env
    forall env msg (m :: * -> *).
    HasLog env msg m =>
    LogAction m msg -> env -> env
    setLogAction)
        {-# INLINE logActionL #-}

    instance HasLog (LogAction m msg) msg m where
        getLogAction :: LogAction m msg -> LogAction m msg
        getLogAction :: LogAction m msg -> LogAction m msg
    getLogAction = LogAction m msg -> LogAction m msg
    forall a. a -> a
    id
        {-# INLINE getLogAction #-}

        setLogAction :: LogAction m msg -> LogAction m msg -> LogAction m msg
        setLogAction :: LogAction m msg -> LogAction m msg -> LogAction m msg
    setLogAction = LogAction m msg -> LogAction m msg -> LogAction m msg
    forall a b. a -> b -> a
    const
        {-# INLINE setLogAction #-}

        overLogAction
            :: (LogAction m msg -> LogAction m msg)
            -> LogAction m msg
            -> LogAction m msg
        overLogAction :: (LogAction m msg -> LogAction m msg)
    -> LogAction m msg -> LogAction m msg
    overLogAction = (LogAction m msg -> LogAction m msg)
    -> LogAction m msg -> LogAction m msg
    forall a. a -> a
    id
        {-# INLINE overLogAction #-}

        logActionL :: Lens' (LogAction m msg) (LogAction m msg)
        logActionL :: Lens' (LogAction m msg) (LogAction m msg)
    logActionL = \LogAction m msg -> f (LogAction m msg)
    f LogAction m msg
    s -> LogAction m msg
    s LogAction m msg -> f (LogAction m msg) -> f (LogAction m msg)
    forall a b. a -> f b -> f a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ LogAction m msg -> f (LogAction m msg)
    f LogAction m msg
    s
        {-# INLINE logActionL #-}

    ----------------------------------------------------------------------------
    -- Lens
    ----------------------------------------------------------------------------

    {- $lens
    To keep @co-log-core@ a lightweight library it was decided to introduce local
    'Lens'' type alias as it doesn't harm.
    -}

    {- | The monomorphic lenses which don't change the type of the container (or of
    the value inside).
    -}
    type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s

    -- | Creates 'Lens'' from the getter and setter.
    lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
    lens :: forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
    lens s -> a
    getter s -> a -> s
    setter = \a -> f a
    f s
    s -> s -> a -> s
    setter s
    s (a -> s) -> f a -> f s
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f a
    f (s -> a
    getter s
    s)
    {-# INLINE lens #-}