shelly 1.6.8.7 → 1.6.9

raw patch · 7 files changed

+71/−26 lines, 7 files

Files

• README.md +4/−7
• shelly.cabal +2/−1
• src/Shelly.hs +40/−14
• test/src/FindSpec.hs +4/−4
• test/src/SshSpec.hs +18/−0
• test/src/TestMain.hs +2/−0
• test/testall +1/−0

@@ -78,10 +78,9 @@ 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 @@ ### 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 @@  ## Future plans -* improved SSH API-* more efficient piping/redirecting (issue #18)-* more efficient find functions (issue #23)+* Don't use the filepath library

@@ -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 @@     ReadFileSpec     RmSpec     RunSpec+    SshSpec     Shelly     Shelly.Base     Shelly.Find

@@ -34,7 +34,8 @@          , 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 @@     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 @@ 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 @@ -- 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 server sshargs cmds = sshPairsWithOptions' run server sshargs cmds SeqSsh -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' :: (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

@@ -29,7 +29,7 @@       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 @@       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 @@       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 @@       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"] 

@@ -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'\""

@@ -12,6 +12,7 @@ import CopySpec import LiftedSpec import RunSpec+import SshSpec  import Test.Hspec @@ -28,3 +29,4 @@     copySpec     liftedSpec     runSpec+    sshSpec

@@ -41,6 +41,7 @@ WhichSpec WriteSpec RunSpec+SshSpec '  EXCL=""