From a79097e5b28da8a098405dc9c15235a57f887160 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Sat, 14 Oct 2023 05:47:28 +0300
Subject: [PATCH] fix

---
 lib/Data/Config/Suckless/KeyValue.hs      | 12 ++++--
 test/Data/Config/Suckless/KeyValueSpec.hs | 50 +++++++++++++++--------
 2 files changed, 41 insertions(+), 21 deletions(-)

diff --git a/lib/Data/Config/Suckless/KeyValue.hs b/lib/Data/Config/Suckless/KeyValue.hs
index 5feedba..033d002 100644
--- a/lib/Data/Config/Suckless/KeyValue.hs
+++ b/lib/Data/Config/Suckless/KeyValue.hs
@@ -32,10 +32,7 @@ pattern Key :: forall {c}. Id -> [Syntax c] -> [Syntax c]
 pattern Key n ns <- SymbolVal  n : ns
 
 
-instance HasConf (Reader [Syntax C]) where
-  getConf = ask
-
-instance Monad m => HasConf (ReaderT [Syntax C] m) where
+instance {-# OVERLAPPABLE #-} Monad m => HasConf (ReaderT [Syntax C] m) where
   getConf = ask
 
 instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a (Maybe Integer) m) => HasCfgValue a (Maybe Integer) m where
@@ -46,6 +43,13 @@ instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a (Maybe Integer) m) => HasC
                 ]
 
 
+instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a (Maybe Int) m) => HasCfgValue a (Maybe Int) m where
+  cfgValue = lastMay . val <$> getConf
+    where
+      val syn = [ fromIntegral e
+                | ListVal @C (Key s [LitIntVal e]) <- syn, s == key @a @(Maybe Int) @m
+                ]
+
 instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a (Maybe Scientific) m) => HasCfgValue a (Maybe Scientific) m where
   cfgValue = lastMay . val <$> getConf
     where
diff --git a/test/Data/Config/Suckless/KeyValueSpec.hs b/test/Data/Config/Suckless/KeyValueSpec.hs
index 4766fde..a9f09e0 100644
--- a/test/Data/Config/Suckless/KeyValueSpec.hs
+++ b/test/Data/Config/Suckless/KeyValueSpec.hs
@@ -4,7 +4,9 @@
 
 module Data.Config.Suckless.KeyValueSpec (spec) where
 
+import Data.Function
 import Control.Monad.IO.Class
+import Control.Monad.Reader
 import Data.Config.Suckless.KeyValue
 import Data.Config.Suckless.Parse
 import Data.Config.Suckless.Syntax
@@ -39,55 +41,55 @@ data Sci5
 data O1
 data O2
 
-instance MonadIO m => HasCfgKey FirstKey (Maybe String) m where
+instance Monad m => HasCfgKey FirstKey (Maybe String) m where
   key = "foo"
 
-instance MonadIO m => HasCfgKey SecondKey (Set String) m where
+instance Monad m => HasCfgKey SecondKey (Set String) m where
   key = "bar"
 
-instance MonadIO m => HasCfgKey ThirdKey (Maybe String) m where
+instance Monad m => HasCfgKey ThirdKey (Maybe String) m where
   key = "baz"
 
-instance MonadIO m => HasCfgKey Int1 b m where
+instance Monad m => HasCfgKey Int1 b m where
   key = "int1"
 
-instance MonadIO m => HasCfgKey Int2 b m where
+instance Monad m => HasCfgKey Int2 b m where
   key = "int2"
 
-instance MonadIO m => HasCfgKey Int3 b m where
+instance Monad m => HasCfgKey Int3 b m where
   key = "int3"
 
-instance MonadIO m => HasCfgKey Int4 b m where
+instance Monad m => HasCfgKey Int4 b m where
   key = "int4"
 
-instance MonadIO m => HasCfgKey Int5 b m where
+instance Monad m => HasCfgKey Int5 b m where
   key = "int5"
 
-instance MonadIO m => HasCfgKey Int6 b m where
+instance Monad m => HasCfgKey Int6 b m where
   key = "int6"
 
-instance MonadIO m => HasCfgKey Sci1 b m where
+instance Monad m => HasCfgKey Sci1 b m where
   key = "sci1"
 
-instance MonadIO m => HasCfgKey Sci2 b m where
+instance Monad m => HasCfgKey Sci2 b m where
   key = "sci2"
 
-instance MonadIO m => HasCfgKey Sci3 b m where
+instance Monad m => HasCfgKey Sci3 b m where
   key = "sci3"
 
-instance MonadIO m => HasCfgKey Sci4 b m where
+instance Monad m => HasCfgKey Sci4 b m where
   key = "sci4"
 
-instance MonadIO m => HasCfgKey Sci5 b m where
+instance Monad m => HasCfgKey Sci5 b m where
   key = "sci5"
 
-instance MonadIO m => HasCfgKey O1 b m where
+instance Monad m => HasCfgKey O1 b m where
   key = "some-object"
 
-instance MonadIO m => HasCfgKey O2 b m where
+instance Monad m => HasCfgKey O2 b m where
   key = "another-object"
 
-instance (Monad m, MonadIO m) => HasConf m where
+instance HasConf IO where
   getConf = liftIO readConfig
 
 readConfig :: IO [Syntax C]
@@ -162,3 +164,17 @@ spec = do
       o2 `shouldBe` decode wtf2
 
 
+    it "works in Reader" $ do
+
+      let cfg = [qc|
+int1 123
+
+|]
+      let conf = parseTop cfg & either mempty id
+
+      let v = runReader (cfgValue @Int1 @(Maybe Int)) conf
+
+      v `shouldBe` Just 123
+
+
+