{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings,
MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, TypeFamilies, IncoherentInstances #-}{-# LANGUAGE CPP #-}-- | A module for shell-like / perl-like programming in Haskell.-- Shelly's focus is entirely on ease of use for those coming from shell scripting.-- However, it also tries to use modern libraries and techniques to keep things efficient.---- The functionality provided by-- this module is (unlike standard Haskell filesystem functionality)-- thread-safe: each ShIO maintains its own environment and its own working-- directory.---- I highly recommend putting the following at the top of your program,-- otherwise you will likely need either type annotations or type conversions---- > {-# LANGUAGE OverloadedStrings #-}-- > {-# LANGUAGE ExtendedDefaultRules #-}-- > {-# OPTIONS_GHC -fno-warn-type-defaults #-}-- > import Data.Text.Lazy as LT-- > default (LT.Text)moduleShelly(-- * Entering ShIO.ShIO,shelly,sub,silently,verbosely,escaping,print_stdout,print_commands-- * Running external commands.,run,run_,cmd,(-|-),lastStderr,setStdin,command,command_,command1,command1_,sshPairs,sshPairs_-- , Sudo(..), run_sudo-- * Modifying and querying environment.,setenv,getenv,getenv_def,appendToPath-- * Environment directory,cd,chdir,pwd-- * Printing,echo,echo_n,echo_err,echo_n_err,inspect,tag,trace,show_command-- * Querying filesystem.,ls,ls',test_e,test_f,test_d,test_s,which,find-- * Filename helpers,path,absPath,(</>),(<.>)-- * Manipulating filesystem.,mv,rm_f,rm_rf,cp,cp_r,mkdir,mkdir_p,readfile,writefile,appendfile,withTmpDir-- * Running external commands asynchronously.,jobs,background,getBgResult,BgResult-- * exiting the program,exit,errorExit,terror-- * Utilities.,(<$>),(<$$>),grep,whenM,unlessM,canonic,catchany,catch_sh,catchany_sh,Timing(..),time,RunFailed(..)-- * convert between Text and FilePath,toTextIgnore,toTextWarn,fromText-- * Re-exported for your convenience,liftIO,when,unless,FilePath)where-- TODO:-- shebang runner that puts wrappers in and invokes-- perhaps also adds monadloc-- convenience for commands that use record arguments{-
let oFiles = ("a.o", "b.o")
let ldOutput x = ("-o", x)
let def = LD { output = error "", verbose = False, inputs = [] }
data LD = LD { output :: FilePath, verbose :: Bool, inputs :: [FilePath] } deriving(Data, Typeable)
instance Runnable LD where
run :: LD -> IO ()
class Runnable a where
run :: a -> ShIO Text
let ld = def :: LD
run (ld "foo") { oFiles = [] }
run ld { oFiles = [] }
ld = ..magic..
-}importPreludehiding(catch,readFile,FilePath)importData.List(isInfixOf)importData.Char(isAlphaNum,isSpace)importData.TypeableimportData.IORefimportData.MaybeimportSystem.IOhiding(readFile,FilePath)importSystem.ExitimportSystem.EnvironmentimportControl.ApplicativeimportControl.Exceptionhiding(handle)importControl.Monad.ReaderimportControl.ConcurrentimportqualifiedControl.Concurrent.MSemasSemimportData.Time.Clock(getCurrentTime,diffUTCTime)importqualifiedData.Text.Lazy.IOasTIOimportqualifiedData.Text.IOasSTIOimportSystem.Process(CmdSpec(..),StdStream(CreatePipe),CreateProcess(..),createProcess,waitForProcess,ProcessHandle)importqualifiedData.Text.LazyasLTimportData.Text.Lazy(Text)importqualifiedData.Text.Lazy.BuilderasBimportqualifiedData.TextasTimportData.Monoid(mappend)importFilesystem.Path.CurrentOShiding(concat,fromText,(</>),(<.>))importFilesystemimportqualifiedFilesystem.Path.CurrentOSasFPimportSystem.PosixCompat.Files(getSymbolicLinkStatus,isSymbolicLink)importSystem.Directory(setPermissions,getPermissions,Permissions(..),getTemporaryDirectory,findExecutable){- GHC won't default to Text with this, even with extensions!
- see: http://hackage.haskell.org/trac/ghc/ticket/6030class ShellArgs a where
toTextArgs :: a -> [Text]
instance ShellArgs Text where toTextArgs t = [t]
instance ShellArgs FilePath where toTextArgs t = [toTextIgnore t]
instance ShellArgs [Text] where toTextArgs = id
instance ShellArgs [FilePath] where toTextArgs = map toTextIgnore
instance ShellArgs (Text, Text) where
toTextArgs (t1,t2) = [t1, t2]
instance ShellArgs (FilePath, FilePath) where
toTextArgs (fp1,fp2) = [toTextIgnore fp1, toTextIgnore fp2]
instance ShellArgs (Text, FilePath) where
toTextArgs (t1, fp1) = [t1, toTextIgnore fp1]
instance ShellArgs (FilePath, Text) where
toTextArgs (fp1,t1) = [toTextIgnore fp1, t1]
cmd :: (ShellArgs args) => FilePath -> args -> ShIO Text
cmd fp args = run fp $ toTextArgs args
-}-- | Converter for the variadic argument version of 'run' called 'cmd'.classShellArgawheretoTextArg::a->TextinstanceShellArgTextwheretoTextArg=idinstanceShellArgFilePathwheretoTextArg=toTextIgnore-- Voodoo to create the variadic function 'cmd'classShellCommandtwherecmdAll::FilePath->[Text]->tinstanceShellCommand(ShIOText)wherecmdAllfpargs=runfpargsinstance(s~Text,Shows)=>ShellCommand(ShIOs)wherecmdAllfpargs=runfpargs-- note that ShIO () actually doesn't work for its case (_<- cmd) when there is no type signatureinstanceShellCommand(ShIO())wherecmdAllfpargs=run_fpargs>>liftIO(throwIOCmdError)dataCmdError=CmdErrorderivingTypeableinstanceShowCmdErrorwhereshow(CmdError)="Sorry! You are running up against some of the magic from using the variadic argument function 'cmd'. Please report this issue so we can fix it."instanceExceptionCmdErrorinstance(ShellArgarg,ShellCommandresult)=>ShellCommand(arg->result)wherecmdAllfpacc=\x->cmdAllfp(acc++[toTextArgx])-- | variadic argument version of run.-- The syntax is more convenient but it also allows the use of a FilePath as a command argument.-- So an argument can be a Text or a FilePath.-- a FilePath is converted to Text with 'toTextIgnore'.-- You will need to add the following to your module:---- > {-# LANGUAGE OverloadedStrings #-}-- > {-# LANGUAGE ExtendedDefaultRules #-}-- > {-# OPTIONS_GHC -fno-warn-type-defaults #-}-- > import Shelly-- > import Data.Text.Lazy as LT-- > default (LT.Text)--cmd::(ShellCommandresult)=>FilePath->resultcmdfp=cmdAllfp[]-- | Helper to convert a Text to a FilePath. Used by '(</>)' and '(<.>)'classToFilePathawheretoFilePath::a->FilePathinstanceToFilePathFilePathwheretoFilePath=idinstanceToFilePathTextwheretoFilePath=fromTextinstanceToFilePathT.TextwheretoFilePath=FP.fromTextinstanceToFilePathStringwheretoFilePath=FP.fromText.T.pack-- | uses System.FilePath.CurrentOS, but can automatically convert a Text(</>)::(ToFilePathfilepath1,ToFilePathfilepath2)=>filepath1->filepath2->FilePathx</>y=toFilePathxFP.</>toFilePathy-- | uses System.FilePath.CurrentOS, but can automatically convert a Text(<.>)::(ToFilePathfilepath)=>filepath->Text->FilePathx<.>y=toFilePathxFP.<.>LT.toStricty-- | silently uses the Right or Left value of "Filesystem.Path.CurrentOS.toText"toTextIgnore::FilePath->TexttoTextIgnorefp=LT.fromStrict$casetoTextfpofLeftf->fRightf->ftoTextWarn::FilePath->ShIOTexttoTextWarnefile=fmaplazy$casetoTextefileofLeftf->encodeErrorf>>returnfRightf->returnfwhereencodeErrorf=echo("Invalid encoding for file: "`mappend`lazyf)lazy=LT.fromStrictfromText::Text->FilePathfromText=FP.fromText.LT.toStrictprintGetContent::Handle->Handle->IOTextprintGetContentrHwH=fmapB.toLazyText$printFoldHandleLines(B.fromText"")foldBuilderrHwHgetContent::Handle->IOTextgetContenth=fmapB.toLazyText$foldHandleLines(B.fromText"")foldBuilderhtypeFoldCallbacka=((a,Text)->a)printFoldHandleLines::a->FoldCallbacka->Handle->Handle->IOaprintFoldHandleLinesstartfoldLinereadHandlewriteHandle=gostartwheregoacc=doline<-TIO.hGetLinereadHandleTIO.hPutStrLnwriteHandleline>>go(foldLine(acc,line))`catchany`\_->returnaccfoldHandleLines::a->FoldCallbacka->Handle->IOafoldHandleLinesstartfoldLinereadHandle=gostartwheregoacc=doline<-TIO.hGetLinereadHandlego$foldLine(acc,line)`catchany`\_->returnaccdataState=State{sCode::Int,sStdin::MaybeText-- ^ stdin for the command to be run,sStderr::Text,sDirectory::FilePath,sPrintStdout::Bool-- ^ print stdout of command that is executed,sPrintCommands::Bool-- ^ print command that is executed,sRun::FilePath->[Text]->ShIO(Handle,Handle,Handle,ProcessHandle),sEnvironment::[(String,String)],sTrace::B.Builder}-- | same as 'trace', but use it combinator styletag::ShIOa->Text->ShIOatagactionmsg=dotracemsgresult<-actionreturnresult-- | log actions that occurtrace::Text->ShIO()tracemsg=modify$\st->st{sTrace=sTracest`mappend`B.fromLazyTextmsg`mappend`"\n"}typeShIOa=ReaderT(IORefState)IOaget::ShIOStateget=dostateVar<-askliftIO(readIORefstateVar)put::State->ShIO()putnewState=dostateVar<-askliftIO(writeIORefstateVarnewState)modify::(State->State)->ShIO()modifyf=dostate<-askliftIO(modifyIORefstatef)gets::(State->a)->ShIOagetsf=f<$>get-- FIXME: find the full path to the exe from PATHrunCommand::FilePath->[Text]->ShIO(Handle,Handle,Handle,ProcessHandle)runCommandexeargs=dost<-getshellyProcessst$RawCommand(unpackexe)(mapLT.unpackargs)runCommandNoEscape::FilePath->[Text]->ShIO(Handle,Handle,Handle,ProcessHandle)runCommandNoEscapeexeargs=dost<-getshellyProcessst$ShellCommand$LT.unpack$LT.intercalate" "(toTextIgnoreexe:args)shellyProcess::State->CmdSpec->ShIO(Handle,Handle,Handle,ProcessHandle)shellyProcessstcmdSpec=do(Justhin,Justhout,Justherr,pHandle)<-liftIO$createProcess$CreateProcess{cmdspec=cmdSpec,cwd=Just$unpack$sDirectoryst,env=Just$sEnvironmentst,std_in=CreatePipe,std_out=CreatePipe,std_err=CreatePipe,close_fds=False#if MIN_VERSION_process(1,1,0),create_group=False#endif}return(hin,hout,herr,pHandle){-
-- | use for commands requiring usage of sudo. see 'run_sudo'.
-- Use this pattern for priveledge separation
newtype Sudo a = Sudo { sudo :: ShIO a }
-- | require that the caller explicitly state 'sudo'
run_sudo :: Text -> [Text] -> Sudo Text
run_sudo cmd args = Sudo $ run "/usr/bin/sudo" (cmd:args)
-}-- | A helper to catch any exception (same as-- @... `catch` \(e :: SomeException) -> ...@).catchany::IOa->(SomeException->IOa)->IOacatchany=catch-- | Catch an exception in the ShIO monad.catch_sh::(Exceptione)=>ShIOa->(e->ShIOa)->ShIOacatch_shah=doref<-askliftIO$catch(runReaderTaref)(\e->runReaderT(he)ref)-- | Catch an exception in the ShIO monad.catchany_sh::ShIOa->(SomeException->ShIOa)->ShIOacatchany_sh=catch_sh-- | Change current working directory of ShIO. This does *not* change the-- working directory of the process we are running it. Instead, ShIO keeps-- track of its own workking directory and builds absolute paths internally-- instead of passing down relative paths. This may have performance-- repercussions if you are doing hundreds of thousands of filesystem-- operations. You will want to handle these issues differently in those cases.cd::FilePath->ShIO()cddir=dodir'<-absPathdirtrace$"cd "`mappend`toTextIgnoredir'modify$\st->st{sDirectory=dir'}-- | "cd", execute a ShIO action in the new directory and then pop back to the original directorychdir::FilePath->ShIOa->ShIOachdirdiraction=dod<-pwdcddirr<-action`catchany_sh`(\e->cdd>>liftIO(throwIOe))cddreturnr-- | makes an absolute path. Same as canonic.-- TODO: use normalise from system-filepathpath::FilePath->ShIOFilePathpath=canonic-- | makes an absolute path. @path@ will also normalizeabsPath::FilePath->ShIOFilePathabsPathp|relativep=(FP.</>p)<$>getssDirectory|otherwise=returnp-- | apply a String IO operations to a Text FilePath{-
liftStringIO :: (String -> IO String) -> FilePath -> ShIO FilePath
liftStringIO f = liftIO . f . unpack >=> return . pack
-- | @asString f = pack . f . unpack@
asString :: (String -> String) -> FilePath -> FilePath
asString f = pack . f . unpack
-}unpack::FilePath->Stringunpack=encodeStringpack::String->FilePathpack=decodeString-- | Currently a "renameFile" wrapper. TODO: Support cross-filesystem-- move. TODO: Support directory paths in the second parameter, like in "cp".mv::FilePath->FilePath->ShIO()mvab=doa'<-absPathab'<-absPathbtrace$"mv "`mappend`toTextIgnorea'`mappend`" "`mappend`toTextIgnoreb'liftIO$renamea'b'-- | Get back [Text] instead of [FilePath]ls'::FilePath->ShIO[Text]ls'fp=dotrace$"ls "`mappend`toTextIgnorefpefiles<-lsfpmapMtoTextWarnefiles-- | List directory contents. Does *not* include \".\" and \"..\", but it does-- include (other) hidden files.ls::FilePath->ShIO[FilePath]ls=path>=>\fp->(liftIO$listDirectoryfp)`tag`("ls "`mappend`toTextIgnorefp)-- | List directory recursively (like the POSIX utility "find").find::FilePath->ShIO[FilePath]finddir=dotrace("find "`mappend`toTextIgnoredir)bits<-lsdirsubDir<-forMbits$\x->doex<-test_d$dirFP.</>xsym<-test_s$dirFP.</>xifex&&notsymthenfind(dirFP.</>x)elsereturn[]return$map(dirFP.</>)bits++concatsubDir-- | Obtain the current (ShIO) working directory.pwd::ShIOFilePathpwd=getssDirectory`tag`"pwd"-- | Echo text to standard (error, when using _err variants) output. The _n-- variants do not print a final newline.echo,echo_n,echo_err,echo_n_err::Text->ShIO()echo=traceLiftIOTIO.putStrLnecho_n=traceLiftIO$(>>hFlushSystem.IO.stdout).TIO.putStrecho_err=traceLiftIO$TIO.hPutStrLnstderrecho_n_err=traceLiftIO$(>>hFlushstderr).TIO.hPutStrstderrtraceLiftIO::(Text->IO())->Text->ShIO()traceLiftIOfmsg=trace("echo "`mappend`"'"`mappend`msg`mappend`"'")>>liftIO(fmsg)exit::Int->ShIO()exit0=liftIO(exitWithExitSuccess)`tag`"exit 0"exitn=liftIO(exitWith(ExitFailuren))`tag`("exit "`mappend`LT.pack(shown))errorExit::Text->ShIO()errorExitmsg=echomsg>>exit1-- | fail that takes a Textterror::Text->ShIOaterror=fail.LT.unpack-- | a print lifted into ShIOinspect::(Shows)=>s->ShIO()inspectx=do(trace.LT.pack.show)xliftIO$printx-- | Create a new directory (fails if the directory exists).mkdir::FilePath->ShIO()mkdir=absPath>=>\fp->dotrace$"mkdir "`mappend`toTextIgnorefpliftIO$createDirectoryFalsefp`catchany`(\e->throwIOe>>return())-- | Create a new directory, including parents (succeeds if the directory-- already exists).mkdir_p::FilePath->ShIO()mkdir_p=absPath>=>\fp->dotrace$"mkdir -p "`mappend`toTextIgnorefpliftIO$createTreefp-- | Get a full path to an executable on @PATH@, if exists. FIXME does not-- respect setenv'd environment and uses @findExecutable@ which uses the @PATH@ inherited from the process-- environment.-- FIXME: findExecutable does not maintain a hash of existing commands and does a ton of file statswhich::FilePath->ShIO(MaybeFilePath)whichfp=do(trace.mappend"which ".toTextIgnore)fp(liftIO.findExecutable.unpack>=>return.fmappack)fp-- | Obtain a (reasonably) canonic file path to a filesystem object. Based on-- "canonicalizePath" in FileSystem.canonic::FilePath->ShIOFilePathcanonic=absPath>=>liftIO.canonicalizePath-- | A monadic-conditional version of the "when" guard.whenM::Monadm=>mBool->m()->m()whenMca=c>>=\res->whenresa-- | A monadic-conditional version of the "unless" guard.unlessM::Monadm=>mBool->m()->m()unlessMca=c>>=\res->unlessresa-- | Does a path point to an existing filesystem object?test_e::FilePath->ShIOBooltest_ef=dofs<-absPathfliftIO$dofile<-isFilefsiffilethenreturnTrueelseisDirectoryfs-- | Does a path point to an existing file?test_f::FilePath->ShIOBooltest_f=absPath>=>liftIO.isFile-- | Does a path point to an existing directory?test_d::FilePath->ShIOBooltest_d=absPath>=>liftIO.isDirectory-- | Does a path point to a symlink?test_s::FilePath->ShIOBooltest_s=absPath>=>liftIO.\f->dostat<-getSymbolicLinkStatus(unpackf)return$isSymbolicLinkstat-- | A swiss army cannon for removing things. Actually this goes farther than a-- normal rm -rf, as it will circumvent permission problems for the files we-- own. Use carefully.rm_rf::FilePath->ShIO()rm_rff=absPathf>>=\f'->dotrace$"rm -rf "`mappend`toTextIgnorefwhenM(test_df)$do_<-findf'>>=mapM(\file->liftIO_$fixPermissions(unpackfile)`catchany`\_->return())liftIO_$removeTreef'whenM(test_ff)$rm_ff'wherefixPermissionsfile=dopermissions<-liftIO$getPermissionsfileletdeletable=permissions{readable=True,writable=True,executable=True}liftIO$setPermissionsfiledeletable-- | Remove a file. Does not fail if the file already is not there. Does fail-- if the file is not a file.rm_f::FilePath->ShIO()rm_ff=dotrace$"rm -f "`mappend`toTextIgnorefwhenM(test_ef)$absPathf>>=liftIO.removeFile-- | Set an environment variable. The environment is maintained in ShIO-- internally, and is passed to any external commands to be executed.setenv::Text->Text->ShIO()setenvkv=let(kStr,vStr)=(LT.unpackk,LT.unpackv)wibbleenvironment=(kStr,vStr):filter((/=kStr).fst)environmentinmodify$\x->x{sEnvironment=wibble$sEnvironmentx}-- | add the filepath onto the PATH env variable-- FIXME: only effects the PATH once the process is ran, as per comments in 'which'appendToPath::FilePath->ShIO()appendToPathfilepath=dotp<-toTextWarnfilepathpe<-getenvpath_envsetenvpath_env$pe`mappend`":"`mappend`tpwherepath_env="PATH"-- | Fetch the current value of an environment variable. Both empty and-- non-existent variables give empty string as a result.getenv::Text->ShIOTextgetenvk=getenv_defk""-- | Fetch the current value of an environment variable. Both empty and-- non-existent variables give the default value as a resultgetenv_def::Text->Text->ShIOTextgetenv_defkd=getssEnvironment>>=return.LT.pack.fromMaybe(LT.unpackd).lookup(LT.unpackk)-- | Create a sub-ShIO in which external command outputs are not echoed.-- Also commands are not printed.-- See "sub".silently::ShIOa->ShIOasilentlya=sub$modify(\x->x{sPrintStdout=False,sPrintCommands=False})>>a-- | Create a sub-ShIO in which external command outputs are echoed.-- Executed commands are printed-- See "sub".verbosely::ShIOa->ShIOaverboselya=sub$modify(\x->x{sPrintStdout=True,sPrintCommands=True})>>a-- | Turn on/off printing stdoutprint_stdout::Bool->ShIOa->ShIOaprint_stdoutshouldPrinta=sub$modify(\x->x{sPrintStdout=shouldPrint})>>a-- | Create a 'BgJobManager' that has a 'limit' on the max number of background tasks.-- an invocation of jobs is independent of any others, and not tied to the ShIO monad in any way.-- This blocks the execution of the program until all 'background' jobs are finished.jobs::Int->(BgJobManager->ShIOa)->ShIOajobslimitaction=dounless(limit>0)$terror"expected limit to be > 0"availableJobsSem<-liftIO$Sem.newlimitres<-action$BgJobManageravailableJobsSemliftIO$waitForJobsavailableJobsSemreturnreswherewaitForJobssem=doavail<-Sem.peekAvailsemifavail==limitthenreturn()elsewaitForJobssem-- | The manager tracks the number of jobs. Register your 'background' jobs with it.newtypeBgJobManager=BgJobManager(Sem.MSemInt)-- | Type returned by tasks run asynchronously in the background.newtypeBgResulta=BgResult(MVara)-- | Returns the promised result from a backgrounded task. Blocks until-- the task completes.getBgResult::BgResulta->ShIOagetBgResult(BgResultmvar)=liftIO$takeMVarmvar-- | Run the `ShIO` task asynchronously in the background, returns-- the `BgResult a`, a promise immediately. Run "getBgResult" to wait for the result.-- The background task will inherit the current ShIO context-- The 'BjJobManager' ensures the max jobs limit must be sufficient for the parent and all children.background::BgJobManager->ShIOa->ShIO(BgResulta)background(BgJobManagermanager)proc=dostate<-getliftIO$do-- take up a spot-- It is important to do this before forkIO:-- It ensures that that jobs will block and the program won't exit before our jobs are done-- On the other hand, a user might not expect 'jobs' to blockSem.waitmanagermvar<-newEmptyMVar-- future result_<-forkIO$doresult<-shelly$(putstate>>proc)Sem.signalmanager-- open a spot back upliftIO$putMVarmvarresultreturn$BgResultmvar-- | Turn on/off command echoing.print_commands::Bool->ShIOa->ShIOaprint_commandsshouldPrinta=sub$modify(\st->st{sPrintCommands=shouldPrint})>>a-- | Enter a sub-ShIO that inherits the environment-- The original state will be restored when the sub-ShIO completes.-- Exceptions are propagated normally.sub::ShIOa->ShIOasuba=dooldState<-getmodify$\st->st{sTrace=B.fromText""}r<-a`catchany_sh`(\e->dorestoreStateoldStateliftIO$throwIOe)restoreStateoldStatereturnrwhererestoreStateoldState=donewState<-getputoldState{sTrace=sTraceoldState`mappend`sTracenewState}escaping::Bool->ShIOa->ShIOaescapingshouldEscapeaction=sub$domodify$\st->st{sRun=ifshouldEscapethenrunCommandelserunCommandNoEscape}action-- | Enter a ShIO from (Monad)IO. The environment and working directories are-- inherited from the current process-wide values. Any subsequent changes in-- processwide working directory or environment are not reflected in the-- running ShIO.shelly::MonadIOm=>ShIOa->mashellyaction=doenvironment<-liftIOgetEnvironmentdir<-liftIOgetWorkingDirectoryletdef=State{sCode=0,sStdin=Nothing,sStderr=LT.empty,sPrintStdout=True,sPrintCommands=False,sRun=runCommand,sEnvironment=environment,sTrace=B.fromText"",sDirectory=dir}stref<-liftIO$newIORefdefletcaught=action`catchany_sh`\e->get>>=liftIO.throwIO.ReThrownExceptione.errorMsg.LT.unpack.B.toLazyText.sTraceliftIO$runReaderTcaughtstrefwhereerrorMsgtrc="Ran commands: \n"`mappend`trcdataRunFailed=RunFailedFilePath[Text]IntTextderiving(Typeable)instanceShowRunFailedwhereshow(RunFailedexeargscodeerrs)=letcodeMsg=casecodeof127->". exit code 127 usually means the command does not exist (in the PATH)"_->""in"error running: "++LT.unpack(show_commandexeargs)++"\nexit status: "++showcode++codeMsg++"\nstderr: "++LT.unpackerrsinstanceExceptionRunFailedshow_command::FilePath->[Text]->Textshow_commandexeargs=LT.intercalate" "$mapquote(toTextIgnoreexe:args)wherequotet=ifLT.any(=='\'')tthentelseifLT.anyisSpacetthensurround'\''telsetsurround::Char->Text->Textsurroundct=LT.consc$LT.snoctc-- | same as 'sshPairs', but returns ()sshPairs_::Text->[(FilePath,[Text])]->ShIO()sshPairs__[]=return()sshPairs_servercmds=sshPairs'run_servercmds-- | run commands over SSH.-- An ssh executable is expected in your path.-- Commands are in the same form as 'run', but given as pairs---- > sshPairs "server-name" [("cd", "dir"), ("rm",["-r","dir2"])]---- I am not fond of this interface, but it seems to work.---- Please note this sets 'escaping' to False: the commands will not be shell escaped.-- I think this should be more convenient for ssh.-- Internally the list of commands are combined with the string " && " before given to ssh.sshPairs::Text->[(FilePath,[Text])]->ShIOTextsshPairs_[]=return""sshPairsservercmds=sshPairs'runservercmdssshPairs'::(FilePath->[Text]->ShIOa)->Text->[(FilePath,[Text])]->ShIOasshPairs'run'serveractions=doescapingFalse$doletssh_commands=surround'\''$foldl1((mappend).(mappend" && "))(maptoSSHactions)run'"ssh"$[server,ssh_commands]wheretoSSH(exe,args)=show_commandexeargsdataExceptione=>ReThrownExceptione=ReThrownExceptioneStringderiving(Typeable)instanceExceptione=>Exception(ReThrownExceptione)instanceExceptione=>Show(ReThrownExceptione)whereshow(ReThrownExceptionexmsg)="\n"++msg++"\n"++"Exception: "++showex-- | Execute an external command. Takes the command name (no shell allowed,-- just a name of something that can be found via @PATH@; FIXME: setenv'd-- @PATH@ is not taken into account when finding the exe name)---- "stdout" and "stderr" are collected. The "stdout" is returned as-- a result of "run", and complete stderr output is available after the fact using-- "lastStderr" ---- All of the stdout output will be loaded into memory-- You can avoid this but still consume the result by using "run_",-- If you want to avoid the memory and need to process the output then use "runFoldLines".run::FilePath->[Text]->ShIOTextrunexeargs=fmapB.toLazyText$runFoldLines(B.fromText"")foldBuilderexeargsfoldBuilder::(B.Builder,Text)->B.BuilderfoldBuilder(b,line)=b`mappend`B.fromLazyTextline`mappend`B.singleton'\n'-- | bind some arguments to run for re-use-- Example: @monit = command "monit" ["-c", "monitrc"]@command::FilePath->[Text]->[Text]->ShIOTextcommandcomargsmore_args=runcom(args++more_args)-- | bind some arguments to "run_" for re-use-- Example: @monit_ = command_ "monit" ["-c", "monitrc"]@command_::FilePath->[Text]->[Text]->ShIO()command_comargsmore_args=run_com(args++more_args)-- | bind some arguments to run for re-use, and expect 1 argument-- Example: @git = command1 "git" []; git "pull" ["origin", "master"]@command1::FilePath->[Text]->Text->[Text]->ShIOTextcommand1comargsone_argmore_args=runcom([one_arg]++args++more_args)-- | bind some arguments to run for re-use, and expect 1 argument-- Example: @git_ = command1_ "git" []; git+ "pull" ["origin", "master"]@command1_::FilePath->[Text]->Text->[Text]->ShIO()command1_comargsone_argmore_args=run_com([one_arg]++args++more_args)-- the same as "run", but return () instead of the stdout contentrun_::FilePath->[Text]->ShIO()run_=runFoldLines()(\(_,_)->())liftIO_::IOa->ShIO()liftIO_action=liftIOaction>>return()-- same as "run", but fold over stdout as it is read to avoid keeping it in memory-- stderr is still placed in memory (this could be changed in the future)runFoldLines::a->FoldCallbacka->FilePath->[Text]->ShIOarunFoldLinesstartcbexeargs=do-- clear stdin before beginning command executionorigstate<-getletmStdin=sStdinorigstateput$origstate{sStdin=Nothing,sCode=0,sStderr=LT.empty}state<-getletcmdString=show_commandexeargswhen(sPrintCommandsstate)$echocmdStringtracecmdString(inH,outH,errH,procH)<-sRunstateexeargscasemStdinofJustinput->liftIO$TIO.hPutStrinHinput>>hCloseinH-- stdin is cleared from state belowNothing->return()errV<-liftIOnewEmptyMVaroutV<-liftIOnewEmptyMVarifsPrintStdoutstatethendoliftIO_$forkIO$printGetContenterrHstderr>>=putMVarerrVliftIO_$forkIO$printFoldHandleLinesstartcboutHstdout>>=putMVaroutVelsedoliftIO_$forkIO$getContenterrH>>=putMVarerrVliftIO_$forkIO$foldHandleLinesstartcboutH>>=putMVaroutVerrs<-liftIO$takeMVarerrVex<-liftIO$waitForProcessprocHletcode=caseexofExitSuccess->0ExitFailuren->nput$state{sStderr=errs,sCode=code}liftIO$caseexofExitSuccess->takeMVaroutVExitFailuren->throwIO$RunFailedexeargsnerrs-- | The output of last external command. See "run".lastStderr::ShIOTextlastStderr=getssStderr-- | set the stdin to be used and cleared by the next "run".setStdin::Text->ShIO()setStdininput=modify$\st->st{sStdin=Justinput}-- | Pipe operator. set the stdout the first command as the stdin of the second.(-|-)::ShIOText->ShIOb->ShIObone-|-two=dores<-(print_stdoutFalse)onesetStdinrestwodataTiming=TimingDoublederiving(Read,Show,Ord,Eq)-- | Run a ShIO computation and collect timing information.time::ShIOa->ShIO(Timing,a)timewhat=sub$dotrace"time"t<-liftIOgetCurrentTimeres<-whatt'<-liftIOgetCurrentTimeletmt=Timing(realToFrac$diffUTCTimet't)return(mt,res){-
stats_f <- liftIO $
do tmpdir <- getTemporaryDirectory
(f, h) <- openTempFile tmpdir "darcs-stats-XXXX"
hClose h
return f
let args = args' ++ ["+RTS", "-s" ++ stats_f, "-RTS"]
...
stats <- liftIO $ do c <- readFile' stats_f
removeFile stats_f `catchany` \e -> hPutStrLn stderr (show e)
return c
`catchany` \_ -> return ""
let bytes = (stats =~ "([0-9, ]+) M[bB] total memory in use") :: String
mem = case length bytes of
0 -> 0
_ -> (read (filter (`elem` "0123456789") bytes) :: Int)
recordMemoryUsed $ mem * 1024 * 1024
return res
-}-- | Copy a file, or a directory recursively.cp_r::FilePath->FilePath->ShIO()cp_rfromto=dotrace$"cp -r "`mappend`toTextIgnorefrom`mappend`" "`mappend`toTextIgnoretofrom_d<-(test_dfrom)ifnotfrom_dthencpfromtoelsedoletfromName=filenamefromlettoDir=iffilenameto==fromNamethentoelsetoFP.</>fromNameunlessM(test_dtoDir)$mkdirtoDirlsfrom>>=mapM_(\item->cp_r(fromFP.</>filenameitem)(toDirFP.</>filenameitem))-- | Copy a file. The second path could be a directory, in which case the-- original file name is used, in that directory.cp::FilePath->FilePath->ShIO()cpfromto=dofrom'<-absPathfromto'<-absPathtotrace$"cp "`mappend`toTextIgnorefrom'`mappend`" "`mappend`toTextIgnoreto'to_dir<-test_dtoletto_loc=ifto_dirthento'FP.</>filenamefromelseto'liftIO$copyFilefrom'to_loc`catchany`(\e->throwIO$ReThrownExceptione(extraMsgto_locfrom'))whereextraMsgtf="during copy from: "++unpackf++" to: "++unpackt-- | for 'grep'classPredicateLikepatternhaywherematch::pattern->hay->BoolinstancePredicateLike(a->Bool)awherematch=idinstance(Eqa)=>PredicateLike[a][a]wherematchpat=(pat`isInfixOf`)-- | Like filter, but more conveniently used with String lists, where a-- substring match (TODO: also provide globs) is expressed as-- @grep \"needle\" [ \"the\", \"stack\", \"of\", \"hay\" ]@. Boolean-- predicates just like with "filter" are supported too:-- @grep (\"fun\" `isPrefixOf`) [...]@.grep::(PredicateLikepatternhay)=>pattern->[hay]->[hay]grepp=filter(matchp)-- | A functor-lifting function composition.(<$$>)::(Functorm)=>(b->c)->(a->mb)->a->mcf<$$>v=fmapf.v-- | Create a temporary directory and pass it as a parameter to a ShIO-- computation. The directory is nuked afterwards.withTmpDir::(FilePath->ShIOa)->ShIOawithTmpDiract=dotrace"withTmpDir"dir<-liftIOgetTemporaryDirectorytid<-liftIOmyThreadId(pS,handle)<-liftIO$openTempFiledir("tmp"++filterisAlphaNum(showtid))letp=packpSliftIO$hClosehandle-- required on windowsrm_fpmkdirpa<-actp`catchany_sh`\e->dorm_rfp>>liftIO(throwIOe)rm_rfpreturna-- | Write a Lazy Text to a file.writefile::FilePath->Text->ShIO()writefilefbits=absPathf>>=\f'->dotrace$"writefile "`mappend`toTextIgnoref'liftIO(TIO.writeFile(unpackf')bits)-- | Append a Lazy Text to a file.appendfile::FilePath->Text->ShIO()appendfilefbits=absPathf>>=\f'->dotrace$"appendfile "`mappend`toTextIgnoref'liftIO(TIO.appendFile(unpackf')bits)-- | (Strictly) read file into a Text.-- All other functions use Lazy Text.-- So Internally this reads a file as strict text and then converts it to lazy text, which is inefficientreadfile::FilePath->ShIOTextreadfile=absPath>=>\fp->dotrace$"readfile "`mappend`toTextIgnorefp(fmapLT.fromStrict.liftIO.STIO.readFile.unpack)fp