This commit is contained in:
Dmitry Zuikov 2023-10-14 05:47:28 +03:00
parent a0919addd3
commit a79097e5b2
2 changed files with 41 additions and 21 deletions

View File

@ -32,10 +32,7 @@ pattern Key :: forall {c}. Id -> [Syntax c] -> [Syntax c]
pattern Key n ns <- SymbolVal n : ns pattern Key n ns <- SymbolVal n : ns
instance HasConf (Reader [Syntax C]) where instance {-# OVERLAPPABLE #-} Monad m => HasConf (ReaderT [Syntax C] m) where
getConf = ask
instance Monad m => HasConf (ReaderT [Syntax C] m) where
getConf = ask getConf = ask
instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a (Maybe Integer) m) => HasCfgValue a (Maybe Integer) m where 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 instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a (Maybe Scientific) m) => HasCfgValue a (Maybe Scientific) m where
cfgValue = lastMay . val <$> getConf cfgValue = lastMay . val <$> getConf
where where

View File

@ -4,7 +4,9 @@
module Data.Config.Suckless.KeyValueSpec (spec) where module Data.Config.Suckless.KeyValueSpec (spec) where
import Data.Function
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Config.Suckless.KeyValue import Data.Config.Suckless.KeyValue
import Data.Config.Suckless.Parse import Data.Config.Suckless.Parse
import Data.Config.Suckless.Syntax import Data.Config.Suckless.Syntax
@ -39,55 +41,55 @@ data Sci5
data O1 data O1
data O2 data O2
instance MonadIO m => HasCfgKey FirstKey (Maybe String) m where instance Monad m => HasCfgKey FirstKey (Maybe String) m where
key = "foo" key = "foo"
instance MonadIO m => HasCfgKey SecondKey (Set String) m where instance Monad m => HasCfgKey SecondKey (Set String) m where
key = "bar" key = "bar"
instance MonadIO m => HasCfgKey ThirdKey (Maybe String) m where instance Monad m => HasCfgKey ThirdKey (Maybe String) m where
key = "baz" key = "baz"
instance MonadIO m => HasCfgKey Int1 b m where instance Monad m => HasCfgKey Int1 b m where
key = "int1" key = "int1"
instance MonadIO m => HasCfgKey Int2 b m where instance Monad m => HasCfgKey Int2 b m where
key = "int2" key = "int2"
instance MonadIO m => HasCfgKey Int3 b m where instance Monad m => HasCfgKey Int3 b m where
key = "int3" key = "int3"
instance MonadIO m => HasCfgKey Int4 b m where instance Monad m => HasCfgKey Int4 b m where
key = "int4" key = "int4"
instance MonadIO m => HasCfgKey Int5 b m where instance Monad m => HasCfgKey Int5 b m where
key = "int5" key = "int5"
instance MonadIO m => HasCfgKey Int6 b m where instance Monad m => HasCfgKey Int6 b m where
key = "int6" key = "int6"
instance MonadIO m => HasCfgKey Sci1 b m where instance Monad m => HasCfgKey Sci1 b m where
key = "sci1" key = "sci1"
instance MonadIO m => HasCfgKey Sci2 b m where instance Monad m => HasCfgKey Sci2 b m where
key = "sci2" key = "sci2"
instance MonadIO m => HasCfgKey Sci3 b m where instance Monad m => HasCfgKey Sci3 b m where
key = "sci3" key = "sci3"
instance MonadIO m => HasCfgKey Sci4 b m where instance Monad m => HasCfgKey Sci4 b m where
key = "sci4" key = "sci4"
instance MonadIO m => HasCfgKey Sci5 b m where instance Monad m => HasCfgKey Sci5 b m where
key = "sci5" key = "sci5"
instance MonadIO m => HasCfgKey O1 b m where instance Monad m => HasCfgKey O1 b m where
key = "some-object" key = "some-object"
instance MonadIO m => HasCfgKey O2 b m where instance Monad m => HasCfgKey O2 b m where
key = "another-object" key = "another-object"
instance (Monad m, MonadIO m) => HasConf m where instance HasConf IO where
getConf = liftIO readConfig getConf = liftIO readConfig
readConfig :: IO [Syntax C] readConfig :: IO [Syntax C]
@ -162,3 +164,17 @@ spec = do
o2 `shouldBe` decode wtf2 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