From 026f5b8786fece894ab1357747627b180db5a0ee Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Thu, 7 Mar 2024 04:59:37 +0100
Subject: chore: interpolate named variables

---
 sh.cabal             |  2 +-
 src/Process/Shell.hs | 53 ++++++++++++++++++++++++++--------------------------
 test/Main.hs         | 26 ++++++++++++--------------
 3 files changed, 39 insertions(+), 42 deletions(-)

diff --git a/sh.cabal b/sh.cabal
index 8d0733f..316619c 100644
--- a/sh.cabal
+++ b/sh.cabal
@@ -5,7 +5,6 @@ license:         BSD-3-Clause
 license-file:    LICENSE
 maintainer:      aforemny@posteo.de
 author:          Alexander Foremny
-
 build-type:      Simple
 extra-doc-files: CHANGELOG.md
 
@@ -17,6 +16,7 @@ library
     build-depends:
         base,
         bytestring,
+        haskell-src-meta,
         megaparsec,
         mtl,
         template-haskell,
diff --git a/src/Process/Shell.hs b/src/Process/Shell.hs
index 63d2f8a..2d254ad 100644
--- a/src/Process/Shell.hs
+++ b/src/Process/Shell.hs
@@ -24,11 +24,13 @@ import Data.Text.Encoding qualified as T
 import Data.Text.Lazy qualified as LT
 import Data.Text.Lazy.Encoding qualified as LT
 import Data.Void
+import Language.Haskell.Meta.Parse
 import Language.Haskell.TH
 import Language.Haskell.TH.Quote
 import System.Process.Typed
 import Text.Megaparsec
 import Text.Megaparsec.Char
+import Prelude hiding (exp)
 
 class Processable a r where
   sh_ :: a -> r
@@ -111,18 +113,9 @@ instance Quotable T.Text where
 instance Quotable LT.Text where
   toString = LT.unpack
 
-data Expr a
+data Expr
   = Lit String
-  | Var Bool a
-  deriving (Show)
-
-expr :: (String -> b) -> (Bool -> a -> b) -> Expr a -> b
-expr f _ (Lit a) = f a
-expr _ g (Var q a) = g q a
-
-unVar :: Expr a -> Maybe a
-unVar (Lit _) = Nothing
-unVar (Var _ a) = Just a
+  | Var Bool (Q Exp)
 
 sh :: QuasiQuoter
 sh = QuasiQuoter quoteExp undefined undefined undefined
@@ -132,25 +125,31 @@ sh = QuasiQuoter quoteExp undefined undefined undefined
       either (fail . errorBundlePretty) makeExp
         . parse (parser <* eof) ""
 
-    parser :: ParsecT Void String Identity [Expr ()]
+    parser :: ParsecT Void String Identity [Expr]
     parser =
       many . choice $
-        [ const (Lit "%") <$> string "%%",
-          const (Var True ()) <$> string "'%'",
-          const (Var False ()) <$> satisfy (== '%'),
-          Lit <$> takeWhile1P Nothing (not . (`elem` "'%")),
-          Lit <$> string "'%",
-          Lit <$> string "'"
+        [ do
+            Var False . either fail pure . parseExp
+              <$> ( string "#{"
+                      *> takeWhile1P Nothing (/= '}')
+                      <* string "}"
+                  ),
+          do
+            Var True . either fail pure . parseExp
+              <$> ( string "'#{"
+                      *> takeWhile1P Nothing (/= '}')
+                      <* string "}'"
+                  ),
+          do
+            Lit <$> takeWhile1P Nothing ((&&) <$> (/= '#') <*> (/= '\''))
         ]
 
-    makeExp :: [Expr ()] -> Q Exp
-    makeExp exprs' = do
-      exprs <-
-        mapM
-          (expr (pure . Lit) (\q _ -> Var q <$> newName "x"))
-          exprs'
-      lamE (map varP (mapMaybe unVar exprs)) . appE [|sh_|] $
-        flip (foldM (flip go)) exprs =<< [|""|]
+    makeExp :: [Expr] -> Q Exp
+    makeExp exprs = do
+      appE [|sh_|] $ flip (foldM (flip go)) exprs =<< [|""|]
 
     go (Lit s) = appE [|flip (++) s|] . pure
-    go (Var q n) = appE (appE [|flip (++)|] (appE [|if q then squote else dquote|] (varE n))) . pure
+    go (Var q exp) =
+      appE
+        (appE [|flip (++)|] (appE [|if q then squote else dquote|] exp))
+        . pure
diff --git a/test/Main.hs b/test/Main.hs
index ad69469..9bde55e 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -31,27 +31,25 @@ main = hspec do
         |]
   describe "arguments" do
     it "passes `Int`" do
-      (`shouldBe` "1") =<< [sh|echo -n %|] (1 :: Int)
+      (`shouldBe` "1") =<< let x = 1 :: Int in [sh|echo -n '#{x}'|]
     it "passes `Text`" do
-      (`shouldBe` "foobar") =<< [sh|echo -n %|] (T.pack "foobar")
-      (`shouldBe` "foobar") =<< [sh|echo -n %|] (LT.pack "foobar")
+      (`shouldBe` "foobar") =<< let x = T.pack "foobar" in [sh|echo -n '#{x}'|]
+      (`shouldBe` "foobar") =<< let x = LT.pack "foobar" in [sh|echo -n '#{x}'|]
     it "passes `ByteString`" do
-      (`shouldBe` "foobar") =<< [sh|echo -n %|] (B.pack "foobar")
-      (`shouldBe` "foobar") =<< [sh|echo -n %|] (LB.pack "foobar")
+      (`shouldBe` "foobar") =<< let x = B.pack "foobar" in [sh|echo -n '#{x}'|]
+      (`shouldBe` "foobar") =<< let x = LB.pack "foobar" in [sh|echo -n '#{x}'|]
+    it "interpolates expressions" do
+      (`shouldBe` "1") =<< let x = 1 :: Int in [sh|echo -n '#{show x}'|]
   describe "quoting" do
     it "preserves arguments" do
       (`shouldBe` "foo\\ bar")
-        =<< [sh|printf %%q %|] "foo bar"
+        =<< let x = "foo bar" in [sh|printf %q '#{x}'|]
     it "preserves special characters" do
       (`shouldBe` "foo\\ bar")
-        =<< [sh|foo=foo; bar=bar; ( printf %%q % )|] "$foo $bar"
+        =<< let x = "$foo $bar" in [sh|foo=foo; bar=bar; ( printf %q #{x} )|]
     it "escapes special characters" do
       (`shouldBe` "\\$foo\\ \\$bar")
-        =<< [sh|printf %%q '%'|] "$foo $bar"
+        =<< let x = "$foo $bar" in [sh|foo=foo; bar=bar; ( printf %q '#{x}' )|]
     it "preserves empty arguments" do
-      (`shouldBe` "''") =<< [sh|printf %%q %|] ""
-      (`shouldBe` "''") =<< [sh|printf %%q '%'|] ""
-  describe "parsing" do
-    it "parses garbled arguments" do
-      (`shouldBe` "%  foo") =<< [sh|echo -n '% ' %|] "foo"
-      (`shouldBe` "  foo") =<< [sh|echo -n ' ' %|] "foo"
+      (`shouldBe` "''") =<< let x = "" in [sh|printf %q #{x}|]
+      (`shouldBe` "''") =<< let x = "" in [sh|printf %q '#{x}'|]
-- 
cgit v1.2.3