{-# OPTIONS_GHC -XFlexibleInstances -XTypeSynonymInstances -XStandaloneDeriving #-}{- Commands for HSH
Copyright (C) 2004-2008 John Goerzen <jgoerzen@complete.org>
Please see the COPYRIGHT file
-}{- |
Module : HSH.Command
Copyright : Copyright (C) 2006-2009 John Goerzen
License : GNU LGPL, version 2.1 or above
Maintainer : John Goerzen <jgoerzen@complete.org>
Stability : provisional
Portability: portable
Copyright (c) 2006-2009 John Goerzen, jgoerzen\@complete.org
-}moduleHSH.Command(Environment,ShellCommand(..),PipeCommand(..),(-|-),RunResult,run,runIO,runSL,InvokeResult,checkResults,tryEC,catchEC,setenv,unsetenv)where-- import System.IO.HVIO-- import System.IO.UtilsimportPreludehiding(catch)importSystem.IOimportSystem.ExitimportSystem.Log.LoggerimportSystem.IO.Errorhiding(catch)importData.Maybe.UtilsimportData.MaybeimportData.List.Utils(uniq)importControl.Exception(try,evaluate,SomeException,catch)importText.Regex.PosiximportControl.Monad(when)importData.String.Utils(rstrip)importControl.ConcurrentimportSystem.ProcessimportSystem.Environment(getEnvironment)importqualifiedData.ByteString.LazyasBSLimportqualifiedData.ByteStringasBSimportHSH.Channeld,dr::String->IO()d=debugM"HSH.Command"dr=debugM"HSH.Command.Run"em=errorM"HSH.Command"{- | Result type for shell commands. The String is the text description of
the command, not its output. -}typeInvokeResult=(String,IOExitCode){- | Type for the environment. -}typeEnvironment=Maybe[(String,String)]{- | A shell command is something we can invoke, pipe to, pipe from,
or pipe in both directions. All commands that can be run as shell
commands must define these methods.
Minimum implementation is 'fdInvoke'.
Some pre-defined instances include:
* A simple bare string, which is passed to the shell for execution. The shell
will then typically expand wildcards, parse parameters, etc.
* A @(String, [String])@ tuple. The first item in the tuple gives
the name of a program to run, and the second gives its arguments.
The shell is never involved. This is ideal for passing filenames,
since there is no security risk involving special shell characters.
* A @Handle -> Handle -> IO ()@ function, which reads from the first
handle and write to the second.
* Various functions. These functions will accept input representing
its standard input and output will go to standard output.
Some pre-defined instance functions include:
* @(String -> String)@, @(String -> IO String)@, plus the same definitions
for ByteStrings.
* @([String] -> [String])@, @([String] -> IO [String])@, where each @String@
in the list represents a single line
* @(() -> String)@, @(() -> IO String)@, for commands that explicitly
read no input. Useful with closures. Useful when you want to avoid
reading stdin because something else already is. These have the unit as
part of the function because otherwise we would have conflicts with things
such as bare Strings, which represent a command name.
-}class(Showa)=>ShellCommandawhere{- | Invoke a command. -}fdInvoke::a-- ^ The command->Environment-- ^ The environment->Channel-- ^ Where to read input from->IO(Channel,[InvokeResult])-- ^ Returns an action that, when evaluated, waits for the process to finish and returns an exit code.instanceShow(Handle->Handle->IO())whereshow_="(Handle -> Handle -> IO ())"instanceShow(Channel->IOChannel)whereshow_="(Channel -> IO Channel)"instanceShow(String->String)whereshow_="(String -> String)"instanceShow(()->String)whereshow_="(() -> String)"instanceShow(String->IOString)whereshow_="(String -> IO String)"instanceShow(()->IOString)whereshow_="(() -> IO String)"instanceShow(BSL.ByteString->BSL.ByteString)whereshow_="(Data.ByteString.Lazy.ByteString -> Data.ByteString.Lazy.ByteString)"instanceShow(()->BSL.ByteString)whereshow_="(() -> Data.ByteString.Lazy.ByteString)"instanceShow(BSL.ByteString->IOBSL.ByteString)whereshow_="(Data.ByteString.Lazy.ByteString -> IO Data.ByteString.Lazy.ByteString)"instanceShow(()->IOBSL.ByteString)whereshow_="(() -> IO BSL.ByteString)"instanceShow(BS.ByteString->BS.ByteString)whereshow_="(Data.ByteString.ByteString -> Data.ByteString.ByteString)"instanceShow(()->BS.ByteString)whereshow_="(() -> Data.ByteString.ByteString)"instanceShow(BS.ByteString->IOBS.ByteString)whereshow_="(Data.ByteString.ByteString -> IO Data.ByteString.ByteString)"instanceShow(()->IOBS.ByteString)whereshow_="(() -> IO Data.ByteString.ByteString)"instanceShellCommand(String->IOString)wherefdInvoke=genericStringlikeIOchanAsString{- | A user function that takes no input, and generates output. We will deal
with it using hPutStr to send the output on. -}instanceShellCommand(()->IOString)wherefdInvoke=genericStringlikeOinstanceShellCommand(BSL.ByteString->IOBSL.ByteString)wherefdInvoke=genericStringlikeIOchanAsBSLinstanceShellCommand(()->IOBSL.ByteString)wherefdInvoke=genericStringlikeOinstanceShellCommand(BS.ByteString->IOBS.ByteString)wherefdInvoke=genericStringlikeIOchanAsBSinstanceShellCommand(()->IOBS.ByteString)wherefdInvoke=genericStringlikeO{- | An instance of 'ShellCommand' for a pure Haskell function mapping
String to String. Implement in terms of (String -> IO String) for
simplicity. -}instanceShellCommand(String->String)wherefdInvokefunc=fdInvokeiofuncwhereiofunc::String->IOStringiofunc=return.funcinstanceShellCommand(()->String)wherefdInvokefunc=fdInvokeiofuncwhereiofunc::()->IOStringiofunc=return.funcinstanceShellCommand(BSL.ByteString->BSL.ByteString)wherefdInvokefunc=fdInvokeiofuncwhereiofunc::BSL.ByteString->IOBSL.ByteStringiofunc=return.funcinstanceShellCommand(()->BSL.ByteString)wherefdInvokefunc=fdInvokeiofuncwhereiofunc::()->IOBSL.ByteStringiofunc=return.funcinstanceShellCommand(BS.ByteString->BS.ByteString)wherefdInvokefunc=fdInvokeiofuncwhereiofunc::BS.ByteString->IOBS.ByteStringiofunc=return.funcinstanceShellCommand(()->BS.ByteString)wherefdInvokefunc=fdInvokeiofuncwhereiofunc::()->IOBS.ByteStringiofunc=return.funcinstanceShellCommand(Channel->IOChannel)wherefdInvokefunc_cstdin=runInHandler(showfunc)(funccstdin){-
instance ShellCommand (Handle -> Handle -> IO ()) where
fdInvoke func cstdin cstdout =
runInHandler (show func) (func hstdin hstdout)
-}genericStringlikeIO::(Show(a->IOa),Channelizablea)=>(Channel->IOa)->(a->IOa)->Environment->Channel->IO(Channel,[InvokeResult])genericStringlikeIOdechanfuncuserfunc_cstdin=docontents<-dechanfunccstdinrunInHandler(showuserfunc)(realfunccontents)whererealfunccontents=dor<-userfunccontentsreturn(toChannelr)genericStringlikeO::(Show(()->IOa),Channelizablea)=>(()->IOa)->Environment->Channel->IO(Channel,[InvokeResult])genericStringlikeOuserfunc__=runInHandler(showuserfunc)realfuncwhererealfunc::IOChannelrealfunc=dor<-userfunc()return(toChannelr)instanceShow([String]->[String])whereshow_="([String] -> [String])"instanceShow(()->[String])whereshow_="(() -> [String])"instanceShow([String]->IO[String])whereshow_="([String] -> IO [String])"instanceShow(()->IO[String])whereshow_="(() -> IO [String])"{- | An instance of 'ShellCommand' for a pure Haskell function mapping
[String] to [String].
A [String] is generated from a Handle via the 'lines' function, and the
reverse occurs via 'unlines'.
So, this function is intended to operate upon lines of input and produce
lines of output. -}instanceShellCommand([String]->[String])wherefdInvokefunc=fdInvoke(unlines.func.lines)instanceShellCommand(()->[String])wherefdInvokefunc=fdInvoke(unlines.func){- | The same for an IO function -}instanceShellCommand([String]->IO[String])wherefdInvokefunc=fdInvokeiofuncwhereiofuncinput=dor<-func(linesinput)return(unlinesr)instanceShellCommand(()->IO[String])wherefdInvokefunc=fdInvokeiofuncwhereiofunc::(()->IOString)iofunc()=dor<-func()return(unlinesr){- | An instance of 'ShellCommand' for an external command. The
first String is the command to run, and the list of Strings represents the
arguments to the program, if any. -}instanceShellCommand(String,[String])wherefdInvoke(fp,args)=genericCommand(RawCommandfpargs){- | An instance of 'ShellCommand' for an external command. The
String is split using words to the command to run, and the arguments, if any. -}instanceShellCommandStringwherefdInvokecmd=genericCommand(ShellCommandcmd){- | How to we handle and external command. -}genericCommand::CmdSpec->Environment->Channel->IO(Channel,[InvokeResult])-- Handling external command when stdin channel is a HandlegenericCommandcenviron(ChanHandleih)=letcp=CreateProcess{cmdspec=c,cwd=Nothing,env=environ,std_in=UseHandleih,std_out=CreatePipe,std_err=Inherit,close_fds=True#if MIN_VERSION_process(1,1,0)-- Or use GHC version as a proxy: __GLASGOW_HASKELL__ >= 720-- Added field in process 1.1.0.0:,create_group=False#endif}indo(_,oh',_,ph)<-createProcesscpletoh=fromJustoh'return(ChanHandleoh,[(printCmdSpecc,waitForProcessph)])genericCommandcspecenvironichan=letcp=CreateProcess{cmdspec=cspec,cwd=Nothing,env=environ,std_in=CreatePipe,std_out=CreatePipe,std_err=Inherit,close_fds=True#if MIN_VERSION_process(1,1,0)-- Added field in process 1.1.0.0:,create_group=False#endif}indo(ih',oh',_,ph)<-createProcesscpletih=fromJustih'letoh=fromJustoh'chanToHandleTrueichanihreturn(ChanHandleoh,[(printCmdSpeccspec,waitForProcessph)])printCmdSpec::CmdSpec->StringprintCmdSpec(ShellCommands)=sprintCmdSpec(RawCommandfpargs)=show(fp,args)-------------------------------------------------------------- Pipes------------------------------------------------------------dataPipeCommandab=(ShellCommanda,ShellCommandb)=>PipeCommandabderivinginstanceShow(PipeCommandab){- | An instance of 'ShellCommand' represeting a pipeline. -}instance(ShellCommanda,ShellCommandb)=>ShellCommand(PipeCommandab)wherefdInvoke(PipeCommandcmd1cmd2)envichan=do(chan1,res1)<-fdInvokecmd1envichan(chan2,res2)<-fdInvokecmd2envchan1return(chan2,res1++res2){- | Pipe the output of the first command into the input of the second. -}(-|-)::(ShellCommanda,ShellCommandb)=>a->b->PipeCommandab(-|-)=PipeCommand{- | Different ways to get data from 'run'.
* IO () runs, throws an exception on error, and sends stdout to stdout
* IO String runs, throws an exception on error, reads stdout into
a buffer, and returns it as a string. Note: This output is not lazy.
* IO [String] is same as IO String, but returns the results as lines.
Note: this output is not lazy.
* IO ExitCode runs and returns an ExitCode with the exit
information. stdout is sent to stdout. Exceptions are not thrown.
* IO (String, ExitCode) is like IO ExitCode, but also
includes a description of the last command in the pipe to have
an error (or the last command, if there was no error).
* IO ByteString and are similar to their String counterparts.
* IO (String, IO (String, ExitCode)) returns a String read lazily
and an IO action that, when evaluated, finishes up the process and
results in its exit status. This command returns immediately.
* IO (IO (String, ExitCode)) sends stdout to stdout but returns
immediately. It forks off the child but does not wait for it to finish.
You can use 'checkResults' to wait for the finish.
* IO Int returns the exit code from a program directly. If a signal
caused the command to be reaped, returns 128 + SIGNUM.
* IO Bool returns True if the program exited normally (exit code 0,
not stopped by a signal) and False otherwise.
To address insufficient laziness, you can process anything that needs to be
processed lazily within the pipeline itself.
-}classRunResultawhere{- | Runs a command (or pipe of commands), with results presented
in any number of different ways. -}run::(ShellCommandb)=>b->ainstanceRunResult(IO())whereruncmd=runcmd>>=checkResultsinstanceRunResult(IO(String,ExitCode))whereruncmd=do(ochan,r)<-fdInvokecmdNothing(ChanHandlestdin)chanToHandleFalseochanstdoutprocessResultsrinstanceRunResult(IOExitCode)whereruncmd=((runcmd)::IO(String,ExitCode))>>=return.sndinstanceRunResult(IOInt)whereruncmd=dorc<-runcmdcasercofExitSuccess->return0ExitFailurex->returnxinstanceRunResult(IOBool)whereruncmd=dorc<-runcmdreturn((rc::Int)==0)instanceRunResult(IO[String])whereruncmd=dor<-runcmdreturn(linesr)instanceRunResult(IOString)whereruncmd=genericStringlikeResultchanAsString(\c->evaluate(lengthc))cmdinstanceRunResult(IOBSL.ByteString)whereruncmd=genericStringlikeResultchanAsBSL(\c->evaluate(BSL.lengthc))cmdinstanceRunResult(IOBS.ByteString)whereruncmd=genericStringlikeResultchanAsBS(\c->evaluate(BS.lengthc))cmdinstanceRunResult(IO(String,IO(String,ExitCode)))whereruncmd=intermediateStringlikeResultchanAsStringcmdinstanceRunResult(IO(BSL.ByteString,IO(String,ExitCode)))whereruncmd=intermediateStringlikeResultchanAsBSLcmdinstanceRunResult(IO(BS.ByteString,IO(String,ExitCode)))whereruncmd=intermediateStringlikeResultchanAsBScmdinstanceRunResult(IO(IO(String,ExitCode)))whereruncmd=do(ochan,r)<-fdInvokecmdNothing(ChanHandlestdin)chanToHandleFalseochanstdoutreturn(processResultsr)intermediateStringlikeResult::ShellCommandb=>(Channel->IOa)->b->IO(a,IO(String,ExitCode))intermediateStringlikeResultchanfunccmd=do(ochan,r)<-fdInvokecmdNothing(ChanHandlestdin)c<-chanfuncochanreturn(c,processResultsr)genericStringlikeResult::ShellCommandb=>(Channel->IOa)->(a->IOc)->b->IOagenericStringlikeResultchanfuncevalfunccmd=do(c,r)<-intermediateStringlikeResultchanfunccmdevalfuncc--evaluate (length c)-- d "runS 6"-- d "runS 7"r>>=checkResults-- d "runS 8"returnc{- | Evaluates the result codes and returns an overall status -}processResults::[InvokeResult]->IO(String,ExitCode)processResultsr=dorc<-mapMprocresultrcasecatMaybesrcof[]->return(fst(lastr),ExitSuccess)x->return(lastx)whereprocresult::InvokeResult->IO(Maybe(String,ExitCode))procresult(cmd,action)=dorc<-actionreturn$casercofExitSuccess->Nothingx->Just(cmd,x){- | Evaluates result codes and raises an error for any bad ones it finds. -}checkResults::(String,ExitCode)->IO()checkResults(cmd,ps)=casepsofExitSuccess->return()ExitFailurex->fail$cmd++": exited with code "++showx{- FIXME: generate these again
Terminated sig ->
fail $ cmd ++ ": terminated by signal " ++ show sig
Stopped sig ->
fail $ cmd ++ ": stopped by signal " ++ show sig
-}{- | Handle an exception derived from a program exiting abnormally -}tryEC::IOa->IO(EitherExitCodea)tryECaction=dor<-tryactioncaserofLeftioe->ifisUserErrorioethencase(ioeGetErrorStringioe=~~pat)ofNothing->ioErrorioe-- not ours; re-raise itJuste->return.Left.procit$eelseioErrorioe-- not ours; re-raise itRightresult->return(Rightresult)wherepat=": exited with code [0-9]+$|: terminated by signal ([0-9]+)$|: stopped by signal [0-9]+"procit::String->ExitCodeprocite|e=~"^: exited"=ExitFailure(str2ece)-- | e =~ "^: terminated by signal" = Terminated (str2ec e)-- | e =~ "^: stopped by signal" = Stopped (str2ec e)|otherwise=error"Internal error in tryEC"str2ece=read(e=~"[0-9]+$"){- | Catch an exception derived from a program exiting abnormally -}catchEC::IOa->(ExitCode->IOa)->IOacatchECactionhandler=dor<-tryECactioncaserofLeftec->handlerecRightresult->returnresult{- | A convenience function. Refers only to the version of 'run'
that returns @IO ()@. This prevents you from having to cast to it
all the time when you do not care about the result of 'run'.
The implementation is simply:
>runIO :: (ShellCommand a) => a -> IO ()
>runIO = run
-}runIO::(ShellCommanda)=>a->IO()runIO=run{- | Another convenience function. This returns the first line of the output,
with any trailing newlines or whitespace stripped off. No leading whitespace
is stripped. This function will raise an exception if there is not at least
one line of output. Mnemonic: runSL means \"run single line\".
This command exists separately from 'run' because there is already a
'run' instance that returns a String, though that instance returns the
entirety of the output in that String. -}runSL::(ShellCommanda)=>a->IOStringrunSLcmd=dor<-runcmdwhen(r==[])$fail$"runSL: no output received from "++showcmdreturn(rstrip.head$r){- | Convenience function to wrap a child thread. Kicks off the thread, handles
running the code, traps execptions, the works.
Note that if func is lazy, such as a getContents sort of thing,
the exception may go uncaught here.
NOTE: expects func to be lazy!
-}runInHandler::String-- ^ Description of this function->(IOChannel)-- ^ The action to run in the thread->IO(Channel,[InvokeResult])runInHandlerdescripfunc=catch(realfunc)(exchandler)whererealfunc=dor<-funcreturn(r,[(descrip,returnExitSuccess)])exchandler::SomeException->IO(Channel,[InvokeResult])exchandlere=doem$"runInHandler/"++descrip++": "++showereturn(ChanString"",[(descrip,return(ExitFailure1))])-------------------------------------------------------------- Environment------------------------------------------------------------{- | An environment variable filter function.
This is a low-level interface; see 'setenv' and 'unsetenv' for more convenient
interfaces. -}typeEnvironFilter=[(String,String)]->[(String,String)]instanceShowEnvironFilterwhereshow_="EnvironFilter"{- | A command that carries environment variable information with it.
This is a low-level interface; see 'setenv' and 'unsetenv' for more
convenient interfaces. -}dataEnvironCommanda=(ShellCommanda)=>EnvironCommandEnvironFilteraderivinginstanceShow(EnvironCommanda)instance(ShellCommanda)=>ShellCommand(EnvironCommanda)wherefdInvoke(EnvironCommandefiltercmd)Nothingichan=do-- No incoming environment; initialize from system default.e<-getEnvironmentfdInvokecmd(Just(efiltere))ichanfdInvoke(EnvironCommandefiltercmd)(Justienv)ichan=fdInvokecmd(Just(efilterienv))ichan{- | Sets an environment variable, replacing an existing one if it exists.
Here's a sample ghci session to illustrate. First, let's see the defaults for
some variables:
> Prelude HSH> runIO $ "echo $TERM, $LANG"
> xterm, en_US.UTF-8
Now, let's set one:
> Prelude HSH> runIO $ setenv [("TERM", "foo")] $ "echo $TERM, $LANG"
> foo, en_US.UTF-8
Or two:
> Prelude HSH> runIO $ setenv [("TERM", "foo")] $ setenv [("LANG", "de_DE.UTF-8")] $ "echo $TERM, $LANG"
> foo, de_DE.UTF-8
We could also do it easier, like this:
> Prelude HSH> runIO $ setenv [("TERM", "foo"), ("LANG", "de_DE.UTF-8")] $ "echo $TERM, $LANG"
> foo, de_DE.UTF-8
It can be combined with unsetenv:
> Prelude HSH> runIO $ setenv [("TERM", "foo")] $ unsetenv ["LANG"] $ "echo $TERM, $LANG"
> foo,
And used with pipes:
> Prelude HSH> runIO $ setenv [("TERM", "foo")] $ "echo $TERM, $LANG" -|- "tr a-z A-Z"
> FOO, EN_US.UTF-8
See also 'unsetenv'.
-}setenv::(ShellCommandcmd)=>[(String,String)]->cmd->EnvironCommandcmdsetenvitemscmd=EnvironCommandefiltercmdwhereefilterienv=foldrefilter'ienvitemsefilter'(key,val)ienv=(key,val):(filter(\(k,_)->k/=key)ienv){- | Removes an environment variable if it exists; does nothing otherwise.
See also 'setenv', which has a more extensive example.
-}unsetenv::(ShellCommandcmd)=>[String]->cmd->EnvironCommandcmdunsetenvkeyscmd=EnvironCommandefiltercmdwhereefilterienv=foldrefilter'ienvkeysefilter'key=filter(\(k,_)->k/=key)