shell-monad 0.1.0 → 0.2.0

raw patch · 4 files changed

+108/−38 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +10/−2
• Control/Monad/Shell.hs +94/−32
• examples/santa.hs +3/−3
• shell-monad.cabal +1/−1

@@ -1,10 +1,18 @@-shell-monad (0.1.0) UNRELEASED; urgency=medium+shell-monad (0.2.0) unstable; urgency=medium +  * newVar, newVarContaining, takeParameter, and func all+    now take a namehint parameter, which can be () or (NameHinted "foo").+  * Added -&&- and -||-++ -- Joey Hess <id@joeyh.name>  Thu, 25 Dec 2014 20:19:35 -0400++shell-monad (0.1.0) unstable; urgency=medium+   * Added positionalParameters and takeParameter.   * Shell functions can be called with parameters.   * String is now an instance of CmdArg - -- Joey Hess <id@joeyh.name>  Thu, 25 Dec 2014 12:17:23 -0400+ -- Joey Hess <id@joeyh.name>  Thu, 25 Dec 2014 13:04:35 -0400  shell-monad (0.0.3) unstable; urgency=medium 

@@ -20,6 +20,8 @@ 	Output(..), 	Val(..), 	comment,+	NamedLike(..),+	NameHinted, 	newVar, 	newVarContaining, 	globalVar,@@ -27,6 +29,8 @@ 	takeParameter, 	func, 	(-|-),+	(-&&-),+	(-||-), 	forCmd, 	whileCmd, 	ifCmd,@@ -78,6 +82,8 @@ 	| 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 -- ^ ||  -- | Indents an Expr indent :: Expr -> Expr@@ -86,6 +92,8 @@ 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 (And e1 e2) = And (indent e1) (indent e2)+indent (Or e1 e2) = Or (indent e1) (indent e2)  -- | Shell script monad. newtype Script a = Script (Env -> ([Expr], Env, a))@@ -144,6 +152,8 @@ 	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  -- | Generates a single line of shell code. linearScript :: Script f -> L.Text@@ -159,6 +169,8 @@ 	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  -- | Adds a shell command to the script. run :: L.Text -> [L.Text] -> Script ()@@ -244,31 +256,52 @@ comment :: L.Text -> Script () comment = add . Comment +-- | Suggests that a shell variable or function have its name contain+-- the specified Text.+newtype NamedLike = NamedLike L.Text++-- | Class of values that provide a hint for the name to use for a shell+-- variable or function.+--+-- To skip providing a hint, use '()'.+-- To provide a hint, use '(NamedLike \"name\")'.+class NameHinted h where+	hinted :: (Maybe L.Text -> a) -> h -> a++instance NameHinted () where+	hinted f _ = f Nothing++instance NameHinted NamedLike where+	hinted f (NamedLike h) = f (Just h)++instance NameHinted (Maybe L.Text) where+	hinted = id+ -- | Defines a new shell variable. ----- The name of the variable that appears in the shell script will be based--- on provided name (which can be mempty), but each call to newVar will--- generate a new, unique variable name.-newVar-	:: L.Text -- ^ base of variable name-	-> Script Var-newVar basename = Script $ \env ->-	let v = go env (0 :: Integer)+-- 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) => namehint -> Script Var+newVar = hinted $ \namehint -> Script $ \env ->+	let v = go namehint env (0 :: Integer) 	in ([], modifyEnvVars env (S.insert v), v)   where-	go env x-		| S.member v (envVars env) = go env (succ x)+	go namehint env x+		| S.member v (envVars env) = go namehint env (succ x) 		| otherwise = v 	  where-		v = Var $ "_" <> basename <> L.pack (show (x + 1))+		v = Var $ "_"+			<> genvarname namehint+			<> if x == 0 then "" else L.pack (show (x + 1))+	+	genvarname = maybe "v" (L.filter isAlpha)  -- | Creates a new shell variable, with an initial value.-newVarContaining-	:: L.Text -- ^ base of variable name-	-> L.Text -- ^ value-	-> Script Var-newVarContaining basename value = do-	v@(Var name) <- newVar basename+newVarContaining :: (NameHinted namehint) => L.Text -> namehint -> Script Var+newVarContaining value = hinted $ \namehint -> do+	v@(Var name) <- newVar namehint 	Script $ \env -> ([Cmd (name <> "=" <> getQ (quote value))], env, v)  -- | Gets a Var that refers to a global variable, such as PATH@@ -297,9 +330,9 @@ -- > removefirstfile = script $ do -- >   cmd "rm" =<< takeParameter -- >   cmd "echo" "remaining parameters:" positionalParameters-takeParameter :: Script Var-takeParameter = do-	p@(Var name) <- newVar "param"+takeParameter :: (NameHinted namehint) => namehint -> Script Var+takeParameter = hinted $ \namehint -> do+	p@(Var name) <- newVar namehint 	Script $ \env -> ([Cmd (name <> "=\"$1\""), Cmd "shift"], env, p)  -- | Defines a shell function, and returns an action that can be run to@@ -309,6 +342,11 @@ -- Typically, it will make sense to specify a more concrete type -- when defining the shell function. --+-- The shell function will be given a unique name, that is not used by any+-- other shell function. The namehint can be used to influence the contents+-- of the function name, which makes for more readable generated shell+-- code.+-- -- For example: -- -- > demo = script $ do@@ -318,23 +356,30 @@ -- >    hohoho (Val 3) -- >  -- > mkHohoho :: Script (Val Int -> Script ())--- > mkHohoho = func $ do+-- > mkHohoho = func (NamedLike "hohoho") $ do -- >    num <- takeParameter -- >    forCmd (cmd "seq" "1" num) $ \_n -> -- >       cmd "echo" "Ho, ho, ho!" "Merry xmas!"-func :: ShellCmd callfunc => Script () -> Script callfunc-func s = Script $ \env ->-	let f = go env (0 :: Integer)+func+	:: (NameHinted namehint, ShellCmd 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 	in (definefunc f ls, env'', callfunc f)   where-	basename = "p"-	go env x-		| S.member f (envFuncs env) = go env (succ x)+	go basename env x+		| S.member f (envFuncs env) = go basename env (succ x) 		| otherwise = f 	  where-		f = Func $ basename <> L.pack (show (x + 1))+		f = Func $ "_"+			<> basename+			<> if x == 0 then "" else L.pack (show (x + 1))+	+	genfuncname = maybe "p" (L.filter isAlpha)  	definefunc (Func f) ls = (Cmd $ f <> " () { :") : map indent ls ++ [ Cmd "}" ] @@ -342,10 +387,21 @@  -- | Pipes together two Scripts. (-|-) :: Script () -> Script () -> Script ()-a -|- b = do+(-|-) = 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 $ Pipe (toExp alines) (toExp blines)+	add $ f (toExp alines) (toExp blines)   where 	toExp [e] = e 	toExp l = Subshell L.empty l@@ -356,7 +412,7 @@ -- The action is run for each part, passed a Var containing the part. forCmd :: Script () -> (Var -> Script ()) -> Script () forCmd c a = do-	v@(Var vname) <- newVar "x"+	v@(Var vname) <- newVar (NamedLike "x") 	s <- toLinearScript <$> runM c 	add $ Cmd $ "for " <> vname <> " in $(" <> s <> ")" 	block "do" (a v)@@ -429,9 +485,15 @@ ignoreFailure :: Script () -> Script () ignoreFailure s = runM s >>= mapM_ (add . go)   where-	go (Cmd t) = Cmd $ t <> " || true"+	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)+	-- Note that in shell, a && b || true will result in true;+	-- there is no need for extra parens.+	go c@(And _ _) = Or c true+	go (Or e1 e2) = Or e1 (go e2)++	true = Cmd "true"

@@ -21,8 +21,8 @@ 	hohoho (Val 3)  mkHohoho :: Script (Val Int -> Script ())-mkHohoho = func $ do-	num <- takeParameter+mkHohoho = func (NamedLike "hohoho") $ do+	num <- takeParameter (NamedLike "num") 	forCmd (cmd "seq" "1" num) $ \_n -> 		cmd "echo" "Ho, ho, ho!" "Merry xmas!" @@ -32,6 +32,6 @@ promptFor :: T.Text -> (Var -> Script ()) -> Script () promptFor prompt cont = do 	cmd "printf" (prompt <> " ")-	var <- newVar "prompt"+	var <- newVar (NamedLike prompt) 	readVar var 	cont var

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