shell-monad 0.0.1 → 0.0.2

raw patch · 5 files changed

+145/−53 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +13/−0
• Control/Monad/Shell.hs +97/−19
• examples/santa.hs +32/−0
• santa.hs +0/−32
• shell-monad.cabal +3/−2

@@ -0,0 +1,13 @@+shell-monad (0.0.2) unstable; urgency=medium++  * Better constructing of pipes.+  * Added whileCmd, ifCmd, whenCmd, and unlessCmd.+  * Added stopOnFailure and ignoreFailure.++ -- Joey Hess <id@joeyh.name>  Thu, 25 Dec 2014 01:11:34 -0400++shell-monad (0.0.1) unstable; urgency=medium++  * First release.++ -- Joey Hess <id@joeyh.name>  Wed, 24 Dec 2014 19:23:44 -0400

@@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}  module Control.Monad.Shell ( 	Script,@@ -10,6 +11,8 @@ 	linearScript, 	Var, 	val,+	Q,+	quote, 	Expr, 	indent, 	run,@@ -20,15 +23,21 @@ 	newVarContaining, 	globalVar, 	func,+	(-|-), 	forCmd,-	quote,+	whileCmd,+	ifCmd,+	whenCmd,+	unlessCmd, 	readVar,-	(-|-),+	stopOnFailure,+	ignoreFailure, ) where  import qualified Data.Text.Lazy as L import qualified Data.Set as S import Data.Monoid+import Control.Applicative import Data.Char  -- | A shell variable.@@ -81,6 +90,7 @@  -- | Shell script monad. newtype Script a = Script (Env -> ([Expr], Env, a))+	deriving (Functor)  instance Monad Script where         return ret = Script $ \env -> ([], env, ret)@@ -158,7 +168,7 @@ -- | Variadic argument version of 'run'. -- -- The command can be passed any number of arguments.--- As well as passing Text arguments, it also accepts Var arguments,+-- As well as passing Text and Q arguments, it also accepts Var arguments, -- which passes the value of a shell variable to the command. -- -- Convenient usage of 'cmd' requires the following:@@ -166,7 +176,7 @@ -- > {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-} -- > {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- > import Control.Monad.Shell--- > import qualified Data.Text.Lazy as T+-- > import qualified Data.Text.Lazy as L -- > default (L.Text) -- -- This allows writing, for example:@@ -250,7 +260,7 @@ 	    (ls, env'') = eval env' s 	in (definefunc f ls, env'', callfunc f)   where-	basename = "f"+	basename = "p" 	go env x 		| S.member f (envFuncs env) = go env (succ x) 		| otherwise = f@@ -262,6 +272,16 @@ 	callfunc :: Func -> Script () 	callfunc (Func f) = add $ Cmd f +-- | Pipes together two Scripts.+(-|-) :: Script () -> Script () -> Script ()+a -|- b = do+	alines <- runM a+	blines <- runM b+	add $ Pipe (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) --@@ -269,23 +289,81 @@ forCmd :: Script () -> (Var -> Script ()) -> Script () forCmd c a = do 	v@(Var vname) <- newVar "x"-	cmdlines <- runM c-	add $ Cmd $ "for " <> vname <> " in $(" <> toLinearScript cmdlines <> ")"-	-- Using : as the first command in the loop ensures that the loop-	-- body is not empty, and allows for more regular indentation.-	add $ Cmd "do :"-	mapM_ (add . indent) =<< runM (a v)+	s <- toLinearScript <$> runM c+	add $ Cmd $ "for " <> vname <> " in $(" <> s <> ")"+	block "do" (a v) 	add $ Cmd "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 <> ")"+	block "do" a+	add $ Cmd "done"++-- | if with a monadic conditional+--+-- If the conditional exits 0, the first action is run, else the second.+ifCmd :: Script () -> Script () -> Script () -> Script ()+ifCmd cond thena elsea = +	ifCmd' id cond $ do+		block "then" thena+		block "else" elsea++ifCmd' :: (L.Text -> L.Text) -> Script () -> Script () -> Script ()+ifCmd' condf cond body = do+	condl <- runM cond+	add $ Cmd $ "if " <> condf (singleline condl)+	body+	add $ Cmd "fi"+  where+	singleline l =+		let c = case l of+			[c'@(Cmd {})] -> c'+			[c'@(Subshell {})] -> c'+			_ -> Subshell L.empty l+		in toLinearScript [c]++-- | when with a monadic conditional+whenCmd :: Script () -> Script () -> Script ()+whenCmd cond a = +	ifCmd' id cond $+		block "then" a++-- | unless with a monadic conditional+unlessCmd :: Script () -> Script () -> Script ()+unlessCmd cond a =+	ifCmd' ("! " <>) cond $+		block "then" a++-- | Creates a block such as "do : ; cmd ; cmd" or "else : ; cmd ; cmd"+--+-- The use of : ensures that the block is not empty, and allows+-- for more regular indetnetion, as well as making the single line+-- formatting work.+block :: L.Text -> Script () -> Script ()+block word s = do+	add $ Cmd $ word <> " :"+	mapM_ (add . indent) =<< runM s+ -- | Generates shell code to read a variable from stdin. readVar :: Var -> Script () readVar (Var vname) = add $ Cmd $ "read " <> getQ (quote vname) --- | Pipes together two Scripts.-(-|-) :: Script () -> Script () -> Script ()-a -|- b = do-	alines <- runM a-	blines <- runM b-	add $ case (alines, blines) of-		([ca@(Cmd{})], [cb@(Cmd{})]) -> Pipe ca cb-		_ -> Pipe (Subshell L.empty alines) (Subshell L.empty blines)+-- | 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 "+" <> "x"++-- | Makes a nonzero exit status be ignored.+ignoreFailure :: Script () -> Script ()+ignoreFailure s = runM s >>= mapM_ (add . go)+  where+	go (Cmd t) = Cmd $ t <> " || 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)

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+import Control.Monad.Shell+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as T+import Data.Monoid+default (T.Text)++main :: IO ()+main = T.writeFile "santa.sh" $ script $ do+	hohoho <- func $+		cmd "echo" "Ho, ho, ho!" "Merry xmas!"+	hohoho++	promptFor "What's your name?" $ \name -> pipeLess $ do+		cmd "echo" "Let's see what's in" (val name <> quote "'s") "stocking!"+		forCmd (cmd "ls" "-1" (quote "/home/" <> val name)) $ \f -> do+			cmd "echo" "a shiny new" f+			hohoho++	cmd "rm" "/table/cookies" "/table/milk"+	hohoho++pipeLess :: Script () -> Script ()+pipeLess c = c -|- cmd "less"++promptFor :: T.Text -> (Var -> Script ()) -> Script ()+promptFor prompt cont = do+	cmd "printf" (prompt <> " ")+	var <- newVar "prompt"+	readVar var+	cont var

@@ -1,32 +0,0 @@-{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}-import Control.Monad.Shell-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T-import Data.Monoid-default (T.Text)--main :: IO ()-main = T.writeFile "santa.sh" $ script $ do-	hohoho <- func $-		cmd "echo" "Ho, ho, ho!" "Merry xmas!"-	hohoho--	promptFor "What's your name?" $ \name -> pipeLess $ do-		cmd "echo" "Let's see what's in" (val name <> quote "'s") "stocking!"-		forCmd (cmd "ls" "-1" (quote "/home/" <> val name)) $ \f -> do-			cmd "echo" "a shiny new" f-			hohoho--	cmd "rm" "/table/cookies" "/table/milk"-	hohoho--pipeLess :: Script () -> Script ()-pipeLess c = c -|- cmd "less"--promptFor :: T.Text -> (Var -> Script ()) -> Script ()-promptFor prompt cont = do-	cmd "printf" (prompt <> " ")-	var <- newVar "prompt"-	readVar var-	cont var

@@ -1,5 +1,5 @@ Name: shell-monad-Version: 0.0.1+Version: 0.0.2 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -13,7 +13,8 @@ Description:  This is a shell monad, for generating shell scripts. Extra-Source-Files:-  santa.hs+  CHANGELOG+  examples/santa.hs  Library   GHC-Options: -Wall