diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) Keegan McAllister 2011 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his 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 AUTHORS 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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,12 @@ +This library provides a quasiquoter for executing shell commands in Haskell, +somewhat similar to Perl's backtick operator. Shell commands are IO actions, +and they capture the command's standard output as a String result. You can +also interpolate Haskell variables into a command. + +Documentation is hosted at http://hackage.haskell.org/package/shqq + +To build the documentation yourself, run + + $ cabal configure && cabal haddock --hyperlink-source + +This will produce HTML documentation under dist/doc/html/shqq diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#! /usr/bin/runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/System/ShQQ.hs b/System/ShQQ.hs new file mode 100644 --- /dev/null +++ b/System/ShQQ.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE + TemplateHaskell + , CPP #-} + +-- | Embed shell commands with interpolated Haskell +-- variables, and capture output. +module System.ShQQ + ( -- * Quasiquoters + sh + , shc + + -- * Helper functions + -- + -- | These functions are used in the implementation of + -- @'sh'@, and may be useful on their own. + , readShell + , readShellWithCode + , showNonString + ) where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Control.Applicative +import Control.Exception ( evaluate, throwIO ) +import Data.Char +import Data.Foldable ( asum ) +import Data.Typeable ( Typeable, cast ) +import Text.Parsec hiding ( (<|>), many ) +import Text.Parsec.String +import System.IO +import System.Exit + +import qualified System.Posix.Escape.Unicode as E +import qualified System.Process as P + +#if defined(mingw32_HOST_OS) +#error shqq is not supported on Windows. +#endif + +-- | Acts like the identity function on @'String'@, and +-- like @'show'@ on other types. +showNonString :: (Typeable a, Show a) => a -> String +showNonString x = case cast x of + Just y -> y + Nothing -> show x + +data Tok + = Lit String + | VarOne String + | VarMany String + deriving (Show) + +parseToks :: Parser [Tok] +parseToks = many part where + isIdent '_' = True + isIdent x = isAlphaNum x + -- NB: '\'' excluded + + ident = some (satisfy isIdent) + var = VarOne <$> ident + <|> VarMany <$ char '+' <*> ident + part = asum [ + char '\\' *> ( Lit "\\" <$ char '\\' + <|> Lit "$" <$ char '$' ) + , char '$' *> + ( var <|> between (char '{') (char '}') var ) + , Lit <$> some (noneOf "$\\") ] + +-- | Execute a shell command, capturing output and exit code. +-- +-- Used in the implementation of @'shc'@. +readShellWithCode :: String -> IO (ExitCode, String) +readShellWithCode cmd = do + (Nothing, Just hOut, Nothing, hProc) <- P.createProcess $ + (P.shell cmd) { P.std_out = P.CreatePipe } + out <- hGetContents hOut + _ <- evaluate (length out) + hClose hOut + ec <- P.waitForProcess hProc + return (ec, out) + +-- | Execute a shell command, capturing output. +-- +-- Used in the implementation of @'sh'@. +readShell :: String -> IO String +readShell cmd = do + (ec, out) <- readShellWithCode cmd + case ec of + ExitSuccess -> return out + _ -> throwIO ec + +mkExp :: Q Exp -> [Tok] -> Q Exp +mkExp reader toks = [| $reader (concat $strs) |] where + strs = listE (map f toks) + var = varE . mkName + f (Lit x) = [| x |] + f (VarOne v) = [| E.escape (showNonString $(var v)) |] + f (VarMany v) = [| showNonString $(var v) |] + +shExp :: Q Exp -> String -> Q Exp +shExp reader xs = case parse parseToks "System.ShQQ expression" xs of + Left e -> error ('\n' : show e) + Right t -> mkExp reader t + +baseQQ :: QuasiQuoter +baseQQ = QuasiQuoter + { quoteExp = error "internal error in System.ShQQ" + , quotePat = const (error "no pattern quote for System.ShQQ") +#if MIN_VERSION_template_haskell(2,5,0) + , quoteType = const (error "no type quote for System.ShQQ") + , quoteDec = const (error "no decl quote for System.ShQQ") +#endif + } + + +{- | Execute a shell command, capturing output. + +This requires the @QuasiQuotes@ extension. + +The expression @[sh| ... |]@ has type @'IO' 'String'@. +Executing this IO action will invoke the quoted shell +command and produce its standard output as a @'String'@. + +>>> [sh| sha1sum /proc/uptime |] +"ebe14a88cf9be69d2192dcd7bec395e3f00ca7a4 /proc/uptime\n" + +You can interpolate Haskell @'String'@ variables using the +syntax @$x@. Special characters are escaped, so that the +program invoked by the shell will see each interpolated +variable as a single argument. + +>>> let x = "foo bar" in [sh| cat $x |] +cat: foo bar: No such file or directory +*** Exception: ExitFailure 1 + +You can also write @${x}@ to separate the variable name from +adjacent characters. + +>>> let x = "b" in [sh| echo a${x}c |] +"abc\n" + +Be careful: the automatic escaping means that @[sh| cat '$x' +|]@ is /less safe/ than @[sh| cat $x |]@, though it will +work \"by accident\" in common cases. + +To interpolate /without/ escaping special characters, use +the syntax @$+x@ . + +>>> let x = "foo bar" in [sh| cat $+x |] +cat: foo: No such file or directory +cat: bar: No such file or directory +*** Exception: ExitFailure 1 + +You can pass a literal @$@ to the shell as @\\$@, or a +literal @\\@ as @\\\\@. + +As demonstrated above, a non-zero exit code from the +subprocess will raise an exception in your Haskell program. + +Variables of type other than @'String'@ are interpolated via +@'show'@. + +>>> let x = Just (2 + 2) in [sh| touch $x; ls -l J* |] +"-rw-r--r-- 1 keegan keegan 0 Oct 7 23:28 Just 4\n" + +The interpolated variable's type must be an instance of +@'Show'@ and of @'Typeable'@. + +-} + +sh :: QuasiQuoter +sh = baseQQ { quoteExp = shExp [| readShell |] } + + +{- | Execute a shell command, capturing output and exit code. + +The expression @[shc| ... |]@ has type @'IO' ('ExitCode', +'String')@. A non-zero exit code does not raise an +exception your the Haskell program. + +Otherwise, @'shc'@ acts like @'sh'@. + +-} + +shc :: QuasiQuoter +shc = baseQQ { quoteExp = shExp [| readShellWithCode |] } diff --git a/examples/dupe.hs b/examples/dupe.hs new file mode 100644 --- /dev/null +++ b/examples/dupe.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE QuasiQuotes, TupleSections #-} + +{- dupe.hs: find duplicate files + +This program finds duplicate files in the directory tree rooted at the +current working directory. + +It demonstrates the goal of the shqq library: to combine the easy +command execution of traditional shell scripting with the strengths of +Haskell, such as concurrency and non-trivial data structures. + +Depends on: shqq-0.1, spawn-0.3, split-0.1 + +Run it with: + $ ghc -O -threaded -rtsopts dupe.hs + $ ./dupe +RTS -N + +-} + +import Control.Concurrent.Spawn +import Data.List.Split +import System.Posix.Files +import System.ShQQ + +import qualified Data.Map as M + +-- Find potentially duplicate files based on some key, either size +-- or a checksum. +dupes :: (Ord k) => [(FilePath,k)] -> [[FilePath]] +dupes = filter (not . null . drop 1) . M.elems + . foldr (\(v,k) -> M.insertWith (++) k [v]) M.empty + +-- We want to collect data in parallel, but the OS will complain if we +-- have too many open files. We limit each pass to have at most 256 +-- tests in progress at once. +inParallel :: (a -> IO b) -> [a] -> IO [b] +inParallel f xs = do p <- pool 256; parMapIO (p . f) xs + +main :: IO () +main = do + files <- endBy "\0" `fmap` [sh| find -type f -print0 |] + + -- Get the size of every file, as a first pass. + let getSize f = ((f,) . fileSize) `fmap` getFileStatus f + sizeDupes <- dupes `fmap` inParallel getSize files + + -- Checksum the files which have duplicated sizes. + let getSha f = ((f,) . head . words) `fmap` [sh| sha1sum $f |] + shaDupes <- dupes `fmap` inParallel getSha (concat sizeDupes) + + -- Print duplicated file names, one per line, with a blank line + -- after each group of duplicates. + mapM_ (mapM_ putStrLn . (++[""])) shaDupes diff --git a/shqq.cabal b/shqq.cabal new file mode 100644 --- /dev/null +++ b/shqq.cabal @@ -0,0 +1,57 @@ +name: shqq +version: 0.1 +license: BSD3 +license-file: LICENSE +synopsis: Embed shell commands with interpolated Haskell variables, and capture output +category: System +author: Keegan McAllister +maintainer: Keegan McAllister +build-type: Simple +cabal-version: >=1.6 +description: + This library provides a quasiquoter for executing shell commands, somewhat + similar to Perl's backtick operator. Shell commands are IO actions, and + they capture the command's standard output as a @String@ result. + . + You can use Haskell variables in a shell command. A string representation + of the contents will be interpolated. The shell will see each interpolated + variable as a single token without interpreting special characters, unless + you choose otherwise. + . + Note: The shell escaping is not correct for the Windows shell. This library + should fail to build on Windows, as well. + . + Examples of using this library are included in @examples/@. + +extra-source-files: + README + , examples/dupe.hs + +-- Our shell escaping is not correct on Windows. We make the project Unix-only +-- in two ways: the 'unix' dependency, and a CPP macro check in ShQQ.hs. + +library + exposed-modules: + System.ShQQ + ghc-options: -Wall + build-depends: + base >= 3 && < 5 + , template-haskell >= 2.3 + , posix-escape >= 0.1 + , parsec >= 3.1 + , unix + + -- NB: process-1.0 has a Unicode handling bug which makes shell escaping + -- ineffective, compromising security. See: + -- + -- http://hackage.haskell.org/trac/ghc/ticket/4006 + -- http://hackage.haskell.org/trac/ghc/ticket/1414 + , process >= 1.1 + + other-extensions: + TemplateHaskell + , CPP + +source-repository head + type: git + location: git://github.com/kmcallister/shqq