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

---
 src/Process/Shell.hs | 53 ++++++++++++++++++++++++++--------------------------
 1 file changed, 26 insertions(+), 27 deletions(-)

(limited to 'src/Process/Shell.hs')

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
-- 
cgit v1.2.3