quasi-quotes for config keys

2 files changed, 22 insertions, 3 deletions

diff --git a/src/Conftrack.hs b/src/Conftrack.hs
index ab830ff..6f030a6 100644
--- a/src/Conftrack.hs
+++ b/src/Conftrack.hs
@@ -22,9 +22,10 @@ module Conftrack
   , Key(..)
   , Value(..)
   , configKeysOf
+  , key
   ) where
 
-import Conftrack.Value (ConfigError(..), ConfigValue(..), Key (..), Origin(..), Value(..), KeyPart, prefixedWith)
+import Conftrack.Value (ConfigError(..), ConfigValue(..), Key (..), Origin(..), Value(..), KeyPart, prefixedWith, key)
 import Conftrack.Source (SomeSource (..), ConfigSource (..))
 
 import Prelude hiding (unzip)
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)