command-qq 0.3.0.0 → 0.3.1.0

raw patch · 10 files changed

+168/−63 lines, 10 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• LICENSE +1/−5
• README.md +1/−1
• command-qq.cabal +6/−3
• src/System/Command/QQ.hs +21/−21
• src/System/Command/QQ/Embed.hs +1/−2
• src/System/Command/QQ/Eval.hs +35/−29
• src/System/Command/QQ/Predef.hs +3/−2
• test/System/Command/QQ/PredefSpec.hs +54/−0
• test/System/Command/QQSpec.hs +37/−0

@@ -1,3 +1,12 @@+0.3.1.0+=======++  * Improved exception handling++  * Relaxed the licesnse to BSD2++  * Made compatible with GHC 8.8+ 0.3.0.0 ======= 

@@ -1,4 +1,4 @@-Copyright (c) 2013, Matvey Aksenov+Copyright (c) 2013-2017, Matvey Aksenov  All rights reserved. @@ -12,10 +12,6 @@       copyright notice, this list of conditions and the following       disclaimer in the documentation and/or other materials provided       with the distribution.--    * Neither the name of Matvey Aksenov nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

@@ -74,4 +74,4 @@ See [`examples/CommandT.hs`][1]    [0]: https://github.com/biegunka/command-qq/blob/master/src/System/Command/QQ/Predef.hs-  [1]: https://github.com/biegunka/command-qq/blob/master/examples/CommandT.hs+  [1]: https://github.com/biegunka/command-qq/blob/master/example/CommandT.hs

@@ -1,5 +1,5 @@ name:                command-qq-version:             0.3.0.0+version:             0.3.1.0 synopsis:            Quasiquoters for external commands description:   Features:@@ -29,7 +29,7 @@     See @examples/CommandT.hs@   . homepage:            http://biegunka.github.io/command-qq/-license:             BSD3+license:             BSD2 license-file:        LICENSE author:              Matvey Aksenov maintainer:          matvey.aksenov@gmail.com@@ -48,7 +48,7 @@ source-repository this   type:              git   location:          https://github.com/biegunka/command-qq-  tag:               0.3.0.0+  tag:               0.3.1.0  library   default-language:  Haskell2010@@ -70,6 +70,7 @@   build-depends:       base == 4.*     , doctest+    , transformers   hs-source-dirs:    test   main-is:           Doctests.hs @@ -89,3 +90,5 @@   other-modules:     System.Command.QQ.EmbedSpec     System.Command.QQ.EvalSpec+    System.Command.QQ.PredefSpec+    System.Command.QQSpec

@@ -19,16 +19,16 @@   , module System.Command.QQ.Eval   ) where -import Control.Applicative-import Data.Char (isLower, isUpper)-import Data.Maybe (fromMaybe)-import Language.Haskell.TH-import Language.Haskell.TH.Quote-import System.Environment (lookupEnv)-import Text.Read (readMaybe)+import           Data.Char (isLower, isUpper)+import           Data.Maybe (fromMaybe)+import           Language.Haskell.TH (Q, Exp)+import qualified Language.Haskell.TH as TH+import           Language.Haskell.TH.Quote (QuasiQuoter(..))+import           System.Environment (lookupEnv)+import           Text.Read (readMaybe) -import System.Command.QQ.Embed-import System.Command.QQ.Eval+import           System.Command.QQ.Embed+import           System.Command.QQ.Eval  -- $setup -- >>> :set -XQuasiQuotes@@ -56,7 +56,7 @@ -- "7 apples!\n" sh :: QuasiQuoter sh = quoter $ \string -> do-  shellEx <- runIO $ getEnvDefault "/bin/sh" "SHELL"+  shellEx <- TH.runIO (getEnvDefault "/bin/sh" "SHELL")   callCommand shellEx ["-c"] string  -- | Simple quasiquoter for the default shell@@ -68,7 +68,7 @@ -- hello, world! sh_ :: QuasiQuoter sh_ = quoter $ \string -> do-  shellEx <- runIO $ getEnvDefault "/bin/sh" "SHELL"+  shellEx <- TH.runIO (getEnvDefault "/bin/sh" "SHELL")   callCommand_ shellEx ["-c"] string  -- | Shell's quasiquoter constructor@@ -110,7 +110,7 @@   }  where   failure kind =-    fail $ "this quasiquoter does not support splicing " ++ kind+    error ("this quasiquoter does not support splicing " ++ kind)  -- | Construct Haskell expression for external command call callCommand@@ -146,14 +146,14 @@       _                            -> fail "Should never happen"    var (break (== '}') -> parts) = case parts of-     (b : efore, '}' : after)-        | isLower b                     -> external (VarE (mkName (b:efore))) after-        | isUpper b                     -> external (ConE (mkName (b:efore))) after-        | Just i <- readMaybe (b:efore) -> external (LitE (IntegerL i)) after-        | Just d <- readMaybe (b:efore) -> external (LitE (RationalL (toRational (d :: Double)))) after-        | Just c <- readMaybe (b:efore) -> external (LitE (CharL c)) after-        | Just s <- readMaybe (b:efore) -> external (LitE (StringL s)) after-     (before, _)                        -> fail $ "Invalid name: " ++ before+    (b : efore, '}' : after)+      | isLower b                     -> external (TH.VarE (TH.mkName (b:efore))) after+      | isUpper b                     -> external (TH.ConE (TH.mkName (b:efore))) after+      | Just i <- readMaybe (b:efore) -> external (TH.LitE (TH.IntegerL i)) after+      | Just d <- readMaybe (b:efore) -> external (TH.LitE (TH.RationalL (toRational (d :: Double)))) after+      | Just c <- readMaybe (b:efore) -> external (TH.LitE (TH.CharL c)) after+      | Just s <- readMaybe (b:efore) -> external (TH.LitE (TH.StringL s)) after+    (before, _)                        -> fail ("Invalid name: " ++ before)    external :: Exp -> String -> Q Exp   external e after = [e| embed $(return e) ++ $(raw after) |]@@ -163,4 +163,4 @@   :: String -- ^ The default vefault   -> String -- ^ Environment variable   -> IO String-getEnvDefault def query = fromMaybe def <$> lookupEnv query+getEnvDefault def = fmap (fromMaybe def) . lookupEnv

@@ -6,7 +6,6 @@   ( Embed(..)   ) where -import           Control.Applicative import           Data.Int import           Data.Ratio (Ratio) import qualified Data.Text as Text@@ -71,7 +70,7 @@ -- >>> embed 'c' -- "c" instance Embed Char where-  embed = pure+  embed x = [x]  -- | -- >>> embed ("hi" :: String)

@@ -5,13 +5,13 @@   ( Eval(..)   ) where -import           Control.Applicative import           Control.Concurrent-import           Control.Exception (evaluate)+import           Control.Exception (evaluate, mask, onException) import           Control.Monad+import           Data.Foldable (traverse_) import           Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T+import qualified Data.Text.Lazy as Text+import qualified Data.Text.Lazy.IO as Text import           System.Exit (ExitCode) import qualified System.Process as P import           System.IO (hFlush, hClose)@@ -33,7 +33,7 @@ -- >>> [sh|echo hello world|] :: IO () -- hello world instance Eval (IO ()) where-  eval command args = () <$ P.rawSystem command args+  eval command = void . P.rawSystem command  -- | Return exit code of the external process --@@ -44,7 +44,7 @@ -- ExitFailure 7 instance Eval (IO ExitCode) where   eval command args = do-    (s, _, _) <- eval command args (T.pack "")+    (s, _, _) <- eval command args Text.empty     return s  -- | Return stdout of the external process as 'Text'@@ -65,7 +65,7 @@ -- >>> [sh|echo -n hello world|] :: IO String -- "hello world" instance Eval (IO String) where-  eval command args = T.unpack <$> eval command args+  eval command = fmap Text.unpack . eval command  -- | Return exit code, stdout, and stderr of external process --@@ -76,7 +76,7 @@   , o ~ Text   , e ~ Text   ) => Eval (IO (s, o, e)) where-  eval command args = eval command args (T.pack "")+  eval command args = eval command args Text.empty  -- | Return exit code, stdout, and stderr of the external process -- and pass supplied 'Text' to its stdin@@ -90,30 +90,36 @@   eval = readProcessWithExitCode  readProcessWithExitCode :: String -> [String] -> Text -> IO (ExitCode, Text, Text)-readProcessWithExitCode cmd args input = do-  (Just inh, Just outh, Just errh, p) <--      P.createProcess (P.proc cmd args)-        { P.std_in  = P.CreatePipe-        , P.std_out = P.CreatePipe-        , P.std_err = P.CreatePipe-        }+readProcessWithExitCode cmd args input =+  mask $ \restore -> do+    (Just inh, Just outh, Just errh, pid) <-+        P.createProcess (P.proc cmd args)+          { P.std_in  = P.CreatePipe+          , P.std_out = P.CreatePipe+          , P.std_err = P.CreatePipe+          } -  var <- newEmptyMVar-  out <- T.hGetContents outh-  err <- T.hGetContents errh+    onException+      (restore $ do+        var <- newEmptyMVar+        out <- Text.hGetContents outh+        err <- Text.hGetContents errh -  forkFinally (evaluate (T.length out)) (\_ -> putMVar var ())-  forkFinally (evaluate (T.length err)) (\_ -> putMVar var ())+        forkFinally (evaluate (Text.length out)) (\_ -> putMVar var ())+        forkFinally (evaluate (Text.length err)) (\_ -> putMVar var ()) -  unless (T.null input) $-    T.hPutStr inh input >> hFlush inh-  hClose inh+        unless (Text.null input) $+          Text.hPutStr inh input >> hFlush inh+        hClose inh -  takeMVar var-  takeMVar var-  hClose outh-  hClose errh+        takeMVar var+        takeMVar var+        hClose outh+        hClose errh -  s <- P.waitForProcess p+        s <- P.waitForProcess pid -  return (s, out, err)+        return (s, out, err))+      (do P.terminateProcess pid+          traverse_ hClose [inh, outh, errh]+          P.waitForProcess pid)

@@ -5,6 +5,7 @@  import System.Command.QQ (interpreter, shell, quoter, callCommand) + -- | @bash@ shell bash :: QuasiQuoter bash = shell "bash"@@ -15,11 +16,11 @@  -- | @awk@ interpreter awk :: QuasiQuoter-awk = quoter $ callCommand "awk" []+awk = quoter (callCommand "awk" [])  -- | @ghci@ interpreter ghci :: QuasiQuoter-ghci = quoter $ callCommand "ghc" ["-ignore-dot-ghci", "-e"]+ghci = quoter (callCommand "ghc" ["-ignore-dot-ghci", "-e"])  -- | @perl@ interpreter perl :: QuasiQuoter

@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module System.Command.QQ.PredefSpec (spec) where++import           Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as Text+import           System.Exit (ExitCode(..))+import           Test.Hspec++import           System.Command.QQ.Predef+++spec :: Spec+spec = do+  it "runs bash" $+    fmap stdout [bash|echo $0|] `shouldReturn` "bash\n"++  it "runs zsh" $+    fmap stdout [zsh|echo $0|] `shouldReturn` "zsh\n"++  it "runs awk interpreter" $+    fmap stdout [awk|BEGIN { print 4 * 7 } |] `shouldReturn` "28\n"++  it "runs ghci" $+    fmap stdout [ghci|print (4 * 7)|] `shouldReturn` "28\n"++  it "runs perl interpreter" $+    fmap stdout [perl|print 4 * 7 . "\n"|] `shouldReturn` "28\n"++  it "runs ruby interpreter" $+    fmap stdout [ruby|puts 4 * 7|] `shouldReturn` "28\n"++  let traceback = "Traceback (most recent call last):"++  it "python shows tracebacks" $ do+    err <- fmap (Text.lines . stderr) [python|print(4 / 0)|]+    err `shouldContain` [traceback]++  it "python2 shows tracebacks" $ do+    err <- fmap (Text.lines . stderr) [python2|print(4 / 0)|]+    err `shouldContain` [traceback]++  it "python3 shows tracebacks" $ do+    err <- fmap (Text.lines . stderr) [python3|print(4 / 0)|]+    err `shouldContain` [traceback]++  it "python3 really runs python 3" $ do+    err <- fmap (Text.lines . stderr) [python3|print 7|]+    err `shouldSatisfy` (any ("SyntaxError:" `Text.isPrefixOf`))+++stdout, stderr :: (ExitCode, Text, Text) -> Text+stderr (_, _, xs) = xs+stdout (_, xs, _) = xs

@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell #-}+module System.Command.QQSpec (spec) where++import Test.Hspec++import System.Command.QQ (substituteVars)+++spec :: Spec+spec = do+  describe "substituteVars" $ do+    it "does not change simple string literals" $+      $(substituteVars "hello!") `shouldBe` "hello!"++    it "substitutes variables of type Int" $ do+      let foo = 5 :: Int+      $(substituteVars "hello#{foo}bye!") `shouldBe` "hello5bye!"++    it "substitutes variables of type String" $ do+      let foo = "or"+      $(substituteVars "hello#{foo}bye!") `shouldBe` "helloorbye!"++    it "leaves an escape hatch for typing literal #{} in" $ do+      let foo = "or"+      $(substituteVars "hello#\\{foo}bye!") `shouldBe` "hello#{foo}bye!"++    it "escape hatch can be escaped" $ do+      let foo = "or"+      $(substituteVars "hello#\\\\{foo}bye!") `shouldBe` "hello#\\{foo}bye!"++    it "leaves another (possibly more natural) escape hatch for typing literal #{} in" $ do+      let foo = "or"+      $(substituteVars "hello\\#{foo}bye!") `shouldBe` "hello#{foo}bye!"++    it "another escape hatch can be escaped too" $ do+      let foo = "or"+      $(substituteVars "hello\\\\#{foo}bye!") `shouldBe` "hello\\orbye!"