packages feed

command-qq (empty) → 0.1.0.0

raw patch · 9 files changed

+615/−0 lines, 9 filesdep +basedep +command-qqdep +doctestsetup-changed

Dependencies added: base, command-qq, doctest, hspec, process, template-haskell, unix

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Matvey Aksenov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      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+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ command-qq.cabal view
@@ -0,0 +1,83 @@+name:                command-qq+version:             0.1.0.0+synopsis:            Quasiquoters for external commands+description:+  Features:+  .+  * Quasiquotation syntax for external commands:+  .+  > [sh| echo hello world! |]+  .+  * Easy way to define custom quasiquoters (see @examples/CustomQQ.hs@)+  .+  > ghci = QQ.quoter $ QQ.callCommand "ghc" ["-ignore-dot-ghci", "-e"]+  .+  * Can embed Haskell variables in scripts+  .+  > class Embed a where+  >   embed :: a -> String+  >+  > instance Embed String+  >   embed = id+  >+  > main :: IO ()+  > main = let excl = replicate 3 '!' in -- I'd love to show an example but haddock markup fails here+  .+  * Can embed quasiquoters in DSLs (see @examples/CommandT.hs@)+  .+  > class Eval r where+  >   eval :: String -> [String] -> r+  >+  > instance Eval (IO ExitCode) where+  >   eval command args = System.Process.rawSystem command args+  .+homepage:            http://biegunka.github.io/command-qq/+license:             BSD3+license-file:        LICENSE+author:              Matvey Aksenov+maintainer:          matvey.aksenov@gmail.com+category:            System+build-type:          Simple+cabal-version:       >= 1.10+extra-source-files:+  examples/CommandT.hs+  examples/CustomQQ.hs+++library+  default-language:  Haskell2010+  build-depends:+    base == 4.*,+    process,+    template-haskell,+    unix+  hs-source-dirs:    src+  exposed-modules:   System.Command.QQ++test-suite doctests+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  build-depends:+    base == 4.*,+    doctest+  hs-source-dirs:    tests+  main-is:           Doctests.hs++test-suite spec+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  build-depends:+    base == 4.*,+    hspec,+    command-qq,+    template-haskell+  hs-source-dirs:+    tests,+    examples+  main-is:           Spec.hs+  other-modules:     EmbeddingSpec+++source-repository head+  type:              git+  location:          https://github.com/biegunka/command-qq
+ examples/CommandT.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+-- | Example DSL made on top of "System.Command.QQ"+--+-- Provides [semi-]convenient way to run external commands+-- in sequence and parse their output.+--+-- DSL does not use any custom quasiquoters but provides 'Eval'+-- instances for custom datatypes that implement desired semantics+module CommandT where++import Control.Applicative                         -- base+  ( Applicative(..), Alternative(..) )+import Control.Monad (MonadPlus(..))               -- base+import Control.Monad.IO.Class (MonadIO(..))        -- transformers+import Control.Monad.Trans.Class (MonadTrans(..))  -- transformers+import Control.Monad.Trans.Either                  -- either+import Data.Functor.Alt (Alt(..))                  -- semigroupoids+import Data.Functor.Apply (Apply(..))              -- semigroupoids+import Data.Functor.Bind (Bind(..))                -- semigroupoids+import Data.Monoid (Last(..))                      -- base+import System.Exit (ExitCode(..))                  -- base+import System.Command.QQ (Eval(..))                -- command-qq++-- $setup+-- >>> :set -XQuasiQuotes+-- >>> import System.Command.QQ+-- >>> let lengths = [sh|while read line; do echo ${#line}; done|] :: String -> CommandT IO String+++infixl 1 >>! -- same as >>=+++-- | External commands sequencing result+--+-- Every external command results either in failure (thus provides non-zero+-- exit code and @stderr@) or some value (typically its @stdout@)+--+-- For example:+--+-- >>> runCommandT $ [sh|echo -e "hello\nworld!!!"|] >>= lengths+-- Right "5\n8\n"+--+-- 'CommandT' implements the usual 'Alternative' instance semantics:+--+-- >>> runCommandT $ [sh|exit 1|] <|> [sh|echo hello|]+-- Right "hello\n"+--+-- If everything fails, then last failure is returned:+--+-- >>> do Left (Last (Just (Failure _ i _))) <- runCommandT $ [sh|exit 1|] <|> [sh|exit 3|]; print i+-- 3+newtype CommandT m a = CommandT { unCommandT :: EitherT (Last Failure) m a }++-- | Failed command with exit code and @stderr@+data Failure = Failure Command Int String+    deriving (Show, Read)++-- | Command name and arguments+data Command = Command String [String]+    deriving (Show, Read)++-- | Run external commands and get the result+runCommandT :: CommandT m a -> m (Either (Last Failure) a)+runCommandT = runEitherT . unCommandT++instance Monad m => Functor (CommandT m) where+  fmap f (CommandT x) = CommandT (fmap f x)++instance Monad m => Apply (CommandT m) where+  CommandT f <.> CommandT x = CommandT (f <.> x)++instance Monad m => Applicative (CommandT m) where+  pure = CommandT . pure+  (<*>) = (<.>)++instance Monad m => Bind (CommandT m) where+  CommandT x >>- k = CommandT (x >>- unCommandT . k)++instance Monad m => Monad (CommandT m) where+  return = pure+  (>>=) = (>>-)++instance Monad m => Alt (CommandT m) where+  CommandT f <!> CommandT x = CommandT (f <!> x)++instance Monad m => Alternative (CommandT m) where+  empty = CommandT empty+  (<|>) = (<!>)++instance Monad m => MonadPlus (CommandT m) where+  mzero = empty+  mplus = (<|>)++instance MonadTrans CommandT where+  lift = CommandT . lift++instance MonadIO m => MonadIO (CommandT m) where+  liftIO = lift . liftIO++instance (o ~ String, MonadIO m) => Eval (CommandT m o) where+  eval command args = CommandT . EitherT $ do+    (status, out, err) <- liftIO $ eval command args+    return $ case status of+      ExitSuccess   -> Right out+      ExitFailure i -> Left (Last (Just (Failure (Command command args) i err)))++instance (i ~ String, o ~ String, MonadIO m) => Eval (i -> CommandT m o) where+  eval command args input = CommandT . EitherT $ do+    (status, out, err) <- liftIO $ eval command args input+    return $ case status of+      ExitSuccess   -> Right out+      ExitFailure i -> Left (Last (Just (Failure (Command command args) i err)))+++-- | Pass @stderr@ of failed external command to function+--+-- If nothing has failed, we do not have @stderr@, really:+--+-- >>> runCommandT $ [sh|echo -e "hello\nworld!!!">&2|] >>! lengths+-- Left (Last {getLast = Nothing})+--+-- If something has failed, we do have @stderr@ to play with:+--+-- >>> runCommandT $ [sh|echo -e "hello\nworld!!!">&2; exit 1|] >>! lengths+-- Right "5\n8\n"+--+-- And playing may involve arbitrary Haskell functions, of course:+--+-- >>> runCommandT $ [sh|echo -e "hello\nworld!!!">&2; exit 1|] >>! lengths . unlines . reverse . lines+-- Right "8\n5\n"+(>>!) :: Monad m => CommandT m a -> (String -> CommandT m b) -> CommandT m b+x >>! k = CommandT . EitherT $ do+  t <- runCommandT x+  case t of+    Left (Last Nothing) -> return (Left (Last Nothing))+    Left (Last (Just (Failure _ _ err))) -> runCommandT $ k err+    Right _ -> return (Left (Last Nothing))
+ examples/CustomQQ.hs view
@@ -0,0 +1,51 @@+-- | Custom quasiquoters built on top of command-qq+module CustomQQ+  ( sh, bash, zsh+  , python, perl, ruby, ghci+  ) where++import           Language.Haskell.TH.Quote -- template-haskell+import qualified System.Command.QQ as QQ   -- command-qq++-- $setup+-- >>> :set -XQuasiQuotes++-- | Some shell quasiquoters+--+-- >>> [sh|echo "`basename $0`"|] :: IO ()+-- sh+--+-- >>> [bash|echo "$(basename $0)"|] :: IO ()+-- bash+--+-- >>> [zsh|echo "$(basename $0)"|] :: IO ()+-- zsh+sh, bash, zsh :: QuasiQuoter+sh   = QQ.shell "sh"+bash = QQ.shell "bash"+zsh  = QQ.shell "zsh"++-- | Some interpreters quasiquoters+--+-- >>> let foo = 11+--+-- >>> [python|foo = 11; print foo == #{foo}|] :: IO ()+-- True+--+-- >>> [perl|my $foo = 11; print $foo == #{foo}|] :: IO ()+-- 1+--+-- >>> [ruby|foo = 11; puts foo == #{foo}|] :: IO ()+-- true+python, perl, ruby :: QuasiQuoter+python = QQ.shell "python" -- For whatever reason python uses @python -c <command>@ syntax+perl   = QQ.interpreter "perl"+ruby   = QQ.interpreter "ruby"++-- | More involved interpreter quasiquoter+--+-- >>> let foo = 11+-- >>> [ghci|let foo = 11 in print $ foo == #{foo}|] :: IO ()+-- True+ghci :: QuasiQuoter+ghci = QQ.quoter $ QQ.callCommand "ghc" ["-ignore-dot-ghci", "-e"]
+ src/System/Command/QQ.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}+-- | Quasiquoters for external commands+module System.Command.QQ+  ( -- * Quasiquoters+    sh, shell, interpreter+    -- * Customizations+  , quoter, callCommand+  , Eval(..), Embed(..)+  ) where++import           Control.Applicative ((<$), pure)+import           Data.Int+import           Data.Word+import           Language.Haskell.TH+import           Language.Haskell.TH.Quote+import           System.Exit (ExitCode)+import           System.Posix.Env (getEnvDefault)+import qualified System.Process as P++-- $setup+-- >>> :set -XQuasiQuotes+++-- | Quasiquoter for the default shell+--+-- \"default\" here means it uses value of @SHELL@ environment variable+-- or @\/bin\/sh@ if it is not set.+--+-- >>> [sh|echo "hi!"|] :: IO ExitCode+-- hi!+-- ExitSuccess+-- >>> [sh|echo "hi!"|] :: IO String+-- "hi!\n"+--+-- Haskell values can be embedded with Ruby-like syntax:+--+-- >>> let apples = 7+-- >>> [sh|echo "#{apples} apples!"|] :: IO String+-- "7 apples!\n"+--+-- Works only for expressions (obviously):+--+-- >>> return 3 :: IO [sh|blah|]+-- <BLANKLINE>+-- <interactive>:116:16:+--     Exception when trying to run compile-time code:+--       this quasiquoter does not support splicing types+--       Code: quoteType sh "blah"+sh :: QuasiQuoter+sh = quoter $ \string -> do+  shellEx <- runIO $ getEnvDefault "SHELL" "/bin/sh"+  callCommand shellEx ["-c"] string++-- | Shell commands quasiquoter maker+--+-- \"Shell\" here means something that implements the following interface:+--+-- @+-- \<SHELL\> -c \<COMMAND\>+-- @+--+-- /e.g./ @sh@, @bash@, @zsh@, @ksh@, @tcsh@, @python@, etc+--+-- Everything that applies to 'sh' applies to 'shell'+shell :: FilePath -> QuasiQuoter+shell path = quoter (callCommand path ["-c"])++-- | Interpreter commands quasiquoter maker+--+-- \"Interpreter\" here means something that implements the following interface:+--+-- @+-- \<INTERPRETER\> -e \<COMMAND\>+-- @+--+-- /e.g./ @perl@, @ruby@, @ghc@, etc+--+-- Everything that applies to 'sh' applies to 'interpreter'+interpreter :: FilePath -> QuasiQuoter+interpreter path = quoter (callCommand path ["-e"])+++-- | Construct quasiquoter from function taking the string+-- and producing Haskell expression.+--+-- Other kinds of quasiquoters (patterns, types or+-- declarations quasiquoters) will fail in compile time+quoter :: (String -> Q Exp) -> QuasiQuoter+quoter quote = QuasiQuoter+  { quoteExp  = quote+  , quotePat  = failure "patterns"+  , quoteType = failure "types"+  , quoteDec  = failure "declarations"+  }+ where+  failure kind =+    fail $ "this quasiquoter does not support splicing " ++ kind++-- | Construct Haskell expression for external command call+callCommand+  :: FilePath -- ^ Command path+  -> [String] -- ^ Arguments that go to command before quasiquoter contents+  -> String   -- ^ Quasiquoter contents+  -> Q Exp+callCommand path args string =+  [e| eval path (args ++ [$(string2exp string)]) |]++-- | Parse references to Haskell variables+string2exp :: String -> Q Exp+string2exp = raw where+  raw (break (== '#') -> parts) = case parts of+    (before, '#':'{' :after) -> [e| before ++ $(var after) |]+    (before, '#':'\\':after) -> [e| before ++ '#' : $(raw after) |]+    (before, '#':after)      -> [e| before ++ '#' : $(raw after) |]+    (before, [])             -> [e| before |]+    _                        -> fail $ "Should never happen"++  var (break (== '}') -> parts) = case parts of+     (before, '}':after) -> [e| embed $(return (VarE (mkName before))) ++ $(raw after) |]+     (before, _)         -> fail $ "Bad variable pattern: #{" ++ before+++-- | Different interesting return types for quasiquoters+--+-- Instances here mostly resemble the types of things in "System.Process"+class Eval r where+  eval :: String -> [String] -> r++-- | Most basic instance: nothing is known about what happened in external command+--+-- >>> [sh|echo hello world|] :: IO ()+-- hello world+instance Eval (IO ()) where+  eval command args = () <$ P.rawSystem command args++-- | Return only exit code of external process+--+-- >>> [sh|echo hello world|] :: IO ExitCode+-- hello world+-- ExitSuccess+--+-- >>> [sh|exit 1|] :: IO ExitCode+-- ExitFailure 1+instance Eval (IO ExitCode) where+  eval command args = P.rawSystem command args++-- | Return only stdout of external process+--+-- Does not care if external process failed.+--+-- >>> [sh|echo hello world|] :: IO String+-- "hello world\n"+--+-- >>> [sh|echo hello world; return 1|] :: IO String+-- "hello world\n"+instance Eval (IO String) where+  eval command args = do+    (_, out, _) <- eval command args+    return out++-- | Return exit code, stdout, and stderr of external process+--+-- >>> [sh|echo hello world; echo bye world >&2; exit 1|] :: IO (ExitCode, String, String)+-- (ExitFailure 1,"hello world\n","bye world\n")+instance+  ( s ~ ExitCode+  , o ~ String+  , e ~ String+  ) => Eval (IO (s, o, e)) where+  eval command args = P.readProcessWithExitCode command args ""++-- | Return exit code, stdout, and stderr of external process+-- and consume stdin from supplied 'String'+--+-- >>> [sh|while read line; do echo ${#line}; done|] "hello\nworld!\n"+-- (ExitSuccess,"5\n6\n","")+instance+  ( i ~ String+  , o ~ (ExitCode, String, String)+  ) => Eval (i -> IO o) where+  eval command args stdin = P.readProcessWithExitCode command args stdin+++-- | Embed haskell values into external commands+--+-- I recommend using @-XExtendedDefaultRules@ for modules+-- where you want to embed values, it would save for annoying+-- type annotations for numeric literals+--+-- @+-- embed . embed = embed+-- @+class Embed a where+  embed :: a -> String+  default embed :: Show a => a -> String+  embed = show++-- |+-- >>> embed 4+-- "4"+--+-- >>> embed (7 :: Integer)+-- "7"+instance Embed Integer++-- |+-- >>> embed (7 :: Int)+-- "7"+instance Embed Int+instance Embed Int8+instance Embed Int16+instance Embed Int32+instance Embed Int64+instance Embed Word+instance Embed Word8+instance Embed Word16+instance Embed Word32+instance Embed Word64++-- |+-- >>> embed (7 :: Float)+-- "7.0"+instance Embed Float++-- |+-- >>> embed 4.0+-- "4.0"+--+-- >>> embed (7 :: Double)+-- "7.0"+instance Embed Double++-- |+-- >>> embed 'c'+-- "c"+instance Embed Char where+  embed = pure++-- |+-- >>> embed "hi"+-- "hi"+instance Embed String where+  embed = id
+ tests/Doctests.hs view
@@ -0,0 +1,11 @@+module Main where++import Test.DocTest (doctest)+++main :: IO ()+main = doctest+  [ "src/System/Command/QQ.hs"+  , "examples/CustomQQ.hs"+  , "examples/CommandT.hs"+  ]
+ tests/EmbeddingSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+module EmbeddingSpec where++import System.Command.QQ+import Test.Hspec+++spec :: Spec+spec = do+  describe "variable embeddings" $ do++    it "can embed integers" $+      let foo = 7 in [sh|echo #{foo}|] `shouldReturn` "7\n"++    it "can embed doubles" $+      let foo = 7.0 in [sh|echo #{foo}|] `shouldReturn` "7.0\n"++    it "can embed characters" $+      let foo = 'z' in [sh|echo #{foo}|] `shouldReturn` "z\n"++    it "can embed strings" $+      let foo = "hello" in [sh|echo #{foo}|] `shouldReturn` "hello\n"++  describe "multi-line embeddings" $ do++    it "supports multiline commands" $+      [sh|+        echo hello+        echo world+        echo !!!+      |] `shouldReturn` "hello\nworld\n!!!\n"++    it "supports embeddings in multiline commands" $+      let foo = 4+          bar = 7+      in [sh|+        echo #{foo}+        echo #{bar}+      |] `shouldReturn` "4\n7\n"++  describe "escapings" $ do++    it "is possible to write #{} in scripts still (as a comment)" $ do+      [sh|echo #\{foo}|] `shouldReturn` "\n"+      [sh|echo #\\{foo}|] `shouldReturn` "\n"++    it "is possible to write #{} in scripts still (as a string)" $ do+      [sh|echo "#\{foo}"|] `shouldReturn` "#{foo}\n"+      [sh|echo "#\\{foo}"|] `shouldReturn` "#\\{foo}\n"
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}