summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGregWeber <>2017-12-07 04:18:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-12-07 04:18:00 (GMT)
commitd23d8e6f2ae863bb61c4f6462b6798698d9cb179 (patch)
tree21f948bf1360935f8d9b1d270da7fef1dd9fcd9c
parent875d35662afec46c37bdfdbdd90b571f0332e3b6 (diff)
version 1.6.91.6.9
-rw-r--r--README.md11
-rw-r--r--shelly.cabal3
-rw-r--r--src/Shelly.hs56
-rw-r--r--test/src/FindSpec.hs8
-rw-r--r--test/src/SshSpec.hs18
-rw-r--r--test/src/TestMain.hs2
-rwxr-xr-xtest/testall1
7 files changed, 72 insertions, 27 deletions
diff --git a/README.md b/README.md
index 8778f69..2224858 100644
--- a/README.md
+++ b/README.md
@@ -78,10 +78,9 @@ Shelly's finders load all files into memory. This is simpler to use if you contr
Shelly does not change the nature of shell scripting (text in, text out).
If you want something more revolutionary you might try these:
-* [Plush](https://github.com/mzero/plush) shell with nice GUI. Written in Haskell. Actively developed, unlike [TermKit](https://github.com/unconed/TermKit/)
-* PowerShell is proably the best known.
+* PowerShell is probably the best known.
* [Haskell project](https://github.com/pkamenarsky/ytools) using typed JSON
-* [untyped JSON](https://github.com/benbernard/RecordStream)
+* [RecordStream](https://github.com/benbernard/RecordStream) untyped JSON]
## Usage
@@ -145,7 +144,7 @@ Building up abstractions with cmd will require type signatures.
### Escaping
By default, all commands are shell escaped.
-If you want the shell to interpret special characters such as `*`, just use `escaping False $ do ...`
+If you want the shell to interpret special characters such as `*`, just use `escaping False $ do ...`
### Using Text and FilePath together
@@ -180,6 +179,4 @@ You can turn tracing off (not generally recommended) by setting `tracing False`.
## Future plans
-* improved SSH API
-* more efficient piping/redirecting (issue #18)
-* more efficient find functions (issue #23)
+* Don't use the filepath library
diff --git a/shelly.cabal b/shelly.cabal
index f3b0004..3719fb0 100644
--- a/shelly.cabal
+++ b/shelly.cabal
@@ -1,6 +1,6 @@
Name: shelly
-Version: 1.6.8.7
+Version: 1.6.9
Synopsis: shell-like (systems) programming in Haskell
Description: Shelly provides convenient systems programming in Haskell,
@@ -100,6 +100,7 @@ Test-Suite shelly-testsuite
ReadFileSpec
RmSpec
RunSpec
+ SshSpec
Shelly
Shelly.Base
Shelly.Find
diff --git a/src/Shelly.hs b/src/Shelly.hs
index 568fe9f..d4f6e5a 100644
--- a/src/Shelly.hs
+++ b/src/Shelly.hs
@@ -34,7 +34,8 @@ module Shelly
, bash, bash_, bashPipeFail
, (-|-), lastStderr, setStdin, lastExitCode
, command, command_, command1, command1_
- , sshPairs, sshPairs_, sshPairsWithOptions
+ , sshPairs,sshPairsPar, sshPairs_,sshPairsPar_, sshPairsWithOptions
+ , sshCommandText, SshMode(..)
, ShellCmd(..), CmdArg (..)
-- * Running commands Using handles
@@ -319,7 +320,13 @@ runCommand handles st exe args = findExe exe >>= \fullExe ->
RawCommand (encodeString fullExe) (map T.unpack args)
where
findExe :: FilePath -> Sh FilePath
- findExe fp = do
+ findExe
+#if defined(mingw32_HOST_OS) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 708)
+ fp
+#else
+ _fp
+#endif
+ = do
mExe <- whichEith exe
case mExe of
Right execFp -> return execFp
@@ -1039,11 +1046,19 @@ show_command exe args =
surround :: Char -> Text -> Text
surround c t = T.cons c $ T.snoc t c
+data SshMode = ParSsh | SeqSsh
+
-- | same as 'sshPairs', but returns ()
sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh ()
sshPairs_ _ [] = return ()
sshPairs_ server cmds = sshPairs' run_ server cmds
+-- | same as 'sshPairsP', but returns ()
+
+sshPairsPar_ :: Text -> [(FilePath, [Text])] -> Sh ()
+sshPairsPar_ _ [] = return ()
+sshPairsPar_ server cmds = sshPairsPar' run_ server cmds
+
-- | run commands over SSH.
-- An ssh executable is expected in your path.
-- Commands are in the same form as 'run', but given as pairs
@@ -1056,28 +1071,39 @@ sshPairs_ server cmds = sshPairs' run_ server cmds
-- Internally the list of commands are combined with the string @&&@ before given to ssh.
sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text
sshPairs _ [] = return ""
-sshPairs server cmds = sshPairsWithOptions' run server [] cmds
+sshPairs server cmds = sshPairsWithOptions' run server [] cmds SeqSsh
+
+-- | Same as sshPairs, but combines commands with the string @&@, so they will be started in parallell.
+sshPairsPar :: Text -> [(FilePath, [Text])] -> Sh Text
+sshPairsPar _ [] = return ""
+sshPairsPar server cmds = sshPairsWithOptions' run server [] cmds ParSsh
+
+sshPairsPar' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
+sshPairsPar' run' server actions = sshPairsWithOptions' run' server [] actions ParSsh
sshPairs' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
-sshPairs' run' server actions = sshPairsWithOptions' run' server [] actions
-
--- | Like 'sshPairs', but allows for arguments to the call to ssh.
+sshPairs' run' server actions = sshPairsWithOptions' run' server [] actions SeqSsh
+
+-- | Like 'sshPairs', but allows for arguments to the call to ssh.
sshPairsWithOptions :: Text -- ^ Server name.
-> [Text] -- ^ Arguments to ssh (e.g. ["-p","22"]).
-> [(FilePath, [Text])] -- ^ Pairs of commands to run on the remote.
-> Sh Text -- ^ Returns the standard output.
sshPairsWithOptions _ _ [] = return ""
-sshPairsWithOptions server sshargs cmds = sshPairsWithOptions' run server sshargs cmds
-
-sshPairsWithOptions' :: (FilePath -> [Text] -> Sh a) -> Text -> [Text] -> [(FilePath, [Text])] -> Sh a
-sshPairsWithOptions' run' server sshargs actions = escaping False $ do
- let ssh_commands = surround '\'' $ foldl1
- (\memo next -> memo <> " && " <> next)
- (map toSSH actions)
- run' "ssh" ([server] ++ sshargs ++ [ssh_commands])
+sshPairsWithOptions server sshargs cmds = sshPairsWithOptions' run server sshargs cmds SeqSsh
+
+sshPairsWithOptions' :: (FilePath -> [Text] -> Sh a) -> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a
+sshPairsWithOptions' run' server sshargs actions mode = escaping False $ do
+ run' "ssh" ([server] ++ sshargs ++ [sshCommandText actions mode])
+
+sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text
+sshCommandText actions mode =
+ surround '"' (foldl1 joiner (map toSSH actions))
where
toSSH (exe,args) = show_command exe args
-
+ joiner memo next = case mode of
+ SeqSsh -> memo <> " && " <> next
+ ParSsh -> memo <> " & " <> next
data QuietExit = QuietExit Int deriving (Show, Typeable)
instance Exception QuietExit
diff --git a/test/src/FindSpec.hs b/test/src/FindSpec.hs
index 11a0921..3a2ecbc 100644
--- a/test/src/FindSpec.hs
+++ b/test/src/FindSpec.hs
@@ -29,7 +29,7 @@ findSpec = do
res <- shelly $ cd "test/src" >> ls "."
sort res @?= ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",
"./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs",
- "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs",
+ "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs",
"./TestInit.hs", "./TestMain.hs",
"./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"]
@@ -37,7 +37,7 @@ findSpec = do
res <- shelly $ cd "test/src" >> find "."
sort res @?= ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",
"./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs",
- "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs",
+ "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs",
"./TestInit.hs", "./TestMain.hs",
"./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"]
@@ -56,7 +56,7 @@ findSpec = do
sort res @?= ["test/src/CopySpec.hs", "test/src/EnvSpec.hs", "test/src/FailureSpec.hs",
"test/src/FindSpec.hs", "test/src/Help.hs", "test/src/LiftedSpec.hs",
"test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/ReadFileSpec.hs",
- "test/src/RmSpec.hs", "test/src/RunSpec.hs",
+ "test/src/RmSpec.hs", "test/src/RunSpec.hs", "test/src/SshSpec.hs",
"test/src/TestInit.hs", "test/src/TestMain.hs", "test/src/WhichSpec.hs", "test/src/WriteSpec.hs",
"test/src/sleep.hs"]
@@ -64,7 +64,7 @@ findSpec = do
res <- shelly $ relPath "test/src" >>= find >>= mapM (relativeTo "test/src")
sort res @?= ["CopySpec.hs", "EnvSpec.hs", "FailureSpec.hs", "FindSpec.hs",
"Help.hs", "LiftedSpec.hs", "LogWithSpec.hs", "MoveSpec.hs",
- "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs",
+ "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs", "SshSpec.hs",
"TestInit.hs", "TestMain.hs",
"WhichSpec.hs", "WriteSpec.hs", "sleep.hs"]
diff --git a/test/src/SshSpec.hs b/test/src/SshSpec.hs
new file mode 100644
index 0000000..1fcfcb5
--- /dev/null
+++ b/test/src/SshSpec.hs
@@ -0,0 +1,18 @@
+module SshSpec ( sshSpec ) where
+
+import TestInit
+
+sshSpec :: Spec
+sshSpec = do
+ describe "sshCommandText" $ do
+ it "simple command" $ do
+ let res = sshCommandText [("wibble", [])] SeqSsh
+ res @?= "\"wibble\""
+
+ it "space command" $ do
+ let res = sshCommandText [("to", ["outer space"])] SeqSsh
+ res @?= "\"to 'outer space'\""
+
+ it "multiple space commands" $ do
+ let res = sshCommandText [("to", ["outer space"]), ("and", ["back again"])] SeqSsh
+ res @?= "\"to 'outer space' && and 'back again'\""
diff --git a/test/src/TestMain.hs b/test/src/TestMain.hs
index 5869bce..206423a 100644
--- a/test/src/TestMain.hs
+++ b/test/src/TestMain.hs
@@ -12,6 +12,7 @@ import FailureSpec
import CopySpec
import LiftedSpec
import RunSpec
+import SshSpec
import Test.Hspec
@@ -28,3 +29,4 @@ main = hspec $ do
copySpec
liftedSpec
runSpec
+ sshSpec
diff --git a/test/testall b/test/testall
index 3728b13..3ee91a7 100755
--- a/test/testall
+++ b/test/testall
@@ -41,6 +41,7 @@ ReadFileSpec
WhichSpec
WriteSpec
RunSpec
+SshSpec
'
EXCL=""