shell-monad 0.6.7 → 0.6.8

raw patch · 5 files changed

+118/−37 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• Control/Monad/Shell.hs +102/−31
• TODO +8/−0
• examples/hello.hs +0/−5
• shell-monad.cabal +1/−1

@@ -1,3 +1,10 @@+shell-monad (0.6.8) unstable; urgency=medium++  * Added withEnv, subshell and group.+    Thanks, dhivael++ -- Joey Hess <id@joeyh.name>  Sat, 12 Jan 2019 17:11:39 -0400+ shell-monad (0.6.7) unstable; urgency=medium    * Fix quoting of empty String/Text.

@@ -84,6 +84,9 @@ 	whenCmd, 	unlessCmd, 	caseOf,+	subshell,+	group,+	withEnv, 	(-|-), 	(-&&-), 	(-||-),@@ -196,11 +199,21 @@ instance Named Func where 	getName (Func n) = n +type Indent = Int++type LocalEnv = (L.Text, L.Text)+ -- | A shell expression. data Expr-	= Cmd L.Text -- ^ a command+	= Cmd Indent [LocalEnv] L.Text+	-- ^ a command. may have a local environment to be added to it+	| Raw Indent L.Text+	-- ^ shell code that is not able to a have a local environment added to it+	| EnvWrap Indent L.Text [LocalEnv] [Expr]+	-- ^ named script with a local environment to add to it 	| Comment L.Text -- ^ a comment 	| Subshell L.Text [Expr] -- ^ expressions run in a sub-shell+	| Group L.Text [Expr] -- ^ expressions run in a group 	| Pipe Expr Expr -- ^ Piping the first Expr to the second Expr 	| And Expr Expr -- ^ && 	| Or Expr Expr -- ^ ||@@ -208,9 +221,12 @@  -- | Indents an Expr indent :: Expr -> Expr-indent (Cmd t) = Cmd $ "\t" <> t+indent (Cmd i localenvs t) = Cmd (i + 1) localenvs t+indent (Raw i t) = Raw (i + 1) t+indent (EnvWrap i n localenvs e) = EnvWrap (i + 1) n localenvs (map indent e) indent (Comment t) = Comment $ "\t" <> t indent (Subshell i l) = Subshell ("\t" <> i) (map indent l)+indent (Group i l) = Group ("\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)@@ -237,11 +253,11 @@ 		in  (expr1 <> expr2, env2, f' a')  instance Monad Script where-        return ret = Script $ \env -> ([], env, ret)-        a >>= b = Script $ \start -> let-                (left, mid, v) = call a start-                (right, end, ret) = call (b v) mid-                in (left ++ right, end, ret)+	return ret = Script $ \env -> ([], env, ret)+	a >>= b = Script $ \start -> let+		(left, mid, v) = call a start+		(right, end, ret) = call (b v) mid+		in (left ++ right, end, ret) 	  where 		call :: Script f -> Env -> ([Expr], Env, f) 		call (Script f) = f@@ -291,7 +307,6 @@ script :: Script f -> L.Text script = flip mappend "\n" . L.intercalate "\n" .  	("#!/bin/sh":) . map (fmt True) . gen-  where  -- | Formats an Expr to shell  script. --@@ -299,16 +314,33 @@ fmt :: Bool -> Expr -> L.Text fmt multiline = go   where-	go (Cmd t) = t+	fmtlocalenvs = L.intercalate " " . map (\(k, v) -> k <> "=" <> v)++	go (Cmd i [] t) = L.pack (replicate i '\t') <> t+	go (Cmd i localenvs t) = L.pack (replicate i '\t') <> fmtlocalenvs localenvs <> " " <> t+	go (Raw i t) = L.pack (replicate i '\t') <> t+	go (EnvWrap i n localenvs e) =+		let (lp, sep) = if multiline+			then (L.pack (replicate i '\t'), "\n")+			else ("", ";")+		in lp <> n <> "() { : " <> sep+		   <> L.intercalate sep (map (go . indent) e) <> sep+		   <> lp <> "}" <> sep+		   <> lp <> fmtlocalenvs localenvs <> " " <> n 	-- Comments are represented using : for two reasons: 	-- 1. To support single line rendering. 	-- 2. So that it's a valid shell expression; any 	-- Expr, including Comment can be combined with any other. 	-- For example, Pipe Comment Comment. 	go (Comment t) = ": " <> getQ (quote (L.filter (/= '\n') t))+	go (Subshell i []) = i <> "( : )" 	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 (Group i []) = i <> "{ :; }"+	go (Group i l) =+		let (wrap, sep, end) = if multiline then ("\n", "\n", "") else ("", ";", ";")+		in i <> "{" <> wrap <> L.intercalate sep (map (go . indent) l) <> end <> 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@@ -335,7 +367,7 @@ 			-- (echo l1; echo l2; ...) | cmd 			| otherwise -> 				let heredoc = Subshell L.empty $-					flip map (L.lines t) $ \l -> Cmd $ +					flip map (L.lines t) $ \l -> raw $  						"echo " <> getQ (quote l) 				in go (Pipe heredoc e) @@ -371,8 +403,14 @@  -- | 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))+run c ps = add $ newCmd $ L.intercalate " " (map (getQ . quote) (c:ps)) +newCmd :: L.Text -> Expr+newCmd l = Cmd 0 [] l++raw :: L.Text -> Expr+raw l = Raw 0 l+ -- | Variadic and polymorphic version of 'run' -- -- A command can be passed any number of Params.@@ -453,7 +491,7 @@ 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, ())+		in ([newCmd $ L.intercalate " " ps], env, ())  -- | The output of a command, or even a more complicated Script -- can be passed as a parameter to 'cmd'@@ -525,7 +563,7 @@ newVarContaining' :: (NameHinted namehint) => L.Text -> namehint -> Script (Term Var t) newVarContaining' value = hinted $ \namehint -> do 	v <- newVarUnsafe namehint-	Script $ \env -> ([Cmd (getName v <> "=" <> value)], env, v)+	Script $ \env -> ([raw (getName v <> "=" <> value)], env, v)  -- | Creates a new shell variable with an initial value coming from any -- 'Param'.@@ -554,7 +592,7 @@ newVarFrom param namehint = do 	v <- newVarUnsafe namehint 	Script $ \env ->-		([Cmd (getName v <> "=" <> toTextParam param env)], env, v)+		([raw (getName v <> "=" <> toTextParam param env)], env, v)  -- | Creates a new shell variable, with an initial value which can -- be anything that can be shown.@@ -567,7 +605,7 @@ -- | Sets the Var to the value of the param.  setVar :: Param param => forall a. Term Var a -> param -> Script () setVar v p = Script $ \env -> -	([Cmd (getName v <> "=" <> toTextParam p env)], env, ())+	([raw (getName v <> "=" <> toTextParam p env)], env, ())  -- | Gets a Var that refers to a global variable, such as PATH globalVar :: forall a. L.Text -> Script (Term Var a)@@ -600,7 +638,7 @@ takeParameter :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a) takeParameter = hinted $ \namehint -> do 	p <- newVarUnsafe namehint-	Script $ \env -> ([Cmd (getName p <> "=\"$1\""), Cmd "shift"], env, p)+	Script $ \env -> ([raw (getName p <> "=\"$1\""), raw "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@@ -754,7 +792,7 @@ 	 	genfuncname = maybe "p" (L.filter isAlpha) -	definefunc (Func f) ls = (Cmd $ f <> " () { :") : map indent ls ++ [ Cmd "}" ]+	definefunc (Func f) ls = (raw $ f <> " () { :") : map indent ls ++ [ raw "}" ]  	callfunc (Func f) = cmd f @@ -766,17 +804,17 @@ forCmd c a = do 	v <- newVarUnsafe (NamedLike "x") 	s <- toLinearScript <$> runM c-	add $ Cmd $ "for " <> getName v <> " in $(" <> s <> ")"+	add $ raw $ "for " <> getName v <> " in $(" <> s <> ")" 	block "do" (a v)-	add $ Cmd "done"+	add $ raw "done"  -- | As long as the first Script exits nonzero, runs the second script. whileCmd :: Script () -> Script () -> Script () whileCmd c a = do 	s <- toLinearScript <$> runM c-	add $ Cmd $ "while $(" <> s <> ")"+	add $ raw $ "while $(" <> s <> ")" 	block "do" a-	add $ Cmd "done"+	add $ raw "done"  -- | if with a Script conditional. --@@ -790,13 +828,14 @@ ifCmd' :: (L.Text -> L.Text) -> Script () -> Script () -> Script () ifCmd' condf cond body = do 	condl <- runM cond-	add $ Cmd $ "if " <> condf (singleline condl)+	add $ raw $ "if " <> condf (singleline condl) 	body-	add $ Cmd "fi"+	add $ raw "fi"   where 	singleline l = 		let c = case l of 			[c'@(Cmd {})] -> c'+			[c'@(Raw {})] -> c' 			[c'@(Subshell {})] -> c' 			_ -> Subshell L.empty l 		in toLinearScript [c]@@ -836,16 +875,45 @@ 	-- > : ;; *) : 	-- >     echo default 	-- > : ;; esac-	go _ [] = add $ Cmd ";; esac"+	go _ [] = add $ raw ";; esac" 	go atstart ((t, s):rest) = do 		env <- getEnv 		let leader = if atstart 			then "case " <> toTextParam v env <> " in " 			else ": ;; "-		add $ Cmd $ leader <> getQ t <> ") :"+		add $ raw $ leader <> getQ t <> ") :" 		mapM_ (add . indent) =<< runM s 		go False rest +-- | Runs the script in a new subshell.+subshell :: Script () -> Script ()+subshell s = do+	e <- runM s+	add $ Subshell "" e++-- | Runs the script as a command group in the current subshell.+group :: Script () -> Script ()+group s = do+	e <- runM s+	add $ Group "" e++-- | Add a variable to the local environment of the script.+withEnv :: Param value => L.Text -> value -> Script () -> Script ()+withEnv n v (Script f) = Script $ addEnv . f+  where+	-- We can only add K=V to simple commands. If the input script+	-- contains anything more than one simple command we'll have to wrap+	-- the script into a fresh function and call that with the+	-- environment.+	addEnv (e, env, _) = let localenv = (n, toTextParam v env)+		in case e of+			[Cmd i localenvs l] -> ([Cmd i (localenv : localenvs) l], env, ())+			[EnvWrap i envName localenvs e'] -> ([EnvWrap i envName (localenv : localenvs) e'], env, ())+			l -> ([EnvWrap 0 (getName name) [localenv] l], env', ())+	  where+		(Script nameFn) = newVarUnsafe' (NamedLike "envfn")+		(_, env', name) = nameFn env+ -- | Creates a block such as "do : ; cmd ; cmd" or "else : ; cmd ; cmd" -- -- The use of : ensures that the block is not empty, and allows@@ -853,26 +921,29 @@ -- formatting work. block :: L.Text -> Script () -> Script () block word s = do-	add $ Cmd $ word <> " :"+	add $ raw $ word <> " :" 	mapM_ (add . indent) =<< runM s  -- | Fills a variable with a line read from stdin. readVar :: Term Var String -> Script ()-readVar v = add $ Cmd $ "read " <> getQ (quote (getName v))+readVar v = add $ newCmd $ "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 -- such command. stopOnFailure :: Bool -> Script ()-stopOnFailure b = add $ Cmd $ "set " <> (if b then "-" else "+") <> "e"+stopOnFailure b = add $ raw $ "set " <> (if b then "-" else "+") <> "e"  -- | Makes a nonzero exit status be ignored. ignoreFailure :: Script () -> Script () ignoreFailure s = runM s >>= mapM_ (add . go)   where-	go c@(Cmd _) = Or c true+	go c@(Cmd _ _ _) = Or c true+	go c@(Raw _ _) = Or c true 	go c@(Comment _) = c+	go (EnvWrap i n localenvs e) = EnvWrap i n localenvs (map go e) 	go (Subshell i l) = Subshell i (map go l)+	go (Group i l) = Group i (map go l) 	-- Assumes pipefail is not set. 	go (Pipe e1 e2) = Pipe e1 (go e2) 	-- Note that in shell, a && b || true will result in true;@@ -881,7 +952,7 @@ 	go (Or e1 e2) = Or e1 (go e2) 	go (Redir e r) = Redir (go e) r -	true = Cmd "true"+	true = raw "true"  -- | Pipes together two Scripts. (-|-) :: Script () -> Script () -> Script ()@@ -978,7 +1049,7 @@ -- -- > ifCmd (test (FileExists "foo")) (foo, bar) test :: Test -> Script ()-test t = Script $ \env -> ([Cmd $ "test " <> mkTest env t], env, ())+test t = Script $ \env -> ([newCmd $ "test " <> mkTest env t], env, ())  mkTest :: Env -> Test -> L.Text mkTest env = go

@@ -7,3 +7,11 @@ * Allow: test (n `TEqual` 42)    Perhaps by making Test an instance of Num?++* globalVar and withEnv take a Text name of the variable, and if it's not a+  legal shell variable name, can generate broken shell code.++* The EnvWrap and Raw constructors are an ugly hack around Expr not+  containing an AST for shell scripts. withEnv needs them to determine+  which way to set the local environment variable. An AST would improve+  the internals.

@@ -10,8 +10,3 @@ 	cmd "echo" "hello, world" 	username <- newVarFrom (Output (cmd "whoami")) () 	cmd "echo" "from" (WithVar username (<> "'s shell"))--	v <- globalVar "SOMEVAR"-	ifCmd (test $ TStrEqual v "")-		(cmd "echo" "Bad")-		(cmd "echo" "Good")

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