    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}

    -- |
    -- Module      :  XMonad.Util.ExtensibleConf
    -- Description :  Extensible and composable configuration for contrib modules.
    -- Copyright   :  (c) 2021 Tomáš Janoušek <tomi@nomi.cz>
    -- License     :  BSD3
    -- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>
    --
    -- Extensible and composable configuration for contrib modules.
    --
    -- This is the configuration counterpart of "XMonad.Util.ExtensibleState". It
    -- allows contrib modules to store custom configuration values inside
    -- 'XConfig'. This lets them create custom hooks, ensure they hook into xmonad
    -- core only once, and possibly more.
    --

    module XMonad.Util.ExtensibleConf (
        -- * Usage
        -- $usage

        -- * High-level idioms based on Semigroup
        with,
        add,
        once,
        onceM,

        -- * High-level idioms based on Default
        withDef,
        modifyDef,
        modifyDefM,

        -- * Low-level primitivies
        ask,
        lookup,
        alter,
        alterF,
        ) where

    import Prelude hiding (lookup)
    import XMonad hiding (ask, modify, trace)
    import XMonad.Prelude ((<|>), (<&>), fromMaybe)

    import Data.Typeable
    import qualified Data.Map as M

    -- ---------------------------------------------------------------------
    -- $usage
    --
    -- To utilize this feature in a contrib module, create a data type for the
    -- configuration, then use the helper functions provided here to implement
    -- a user-friendly composable interface for your contrib module.
    --
    -- Example:
    --
    -- > import qualified XMonad.Util.ExtensibleConf as XC
    -- >
    -- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    -- > newtype MyConf = MyConf{ fromMyConf :: [Int] } deriving Semigroup
    -- >
    -- > customLogger :: Int -> XConfig l -> XConfig l
    -- > customLogger i = XC.once (\c -> c{ logHook = logHook c <> lh }) (MyConf [i])
    -- >   where
    -- >     lh :: X ()
    -- >     lh = XC.with $ io . print . fromMyConf
    --
    -- The above defines an xmonad configuration combinator that can be applied
    -- any number of times like so:
    --
    -- > main = xmonad $ … . customLogger 1 . ewmh . customLogger 2 . … $ def{…}
    --
    -- and will always result in just one 'print' invocation in 'logHook'.

    -- ---------------------------------------------------------------------
    -- Low-level primitivies

    -- | Run-time: Retrieve a configuration value of the requested type.
    ask :: (MonadReader XConf m, Typeable a) => m (Maybe a)
    ask :: forall (m :: * -> *) a.
    (MonadReader XConf m, Typeable a) =>
    m (Maybe a)
    ask = (XConf -> Maybe a) -> m (Maybe a)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((XConf -> Maybe a) -> m (Maybe a))
    -> (XConf -> Maybe a) -> m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ XConfig Layout -> Maybe a
    forall a (l :: * -> *). Typeable a => XConfig l -> Maybe a
    lookup (XConfig Layout -> Maybe a)
    -> (XConf -> XConfig Layout) -> XConf -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config

    -- | Config-time: Retrieve a configuration value of the requested type.
    lookup :: forall a l. Typeable a => XConfig l -> Maybe a
    lookup :: forall a (l :: * -> *). Typeable a => XConfig l -> Maybe a
    lookup XConfig l
    c = ConfExtension -> Maybe a
    forall a. Typeable a => ConfExtension -> Maybe a
    fromConfExt (ConfExtension -> Maybe a) -> Maybe ConfExtension -> Maybe a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Proxy a -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a) TypeRep -> Map TypeRep ConfExtension -> Maybe ConfExtension
    forall k a. Ord k => k -> Map k a -> Maybe a
    `M.lookup` XConfig l -> Map TypeRep ConfExtension
    forall (l :: * -> *). XConfig l -> Map TypeRep ConfExtension
    extensibleConf XConfig l
    c

    -- | Config-time: Alter a configuration value, or absence thereof.
    alter :: forall a l. Typeable a => (Maybe a -> Maybe a) -> XConfig l -> XConfig l
    alter :: forall a (l :: * -> *).
    Typeable a =>
    (Maybe a -> Maybe a) -> XConfig l -> XConfig l
    alter Maybe a -> Maybe a
    f = (Map TypeRep ConfExtension -> Map TypeRep ConfExtension)
    -> XConfig l -> XConfig l
    forall {l :: * -> *}.
    (Map TypeRep ConfExtension -> Map TypeRep ConfExtension)
    -> XConfig l -> XConfig l
    mapEC ((Map TypeRep ConfExtension -> Map TypeRep ConfExtension)
     -> XConfig l -> XConfig l)
    -> (Map TypeRep ConfExtension -> Map TypeRep ConfExtension)
    -> XConfig l
    -> XConfig l
    forall a b. (a -> b) -> a -> b
    $ (Maybe ConfExtension -> Maybe ConfExtension)
    -> TypeRep
    -> Map TypeRep ConfExtension
    -> Map TypeRep ConfExtension
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    M.alter ((Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension
    forall a.
    Typeable a =>
    (Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension
    mapConfExt Maybe a -> Maybe a
    f) (Proxy a -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a))
      where
        mapEC :: (Map TypeRep ConfExtension -> Map TypeRep ConfExtension)
    -> XConfig l -> XConfig l
    mapEC Map TypeRep ConfExtension -> Map TypeRep ConfExtension
    g XConfig l
    c = XConfig l
    c{ extensibleConf = g (extensibleConf c) }

    -- | Config-time: Functor variant of 'alter', useful if the configuration
    -- modifications needs to do some 'IO'.
    alterF :: forall a l f. (Typeable a, Functor f)
           => (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l)
    alterF :: forall a (l :: * -> *) (f :: * -> *).
    (Typeable a, Functor f) =>
    (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l)
    alterF Maybe a -> f (Maybe a)
    f = (Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension))
    -> XConfig l -> f (XConfig l)
    forall {f :: * -> *} {l :: * -> *}.
    Functor f =>
    (Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension))
    -> XConfig l -> f (XConfig l)
    mapEC ((Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension))
     -> XConfig l -> f (XConfig l))
    -> (Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension))
    -> XConfig l
    -> f (XConfig l)
    forall a b. (a -> b) -> a -> b
    $ (Maybe ConfExtension -> f (Maybe ConfExtension))
    -> TypeRep
    -> Map TypeRep ConfExtension
    -> f (Map TypeRep ConfExtension)
    forall (f :: * -> *) k a.
    (Functor f, Ord k) =>
    (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
    M.alterF ((Maybe a -> f (Maybe a))
    -> Maybe ConfExtension -> f (Maybe ConfExtension)
    forall a (f :: * -> *).
    (Typeable a, Functor f) =>
    (Maybe a -> f (Maybe a))
    -> Maybe ConfExtension -> f (Maybe ConfExtension)
    mapConfExtF Maybe a -> f (Maybe a)
    f) (Proxy a -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a))
      where
        mapEC :: (Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension))
    -> XConfig l -> f (XConfig l)
    mapEC Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension)
    g XConfig l
    c = Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension)
    g (XConfig l -> Map TypeRep ConfExtension
    forall (l :: * -> *). XConfig l -> Map TypeRep ConfExtension
    extensibleConf XConfig l
    c) f (Map TypeRep ConfExtension)
    -> (Map TypeRep ConfExtension -> XConfig l) -> f (XConfig l)
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> \Map TypeRep ConfExtension
    ec -> XConfig l
    c{ extensibleConf = ec }

    fromConfExt :: Typeable a => ConfExtension -> Maybe a
    fromConfExt :: forall a. Typeable a => ConfExtension -> Maybe a
    fromConfExt (ConfExtension a
    val) = a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    val

    mapConfExt :: Typeable a
               => (Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension
    mapConfExt :: forall a.
    Typeable a =>
    (Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension
    mapConfExt Maybe a -> Maybe a
    f = (a -> ConfExtension) -> Maybe a -> Maybe ConfExtension
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> ConfExtension
    forall a. Typeable a => a -> ConfExtension
    ConfExtension (Maybe a -> Maybe ConfExtension)
    -> (Maybe ConfExtension -> Maybe a)
    -> Maybe ConfExtension
    -> Maybe ConfExtension
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe a -> Maybe a
    f (Maybe a -> Maybe a)
    -> (Maybe ConfExtension -> Maybe a)
    -> Maybe ConfExtension
    -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe ConfExtension -> (ConfExtension -> Maybe a) -> Maybe a
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ConfExtension -> Maybe a
    forall a. Typeable a => ConfExtension -> Maybe a
    fromConfExt)

    mapConfExtF :: (Typeable a, Functor f)
                => (Maybe a -> f (Maybe a)) -> Maybe ConfExtension -> f (Maybe ConfExtension)
    mapConfExtF :: forall a (f :: * -> *).
    (Typeable a, Functor f) =>
    (Maybe a -> f (Maybe a))
    -> Maybe ConfExtension -> f (Maybe ConfExtension)
    mapConfExtF Maybe a -> f (Maybe a)
    f = (Maybe a -> Maybe ConfExtension)
    -> f (Maybe a) -> f (Maybe ConfExtension)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> ConfExtension) -> Maybe a -> Maybe ConfExtension
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> ConfExtension
    forall a. Typeable a => a -> ConfExtension
    ConfExtension) (f (Maybe a) -> f (Maybe ConfExtension))
    -> (Maybe ConfExtension -> f (Maybe a))
    -> Maybe ConfExtension
    -> f (Maybe ConfExtension)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe a -> f (Maybe a)
    f (Maybe a -> f (Maybe a))
    -> (Maybe ConfExtension -> Maybe a)
    -> Maybe ConfExtension
    -> f (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe ConfExtension -> (ConfExtension -> Maybe a) -> Maybe a
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ConfExtension -> Maybe a
    forall a. Typeable a => ConfExtension -> Maybe a
    fromConfExt)

    -- ---------------------------------------------------------------------
    -- High-level idioms based on Semigroup

    -- | Run-time: Run a monadic action with the value of the custom
    -- configuration, if set.
    with :: (MonadReader XConf m, Typeable a, Monoid b) => (a -> m b) -> m b
    with :: forall (m :: * -> *) a b.
    (MonadReader XConf m, Typeable a, Monoid b) =>
    (a -> m b) -> m b
    with a -> m b
    a = m (Maybe a)
    forall (m :: * -> *) a.
    (MonadReader XConf m, Typeable a) =>
    m (Maybe a)
    ask m (Maybe a) -> (Maybe a -> m b) -> m b
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= m b -> (a -> m b) -> Maybe a -> m b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (b -> m b
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure b
    forall a. Monoid a => a
    mempty) a -> m b
    a

    -- | Config-time: Add (append) a piece of custom configuration to an 'XConfig'
    -- using the 'Semigroup' instance of the configuration type.
    add :: (Semigroup a, Typeable a)
        => a -- ^ configuration to add
        -> XConfig l -> XConfig l
    add :: forall a (l :: * -> *).
    (Semigroup a, Typeable a) =>
    a -> XConfig l -> XConfig l
    add a
    x = (Maybe a -> Maybe a) -> XConfig l -> XConfig l
    forall a (l :: * -> *).
    Typeable a =>
    (Maybe a -> Maybe a) -> XConfig l -> XConfig l
    alter (Maybe a -> Maybe a -> Maybe a
    forall a. Semigroup a => a -> a -> a
    <> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x)

    -- | Config-time: 'add' a piece of custom configuration, and if it's the first
    -- piece of this type, also modify the 'XConfig' using the provided function.
    --
    -- This can be used to implement a composable interface for modules that must
    -- only hook into xmonad core once.
    --
    -- (The piece of custom configuration is the last argument as it's expected to
    -- come from the user.)
    once :: forall a l. (Semigroup a, Typeable a)
         => (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once
         -> a -- ^ configuration to add
         -> XConfig l -> XConfig l
    once :: forall a (l :: * -> *).
    (Semigroup a, Typeable a) =>
    (XConfig l -> XConfig l) -> a -> XConfig l -> XConfig l
    once XConfig l -> XConfig l
    f a
    x XConfig l
    c = (XConfig l -> XConfig l)
    -> (a -> XConfig l -> XConfig l)
    -> Maybe a
    -> XConfig l
    -> XConfig l
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe XConfig l -> XConfig l
    f ((XConfig l -> XConfig l) -> a -> XConfig l -> XConfig l
    forall a b. a -> b -> a
    const XConfig l -> XConfig l
    forall a. a -> a
    id) (forall a (l :: * -> *). Typeable a => XConfig l -> Maybe a
    lookup @a XConfig l
    c) (XConfig l -> XConfig l) -> XConfig l -> XConfig l
    forall a b. (a -> b) -> a -> b
    $ a -> XConfig l -> XConfig l
    forall a (l :: * -> *).
    (Semigroup a, Typeable a) =>
    a -> XConfig l -> XConfig l
    add a
    x XConfig l
    c

    -- | Config-time: Applicative (monadic) variant of 'once', useful if the
    -- 'XConfig' modification needs to do some 'IO' (e.g. create an
    -- 'Data.IORef.IORef').
    onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a)
          => (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once
          -> a -- ^ configuration to add
          -> XConfig l -> m (XConfig l)
    onceM :: forall a (l :: * -> *) (m :: * -> *).
    (Applicative m, Semigroup a, Typeable a) =>
    (XConfig l -> m (XConfig l)) -> a -> XConfig l -> m (XConfig l)
    onceM XConfig l -> m (XConfig l)
    f a
    x XConfig l
    c = (XConfig l -> m (XConfig l))
    -> (a -> XConfig l -> m (XConfig l))
    -> Maybe a
    -> XConfig l
    -> m (XConfig l)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe XConfig l -> m (XConfig l)
    f ((XConfig l -> m (XConfig l)) -> a -> XConfig l -> m (XConfig l)
    forall a b. a -> b -> a
    const XConfig l -> m (XConfig l)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure) (forall a (l :: * -> *). Typeable a => XConfig l -> Maybe a
    lookup @a XConfig l
    c) (XConfig l -> m (XConfig l)) -> XConfig l -> m (XConfig l)
    forall a b. (a -> b) -> a -> b
    $ a -> XConfig l -> XConfig l
    forall a (l :: * -> *).
    (Semigroup a, Typeable a) =>
    a -> XConfig l -> XConfig l
    add a
    x XConfig l
    c

    -- ---------------------------------------------------------------------
    -- High-level idioms based on Default

    -- | Run-time: Run a monadic action with the value of the custom
    -- configuration, or the 'Default' value thereof, if absent.
    withDef :: (MonadReader XConf m, Typeable a, Default a) => (a -> m b) -> m b
    withDef :: forall (m :: * -> *) a b.
    (MonadReader XConf m, Typeable a, Default a) =>
    (a -> m b) -> m b
    withDef a -> m b
    a = m (Maybe a)
    forall (m :: * -> *) a.
    (MonadReader XConf m, Typeable a) =>
    m (Maybe a)
    ask m (Maybe a) -> (Maybe a -> m b) -> m b
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> m b
    a (a -> m b) -> (Maybe a -> a) -> Maybe a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    forall a. Default a => a
    def

    -- | Config-time: Modify a configuration value in 'XConfig', initializing it
    -- to its 'Default' value first if absent. This is an alternative to 'add' for
    -- when a 'Semigroup' instance is unavailable or unsuitable.
    --
    -- Note that this must /not/ be used together with any variant of 'once'!
    modifyDef :: forall a l. (Default a, Typeable a)
              => (a -> a) -- ^ modification of configuration
              -> XConfig l -> XConfig l
    modifyDef :: forall a (l :: * -> *).
    (Default a, Typeable a) =>
    (a -> a) -> XConfig l -> XConfig l
    modifyDef a -> a
    f = (Maybe a -> Maybe a) -> XConfig l -> XConfig l
    forall a (l :: * -> *).
    Typeable a =>
    (Maybe a -> Maybe a) -> XConfig l -> XConfig l
    alter ((a -> a
    f (a -> a) -> Maybe a -> Maybe a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Maybe a -> Maybe a) -> (Maybe a -> Maybe a) -> Maybe a -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe a -> Maybe a -> Maybe a
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    forall a. Default a => a
    def))

    -- | Config-time: Applicative (monadic) variant of 'modifyDef', useful if the
    -- configuration value modification needs to do some 'IO' (e.g. create an
    -- 'Data.IORef.IORef').
    --
    -- Note that this must /not/ be used together with any variant of 'once'!
    modifyDefM :: forall a l m. (Applicative m, Default a, Typeable a)
               => (a -> m a) -- ^ modification of configuration
               -> XConfig l -> m (XConfig l)
    modifyDefM :: forall a (l :: * -> *) (m :: * -> *).
    (Applicative m, Default a, Typeable a) =>
    (a -> m a) -> XConfig l -> m (XConfig l)
    modifyDefM a -> m a
    f = (Maybe a -> m (Maybe a)) -> XConfig l -> m (XConfig l)
    forall a (l :: * -> *) (f :: * -> *).
    (Typeable a, Functor f) =>
    (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l)
    alterF ((a -> m a) -> Maybe a -> m (Maybe a)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse a -> m a
    f (Maybe a -> m (Maybe a))
    -> (Maybe a -> Maybe a) -> Maybe a -> m (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe a -> Maybe a -> Maybe a
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    forall a. Default a => a
    def))