{-# LANGUAGE CPP #-}{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings,
MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, TypeFamilies, IncoherentInstances,
GADTs
#-}-- | 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 Sh 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 Shelly-- > import Data.Text.Lazy as LT-- > default (LT.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(..)-- * 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)importControl.Monad.Trans(MonadIO)importControl.Monad.Reader(ask)importPreludehiding(catch,readFile,FilePath)importData.Char(isAlphaNum,isSpace)importData.TypeableimportData.IORefimportData.MaybeimportSystem.IO(hClose,stderr,stdout,openTempFile)importSystem.ExitimportSystem.EnvironmentimportControl.ApplicativeimportControl.Exceptionhiding(handle)importControl.ConcurrentimportData.Time.Clock(getCurrentTime,diffUTCTime)importqualifiedData.Text.Lazy.IOasTIOimportqualifiedData.Text.EncodingasTEimportqualifiedData.Text.Encoding.ErrorasTEimportSystem.Process(CmdSpec(..),StdStream(CreatePipe),CreateProcess(..),createProcess,waitForProcess,terminateProcess,ProcessHandle)importSystem.IO.Error(isPermissionError)importqualifiedData.Text.LazyasLTimportqualifiedData.Text.Lazy.BuilderasBimportqualifiedData.TextasTimportqualifiedData.ByteStringasBSimportData.ByteString(ByteString)importData.Monoid(mappend)importFilesystem.Path.CurrentOShiding(concat,fromText,(</>),(<.>))importFilesystemhiding(canonicalizePath)importqualifiedFilesystem.Path.CurrentOSasFPimportSystem.Directory(setPermissions,getPermissions,Permissions(..),getTemporaryDirectory,findExecutable)importData.Char(isDigit)importData.Tree(Tree(..)){- 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=LT.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'.-- 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'.-- 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.toStrictytoTextWarn::FilePath->ShTexttoTextWarnefile=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"")foldBuilderrHwH{-
getContent :: Handle -> IO Text
getContent h = fmap B.toLazyText $ foldHandleLines (B.fromText "") foldBuilder h
-}typeFoldCallbacka=((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`\_->returnacc-- | same as 'trace', but use it combinator styletag::Sha->Text->Shatagactionmsg=dotracemsgactionput::State->Sh()putnewState=dostateVar<-askliftIO(writeIORefstateVarnewState)-- FIXME: find the full path to the exe from PATHrunCommand::State->FilePath->[Text]->IO(Handle,Handle,Handle,ProcessHandle)runCommandstexeargs=shellyProcessst$RawCommand(unpackexe)(mapLT.unpackargs)runCommandNoEscape::State->FilePath->[Text]->IO(Handle,Handle,Handle,ProcessHandle)runCommandNoEscapestexeargs=shellyProcessst$ShellCommand$LT.unpack$LT.intercalate" "(toTextIgnoreexe:args)shellyProcess::State->CmdSpec->IO(Handle,Handle,Handle,ProcessHandle)shellyProcessstcmdSpec=do(Justhin,Justhout,Justherr,pHandle)<-createProcessCreateProcess{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 :: 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. 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->Sh()cd=canonic>=>cd'wherecd'dir=dotrace$"cd "`mappend`tdirunlessM(test_ddir)$errorExit$"not a directory: "`mappend`tdirmodify$\st->st{sDirectory=dir}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 "`mappend`toTextIgnorefrom`mappend`" "`mappend`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 "`mappend`LT.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.LT.unpack-- | Create a new directory (fails if the directory exists).mkdir::FilePath->Sh()mkdir=absPath>=>\fp->dotrace$"mkdir "`mappend`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 "`mappend`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 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->Sh(MaybeFilePath)whichfp=do(trace.mappend"which ".toTextIgnore)fp(liftIO.findExecutable.unpack>=>return.fmappack)fp-- | 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 "`mappend`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 "`mappend`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"`mappend`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=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'-- TODO: use cross-platform searchPathSeparatorappendToPath::FilePath->Sh()appendToPath=absPath>=>\filepath->dotp<-toTextWarnfilepathpe<-get_env_textpath_envsetenvpath_env$pe`mappend`":"`mappend`tpwherepath_env="PATH"-- | 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.fmapLT.pack.lookup(LT.unpackk)=<<getssEnvironmentreturn$casemvalofNothing->Nothingj@(Justval)->ifLT.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=B.fromText""}a`finally_sh`restoreStateoldStatewhererestoreStateoldState=donewState<-getputoldState{-- avoid losing the logsTrace=sTraceoldState`mappend`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.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=LT.empty,sPrintStdout=True,sPrintCommands=False,sRun=runCommand,sEnvironment=environment,sTracing=True,sTrace=B.fromText"",sDirectory=dir,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: "`mappend`encodeStringlogFile))`catchany_sh`(\_->ranCommands)wheretrc=B.toLazyText.sTrace$stranCommands=return.mappend"Ran commands: \n".LT.unpack$trcshelly_dir=".shelly"shellyFile=chdir_pshelly_dir$dofs<-ls"."return$pack$show(nextNumfs)`mappend`".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: "++LT.unpack(show_commandexeargs)++"\nexit status: "++showcode++codeMsg++"\nstderr: "++LT.unpackerrsinstanceExceptionRunFailedshow_command::FilePath->[Text]->Textshow_commandexeargs=LT.intercalate" "$mapquote(toTextIgnoreexe:args)wherequotet|LT.any(=='\'')t=tquotet|LT.anyisSpacet=surround'\''tquotet|otherwise=tsurround::Char->Text->Textsurroundct=LT.consc$LT.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`mappend`" && "`mappend`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 (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]->ShTextrunexeargs=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"]-- > 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=liftIOaction>>return()-- | 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=do-- clear stdin before beginning command executionorigstate<-getletmStdin=sStdinorigstateput$origstate{sStdin=Nothing,sCode=0,sStderr=LT.empty}state<-getletcmdString=show_commandexeargswhen(sPrintCommandsstate)$echocmdStringtracecmdString(ex,errs,outV)<-liftIO$bracketOnWindowsError(sRunstatestateexeargs)(\(_,_,_,procH)->(terminateProcessprocH))(\(inH,outH,errH,procH)->docasemStdinofJustinput->TIO.hPutStrinHinput>>hCloseinH-- stdin is cleared from state belowNothing->return()errV<-newEmptyMVaroutV'<-newEmptyMVar_<-forkIO$printGetContenterrHstderr>>=putMVarerrV-- liftIO_ $ forkIO $ getContent errH >>= putMVar errV_<-ifsPrintStdoutstatethenforkIO$printFoldHandleLinesstartcboutHstdout>>=putMVaroutV'elseforkIO$foldHandleLinesstartcboutH>>=putMVaroutV'errs'<-takeMVarerrVex'<-waitForProcessprocHreturn(ex',errs',outV'))letcode=caseexofExitSuccess->0ExitFailuren->nmodify$\state'->state'{sStderr=errs,sCode=code}liftIO$case(sErrExitstate,ex)of(True,ExitFailuren)->throwIO$RunFailedexeargsnerrs_->takeMVaroutVwhere-- Windows does not terminate spawned processes, so we must bracket.#if defined(mingw32_HOST_OS)bracketOnWindowsError=bracketOnError#elsebracketOnWindowsErroracquire_main=acquire>>=main#endif-- | 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 "`mappend`toTextIgnorefrom`mappend`" "`mappend`toTextIgnoretotoIsDir<-test_dtowhen(from==to)$liftIO$throwIO$userError$LT.unpack$"cp_r: "`mappend`toTextIgnorefrom`mappend`" and "`mappend`toTextIgnoreto`mappend`" 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 "`mappend`toTextIgnorefrom`mappend`" "`mappend`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 "`mappend`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 "`mappend`toTextIgnorefliftIO(TIO.appendFile(unpackf)bits)-- | (Strictly) read file into a Text.-- All other functions use Lazy Text.-- Internally this reads a file as strict text and then converts it to lazy text, which is inefficientreadfile::FilePath->ShTextreadfile=absPath>=>\fp->dotrace$"readfile "`mappend`toTextIgnorefpreadBinaryfp>>=return.LT.fromStrict.TE.decodeUtf8WithTE.lenientDecode-- | wraps ByteSting readFilereadBinary::FilePath->ShByteStringreadBinary=absPath>=>liftIO.BS.readFile.unpack-- | flipped hasExtension for TexthasExt::Text->FilePath->BoolhasExt=fliphasExtension.LT.toStrict-- | 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*)