From 33bce0badbeb834cf8c584df56c424fe1c9bff7a Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 8 Jun 2024 00:22:17 +0200
Subject: quasi-quotes for config keys

---
 src/Conftrack/Value.hs | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

(limited to 'src/Conftrack')

diff --git a/src/Conftrack/Value.hs b/src/Conftrack/Value.hs
index 5c8d949..6fe8780 100644
--- a/src/Conftrack/Value.hs
+++ b/src/Conftrack/Value.hs
@@ -6,15 +6,18 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Conftrack.Value (Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..), KeyPart, prefixedWith) where
+module Conftrack.Value (key, Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..), KeyPart, prefixedWith) where
 
 import Data.Text(Text)
 import qualified Data.Text as T
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LB
 import Data.List.NonEmpty (NonEmpty, prependList)
+import qualified Data.List.NonEmpty as NonEmpty
 import System.OsPath (OsPath, encodeUtf)
 import qualified Data.Text.Encoding as BS
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
+import Language.Haskell.TH.Syntax (Lift(lift))
 
 data Value =
   ConfigString BS.ByteString
@@ -27,7 +30,22 @@ data Value =
 type KeyPart = Text
 
 newtype Key = Key (NonEmpty KeyPart)
-  deriving newtype (Eq, Ord, Show)
+  deriving newtype (Eq, Ord)
+  deriving (Lift)
+
+instance Show Key where
+  show (Key parts) = T.unpack (T.intercalate "." (NonEmpty.toList parts))
+
+key :: QuasiQuoter
+key = QuasiQuoter
+  { quoteExp = lift . Key . NonEmpty.fromList . T.splitOn "." . T.pack
+  , quotePat = \_ -> fail "key quoter cannot be used in patterns"
+  , quoteType = \_ -> fail "key quasi-quote cannot be used for types"
+  , quoteDec = \_ -> fail "key quasi-quote cannot be used in declarations"}
+
+blub :: String -> Key
+blub = undefined
+
 
 prefixedWith :: Key -> [KeyPart] -> Key
 prefixedWith (Key key) prefix = Key (prependList prefix key)
-- 
cgit v1.2.3