shell-monad 0.5.0 → 0.6.0

raw patch · 8 files changed

+343/−129 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +19/−0
• Control/Monad/Shell.hs +303/−110
• Control/Monad/Shell/Quote.hs +0/−1
• TODO +4/−1
• examples/fib.hs +3/−3
• examples/protocol.hs +7/−7
• examples/santa.hs +6/−6
• shell-monad.cabal +1/−1

@@ -1,3 +1,22 @@+shell-monad (0.6.0) unstable; urgency=medium++  * Added a nice interface to the test command. Test is a GADT,+    which allows constraining numeric tests to only accept+    Integral Vars.+  * Fix bug in lengthVar.+  * Fix the variable returned by lengthVar so it can be expanded+    inside an arithmetic expression.+  * Fixed composition of defaultVar, whenVar, errUnlessVar, and+    trimVar.+  * The Var data type has been renamed to Term Var.+  * There is also a Term Static, for static values from haskell.+  * Instead of Val x, use static x.+  * Implemented a Num instance for Arith, so now Arith can be built+    up from regular haskell expressions, for example:+    val x * (100 + val y)++ -- Joey Hess <id@joeyh.name>  Sun, 28 Dec 2014 20:14:47 -0400+ shell-monad (0.5.0) unstable; urgency=medium    * newVarContaining is generalized to work for all showable data types.

@@ -6,14 +6,17 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE EmptyDataDecls #-}  module Control.Monad.Shell ( 	-- * Core 	Script, 	script, 	linearScript,+	Term, 	Var,-	Val(..),+	Static, 	Quoted, 	Quotable(..), 	glob,@@ -26,6 +29,7 @@ 	-- * Shell variables 	NamedLike(..), 	NameHinted,+	static, 	newVar, 	newVarContaining, 	setVar,@@ -64,7 +68,11 @@ 	stopOnFailure, 	ignoreFailure, 	errUnlessVar,+	-- * Tests+	test,+	Test(..), 	-- * Shell Arithmetic Expressions+	val, 	Arith(..), 	-- * Misc 	comment,@@ -81,26 +89,35 @@  import Control.Monad.Shell.Quote --- | A shell variable, with an associated phantom type.-newtype Var a = Var UntypedVar+-- | A term that can be expanded in a shell command line.+--+-- Mostly, this is used for shell variables: 'Term Var a'+--+-- It can also be used for static values: 'Term Static a'+data Term t a where+	VarTerm :: UntypedVar -> Term Var a+	StaticTerm :: (Quotable (Val a)) => a -> Term Static a +data Var+data Static+ data UntypedVar = V 	{ varName :: VarName 	, expandVar :: Env -> VarName -> Quoted L.Text 	} --- | Casts from any type of Var to any other type. Use with caution!-castVar :: forall a b. Var a -> Var b-castVar (Var v) = Var v- newtype VarName = VarName L.Text 	deriving (Eq, Ord, Show) -simpleVar :: forall a. VarName -> Var a-simpleVar name = Var $ V+simpleVar :: forall a. VarName -> Term Var a+simpleVar name = VarTerm $ V 	{ varName = name 	-- Used to expand the variable; can be overridden for other 	-- types of variable expansion.+	--+	-- It's important that the shell code this generates never+	-- contain any quotes. That would prevent it from being nested+	-- inside an arithmatic expression. 	, expandVar = \_ (VarName n) -> Q ("$" <> n) 	} @@ -122,6 +139,21 @@ newtype Func = Func L.Text 	deriving (Eq, Ord, Show) +class Named t where+	getName :: t -> L.Text++instance Named (Term Var t) where+	getName (VarTerm v) = getName v++instance Named UntypedVar where+	getName = getName . varName++instance Named VarName where+	getName (VarName n) = n++instance Named Func where+	getName (Func n) = n+ -- | A shell expression. data Expr 	= Cmd L.Text -- ^ a command@@ -176,17 +208,20 @@ 	mempty = Env mempty mempty 	mappend a b = Env (envVars a <> envVars b) (envFuncs a <> envFuncs b) +getEnv :: Script Env+getEnv = Script $ \env -> ([], env, env)+ modifyEnvVars :: Env -> (S.Set VarName -> S.Set VarName) -> Env modifyEnvVars env f = env { envVars = f (envVars env) }  modifyEnvFuncs :: Env -> (S.Set Func -> S.Set Func) -> Env modifyEnvFuncs env f = env { envFuncs = f (envFuncs env) } --- | runScriptuate the monad and generates a list of Expr+-- | Runs the monad and generates a list of Expr gen :: Script f -> [Expr] gen = fst . runScript mempty --- | Runs  the monad, and returns a list of Expr and the modified+-- | Runs the monad, and returns a list of Expr and the modified -- environment. runScript :: Env -> Script f -> ([Expr], Env) runScript env (Script f) = (code, env') where (code, env', _) = f env@@ -324,19 +359,17 @@ 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) => Param (Val v) where-       toTextParam (Val v) = const $ L.pack (show v)- instance Param UntypedVar where 	toTextParam v = \env -> "\"" <> getQ (expandVar v env (varName v)) <> "\""  -- | Var arguments cause the (quoted) value of a shell variable to be -- passed to the command.-instance Param (Var a) where-	toTextParam (Var v) = toTextParam v+instance Param (Term Var a) where+	toTextParam (VarTerm v) = toTextParam v +instance (Show a) => Param (Term Static a) where+	toTextParam (StaticTerm a) = toTextParam $ quote $ Val a+ -- | Allows modifying the value of a shell variable before it is passed to -- the command. instance Param (WithVar a) where@@ -384,7 +417,7 @@ -- value of the variable, and can modify it, by using eg 'mappend'. -- -- > cmd "rmdir" (WithVar name ("/home/" <>))-data WithVar a = WithVar (Var a) (Quoted L.Text -> Quoted L.Text)+data WithVar a = WithVar (Term Var a) (Quoted L.Text -> Quoted L.Text)  -- | Adds an Expr to the script. add :: Expr -> Script ()@@ -415,39 +448,42 @@ instance NameHinted (Maybe L.Text) where 	hinted = id +-- | Makes a Static Term from any value that can be shown.+static :: (Quotable (Val t)) => t -> Term Static t+static = StaticTerm+ -- | Defines a new shell variable, which starts out not being set. -- -- Each call to newVar will generate a new, unique variable name. -- -- The namehint can influence this name, but is modified to ensure -- uniqueness.-newVar :: (NameHinted namehint) => forall a. namehint -> Script (Var a)+newVar :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a) newVar = newVarContaining' "" -newVarContaining' :: (NameHinted namehint) => L.Text -> namehint -> Script (Var t)+newVarContaining' :: (NameHinted namehint) => L.Text -> namehint -> Script (Term Var t) newVarContaining' value = hinted $ \namehint -> do-	v@(Var (V { varName = VarName name }))-		<- newVarUnsafe namehint-	Script $ \env -> ([Cmd (name <> "=" <> value)], env, v)+	v <- newVarUnsafe namehint+	Script $ \env -> ([Cmd (getName v <> "=" <> value)], env, v)  -- | Createa a new shell variable, with an initial value which can -- be anything that can be shown. -- -- > s <- newVarContaining "foo bar baz" (NamedLike "s")--- > i <- newVarContaining (1 :: Int) (NamedLine "i")-newVarContaining :: (NameHinted namehint, Quotable (Val t)) => t -> namehint -> Script (Var t)+-- > i <- newVarContaining (1 :: Int) (NamedLike "i")+newVarContaining :: (NameHinted namehint, Quotable (Val t)) => t -> namehint -> Script (Term Var t) newVarContaining = newVarContaining' . getQ . quote . Val  -- | Sets the Var to the value of the param. -setVar :: Param param => forall a. Var a -> param -> Script ()-setVar (Var (V { varName = VarName name })) p = Script $ \env -> -	([Cmd (name <> "=" <> toTextParam p env)], env, ())+setVar :: Param param => forall a. Term Var a -> param -> Script ()+setVar v p = Script $ \env -> +	([Cmd (getName v <> "=" <> toTextParam p env)], env, ())  -- | Gets a Var that refers to a global variable, such as PATH-globalVar :: forall a. L.Text -> Script (Var a)+globalVar :: forall a. L.Text -> Script (Term Var a) globalVar name = Script $ \env ->-	let v@(Var v') = simpleVar (VarName name)-	in ([], modifyEnvVars env (S.insert (varName v')), v)+	let v = simpleVar (VarName name)+	in ([], modifyEnvVars env (S.insert (VarName (getName v))), v)  -- | This special Var expands to whatever parameters were passed to the -- shell script.@@ -456,7 +492,7 @@ -- func. -- -- (This is `$@` in shell)-positionalParameters :: forall a. Var a+positionalParameters :: forall a. Term Var a positionalParameters = simpleVar (VarName "@")  -- | Takes the first positional parameter, removing it from@@ -471,90 +507,49 @@ -- > removefirstfile = script $ do -- >   cmd "rm" =<< takeParameter -- >   cmd "echo" "remaining parameters:" positionalParameters-takeParameter :: (NameHinted namehint) => forall a. namehint -> Script (Var a)+takeParameter :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a) takeParameter = hinted $ \namehint -> do-	p@(Var (V { varName = VarName name}))-		<- newVarUnsafe namehint-	Script $ \env -> ([Cmd (name <> "=\"$1\""), Cmd "shift"], env, p)-+	p <- newVarUnsafe namehint+	Script $ \env -> ([Cmd (getName p <> "=\"$1\""), Cmd "shift"], env, p)  -- | Creates a new shell variable, but does not ensure that it's not -- already set to something. For use when the caller is going to generate -- some shell script that is guaranteed to clobber any existing value of -- the variable.-newVarUnsafe :: (NameHinted namehint) => forall a. namehint -> Script (Var a)+newVarUnsafe :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a) newVarUnsafe = hinted $ \namehint -> Script $ \env ->-	let v@(Var v') = go namehint env (0 :: Integer)-	in ([], modifyEnvVars env (S.insert (varName v')), v)+	let v = go namehint env (0 :: Integer)+	in ([], modifyEnvVars env (S.insert (VarName (getName v))), v)   where 	go namehint env x-		| S.member (varName v') (envVars env) =+		| S.member (VarName (getName v)) (envVars env) = 			go namehint env (succ x) 		| otherwise = v 	  where-		v@(Var v') = simpleVar $ VarName $ "_"+		v = simpleVar $ VarName $ "_" 			<> genvarname namehint 			<> if x == 0 then "" else L.pack (show (x + 1)) 	 	genvarname = maybe "v" (L.filter isAlpha) -modVar :: forall a b. Var a -> (L.Text -> Env -> L.Text) -> Script (Var b)-modVar (Var (V { varName = VarName varname })) p = do-	(Var v) <- newVarUnsafe (NamedLike varname)-	return $ Var $ v-		{ expandVar = \env _ -> Q $ "${" <> p varname env <> "}"-		}--modVar' :: (Param param) => forall a b. L.Text -> Var a -> param -> Script (Var b)-modVar' t v p = castVar <$> go-   where-	go = modVar v $ \varname env ->-		varname <> t <> toTextParam p env- -- | Generates a new Var. Expanding this Var will yield the same -- result as expanding the input Var, unless it is empty, in which case -- it instead defaults to the expansion of the param.-defaultVar :: (Param param) => forall a. Var a -> param -> Script (Var a)-defaultVar = modVar' ":-"+defaultVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)+defaultVar = funcVar' ":-"  -- | Generates a new Var. If the input Var is empty, then this new Var -- will likewise expand to the empty string. But if not, the new Var -- expands to the param.-whenVar :: (Param param) => forall a. Var a -> param -> Script (Var a)-whenVar = modVar' ":+"+whenVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)+whenVar = funcVar' ":+"  -- | Generates a new Var. If the input Var is empty then expanding this new -- Var will cause an error to be thrown, using the param as the error -- message. If the input Var is not empty, then the new Var expands to the -- same thing the input Var expands to.-errUnlessVar :: (Param param) => forall a. Var a -> param -> Script (Var a)-errUnlessVar = modVar' ":?"---- | Generates a new Var, which expands to the length of the--- expansion of the input Var.------ Note that 'lengthVar positionalParameters' expands to the number--- of positional parameters.-lengthVar :: forall a. Var a -> Script (Var Integer)--- Implementation note: ${#${foo:-bar}} is not legal shell code.--- So, to allow taking the length of Vars that expand to such things,--- a temporary Var is created, assigned to the expansion of the input Var.--- This yields shell code like:--- ${_tmp1:-$(_tmp1="${foo:-bar}"; echo ${#_tmp1})}--- But, this approach won't work for $@, so handle it as a special--- case.-lengthVar v@(Var (V { varName = VarName varname }))-	| varname /= "@" = do-		tmpvar@(Var tmpvar') <- newVar (NamedLike "tmp")-		modVar tmpvar $ \tmpname env ->-			let hack = do-				setVar tmpvar v-				cmd ("echo" :: L.Text) $ Var $ tmpvar'-					{ expandVar = \_ _ -> Q $-						"${#" <> tmpname <> "}"-					}-			in varname <> ":-" <> toTextParam (Output hack) env-	| otherwise = return $ simpleVar (VarName "#")+errUnlessVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)+errUnlessVar = funcVar' ":?"  -- | Produces a Var that is a trimmed version of the input Var. --@@ -567,16 +562,59 @@ -- -- The act of trimming a Var is assumed to be able to produce a new -- Var holding a different data type.-trimVar :: forall a. Greediness -> Direction -> Var String -> Quoted L.Text -> Script (Var a)-trimVar ShortestMatch FromBeginning = modVar' "#"-trimVar LongestMatch FromBeginning = modVar' "##"-trimVar ShortestMatch FromEnd = modVar' "%"-trimVar LongestMatch FromEnd = modVar' "%%"+trimVar :: forall a. Greediness -> Direction -> Term Var String -> Quoted L.Text -> Script (Term Var a)+trimVar ShortestMatch FromBeginning = funcVar' "#"+trimVar LongestMatch FromBeginning = funcVar' "##"+trimVar ShortestMatch FromEnd = funcVar' "%"+trimVar LongestMatch FromEnd = funcVar' "%%"  data Greediness = ShortestMatch | LongestMatch  data Direction = FromBeginning | FromEnd +-- | Generates a new Var, which expands to the length of the+-- expansion of the input Var.+--+-- Note that 'lengthVar positionalParameters' expands to the number+-- of positional parameters.+lengthVar :: forall a. Term Var a -> Script (Term Var Integer)+lengthVar v+	| getName v == "@" = return $ simpleVar (VarName "#")+	| otherwise = funcVar v ("#" <>)		++-- To implement a Var -> Var function at the shell level,+-- generate shell code like this:+--+-- func () {+-- 	t="$orig"; echo "${t'}"+-- }+--+-- Where t' = transform t+--+-- The returned Var expands to a call to the function: $(func)+-- Note that it's important this call to the function not contain+-- any quotes, so that it can be used inside an arithmetic expression.+funcVar :: forall a b. Term Var a -> (L.Text -> L.Text) -> Script (Term Var b)+funcVar orig transform = do+	tmp@(VarTerm internal) <- newVarUnsafe shortname :: Script (Term Var ())+	f <- mkFunc tmp+	return $ VarTerm $ internal+		{ expandVar = \env _ -> Q $+			"$(" <> toLinearScript (fst (runScript env f)) <> ")"+		}+  where+	mkFunc :: Term Var () -> Script (Script ())+	mkFunc tmp = func shortname $ do+		setVar tmp orig+		cmd ("echo" :: L.Text) $ Q $+			"\"${" <> transform (getName tmp) <> "}\""+	shortname = NamedLike ""++funcVar' :: (Param param) => forall a b. L.Text -> Term Var a -> param -> Script (Term Var b)+funcVar' op v p = do+	t <- toTextParam p <$> getEnv+	funcVar v (<> op <> t)+ -- | Defines a shell function, and returns an action that can be run to -- call the function. --@@ -593,11 +631,11 @@ -- -- > demo = script $ do -- >    hohoho <- mkHohoho--- >    hohoho (Val 1)+-- >    hohoho (static 1) -- >    echo "And I heard him exclaim, ere he rode out of sight ..."--- >    hohoho (Val 3)+-- >    hohoho (static 3) -- > --- > mkHohoho :: Script (Val Int -> Script ())+-- > mkHohoho :: Script (Term Val Int -> Script ()) -- > mkHohoho = func (NamedLike "hohoho") $ do -- >    num <- takeParameter -- >    forCmd (cmd "seq" "1" num) $ \_n ->@@ -631,11 +669,11 @@ -- (using the IFS) -- -- The action is run for each part, passed a Var containing the part.-forCmd :: forall a. Script () -> (Var a -> Script ()) -> Script ()+forCmd :: forall a. Script () -> (Term Var a -> Script ()) -> Script () forCmd c a = do-	v@(Var (V { varName = VarName varname})) <- newVarUnsafe (NamedLike "x")+	v <- newVarUnsafe (NamedLike "x") 	s <- toLinearScript <$> runM c-	add $ Cmd $ "for " <> varname <> " in $(" <> s <> ")"+	add $ Cmd $ "for " <> getName v <> " in $(" <> s <> ")" 	block "do" (a v) 	add $ Cmd "done" @@ -647,7 +685,7 @@ 	block "do" a 	add $ Cmd "done" --- | if with a monadic conditional+-- | if with a Script conditional. -- -- If the conditional exits 0, the first action is run, else the second. ifCmd :: Script () -> Script () -> Script () -> Script ()@@ -685,7 +723,7 @@ -- | Matches the value of the Var against the Quoted Text (which can -- be generated by 'glob'), and runs the Script action associated -- with the first match.-caseOf :: forall a. Var a -> [(Quoted L.Text, Script ())] -> Script ()+caseOf :: forall a. Term Var a -> [(Quoted L.Text, Script ())] -> Script () caseOf _ [] = return () caseOf v l = go True l   where@@ -701,8 +739,9 @@ 	-- > : ;; esac 	go _ [] = add $ Cmd $ ";; esac" 	go atstart ((t, s):rest) = do+		env <- getEnv 		let leader = if atstart-			then "case " <> toTextParam v undefined <> " in "+			then "case " <> toTextParam v env <> " in " 			else ": ;; " 		add $ Cmd $ leader <> getQ t <> ") :" 		mapM_ (add . indent) =<< runM s@@ -718,10 +757,9 @@ 	add $ Cmd $ word <> " :" 	mapM_ (add . indent) =<< runM s --- | Generates shell code to fill a variable with a line read from stdin.-readVar :: Var String -> Script ()-readVar (Var (V { varName = VarName varname })) = add $-	Cmd $ "read " <> getQ (quote varname)+-- | Fills a variable with a line read from stdin.+readVar :: Term Var String -> Script ()+readVar v = add $ Cmd $ "read " <> getQ (quote (getName v))  -- | By default, shell scripts continue running past commands that exit -- nonzero. Use "stopOnFailure True" to make the script stop on the first@@ -835,14 +873,118 @@ hereDocument :: Script () -> L.Text -> Script () hereDocument s t = redir s (RedirHereDoc t) +-- | Creates a Script that checks a Test and exits true (0) or false (1).+--+-- Useful with ifCmd, whenCmd, etc; for example:+--+-- > ifCmd (test (FileExists "foo")) (foo, bar)+test :: Test -> Script ()+test t = Script $ \env -> ([Cmd $ "test " <> mkTest env t], env, ())++mkTest :: Env -> Test -> L.Text+mkTest env = go+  where+	go (TNot t) = unop "!" (go t)+	go (TAnd t1 t2) = binop (go t1) "&&" (go t2)+	go (TOr t1 t2) = binop (go t1) "||" (go t2)+	go (TEmpty p) = unop "-z" (pv p)+	go (TNonEmpty p) = unop "-n" (pv p)+	go (TStrEqual p1 p2) = binop (pv p1) "=" (pv p2)+	go (TStrNotEqual p1 p2) = binop (pv p1) "!=" (pv p2)+	go (TEqual p1 p2) = binop (pv p1) "-eq" (pv p2)+	go (TNotEqual p1 p2) = binop (pv p1) "-ne" (pv p2)+	go (TGT p1 p2) = binop (pv p1) "-gt" (pv p2)+	go (TLT p1 p2) = binop (pv p1) "-lt" (pv p2)+	go (TGE p1 p2) = binop (pv p1) "-ge" (pv p2)+	go (TLE p1 p2) = binop (pv p1) "-le" (pv p2)+	go (TFileEqual p1 p2) = binop (pv p1) "-ef" (pv p2)+	go (TFileNewer p1 p2) = binop (pv p1) "-nt" (pv p2)+	go (TFileOlder p1 p2) = binop (pv p1) "-ot" (pv p2)+	go (TBlockExists p) = unop "-b" (pv p)+	go (TCharExists p) = unop "-c" (pv p)+	go (TDirExists p) = unop "-d" (pv p)+	go (TFileExists p) = unop "-e" (pv p)+	go (TRegularFileExists p) = unop "-f" (pv p)+	go (TSymlinkExists p) = unop "-L" (pv p)+	go (TFileNonEmpty p) = unop "-s" (pv p)+	go (TFileExecutable p) = unop "-x" (pv p)++	paren t = "\\(" <> t <> "\\)"+	+	binop a o b = paren $ a <> " " <> o <> " " <> b+	unop o v = paren $ o <> " " <> v++	pv :: (Param p) => p -> L.Text+	pv = flip toTextParam env++-- | Note that this should only include things that test(1) and+-- shell built-in test commands support portably.+data Test where+	TNot :: Test -> Test -- negation+	TAnd :: Test -> Test -> Test -- 'and'+	TOr :: Test -> Test -> Test -- 'or'+	TEmpty :: (Param p) => p -> Test+	-- Does the param expand to an empty string?+	TNonEmpty :: (Param p) => p -> Test+	TStrEqual :: (Param p, Param q) => p -> q -> Test+	-- Do the parameters expand to the same string?+	TStrNotEqual :: (Param p, Param q) => p -> q -> Test+	TEqual :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test+	-- Are the Vars equal? (Compares integer to integer, not string-wise.)+	TNotEqual :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test +	TGT :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test -- '>'+	TLT :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test -- '<'+	TGE :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test -- '>='+	TLE :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test -- '<='+	TFileEqual :: (Param p, Param q) => p -> q -> Test+	-- Are the files equal? (Compares the files' device and inode numbers).+	TFileNewer :: (Param p, Param q) => p -> q -> Test+	-- Does the first file have a newer modification date?+	TFileOlder :: (Param p, Param q) => p -> q -> Test+	TBlockExists :: (Param p) => p -> Test+	-- Does the block device exist?+	TCharExists :: (Param p) => p -> Test+	-- Does the char device exist?+	TDirExists :: (Param p) => p -> Test+	-- Does the directory exist?+	TFileExists :: (Param p) => p -> Test+	-- Does the file exist?+	TRegularFileExists :: (Param p) => p -> Test+	-- Does the file exist and is it a regular file?+	TSymlinkExists :: (Param p) => p -> Test+	-- Does the symlink exist?+	TFileNonEmpty :: (Param p) => p -> Test+	-- Does the file exist and is not empty?+	TFileExecutable :: (Param p) => p -> Test+	-- Does the file exist and is executable?++instance (Show a, Num a) => Num (Term Static a) where+	fromInteger = static . fromInteger+	(StaticTerm a) + (StaticTerm b) = StaticTerm (a + b)+	(StaticTerm a) * (StaticTerm b) = StaticTerm (a * b)+	(StaticTerm a) - (StaticTerm b) = StaticTerm (a - b)+	abs (StaticTerm a) = StaticTerm (abs a)+	signum (StaticTerm a) = StaticTerm (signum a)++-- | Lifts a Term to Arith.+val :: Term t Integer -> Arith+val t@(VarTerm _) = AVar t+val t@(StaticTerm _) = AStatic t+ -- | This data type represents shell Arithmetic Expressions. -- -- Note that in shell arithmetic, expressions that would evaluate to a -- Bool, such as ANot and AEqual instead evaluate to 1 for True and 0 for -- False.+-- +-- Arith is an instance of Num, which allows you to write expressions+-- like this with shell variables:+--+-- > val x * (100 + val y) data Arith 	= ANum Integer-	| AVar (Var Integer)+	| AVar (Term Var Integer)+	| AStatic (Term Static Integer) 	| ANegate Arith -- ^ negation 	| APlus Arith Arith -- ^ '+' 	| AMinus Arith Arith -- ^ '-'@@ -863,14 +1005,16 @@ 	| ABitAnd Arith Arith -- ^ AND of the bits of the two arguments 	| AShiftLeft Arith Arith -- ^ shift left (first argument's bits are shifted by the value of the second argument) 	| AShiftRight Arith Arith -- ^ shift right-	| ACond Arith Arith Arith -- ^ if the first argument is non-zero, the result is the second, else the result is the third+	| AIf Arith (Arith, Arith) -- ^ if the first argument is non-zero, the result is the second, else the result is the third+	deriving (Eq, Ord)  fmtArith :: Env -> Arith -> L.Text fmtArith env = go   where 	go (ANum i) = L.pack (show i) 	-- shell variable must be expanded without quotes-	go (AVar (Var v)) = getQ $ expandVar v env (varName v)+	go (AVar (VarTerm v)) = getQ $ expandVar v env (varName v)+	go (AStatic (StaticTerm v)) = getQ $ quote $ Val v 	go (ANegate v) = unop "-" v 	go (APlus a b) = binop a "+" b 	go (AMinus a b) = binop a "-" b@@ -891,9 +1035,58 @@ 	go (ABitAnd a b) = binop a "&" b 	go (AShiftLeft a b) = binop a "<<" b 	go (AShiftRight a b) = binop a ">>" b-	go (ACond c a b) = paren $ go c <> " ? " <> go a <> " : " <> go b+	go (AIf c (a, b)) = paren $ go c <> " ? " <> go a <> " : " <> go b  	paren t = "(" <> t <> ")"  	binop a o b = paren $ go a <> " " <> o <> " " <> go b 	unop o v = paren $ o <> " " <> go v++instance Num Arith where+	fromInteger = ANum+	(+) = APlus+	(*) = AMult+	(-) = AMinus+	negate = ANegate+	abs v = AIf (v `ALT` ANum 0)+		( AMult v (ANum (-1))+		, v+		)+	signum v = +		AIf (v `ALT` ANum 0)+			( ANum (-1)+			, AIf (v `AGT` ANum 0)+				( ANum 1+				, ANum 0+				)+			)++-- | Note that 'fromEnum', 'enumFromTo', and 'enumFromThenTo' cannot be used+-- with Arith.+instance Enum Arith where+	succ a = APlus a (ANum 1)+	pred a = AMinus a (ANum 1)+	toEnum = ANum . fromIntegral+	enumFrom a = a : enumFrom (succ a)+	enumFromThen a b = a : enumFromThen b ((b `AMult` (ANum 2)) `AMinus` a)+	fromEnum = error "fromEnum not implemented for Arith"+	enumFromTo = error "enumFromTo not implemented for Arith"+	enumFromThenTo = error "enumFromToThen not implemented for Arith"++instance Eq a => Eq (Term Var a) where+	VarTerm a == VarTerm b = a == b++instance Eq a => Eq (Term Static a) where+	StaticTerm a == StaticTerm b = a == b++instance Eq UntypedVar where+	a == b = varName a == varName b++instance Ord a => Ord (Term Var a) where+	VarTerm a <= VarTerm b = a <= b++instance Ord a => Ord (Term Static a) where+	StaticTerm a <= StaticTerm b = a <= b++instance Ord UntypedVar where+	a <= b = varName a <= varName b

@@ -40,7 +40,6 @@ instance Quotable String where 	quote = quote . L.pack --- | Any Showable value can be quoted, just use 'quote (Val v)' instance (Show v) => Quotable (Val v) where 	quote (Val v) = quote $ show v 

@@ -1,6 +1,9 @@-* nicer interface for the `test` command (aka `[`) * setVar allows `Var a` to be set to any value, the value   is not constrained to be of type `a`. This seems necessary   to allow, eg, `setVar v (Output (cmd "read"))`. On other   hand, it's subptimal when using setVar with a Arith; in this   case `a` should be some Integral.++* Allow: test (n `TEqual` 42)++  Perhaps by making Test an instance of Num?

@@ -9,13 +9,13 @@ main = T.writeFile "fib.sh" $ script $ 	takeParameter () >>= fib >>= cmd "echo" -fib :: Var Integer -> Script (Var Integer)+fib :: Term Var Integer -> Script (Term Var Integer) fib n = do 	prev <- new1 	acc <- new1 	forCmd (cmd "seq" prev n) $ \_ -> do-		setVar acc (AVar acc `APlus` AVar prev)-		setVar prev (AVar acc `AMinus` AVar prev)+		setVar acc (val acc + val prev)+		setVar prev (val acc - val prev) 	return acc   where 	new1 = newVarContaining 1 ()

@@ -27,7 +27,7 @@ instance InputsProto IO Proto where 	input = toProto <$> readLn -instance InputsProto Script (Var String) where+instance InputsProto Script (Term Var String) where 	input = do 		v <- newVar () 		readVar v@@ -66,7 +66,7 @@ 		| otherwise -> error $ "unknown protocol command: " ++ w 	(_, _) -> error "protocol splitting error" -handleProto :: Var String -> Script ()+handleProto :: Term Var String -> Script () handleProto v = do 	w <- getProtoCommand v 	caseOf w@@ -79,20 +79,20 @@ 		  ) 		] -handleFoo :: Var String -> Script ()+handleFoo :: Term Var String -> Script () handleFoo v = toStderr $ cmd "echo" "yay, I got a Foo" v  handleBar :: Script () handleBar = toStderr $ cmd "echo" "yay, I got a Bar" -handleBaz :: Var Int -> Script ()-handleBaz num = forCmd (cmd "seq" (Val (1 :: Int)) num) $+handleBaz :: Term Var Int -> Script ()+handleBaz num = forCmd (cmd "seq" (static (1 :: Int)) num) $ 	toStderr . cmd "echo" "yay, I got a Baz" -getProtoCommand :: Var String -> Script (Var String)+getProtoCommand :: Term Var String -> Script (Term Var String) getProtoCommand v = trimVar LongestMatch FromEnd v (glob " *") -getProtoRest :: forall t. Var String -> Script (Var t)+getProtoRest :: forall t. Term Var String -> Script (Term Var t) getProtoRest v = trimVar ShortestMatch FromBeginning v (glob "[! ]*[ ]")  main :: IO ()

@@ -9,27 +9,27 @@ main :: IO () main = T.writeFile "santa.sh" $ script $ do 	hohoho <- mkHohoho-	hohoho (Val 1)+	hohoho (static 1)  	promptFor "What's your name?" "virginia" $ \name -> pipeLess $ do 		cmd "echo" "Let's see what's in" (WithVar name (<> quote "'s")) "stocking!" 		forCmd (cmd "ls" "-1" (WithVar name (quote "/home/" <>))) $ \f -> do 			cmd "echo" "a shiny new" f-			hohoho (Val 1)+			hohoho (static 1)  	cmd "rm" "/table/cookies" "/table/milk"-	hohoho (Val 3)+	hohoho (static 3) -mkHohoho :: Script (Val Int -> Script ())+mkHohoho :: Script (Term Static Int -> Script ()) mkHohoho = func (NamedLike "hohoho") $ do 	num <- takeParameter (NamedLike "num")-	forCmd (cmd "seq" "1" num) $ \_n ->+	forCmd (cmd "seq" (static (1 :: Int)) num) $ \_n -> 		cmd "echo" "Ho, ho, ho!" "Merry xmas!"  pipeLess :: Script () -> Script () pipeLess c = c -|- cmd "less" -promptFor :: T.Text -> T.Text -> (Var String -> Script ()) -> Script ()+promptFor :: T.Text -> T.Text -> (Term Var String -> Script ()) -> Script () promptFor prompt defaultname cont = do 	cmd "printf" (prompt <> " ") 	var <- newVar (NamedLike prompt)

@@ -1,5 +1,5 @@ Name: shell-monad-Version: 0.5.0+Version: 0.6.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>