diff options
| -rw-r--r-- | sh.cabal | 2 | ||||
| -rw-r--r-- | src/Process/Shell.hs | 53 | ||||
| -rw-r--r-- | test/Main.hs | 26 |
3 files changed, 39 insertions, 42 deletions
@@ -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}'|] |