{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings,
MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances,
TypeFamilies, IncoherentInstances, GADTs #-}-- | A module for shell-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 Sh maintains its own environment and its own working-- directory.---- Recommended usage includes 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 Shelly-- > import qualified Data.Text as T-- > default (T.Text)moduleShelly(-- * Entering Sh.Sh,ShIO,shelly,shellyNoDir,sub,silently,verbosely,escaping,print_stdout,print_commands,tracing,errExit-- * Running external commands.,run,run_,runFoldLines,cmd,FoldCallback,(-|-),lastStderr,setStdin,lastExitCode,command,command_,command1,command1_,sshPairs,sshPairs_,ShellArg(..)-- * Running commands Using handles,runHandle,runHandles,transferLinesAndCombine,transferFoldHandleLines,StdHandle(..),StdStream(..)-- * Modifying and querying environment.,setenv,get_env,get_env_text,getenv,get_env_def,appendToPath-- * Environment directory,cd,chdir,pwd-- * Printing,echo,echo_n,echo_err,echo_n_err,inspect,inspect_err,tag,trace,show_command-- * Querying filesystem.,ls,lsT,test_e,test_f,test_d,test_s,which-- * Filename helpers,absPath,(</>),(<.>),canonic,canonicalize,relPath,relativeTo,path,hasExt-- * Manipulating filesystem.,mv,rm,rm_f,rm_rf,cp,cp_r,mkdir,mkdir_p,mkdirTree-- * reading/writing Files,readfile,readBinary,writefile,appendfile,touchfile,withTmpDir-- * exiting the program,exit,errorExit,quietExit,terror-- * Exceptions,catchany,catch_sh,finally_sh,ShellyHandler(..),catches_sh,catchany_sh-- * convert between Text and FilePath,toTextIgnore,toTextWarn,fromText-- * Utility Functions,whenM,unlessM,time,sleep-- * Re-exported for your convenience,liftIO,when,unless,FilePath,(<$>)-- * internal functions for writing extensions,get,put-- * find functions,find,findWhen,findFold,findDirFilter,findDirFilterWhen,findFoldDirFilter)whereimportShelly.BaseimportShelly.FindimportControl.Monad(when,unless,void,forM,filterM)importControl.Monad.Trans(MonadIO)importControl.Monad.Reader(ask)#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706importPreludehiding(readFile,FilePath,catch)#elseimportPreludehiding(readFile,FilePath)#endifimportData.Char(isAlphaNum,isSpace)importData.TypeableimportData.IORefimportData.Sequence(Seq,(|>))importData.Foldable(toList)importData.MaybeimportSystem.IO(hClose,stderr,stdout,openTempFile)importSystem.IO.Error(isPermissionError,catchIOError,isEOFError,isIllegalOperation)importSystem.ExitimportSystem.EnvironmentimportControl.ApplicativeimportControl.Exceptionhiding(handle)importControl.ConcurrentimportData.Time.Clock(getCurrentTime,diffUTCTime)importqualifiedData.Text.IOasTIOimportqualifiedData.Text.EncodingasTEimportqualifiedData.Text.Encoding.ErrorasTEimportSystem.Process(CmdSpec(..),StdStream(CreatePipe,UseHandle),CreateProcess(..),createProcess,waitForProcess,terminateProcess,ProcessHandle,StdStream(..))importqualifiedData.TextasTimportqualifiedData.ByteStringasBSimportData.ByteString(ByteString)importData.Monoid(Monoid,mempty,mappend)#if __GLASGOW_HASKELL__ < 704infixr5<>(<>)::Monoidm=>m->m->m(<>)=mappend#elseimportData.Monoid((<>))#endifimportFilesystem.Path.CurrentOShiding(concat,fromText,(</>),(<.>))importFilesystemhiding(canonicalizePath)importqualifiedFilesystem.Path.CurrentOSasFPimportSystem.Directory(setPermissions,getPermissions,Permissions(..),getTemporaryDirectory)importData.Char(isDigit)importData.Tree(Tree(..))importqualifiedData.SetasSimportqualifiedData.ListasLsearchPathSeparator::Char#if defined(mingw32_HOST_OS)searchPathSeparator=';'#elsesearchPathSeparator=':'#endif{- 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 -> Sh Text
cmd fp args = run fp $ toTextArgs args
-}-- | Argument converter for the variadic argument version of 'run' called 'cmd'.-- Useful for a type signature of a function that uses 'cmd'classShellArgawheretoTextArg::a->TextinstanceShellArgTextwheretoTextArg=idinstanceShellArgFilePathwheretoTextArg=toTextIgnoreinstanceShellArgStringwheretoTextArg=T.pack-- | used to create the variadic function 'cmd'classShellCommandtwherecmdAll::FilePath->[Text]->tinstanceShellCommand(ShText)wherecmdAll=runinstance(s~Text,Shows)=>ShellCommand(Shs)wherecmdAll=run-- note that Sh () actually doesn't work for its case (_<- cmd) when there is no type signatureinstanceShellCommand(Sh())wherecmdAll=run_instance(ShellArgarg,ShellCommandresult)=>ShellCommand(arg->result)wherecmdAllfpaccx=cmdAllfp(acc++[toTextArgx])-- | variadic argument version of 'run'.-- Please see the documenation for 'run'.---- The syntax is more convenient, but more importantly it also allows the use of a FilePath as a command argument.-- So an argument can be a Text or a FilePath without manual conversions.-- a FilePath is automatically converted to Text with 'toTextIgnore'.---- Convenient usage of 'cmd' requires the following:---- > {-# LANGUAGE OverloadedStrings #-}-- > {-# LANGUAGE ExtendedDefaultRules #-}-- > {-# OPTIONS_GHC -fno-warn-type-defaults #-}-- > import Shelly-- > import qualified Data.Text as T-- > default (T.Text)--cmd::(ShellCommandresult)=>FilePath->resultcmdfp=cmdAllfp[]-- | Helper to convert a Text to a FilePath. Used by '(</>)' and '(<.>)'classToFilePathawheretoFilePath::a->FilePathinstanceToFilePathFilePathwheretoFilePath=idinstanceToFilePathTextwheretoFilePath=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.<.>ytoTextWarn::FilePath->ShTexttoTextWarnefile=casetoTextefileofLeftf->encodeErrorf>>returnfRightf->returnfwhereencodeErrorf=echo("Invalid encoding for file: "<>f)fromText::Text->FilePathfromText=FP.fromText-- | Transfer from one handle to another-- For example, send contents of a process output to stdout.-- does not close the write handle.---- Also, return the complete contents being streamed line by line.transferLinesAndCombine::Handle->Handle->IOTexttransferLinesAndCombineh1h2=transferFoldHandleLinesmempty(|>)h1h2>>=return.lineSeqToTextlineSeqToText::SeqText->Text-- extra append puts a newline at the endlineSeqToText=T.intercalate"\n".toList.flip(|>)""typeFoldCallbacka=(a->Text->a)-- | Transfer from one handle to another-- For example, send contents of a process output to stdout.-- does not close the write handle.---- Also, fold over the contents being streamed line by linetransferFoldHandleLines::a->FoldCallbacka->Handle->Handle->IOatransferFoldHandleLinesstartfoldLinereadHandlewriteHandle=gostartwherecatchIOErrorsaction=catchIOError(fmapJustaction)(\e->ifisEOFErrore||isIllegalOperatione-- handle was closedthenreturnNothingelseioErrore)goacc=domLine<-catchIOErrors(TIO.hGetLinereadHandle)casemLineofNothing->returnaccJustline->TIO.hPutStrLnwriteHandleline>>go(foldLineaccline)foldHandleLines::a->FoldCallbacka->Handle->IOafoldHandleLinesstartfoldLinereadHandle=gostartwheregoacc=doline<-TIO.hGetLinereadHandlego$foldLineaccline`catchany`\_->returnacc-- | same as 'trace', but use it combinator styletag::Sha->Text->Shatagactionmsg=dotracemsgactionput::State->Sh()putnewState=dostateVar<-askliftIO(writeIORefstateVarnewState)runCommandNoEscape::[StdHandle]->State->FilePath->[Text]->Sh(Handle,Handle,Handle,ProcessHandle)runCommandNoEscapehandlesstexeargs=liftIO$shellyProcesshandlesst$ShellCommand$T.unpack$T.intercalate" "(toTextIgnoreexe:args)runCommand::[StdHandle]->State->FilePath->[Text]->Sh(Handle,Handle,Handle,ProcessHandle)runCommandhandlesstexeargs=findExeexe>>=\fullExe->liftIO$shellyProcesshandlesst$RawCommand(unpackfullExe)(mapT.unpackargs)wherefindExe::FilePath->ShFilePathfindExefp=domExe<-whichexecasemExeofJustexecFp->returnexecFp#if defined(mingw32_HOST_OS)-- windows looks in extra places besides the PATH, so just give-- up even if the behavior is not properly specified anymoreNothing->returnfp#elseNothing->liftIO$throwIO$userError$"shelly did not find "`mappend`encodeStringfp`mappend`ifabsoluteexethen""else" in the PATH"#endifshellyProcess::[StdHandle]->State->CmdSpec->IO(Handle,Handle,Handle,ProcessHandle)shellyProcessreusedHandlesstcmdSpec=do(createdInH,createdOutH,createdErrorH,pHandle)<-createProcessCreateProcess{cmdspec=cmdSpec,cwd=Just$unpack$sDirectoryst,env=Just$sEnvironmentst,std_in=createUnlessmInH,std_out=createUnlessmOutH,std_err=createUnlessmErrorH,close_fds=False#if MIN_VERSION_process(1,1,0),create_group=False#endif}return(just$createdInH<|>toHandlemInH,just$createdOutH<|>toHandlemOutH,just$createdErrorH<|>toHandlemErrorH,pHandle)wherejust::Maybea->ajustNothing=error"error in shelly creating process"just(Justj)=jtoHandle(Just(UseHandleh))=JusthtoHandle(JustCreatePipe)=error"shelly process creation failure CreatePIpe"toHandle(JustInherit)=error"cannot access an inherited pipe"toHandleNothing=error"error in shelly creating process"createUnlessNothing=CreatePipecreateUnless(Juststream)=streammInH=getStreammInreusedHandlesmOutH=getStreammOutreusedHandlesmErrorH=getStreammErrorreusedHandlesgetStream::(StdHandle->MaybeStdStream)->[StdHandle]->MaybeStdStreamgetStream_[]=NothinggetStreammHandle(h:hs)=mHandleh<|>getStreammHandlehsmIn,mOut,mError::(StdHandle->MaybeStdStream)mIn(InHandleh)=JusthmIn_=NothingmOut(OutHandleh)=JusthmOut_=NothingmError(ErrorHandleh)=JusthmError_=Nothing{-
-- | use for commands requiring usage of sudo. see 'run_sudo'.
-- Use this pattern for priveledge separation
newtype Sudo a = Sudo { sudo :: Sh 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)
-}-- | Same as a normal 'catch' but specialized for the Sh monad.catch_sh::(Exceptione)=>Sha->(e->Sha)->Shacatch_shactionhandle=doref<-askliftIO$catch(runShactionref)(\e->runSh(handlee)ref)-- | Same as a normal 'finally' but specialized for the 'Sh' monad.finally_sh::Sha->Shb->Shafinally_shactionhandle=doref<-askliftIO$finally(runShactionref)(runShhandleref)-- | You need to wrap exception handlers with this when using 'catches_sh'.dataShellyHandlera=foralle.Exceptione=>ShellyHandler(e->Sha)-- | Same as a normal 'catches', but specialized for the 'Sh' monad.catches_sh::Sha->[ShellyHandlera]->Shacatches_shactionhandlers=doref<-askletrunnera=runSharefliftIO$catches(runneraction)$map(toHandlerrunner)handlerswheretoHandler::(Sha->IOa)->ShellyHandlera->HandleratoHandlerrunner(ShellyHandlerhandle)=Handler(\e->runner(handlee))-- | Catch an exception in the Sh monad.catchany_sh::Sha->(SomeException->Sha)->Shacatchany_sh=catch_sh-- | Change current working directory of Sh. This does *not* change the-- working directory of the process we are running it. Instead, Sh keeps-- track of its own working directory and builds absolute paths internally-- instead of passing down relative paths.cd::FilePath->Sh()cd=canonic>=>cd'wherecd'dir=dotrace$"cd "<>tdirunlessM(test_ddir)$errorExit$"not a directory: "<>tdirmodify$\st->st{sDirectory=dir,sPathExecutables=Nothing}wheretdir=toTextIgnoredir-- | 'cd', execute a Sh action in the new directory and then pop back to the original directorychdir::FilePath->Sha->Shachdirdiraction=dod<-getssDirectorycddiraction`finally_sh`cdd-- | 'chdir', but first create the directory if it does not exitchdir_p::FilePath->Sha->Shachdir_pdaction=mkdir_pd>>chdirdaction-- | apply a String IO operations to a Text FilePath{-
liftStringIO :: (String -> IO String) -> FilePath -> Sh FilePath
liftStringIO f = liftIO . f . unpack >=> return . pack
-- | @asString f = pack . f . unpack@
asString :: (String -> String) -> FilePath -> FilePath
asString f = pack . f . unpack
-}pack::String->FilePathpack=decodeString-- | Move a file. The second path could be a directory, in which case the-- original file is moved into that directory.-- wraps system-fileio 'FileSystem.rename', which may not work across FS boundariesmv::FilePath->FilePath->Sh()mvfrom'to'=dofrom<-absPathfrom'to<-absPathto'trace$"mv "<>toTextIgnorefrom<>" "<>toTextIgnoretoto_dir<-test_dtoletto_loc=ifnotto_dirthentoelsetoFP.</>filenamefromliftIO$renamefromto_loc`catchany`(\e->throwIO$ReThrownExceptione(extraMsgto_locfrom))whereextraMsgtf="during copy from: "++unpackf++" to: "++unpackt-- | Get back [Text] instead of [FilePath]lsT::FilePath->Sh[Text]lsT=ls>=>mapMtoTextWarn-- | Obtain the current (Sh) working directory.pwd::ShFilePathpwd=getssDirectory`tag`"pwd"-- | exit 0 means no errors, all other codes are error conditionsexit::Int->Shaexit0=liftIOexitSuccess`tag`"exit 0"exitn=liftIO(exitWith(ExitFailuren))`tag`("exit "<>T.pack(shown))-- | echo a message and exit with status 1errorExit::Text->ShaerrorExitmsg=echomsg>>exit1-- | for exiting with status > 0 without printing debug informationquietExit::Int->ShaquietExit0=exit0quietExitn=throw$QuietExitn-- | fail that takes a Textterror::Text->Shaterror=fail.T.unpack-- | Create a new directory (fails if the directory exists).mkdir::FilePath->Sh()mkdir=absPath>=>\fp->dotrace$"mkdir "<>toTextIgnorefpliftIO$createDirectoryFalsefp-- | Create a new directory, including parents (succeeds if the directory-- already exists).mkdir_p::FilePath->Sh()mkdir_p=absPath>=>\fp->dotrace$"mkdir -p "<>toTextIgnorefpliftIO$createTreefp-- | Create a new directory tree. You can describe a bunch of directories as -- a tree and this function will create all subdirectories. An example:---- > exec = mkTree $-- > "package" # [-- > "src" # [-- > "Data" # leaves ["Tree", "List", "Set", "Map"] -- > ],-- > "test" # leaves ["QuickCheck", "HUnit"],-- > "dist/doc/html" # []-- > ]-- > where (#) = Node-- > leaves = map (# []) --mkdirTree::TreeFilePath->Sh()mkdirTree=mk.unrollPathwheremk::TreeFilePath->Sh()mk(Nodeats)=dob<-test_daunlessb$mkdirachdira$mapM_mkdirTreetsunrollPath::TreeFilePath->TreeFilePathunrollPath(Nodevts)=unrollRootv$mapunrollPathtswhereunrollRootx=foldr1phi$mapNode$splitDirectoriesxphiab=a.return.b-- | Get a full path to an executable by looking at the @PATH@ environement-- variable. Windows normally looks in additional places besides the-- @PATH@: this does not duplicate that behavior.which::FilePath->Sh(MaybeFilePath)whichoriginalFp=whichFull#if defined(mingw32_HOST_OS)caseextensionoriginalFpofNothing->originalFp<.>"exe"Just_->originalFp#elseoriginalFp#endifwherewhichFullfp=do(trace.mappend"which ".toTextIgnore)fp>>whichUntracedwherewhichUntraced|absolutefp=checkFile|length(splitDirectoriesfp)>0=lookupPath|otherwise=lookupCachecheckFile=doexists<-liftIO$isFilefpreturn$ifexiststhenJustfpelseNothinglookupPath=pathDirs>>=findMapM(\dir->doletfullFp=dir</>fpres<-liftIO$isExecutable$encodeString$fullFpreturn$ifresthenJustfullFpelseNothing)lookupCache=dopathExecutables<-cachedPathExecutablesliftIO$printpathExecutablesreturn$fmap(flip(</>)fp.fst)$L.find(S.memberfp.snd)pathExecutablespathDirs=mapMabsPath=<<((mapfromText.T.split(==searchPathSeparator))`fmap`get_env_text"PATH")isExecutablef=(executable`fmap`getPermissionsf)`catch`(\(_::IOError)->returnFalse)cachedPathExecutables::Sh[(FilePath,S.SetFilePath)]cachedPathExecutables=domPathExecutables<-getssPathExecutablescasemPathExecutablesofJustpExecutables->returnpExecutablesNothing->dodirs<-pathDirsexecutables<-forMdirs(\dir->dofiles<-(liftIO.listDirectory)dir`catch_sh`(\(_::IOError)->return[])exes<-fmap(mapsnd)$liftIO$filterM(isExecutable.fst)$map(\f->(encodeStringf,filenamef))filesreturn$S.fromListexes)letcachedExecutables=zipdirsexecutablesmodify$\x->x{sPathExecutables=JustcachedExecutables}return$cachedExecutables-- | A monadic findMap, taken from MissingM packagefindMapM::Monadm=>(a->m(Maybeb))->[a]->m(Maybeb)findMapM_[]=returnNothingfindMapMf(x:xs)=domb<-fxif(isJustmb)thenreturnmbelsefindMapMfxs-- | 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->ShBooltest_e=absPath>=>\f->liftIO$dofile<-isFilefiffilethenreturnTrueelseisDirectoryf-- | Does a path point to an existing file?test_f::FilePath->ShBooltest_f=absPath>=>liftIO.isFile-- | 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.-- Uses 'removeTree'rm_rf::FilePath->Sh()rm_rf=absPath>=>\f->dotrace$"rm -rf "<>toTextIgnorefisDir<-(test_df)ifnotisDirthenwhenM(test_ff)$rm_ffelse(liftIO_$removeTreef)`catch_sh`(\(e::IOError)->when(isPermissionErrore)$dofindf>>=mapM_(\file->liftIO_$fixPermissions(unpackfile)`catchany`\_->return())liftIO$removeTreef)wherefixPermissionsfile=dopermissions<-liftIO$getPermissionsfileletdeletable=permissions{readable=True,writable=True,executable=True}liftIO$setPermissionsfiledeletable-- | Remove a file. Does not fail if the file does not exist.-- Does fail if the file is not a file.rm_f::FilePath->Sh()rm_f=absPath>=>\f->dotrace$"rm -f "<>toTextIgnorefwhenM(test_ef)$canonicf>>=liftIO.removeFile-- | Remove a file.-- Does fail if the file does not exist (use 'rm_f' instead) or is not a file.rm::FilePath->Sh()rm=absPath>=>\f->dotrace$"rm"<>toTextIgnoref-- TODO: better error message for removeFile (give filename)canonicf>>=liftIO.removeFile-- | Set an environment variable. The environment is maintained in Sh-- internally, and is passed to any external commands to be executed.setenv::Text->Text->Sh()setenvkv=ifk==path_envthensetPathvelsedolet(kStr,vStr)=(T.unpackk,T.unpackv)wibbleenvironment=(kStr,vStr):filter((/=kStr).fst)environmentinmodify$\x->x{sEnvironment=wibble$sEnvironmentx}setPath::Text->Sh()setPathnewPath=domodify$\x->x{sPathExecutables=Nothing}setenvpath_envnewPathpath_env::Textpath_env="PATH"-- | add the filepath onto the PATH env variableappendToPath::FilePath->Sh()appendToPath=absPath>=>\filepath->dotp<-toTextWarnfilepathpe<-get_env_textpath_envsetPath$pe<>T.singletonsearchPathSeparator<>tp-- | Fetch the current value of an environment variable.-- if non-existant or empty text, will be Nothingget_env::Text->Sh(MaybeText)get_envk=domval<-return.fmapT.pack.lookup(T.unpackk)=<<getssEnvironmentreturn$casemvalofNothing->Nothingj@(Justval)->ifT.nullvalthenNothingelsej-- | deprecatedgetenv::Text->ShTextgetenvk=get_env_defk""{-# DEPRECATED getenv "use get_env or get_env_text" #-}-- | Fetch the current value of an environment variable. Both empty and-- non-existent variables give empty string as a result.get_env_text::Text->ShTextget_env_text=get_env_def""-- | Fetch the current value of an environment variable. Both empty and-- non-existent variables give the default Text value as a resultget_env_def::Text->Text->ShTextget_env_defd=get_env>=>return.fromMaybed{-# DEPRECATED get_env_def "use fromMaybe DEFAULT get_env" #-}-- | Create a sub-Sh in which external command outputs are not echoed and-- commands are not printed.-- See 'sub'.silently::Sha->Shasilentlya=sub$modify(\x->x{sPrintStdout=False,sPrintCommands=False})>>a-- | Create a sub-Sh in which external command outputs are echoed and-- Executed commands are printed-- See 'sub'.verbosely::Sha->Shaverboselya=sub$modify(\x->x{sPrintStdout=True,sPrintCommands=True})>>a-- | Create a sub-Sh with stdout printing on or off-- Defaults to True.print_stdout::Bool->Sha->Shaprint_stdoutshouldPrinta=sub$modify(\x->x{sPrintStdout=shouldPrint})>>a-- | Create a sub-Sh with command echoing on or off-- Defaults to False, set to True by 'verbosely'print_commands::Bool->Sha->Shaprint_commandsshouldPrinta=sub$modify(\st->st{sPrintCommands=shouldPrint})>>a-- | Enter a sub-Sh that inherits the environment-- The original state will be restored when the sub-Sh completes.-- Exceptions are propagated normally.sub::Sha->Shasuba=dooldState<-getmodify$\st->st{sTrace=T.empty}a`finally_sh`restoreStateoldStatewhererestoreStateoldState=donewState<-getputoldState{-- avoid losing the logsTrace=sTraceoldState<>sTracenewState-- latest command execution: not make sense to restore these to old settings,sCode=sCodenewState,sStderr=sStderrnewState-- it is questionable what the behavior of stdin should be,sStdin=sStdinnewState}-- | Create a sub-Sh where commands are not traced-- Defaults to True.-- You should only set to False temporarily for very specific reasonstracing::Bool->Sha->ShatracingshouldTraceaction=sub$domodify$\st->st{sTracing=shouldTrace}action-- | Create a sub-Sh with shell character escaping on or off.-- Defaults to @True@.---- Setting to @False@ allows for shell wildcard such as * to be expanded by the shell along with any other special shell characters.-- As a side-effect, setting to @False@ causes changes to @PATH@ to be ignored:-- see the 'run' documentation.escaping::Bool->Sha->ShaescapingshouldEscapeaction=sub$domodify$\st->st{sRun=ifshouldEscapethenrunCommandelserunCommandNoEscape}action-- | named after bash -e errexit. Defaults to @True@.-- When @True@, throw an exception on a non-zero exit code.-- When @False@, ignore a non-zero exit code.-- Not recommended to set to @False@ unless you are specifically checking the error code with 'lastExitCode'.errExit::Bool->Sha->ShaerrExitshouldExitaction=sub$domodify$\st->st{sErrExit=shouldExit}actiondataShellyOpts=ShellyOpts{failToDir::Bool}-- avoid data-default dependency for now-- instance Default ShellyOpts where shellyOpts::ShellyOptsshellyOpts=ShellyOpts{failToDir=True}-- | Using this entry point does not create a @.shelly@ directory in the case-- of failure. Instead it logs directly into the standard error stream (@stderr@).shellyNoDir::MonadIOm=>Sha->mashellyNoDir=shelly'shellyOpts{failToDir=False}-- | Enter a Sh 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 Sh.shelly::MonadIOm=>Sha->mashelly=shelly'shellyOptsshelly'::MonadIOm=>ShellyOpts->Sha->mashelly'optsaction=doenvironment<-liftIOgetEnvironmentdir<-liftIOgetWorkingDirectoryletdef=State{sCode=0,sStdin=Nothing,sStderr=T.empty,sPrintStdout=True,sPrintCommands=False,sRun=runCommand,sEnvironment=environment,sTracing=True,sTrace=T.empty,sDirectory=dir,sPathExecutables=Nothing,sErrExit=True}stref<-liftIO$newIORefdefletcaught=action`catches_sh`[ShellyHandler(\ex->caseexofExitSuccess->liftIO$throwIOexExitFailure_->throwExplainedExceptionex),ShellyHandler(\ex->caseexofQuietExitn->liftIO$throwIO$ExitFailuren),ShellyHandler(\(ex::SomeException)->throwExplainedExceptionex)]liftIO$runShcaughtstrefwherethrowExplainedException::Exceptionexception=>exception->ShathrowExplainedExceptionex=get>>=errorMsg>>=liftIO.throwIO.ReThrownExceptionexerrorMsgst=ifnot(failToDiropts)thenranCommandselsedod<-pwdsf<-shellyFileletlogFile=d</>shelly_dir</>sf(writefilelogFiletrc>>return("log of commands saved to: "<>encodeStringlogFile))`catchany_sh`(\_->ranCommands)wheretrc=sTracestranCommands=return.mappend"Ran commands: \n".T.unpack$trcshelly_dir=".shelly"shellyFile=chdir_pshelly_dir$dofs<-ls"."return$pack$show(nextNumfs)<>".txt"nextNum::[FilePath]->IntnextNum[]=1nextNumfs=(+1).maximum.map(readDef1.filterisDigit.unpack.filename)$fs-- from safe packagereadDef::Reada=>a->String->areadDefdef=fromMaybedef.readMaywherereadMay::Reada=>String->MaybeareadMays=case[x|(x,t)<-readss,("","")<-lext]of[x]->Justx_->NothingdataRunFailed=RunFailedFilePath[Text]IntTextderiving(Typeable)instanceShowRunFailedwhereshow(RunFailedexeargscodeerrs)=letcodeMsg=casecodeof127->". exit code 127 usually means the command does not exist (in the PATH)"_->""in"error running: "++T.unpack(show_commandexeargs)++"\nexit status: "++showcode++codeMsg++"\nstderr: "++T.unpackerrsinstanceExceptionRunFailedshow_command::FilePath->[Text]->Textshow_commandexeargs=T.intercalate" "$mapquote(toTextIgnoreexe:args)wherequotet|T.any(=='\'')t=tquotet|T.anyisSpacet=surround'\''tquotet|otherwise=tsurround::Char->Text->Textsurroundct=T.consc$T.snoctc-- | same as 'sshPairs', but returns ()sshPairs_::Text->[(FilePath,[Text])]->Sh()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"])]---- This interface is crude, but it works for now.---- Please note this sets 'escaping' to False: the commands will not be shell escaped.-- Internally the list of commands are combined with the string @&&@ before given to ssh.sshPairs::Text->[(FilePath,[Text])]->ShTextsshPairs_[]=return""sshPairsservercmds=sshPairs'runservercmdssshPairs'::(FilePath->[Text]->Sha)->Text->[(FilePath,[Text])]->ShasshPairs'run'serveractions=escapingFalse$doletssh_commands=surround'\''$foldl1(\memonext->memo<>" && "<>next)(maptoSSHactions)run'"ssh"[server,ssh_commands]wheretoSSH(exe,args)=show_commandexeargsdataQuietExit=QuietExitIntderiving(Show,Typeable)instanceExceptionQuietExitdataReThrownExceptione=ReThrownExceptioneStringderiving(Typeable)instanceExceptione=>Exception(ReThrownExceptione)instanceExceptione=>Show(ReThrownExceptione)whereshow(ReThrownExceptionexmsg)="\n"++msg++"\n"++"Exception: "++showex-- | Execute an external command.-- Takes the command name and arguments.---- You may prefer using 'cmd' instead, which is a variadic argument version-- of this function.---- '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 if you don't need stdout by using 'run_',-- If you want to avoid the memory and need to process the output then use 'runFoldLines' or 'runHandle' or 'runHandles'.---- By default shell characters are escaped and-- the command name is a name of a program that can be found via @PATH@.-- Shelly will look through the @PATH@ itself to find the command.---- When 'escaping' is set to @False@, shell characters are allowed.-- Since there is no longer a guarantee that a single program name is-- given, Shelly cannot look in the @PATH@ for it.-- a @PATH@ modified by setenv is not taken into account when finding the exe name.-- Instead the original Haskell program @PATH@ is used.-- On a Posix system the @env@ command can be used to make the 'setenv' PATH used when 'escaping' is set to False. @env echo hello@ instead of @echo hello@--run::FilePath->[Text]->ShTextrunfpargs=return.lineSeqToText=<<runFoldLinesmempty(|>)fpargs-- | bind some arguments to run for re-use. Example:---- > monit = command "monit" ["-c", "monitrc"]-- > monit ["stop", "program"]command::FilePath->[Text]->[Text]->ShTextcommandcomargsmore_args=runcom(args++more_args)-- | bind some arguments to 'run_' for re-use. Example:---- > monit_ = command_ "monit" ["-c", "monitrc"]-- > monit_ ["stop", "program"]command_::FilePath->[Text]->[Text]->Sh()command_comargsmore_args=run_com(args++more_args)-- | bind some arguments to run for re-use, and require 1 argument. Example:---- > git = command1 "git" []; git "pull" ["origin", "master"]command1::FilePath->[Text]->Text->[Text]->ShTextcommand1comargsone_argmore_args=runcom([one_arg]++args++more_args)-- | bind some arguments to run for re-use, and require 1 argument. Example:---- > git_ = command1_ "git" []; git "pull" ["origin", "master"]command1_::FilePath->[Text]->Text->[Text]->Sh()command1_comargsone_argmore_args=run_com([one_arg]++args++more_args)-- | the same as 'run', but return @()@ instead of the stdout content-- stdout will be read and discarded line-by-linerun_::FilePath->[Text]->Sh()run_=runFoldLines()(\__->())liftIO_::IOa->Sh()liftIO_action=void(liftIOaction)-- | Similar to 'run' but gives the raw stdout handle in a callback.-- If you want even more control, use 'runHandles'.runHandle::FilePath-- ^ command->[Text]-- ^ arguments->(Handle->Sha)-- ^ stdout handle->SharunHandleexeargswithHandle=runHandlesexeargs[]$\_outHerrH->doerrVar<-liftIO$doerrVar'<-newEmptyMVar_<-forkIO$transferLinesAndCombineerrHstderr>>=putMVarerrVar'returnerrVar'res<-withHandleoutHerrs<-liftIO$takeMVarerrVarmodify$\state'->state'{sStderr=errs}returnres-- | Similar to 'run' but gives direct access to all input and output handles.---- Be careful when using the optional input handles.-- If you specify Inherit for a handle then attempting to access the handle in your-- callback is an errorrunHandles::FilePath-- ^ command->[Text]-- ^ arguments->[StdHandle]-- ^ optionally connect process i/o handles to existing handles->(Handle->Handle->Handle->Sha)-- ^ stdin, stdout and stderr->SharunHandlesexeargsreusedHandleswithHandles=do-- clear stdin before beginning command executionorigstate<-getletmStdin=sStdinorigstateput$origstate{sStdin=Nothing,sCode=0,sStderr=T.empty}state<-getletcmdString=show_commandexeargswhen(sPrintCommandsstate)$echocmdStringtracecmdStringbracketOnWindowsError((sRunstate)reusedHandlesstateexeargs)(\(_,_,_,procH)->(liftIO$terminateProcessprocH))(\(inH,outH,errH,procH)->doliftIO$casemStdinofJustinput->TIO.hPutStrinHinputNothing->return()result<-withHandlesinHoutHerrH(ex,code)<-liftIO$doex'<-waitForProcessprocH-- TODO: specifically catch our own error for Inherit pipeshCloseoutH`catchany`(const$return())hCloseerrH`catchany`(const$return())hCloseinH`catchany`(const$return())return$caseex'ofExitSuccess->(ex',0)ExitFailuren->(ex',n)modify$\state'->state'{sCode=code}case(sErrExitstate,ex)of(True,ExitFailuren)->donewState<-getliftIO$throwIO$RunFailedexeargsn(sStderrnewState)_->returnresult)where-- Windows does not terminate spawned processes, so we must bracket.#if defined(mingw32_HOST_OS)bracketOnWindowsErroracquirereleasemain=doresource<-acquiremainresource`catchany_sh`(\e->do_<-releaseresourceliftIO$throwIOe)#elsebracketOnWindowsError::Sha->(a->Sh())->(a->Shb)->ShbbracketOnWindowsErroracquire_main=acquire>>=main#endif-- | used by 'run'. fold over stdout line-by-line as it is read to avoid keeping it in memory-- stderr is still being placed in memory under the assumption it is always relatively smallrunFoldLines::a->FoldCallbacka->FilePath->[Text]->SharunFoldLinesstartcbexeargs=runHandlesexeargs[]$\inHoutHerrH->do(errVar,outVar)<-liftIO$dohCloseinH-- setStdin was taken care of before the process even ranerrVar'<-newEmptyMVaroutVar'<-newEmptyMVar_<-forkIO$transferLinesAndCombineerrHstderr>>=putMVarerrVar'return(errVar',outVar')state<-geterrs<-liftIO$dovoid$ifsPrintStdoutstatethenforkIO$transferFoldHandleLinesstartcboutHstdout>>=putMVaroutVarelseforkIO$foldHandleLinesstartcboutH>>=putMVaroutVartakeMVarerrVarmodify$\state'->state'{sStderr=errs}liftIO$takeMVaroutVar-- | The output of last external command. See 'run'.lastStderr::ShTextlastStderr=getssStderr-- | The exit code from the last command.-- Unless you set 'errExit' to False you won't get a chance to use this: a non-zero exit code will throw an exception.lastExitCode::ShIntlastExitCode=getssCode-- | set the stdin to be used and cleared by the next 'run'.setStdin::Text->Sh()setStdininput=modify$\st->st{sStdin=Justinput}-- | Pipe operator. set the stdout the first command as the stdin of the second.-- This does not create a shell-level pipe, but hopefully it will in the future.-- To create a shell level pipe you can set @escaping False@ and use a pipe @|@ character in a command.(-|-)::ShText->Shb->Shbone-|-two=dores<-print_stdoutFalseonesetStdinrestwo-- | Copy a file, or a directory recursively.-- uses 'cp'cp_r::FilePath->FilePath->Sh()cp_rfrom'to'=dofrom<-absPathfrom'fromIsDir<-(test_dfrom)ifnotfromIsDirthencpfrom'to'elsedoto<-absPathto'trace$"cp -r "<>toTextIgnorefrom<>" "<>toTextIgnoretotoIsDir<-test_dtowhen(from==to)$liftIO$throwIO$userError$show$"cp_r: "<>toTextIgnorefrom<>" and "<>toTextIgnoreto<>" are identical"finalTo<-ifnottoIsDirthenmkdirto>>returntoelsedoletd=to</>dirname(addTrailingSlashfrom)mkdir_pd>>returndlsfrom>>=mapM_(\item->cp_r(fromFP.</>filenameitem)(finalToFP.</>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->Sh()cpfrom'to'=dofrom<-absPathfrom'to<-absPathto'trace$"cp "<>toTextIgnorefrom<>" "<>toTextIgnoretoto_dir<-test_dtoletto_loc=ifto_dirthentoFP.</>filenamefromelsetoliftIO$copyFilefromto_loc`catchany`(\e->throwIO$ReThrownExceptione(extraMsgto_locfrom))whereextraMsgtf="during copy from: "++unpackf++" to: "++unpackt-- | Create a temporary directory and pass it as a parameter to a Sh-- computation. The directory is nuked afterwards.withTmpDir::(FilePath->Sha)->ShawithTmpDiract=dotrace"withTmpDir"dir<-liftIOgetTemporaryDirectorytid<-liftIOmyThreadId(pS,handle)<-liftIO$openTempFiledir("tmp"++filterisAlphaNum(showtid))letp=packpSliftIO$hClosehandle-- required on windowsrm_fpmkdirpactp`finally_sh`rm_rfp-- | Write a Lazy Text to a file.writefile::FilePath->Text->Sh()writefilef'bits=absPathf'>>=\f->dotrace$"writefile "<>toTextIgnorefliftIO(TIO.writeFile(unpackf)bits)-- | Update a file, creating (a blank file) if it does not exist.touchfile::FilePath->Sh()touchfile=absPath>=>flipappendfile""-- | Append a Lazy Text to a file.appendfile::FilePath->Text->Sh()appendfilef'bits=absPathf'>>=\f->dotrace$"appendfile "<>toTextIgnorefliftIO(TIO.appendFile(unpackf)bits)readfile::FilePath->ShTextreadfile=absPath>=>\fp->dotrace$"readfile "<>toTextIgnorefpreadBinaryfp>>=return.TE.decodeUtf8WithTE.lenientDecode-- | wraps ByteSting readFilereadBinary::FilePath->ShByteStringreadBinary=absPath>=>liftIO.BS.readFile.unpack-- | flipped hasExtension for TexthasExt::Text->FilePath->BoolhasExt=fliphasExtension-- | Run a Sh computation and collect timing information.time::Sha->Sh(Double,a)timewhat=sub$dotrace"time"t<-liftIOgetCurrentTimeres<-whatt'<-liftIOgetCurrentTimereturn(realToFrac$diffUTCTimet't,res)-- | threadDelay wrapper that uses secondssleep::Int->Sh()sleep=liftIO.threadDelay.(1000*1000*)