shell-monad 0.2.0 → 0.2.1

raw patch · 4 files changed

+271/−92 lines, 4 filesdep +unixPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unix

API changes (from Hackage documentation)

Files

• CHANGELOG +14/−0
• Control/Monad/Shell.hs +251/−90
• TODO +3/−0
• shell-monad.cabal +3/−2

@@ -1,3 +1,17 @@+shell-monad (0.2.1) unstable; urgency=medium++  * Simple support for globs.+  * Fixed propigation of the outer monad's state into Output,+    which fixes a bug in the unusual case where variables or funtions+    are defined inside Output.+  * Support redirection, including redirection from here-documents.+  * Here documents are emulated in linearScript output mode.+  * cmd is now polymorhpic on its first argument, allowing+    the command to run to be specified using String, Var, or even+    Output.++ -- Joey Hess <id@joeyh.name>  Fri, 26 Dec 2014 15:20:53 -0400+ shell-monad (0.2.0) unstable; urgency=medium    * newVar, newVarContaining, takeParameter, and func all

@@ -1,4 +1,4 @@--- | A shell script monad+-- | This is a shell monad, for generating shell scripts.  {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-}@@ -14,9 +14,11 @@ 	val, 	Quoted, 	quote,+	glob, 	run, 	cmd,-	CmdArg,+	Param,+	CmdParams, 	Output(..), 	Val(..), 	comment,@@ -28,9 +30,6 @@ 	positionalParameters, 	takeParameter, 	func,-	(-|-),-	(-&&-),-	(-||-), 	forCmd, 	whileCmd, 	ifCmd,@@ -39,6 +38,18 @@ 	readVar, 	stopOnFailure, 	ignoreFailure,+	(-|-),+	(-&&-),+	(-||-),+	RedirFile,+	(|>),+	(|>>),+	(|<),+	toStderr,+	(|>&),+	(|<&),+	(->-),+	hereDocument, ) where  import qualified Data.Text.Lazy as L@@ -46,6 +57,8 @@ import Data.Monoid import Control.Applicative import Data.Char+import System.Posix.Types (Fd)+import System.Posix.IO (stdInput, stdOutput, stdError)  -- | A shell variable. newtype Var = Var L.Text@@ -59,7 +72,7 @@ newtype Quoted a = Q { getQ :: a } 	deriving (Eq, Ord, Show, Monoid) --- | Quotes the value to allow it to be safely exposed to the shell.+-- | Quotes the Text to allow it to be safely exposed to the shell. -- -- The method used is to replace ' with '"'"' and wrap the value inside -- single quotes. This works for POSIX shells, as well as other shells@@ -71,6 +84,20 @@   where 	q = "'" +-- | Treats the Text as a glob, which expands to one parameter per+-- matching file.+--+-- The input is assumed to be a well-formed glob. Characters in it that+-- are not alphanumeric and are not wildcard characters will be escaped+-- before it is exposed to the shell. This allows eg, spaces in globs.+glob :: L.Text -> Quoted L.Text+glob = Q . L.concatMap escape+  where+	escape c+		| isAlphaNum c = L.singleton c+		| c `elem` "*?[!-:]\\" = L.singleton c+		| otherwise = "\\" <> L.singleton c+ -- | A shell function. newtype Func = Func L.Text 	deriving (Eq, Ord, Show)@@ -79,22 +106,31 @@ data Expr 	= Cmd L.Text -- ^ a command 	| Comment L.Text -- ^ a comment-	| HereDocBody L.Text -- ^ the body of a here-doc 	| Subshell L.Text [Expr] -- ^ expressions run in a sub-shell 	| Pipe Expr Expr -- ^ Piping the first Expr to the second Expr 	| And Expr Expr -- ^ && 	| Or Expr Expr -- ^ ||+	| Redir Expr RedirSpec -- ^ Redirects a file handle of the Expr  -- | Indents an Expr indent :: Expr -> Expr indent (Cmd t) = Cmd $ "\t" <> t indent (Comment t) = Comment $ "\t" <> t-indent (HereDocBody t) = HereDocBody t -- cannot indent indent (Subshell i l) = Subshell ("\t" <> i) (map indent l) indent (Pipe e1 e2) = Pipe (indent e1) (indent e2)+indent (Redir e r) = Redir (indent e) r indent (And e1 e2) = And (indent e1) (indent e2) indent (Or e1 e2) = Or (indent e1) (indent e2) +-- | Specifies a redirection.+data RedirSpec+	= RedirToFile Fd FilePath -- ^ redirect the fd to a file+	| RedirToFileAppend Fd FilePath -- ^ append to file+	| RedirFromFile Fd FilePath -- ^ use a file as input+	| RedirOutput Fd Fd -- ^ redirect first fd to the second+	| RedirInput Fd Fd -- ^ same, but for input fd+	| RedirHereDoc L.Text -- ^ use a here document as input+ -- | Shell script monad. newtype Script a = Script (Env -> ([Expr], Env, a)) 	deriving (Functor)@@ -126,115 +162,176 @@ modifyEnvFuncs :: Env -> (S.Set Func -> S.Set Func) -> Env modifyEnvFuncs env f = env { envFuncs = f (envFuncs env) } --- | Evaluate the monad and generates a list of Expr+-- | runScriptuate the monad and generates a list of Expr gen :: Script f -> [Expr]-gen = fst . eval mempty+gen = fst . runScript mempty --- | Evaluates the monad, and returns a list of Expr and the modified+-- | Runs  the monad, and returns a list of Expr and the modified -- environment.-eval :: Env -> Script f -> ([Expr], Env)-eval env (Script f) = (code, env') where (code, env', _) = f env+runScript :: Env -> Script f -> ([Expr], Env)+runScript env (Script f) = (code, env') where (code, env', _) = f env  -- | Runs the passed Script, using the current environment, -- and returns the list of Expr it generates. runM :: Script () -> Script [Expr] runM s = Script $ \env -> -	let (r, env') = eval env s+	let (r, env') = runScript env s 	in ([], env', r)  -- | Generates a shell script, including hashbang, -- suitable to be written to a file. script :: Script f -> L.Text-script = flip mappend "\n" . L.intercalate "\n" . ("#!/bin/sh":) . map fmt . gen+script = flip mappend "\n" . L.intercalate "\n" . +	("#!/bin/sh":) . map (fmt True) . gen   where-	fmt (Cmd t) = t-	fmt (Comment t) = "# " <> L.filter (/= '\n') t-	fmt (HereDocBody t) = t-	fmt (Subshell i l) = i <> "(\n" <> L.intercalate "\n" (map (fmt . indent) l) <> "\n" <> i <> ")"-	fmt (Pipe e1 e2) = fmt e1 <> " | " <> fmt e2-	fmt (And e1 e2) = fmt e1 <> " && " <> fmt e2-	fmt (Or e1 e2) = fmt e1 <> " || " <> fmt e2 +-- | Formats an Expr to shell  script.+--+-- Can generate either multiline or single line shell script.+fmt :: Bool -> Expr -> L.Text+fmt multiline = go+  where+	go (Cmd t) = t+	go (Comment t)+		| multiline = "# " <> L.filter (/= '\n') t+		-- Comments go to end of line, so instead+		-- use : as a no-op command, and pass the comment to it.+		| otherwise = ": " <> getQ (quote (L.filter (/= '\n') t))+	go (Subshell i l) =+		let (wrap, sep) = if multiline then ("\n", "\n") else ("", ";")+		in i <> "(" <> wrap <> L.intercalate sep (map (go . indent) l) <> wrap <> i <> ")"+	go (Pipe e1 e2) = go e1 <> " | " <> go e2+	go (And e1 e2) = go e1 <> " && " <> go e2+	go (Or e1 e2) = go e1 <> " || " <> go e2+	go (Redir e r) = let use = (\t -> go e <> " " <> t) in case r of+		(RedirToFile fd f) ->+			use $ redirFd fd (Just stdOutput) <> "> " <> L.pack f+		(RedirToFileAppend fd f) ->+			use $ redirFd fd (Just stdOutput) <> ">> " <> L.pack f+		(RedirFromFile fd f) ->+			use $ redirFd fd (Just stdInput) <> "< " <> L.pack f+		(RedirOutput fd1 fd2) ->+			use $ redirFd fd1 (Just stdOutput) <> ">&" <> showFd fd2+		(RedirInput fd1 fd2) ->+			use $ redirFd fd1 (Just stdInput) <> "<&" <> showFd fd2+		(RedirHereDoc t)+			| multiline -> +				let marker = eofMarker t+				in use $ "<<" <> marker <> "\n" <> t <> "\n" <> marker+			-- Here documents cannot be represented in a single+			-- line script. Instead, generate:+			-- (echo l1; echo l2; ...) | cmd+			| otherwise ->+				let heredoc = Subshell L.empty $+					flip map (L.lines t) $ \l -> Cmd $ +						"echo " <> getQ (quote l)+				in go (Pipe heredoc e)++-- | Displays a Fd for use in a redirection.+-- +-- Redirections have a default Fd; for example, ">" defaults to redirecting+-- stdout. In this case, the file descriptor number does not need to be+-- included.+redirFd :: Fd -> (Maybe Fd) -> L.Text+redirFd fd deffd+	| Just fd == deffd = ""+	| otherwise = showFd fd++showFd :: Fd -> L.Text+showFd = L.pack . show++-- | Finds an approriate marker to end a here document; the marker cannot+-- appear inside the text.+eofMarker :: L.Text -> L.Text+eofMarker t = go (1 :: Integer)+  where+	go n = let marker = "EOF" <> if n == 1 then "" else L.pack (show n)+		in if marker `L.isInfixOf` t+			then go (succ n)+			else marker+ -- | Generates a single line of shell code. linearScript :: Script f -> L.Text linearScript = toLinearScript . gen  toLinearScript :: [Expr] -> L.Text-toLinearScript = L.intercalate "; " . map fmt-  where-	fmt (Cmd t) = t-	-- Use : as a no-op command, and pass the comment to it.-	fmt (Comment t) = ": " <> getQ (quote (L.filter (/= '\n') t))-	-- No way to express a here-doc in a single line.-	fmt (HereDocBody _) = ""-	fmt (Subshell i l) = i <> "(" <> L.intercalate "; " (map (fmt . indent) l) <> i <> ")"-	fmt (Pipe e1 e2) = fmt e1 <> " | " <> fmt e2-	fmt (And e1 e2) = fmt e1 <> " && " <> fmt e2-	fmt (Or e1 e2) = fmt e1 <> " || " <> fmt e2+toLinearScript = L.intercalate "; " . map (fmt False)  -- | Adds a shell command to the script. run :: L.Text -> [L.Text] -> Script () run c ps = add $ Cmd $ L.intercalate " " (map (getQ . quote) (c:ps)) --- | Variadic argument version of 'run'.+-- | Variadic and polymorphic version of 'run' ----- The command can be passed any number of CmdArgs.+-- A command can be passed any number of Params. ----- Convenient usage of 'cmd' requires the following:+-- > demo = script $ do+-- >   cmd "echo" "hello, world"+-- >   name <- newVar "name"+-- >   readVar name+-- >   cmd "echo" "hello" name --+-- For the most efficient use of 'cmd', add the following boilerplate,+-- which will make string literals in your program default to being Text:+-- -- > {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-} -- > {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- > import Control.Monad.Shell -- > import qualified Data.Text.Lazy as L -- > default (L.Text) ----- This allows writing, for example:+-- Note that the command to run is itself a Param, so it can be a Text,+-- or a String, or even a Var or Output. For example, this echos "hi": -- -- > demo = script $ do--- >   cmd "echo" "hello, world"--- >   name <- newVar "name"--- >   readVar name--- >   cmd "echo" "hello" name-cmd :: (ShellCmd params) => L.Text -> params-cmd c = cmdAll c []+-- >    echovar <- newVarContaining "echo" ()+-- >    cmd echovar "hi"+cmd :: (Param command, CmdParams params) => command -> params+cmd c = cmdAll (toTextParam c) [] -class CmdArg a where-	toTextArg :: a -> L.Text+-- | A Param is anything that can be used as the parameter of a command.+class Param a where+	toTextParam :: a -> (Env -> L.Text)  -- | Text arguments are automatically quoted.-instance CmdArg L.Text where-	toTextArg = getQ . quote+instance Param L.Text where+	toTextParam = const . getQ . quote  -- | String arguments are automatically quoted.-instance CmdArg String where-	toTextArg = toTextArg . L.pack+instance Param String where+	toTextParam = toTextParam . L.pack  -- | Any value that can be shown can be passed to 'cmd'; just wrap it -- inside a Val.-instance (Show v) => CmdArg (Val v) where-	toTextArg (Val v) = L.pack (show v)+instance (Show v) => Param (Val v) where+	toTextParam (Val v) = const $ L.pack (show v)  -- | Var arguments cause the (quoted) value of a shell variable to be -- passed to the command.-instance CmdArg Var where-	toTextArg v = toTextArg (val v)+instance Param Var where+	toTextParam = toTextParam . val  -- | Quoted Text arguments are passed as-is.-instance CmdArg (Quoted L.Text) where-	toTextArg (Q v) = v+instance Param (Quoted L.Text) where+	toTextParam (Q v) = const v  -- | Allows passing the output of a command as a parameter.-instance CmdArg Output where-	toTextArg (Output s) = "\"$(" <> linearScript s <> ")\""+instance Param Output where+	toTextParam (Output s) = \env ->+		let t = toLinearScript $ fst $ runScript env s+		in "\"$(" <> t <> ")\"" -class ShellCmd t where-	cmdAll :: L.Text -> [L.Text] -> t+-- | Allows a function to take any number of Params.+class CmdParams t where+	cmdAll :: (Env -> L.Text) -> [Env -> L.Text] -> t -instance (CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) where-	cmdAll c acc x = cmdAll c (toTextArg x : acc)+instance (Param arg, CmdParams result) => CmdParams (arg -> result) where+	cmdAll c acc x = cmdAll c (toTextParam x : acc) -instance (f ~ ()) => ShellCmd (Script f) where-	cmdAll c acc = add $ Cmd $ L.intercalate " " (c:reverse acc)+instance (f ~ ()) => CmdParams (Script f) where+	cmdAll c acc = Script $ \env -> +		let ps = map (\f -> f env) (c : reverse acc)+		in ([Cmd $ L.intercalate " " ps], env, ())  -- | The output of a command, or even a more complicated Script -- can be passed as a parameter to 'cmd'@@ -322,8 +419,8 @@ -- positionalParameters and returning a new Var that holds the value of the -- parameter. ----- If there are no more positional parameters, an error will be thrown at--- runtime.+-- If there are no more positional parameters, the script will crash+-- with an error. -- -- For example: --@@ -338,7 +435,7 @@ -- | Defines a shell function, and returns an action that can be run to -- call the function. ----- The action is variadic; it can be passed any number of CmdArgs.+-- The action is variadic; it can be passed any number of CmdParams. -- Typically, it will make sense to specify a more concrete type -- when defining the shell function. --@@ -361,14 +458,14 @@ -- >    forCmd (cmd "seq" "1" num) $ \_n -> -- >       cmd "echo" "Ho, ho, ho!" "Merry xmas!" func-	:: (NameHinted namehint, ShellCmd callfunc)+	:: (NameHinted namehint, CmdParams callfunc) 	=> namehint 	-> Script () 	-> Script callfunc func h s = flip hinted h $ \namehint -> Script $ \env -> 	let f = go (genfuncname namehint) env (0 :: Integer) 	    env' = modifyEnvFuncs env (S.insert f)-	    (ls, env'') = eval env' s+	    (ls, env'') = runScript env' s 	in (definefunc f ls, env'', callfunc f)   where 	go basename env x@@ -385,27 +482,6 @@  	callfunc (Func f) = cmd f --- | Pipes together two Scripts.-(-|-) :: Script () -> Script () -> Script ()-(-|-) = combine Pipe---- | ANDs two Scripts.-(-&&-) :: Script () -> Script () -> Script ()-(-&&-) = combine And---- | ORs two Scripts.-(-||-) :: Script () -> Script () -> Script ()-(-||-) = combine Or--combine :: (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()-combine f a b = do-	alines <- runM a-	blines <- runM b-	add $ f (toExp alines) (toExp blines)-  where-	toExp [e] = e-	toExp l = Subshell L.empty l- -- | Runs the command, and separates its output into parts -- (using the IFS) --@@ -487,7 +563,6 @@   where 	go c@(Cmd _) = Or c true 	go c@(Comment _) = c-	go c@(HereDocBody _) = c 	go (Subshell i l) = Subshell i (map go l) 	-- Assumes pipefail is not set. 	go (Pipe e1 e2) = Pipe e1 (go e2)@@ -495,5 +570,91 @@ 	-- there is no need for extra parens. 	go c@(And _ _) = Or c true 	go (Or e1 e2) = Or e1 (go e2)+	go (Redir e r) = Redir (go e) r  	true = Cmd "true"++-- | Pipes together two Scripts.+(-|-) :: Script () -> Script () -> Script ()+(-|-) = combine Pipe++-- | ANDs two Scripts.+(-&&-) :: Script () -> Script () -> Script ()+(-&&-) = combine And++-- | ORs two Scripts.+(-||-) :: Script () -> Script () -> Script ()+(-||-) = combine Or++combine :: (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()+combine f a b = do+	alines <- runM a+	blines <- runM b+	add $ f (toSingleExp alines) (toSingleExp blines)++toSingleExp :: [Expr] -> Expr+toSingleExp [e] = e+toSingleExp l = Subshell L.empty l++redir :: Script () -> RedirSpec -> Script ()+redir s r = do+	e <- toSingleExp <$> runM s+	add $ Redir e r++-- | Any function that takes a RedirFile can be passed a+-- a FilePath, in which case the default file descriptor will be redirected+-- to/from the FilePath.+--+-- Or, it can be passed a tuple of (Fd, FilePath), in which case the+-- specified Fd will be redirected to/from the FilePath.+class RedirFile r where+	fromRedirFile :: Fd -> r -> (Fd, FilePath)++instance RedirFile FilePath where+	fromRedirFile = (,)++instance RedirFile (Fd, FilePath) where+	fromRedirFile = const id++fileRedir :: RedirFile f => f -> Fd -> (Fd -> FilePath -> RedirSpec) -> RedirSpec+fileRedir f deffd c = uncurry c (fromRedirFile deffd f)++-- | Redirects to a file, overwriting any existing file.+--+-- For example, to shut up a noisy command:+--+-- > cmd "find" "/" |> "/dev/null"+(|>) :: RedirFile f => Script () -> f -> Script ()+s |> f = redir s (fileRedir f stdOutput RedirToFile)++-- | Appends to a file. (If file doesn't exist, it will be created.)+(|>>) :: RedirFile f => Script () -> f -> Script ()+s |>> f = redir s (fileRedir f stdOutput RedirToFileAppend)++-- | Redirects standard input from a file.+(|<) :: RedirFile f => Script () -> f -> Script ()+s |< f = redir s (fileRedir f stdInput RedirFromFile)++-- | Redirects a script's output to stderr.+toStderr :: Script () -> Script ()+toStderr s = s ->- stdOutput |>& stdError++-- | Redirects the first file descriptor to output to the second.+--+-- For example, to redirect a command's stderr to stdout:+--+-- > cmd "foo" ->- stdError) |>& stdOutput+(|>&) :: (Script (), Fd) -> Fd -> Script ()+(s, fd1) |>& fd2 = redir s (RedirOutput fd1 fd2)++-- | Redirects the first file descriptor to input from the second.+(|<&) :: (Script (), Fd) -> Fd -> Script ()+(s, fd1) |<& fd2 = redir s (RedirInput fd1 fd2)++-- | Helper for '|>&' and '|<&'+(->-) :: Script () -> Fd -> (Script (), Fd)+(->-) = (,)++-- | Provides the Text as input to the Script, using a here-document.+hereDocument :: Script () -> L.Text -> Script ()+hereDocument s t = redir s (RedirHereDoc t)

@@ -0,0 +1,3 @@+* shell arithmetic+* nicer interface for the `test` command (aka `[`)+* ${var%foo} etc

@@ -1,5 +1,5 @@ Name: shell-monad-Version: 0.2.0+Version: 0.2.1 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -14,12 +14,13 @@  This is a shell monad, for generating shell scripts. Extra-Source-Files:   CHANGELOG+  TODO   examples/santa.hs  Library   GHC-Options: -Wall   Exposed-Modules: Control.Monad.Shell-  Build-Depends: base (>= 4.5), base < 5, containers, text+  Build-Depends: base (>= 4.5), base < 5, containers, text, unix  source-repository head   type: git