[feat] add ways to get and configure config extensions.

3 files changed, 25 insertions, 1 deletions

diff --git a/plug/src/Montis/Core/Extensions.hs b/plug/src/Montis/Core/Extensions.hs
index a44debe..0e8384f 100644
--- a/plug/src/Montis/Core/Extensions.hs
+++ b/plug/src/Montis/Core/Extensions.hs
@@ -19,6 +19,7 @@ data Extension (c :: Type -> Constraint) where
   Extension :: (Typeable a, c a) => a -> Extension c
 
 class Nil a
+instance Nil a
 
 -- | Produces a string representation of a type used to key into the extensible
 -- state map.
diff --git a/plug/src/Montis/Core/Monad.hs b/plug/src/Montis/Core/Monad.hs
index 06bfc28..4d5ac3b 100644
--- a/plug/src/Montis/Core/Monad.hs
+++ b/plug/src/Montis/Core/Monad.hs
@@ -6,7 +6,9 @@ module Montis.Core.Monad where
 import Control.Monad.Identity (Identity (Identity))
 import Control.Monad.Reader
 import Control.Monad.State (MonadState, StateT (runStateT), gets, modify')
+import Data.Default.Class (Default (def))
 import Data.Map qualified as Map
+import Data.Maybe (fromMaybe)
 import Data.Typeable
 import Foreign (StablePtr)
 import Montis.Core.Extensions (Extension (Extension), typeRepr)
@@ -100,3 +102,13 @@ xStateGet = do
     Just (Left s) -> do
       let x = (demarshalExtension s :: Maybe a)
        in forM_ x xStatePut >> return x
+
+-- | Retrieve a typed configuration extension or return the default
+--   instance if the extension had not been configured.
+xConfigGet :: forall a. (Typeable a, Default a) => Montis a
+xConfigGet = do
+  exts <- asks configExtensions
+  return $
+    fromMaybe def $
+      Map.lookup (typeRepr (Proxy :: Proxy a)) exts
+        >>= (\(Extension a) -> cast a)
diff --git a/plug/src/Montis/Core/State.hs b/plug/src/Montis/Core/State.hs
index 899846a..5a35e88 100644
--- a/plug/src/Montis/Core/State.hs
+++ b/plug/src/Montis/Core/State.hs
@@ -1,7 +1,7 @@
 -- | Definitions of montis core state.
 module Montis.Core.State where
 
-import Data.Data (Typeable)
+import Data.Data (Proxy (Proxy), Typeable)
 import Data.Default.Class (Default, def)
 import Data.Map qualified as M
 import Data.Void (Void)
@@ -48,6 +48,17 @@ data Hooks m where
     } ->
     Hooks m
 
+-- | Configures a typed configuration extension.
+configure :: forall a m. (Typeable a) => a -> Config m -> Config m
+configure a c =
+  c
+    { configExtensions =
+        M.insert
+          (typeRepr (Proxy :: Proxy a))
+          (Extension a)
+          (configExtensions c)
+    }
+
 -- | Typeclass defining the set of types which can be used as state extensions
 -- to the W monad. These state extensions may be persistent or not.
 --