merged key-value stuff for config

Squashed commit of the following:

commit c62c48b0aced3d88faba97c3032cc4e684a4f1ff
Author: Vladimir Krutkin <krutkinvs@gmail.com>
Date:   Wed Jul 12 23:38:41 2023 +0300

    Fixme

commit d418474956badee19accd94e8da09473ac162316
Author: Vladimir Krutkin <krutkinvs@gmail.com>
Date:   Wed Jul 12 23:33:10 2023 +0300

    Fix fixme config

commit 2c26673fa42c7dc09bba11b5a8a37ae584f6e6aa
Author: Vladimir Krutkin <krutkinvs@gmail.com>
Date:   Wed Jul 12 23:28:35 2023 +0300

    PR

commit cb4ee37f455b8e001fd5688106b2da1b31885dc4
Author: Vladimir Krutkin <krutkinvs@gmail.com>
Date:   Wed Jul 12 23:25:46 2023 +0300

    Add key-value utilities

.fixme/log

@@ -0,0 +1,5 @@
+
+;; This is a log file. All fixmies status updates go here
+
+fixme-set "workflow" "done" "9QfPgLHLSw"
+(fixme-set "assigned" "voidlizard" "9XmyXek1Y6")

.gitignore

@@ -1,4 +1,3 @@
 dist-newstyle/
 .direnv/
 .fixme/state.db
-.fixme/state.db

doc/devlog

@@ -1,3 +1,9 @@
+## 2023-07-12
+
+PR: key-value-utilities
+  branch: key-value-utilities
+  commit: cb4ee37f455b8e001fd5688106b2da1b31885dc4
+  Добавлены утилиты для работы с ключами и значениями.
 
 ## 2023-02-09
 

lib/Data/Config/Suckless.hs

@@ -1,9 +1,11 @@
 module Data.Config.Suckless
   ( module Data.Config.Suckless.Syntax
   , module Data.Config.Suckless.Parse
+  , module Data.Config.Suckless.KeyValue
   )
   where
 
 import Data.Config.Suckless.Syntax
 import Data.Config.Suckless.Parse
+import Data.Config.Suckless.KeyValue
 

lib/Data/Config/Suckless/KeyValue.hs

@@ -0,0 +1,42 @@
+{-# Language PatternSynonyms #-}
+{-# Language UndecidableInstances #-}
+{-# Language AllowAmbiguousTypes #-}
+module Data.Config.Suckless.KeyValue where
+
+import Data.Config.Suckless.Syntax
+import Data.Config.Suckless.Parse
+
+import Data.String (IsString(..))
+import Data.Set qualified as Set
+import Data.Set (Set)
+import Prettyprinter
+import Safe
+
+type C = MegaParsec
+
+class Monad m => HasCfgKey a b m where
+  -- type family CfgValue a :: Type
+  key :: Id
+
+class (Monad m, HasCfgKey a b m) => HasCfgValue a b m where
+  cfgValue :: m b
+
+class Monad m => HasConf m where
+  getConf :: m [Syntax C]
+
+pattern Key :: forall {c}. Id -> [Syntax c] -> [Syntax c]
+pattern Key n ns <- SymbolVal  n : ns
+
+instance {-# OVERLAPPABLE #-} (HasConf m, Ord b, IsString b, HasCfgKey a (Maybe b) m) => HasCfgValue a (Maybe b) m where
+  cfgValue = lastMay . val <$> getConf
+    where
+      val syn = [ fromString (show $ pretty e)
+                | ListVal @C (Key s [LitStrVal e]) <- syn, s == key @a @(Maybe b) @m
+                ]
+
+instance {-# OVERLAPPABLE #-} (HasConf m, Ord b, IsString b, HasCfgKey a (Set b) m) => HasCfgValue a (Set b) m where
+  cfgValue  = Set.fromList . val <$> getConf
+    where
+      val syn = [ fromString (show $ pretty e)
+                | ListVal @C (Key s [LitStrVal e]) <- syn, s == key @a @(Set b) @m
+                ]

lib/Data/Config/Suckless/Parse/Megaparsec.hs

@@ -12,7 +12,6 @@ import Data.Config.Suckless.Syntax
 
 import Control.Applicative()
 
-import Data.Char (showLitChar)
 import Data.Text qualified as Text
 
 import Control.Monad

suckless-conf.cabal

@@ -63,6 +63,7 @@ library
         Data.Config.Suckless
       , Data.Config.Suckless.Syntax
       , Data.Config.Suckless.Parse
+      , Data.Config.Suckless.KeyValue
 
     other-modules:
         Data.Config.Suckless.Types
@@ -74,8 +75,37 @@ library
                     , containers
                     , megaparsec
                     , prettyprinter
+                    , safe
                     , text
 
     hs-source-dirs:   lib
     default-language: Haskell2010
 
+test-suite spec
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Data.Config.Suckless.KeyValueSpec
+  hs-source-dirs:
+      test
+  ghc-options:
+      -Wall
+      -threaded
+      -rtsopts
+      -with-rtsopts=-N
+  build-tool-depends:
+      hspec-discover:hspec-discover
+  build-depends:      base
+                    , hspec
+                    , suckless-conf
+                    , containers
+                    , mtl
+
+  default-language: Haskell2010
+  default-extensions:
+                      DerivingStrategies
+                    , FlexibleInstances
+                    , MultiParamTypeClasses
+                    , OverloadedStrings
+                    , ScopedTypeVariables
+                    , TypeApplications

t/key-value-test-config

@@ -0,0 +1,4 @@
+; comment
+foo "a"
+bar "a"
+bar "b"

test/Data/Config/Suckless/KeyValueSpec.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Data.Config.Suckless.KeyValueSpec (spec) where
+
+import Control.Monad.IO.Class
+import Data.Config.Suckless.KeyValue
+import Data.Config.Suckless.Parse
+import Data.Config.Suckless.Syntax
+import Data.Functor
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Test.Hspec
+
+data FirstKey
+
+data SecondKey
+
+data ThirdKey
+
+instance MonadIO m => HasCfgKey FirstKey (Maybe String) m where
+  key = "foo"
+
+instance MonadIO m => HasCfgKey SecondKey (Set String) m where
+  key = "bar"
+
+instance MonadIO m => HasCfgKey ThirdKey (Maybe String) m where
+  key = "baz"
+
+instance (Monad m, MonadIO m) => HasConf m where
+  getConf = liftIO readConfig
+
+readConfig :: IO [Syntax C]
+readConfig = do
+  let configFilePath = "t/key-value-test-config"
+  readFile configFilePath <&> parseTop <&> either mempty id
+
+spec :: Spec
+spec = do
+  describe "config parsing" $ do
+    it "reads string" $ do
+      firstValue <- cfgValue @FirstKey @(Maybe String)
+      firstValue `shouldBe` Just "a"
+    it "reads a set of strings" $ do
+      secondValue <- cfgValue @SecondKey @(Set String)
+      secondValue `shouldBe` Set.fromList ["a", "b"]
+    it "reads nothing" $ do
+      thridValue <- cfgValue @ThirdKey @(Maybe String)
+      thridValue `shouldBe` Nothing

test/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}