handsy 0.0.8 → 0.0.9

raw patch · 5 files changed

+94/−51 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• handsy.cabal +1/−1
• src/System/Handsy.hs +37/−23
• src/System/Handsy/Core.hs +7/−6
• src/System/Handsy/Remote.hs +7/−8
• test/Test.hs +42/−13

@@ -1,5 +1,5 @@ name:          handsy-version:       0.0.8+version:       0.0.9 synopsis:      A DSL to describe common shell operations and interpeters for running them locally and remotely. -- description:    Homepage:      https://github.com/utdemir/handsy

@@ -2,24 +2,41 @@ {-# LANGUAGE OverloadedStrings #-}  module System.Handsy-  ( module System.Handsy-  , Handsy-  , Options+  ( Handsy+  , run++  -- * Commands+  , command+  , readFile+  , writeFile+  , appendFile+  , shell++  -- * Helpers+  , command_+  , shell_++  -- * Options+  , Options (..)   , options-  , debug++  -- * Re-exports+  , ExitCode (..)   ) where +import           Prelude                        hiding (appendFile, readFile,+                                                 writeFile)+ import qualified Data.ByteString.Lazy           as B import qualified Data.ByteString.Lazy.Char8     as C import           System.Exit -import           Control.Monad.Trans.Free import           System.Process.ByteString.Lazy  import           System.Handsy.Core             hiding (command) import qualified System.Handsy.Core             as I --- * Actions+-- * Commands  -- | Runs a command command :: FilePath     -- ^ Command to run@@ -37,16 +54,14 @@ -- | @writeFile file str@ function writes the bytestring @str@, to the file @file@. writeFile :: FilePath -> B.ByteString -> Handsy () writeFile fp s = command "dd" ["of=" ++ fp] s >>= \case-  (ExitSuccess, stdin, _) -> return ()-  _                       -> error $ "Error writing to " ++ fp+  (ExitSuccess, _, _) -> return ()+  _                   -> error $ "Error writing to " ++ fp  -- | @appendFile file str@ function appends the bytestring @str@, to the file @file@. appendFile :: FilePath -> B.ByteString -> Handsy () appendFile fp s = command "dd" ["of=" ++ fp, "conv=notrunc", "oflag=append"] s >>= \case-  (ExitSuccess, stdin, _) -> return ()-  _                       -> error $ "Error appending to " ++ fp---- * Helpers+  (ExitSuccess, _, _) -> return ()+  _                   -> error $ "Error appending to " ++ fp  {-| Executes the given string in shell @@ -55,23 +70,22 @@ shell :: String       -- ^ String to execute       -> B.ByteString -- ^ Standart input       -> Handsy (ExitCode, B.ByteString, B.ByteString) -- ^ (ExitCode, Stdout, Stderr)-shell cmd stdin = command "/usr/bin/env" ["sh", "-c", cmd] stdin---- | Same as 'shell', but ExitFailure is a runtime error.-shell_ :: String  -> B.ByteString -> Handsy (B.ByteString, B.ByteString)-shell_ cmd stdin = shell cmd stdin >>= \case-  (ExitFailure code, _, stderr) -> error ('`':cmd ++ "` returned " ++ show code-                                       ++ "\nStderr was: " ++ (C.unpack stderr))-  (ExitSuccess, stdout, stderr) -> return (stdout, stderr)+shell cmd = command "sh" ["-c", cmd]  -- | Same as 'command', but ExitFailure is a runtime error. command_ :: FilePath -> [String] -> B.ByteString -> Handsy (B.ByteString, B.ByteString) command_ path args stdin = command path args stdin >>= \case-  (ExitFailure code, _, stderr) -> error ('`':path ++ ' ' :(show args) ++ "` returned " ++ show code-                                       ++ "\nStderr was: " ++ (C.unpack stderr))+  (ExitFailure code, _, stderr) -> error ('`':path ++ ' ' : show args ++ "` returned " ++ show code+                                       ++ "\nStderr was: " ++ C.unpack stderr)   (ExitSuccess, stdout, stderr) -> return (stdout, stderr) --- * Interpreter+-- | Same as 'shell', but ExitFailure is a runtime error.+shell_ :: String  -> B.ByteString -> Handsy (B.ByteString, B.ByteString)+shell_ cmd stdin = shell cmd stdin >>= \case+  (ExitFailure code, _, stderr) -> error ('`':cmd ++ "` returned " ++ show code+                                       ++ "\nStderr was: " ++ C.unpack stderr)+  (ExitSuccess, stdout, stderr) -> return (stdout, stderr) +-- | Executes the actions locally run :: Options -> Handsy a -> IO a run = interpretSimple readProcessWithExitCode

@@ -7,9 +7,8 @@   , interpret   , interpretSimple   , command-  , Options+  , Options (..)   , options-  , debug   ) where  import           Control.Exception        (bracket)@@ -18,7 +17,7 @@ import           Control.Monad.Trans.Free import qualified Data.ByteString.Lazy     as B import           System.Exit-import           System.IO+import           System.IO                (hPutStrLn, stderr)  data HandsyF k =     Command      FilePath [String] B.ByteString ((ExitCode, B.ByteString, B.ByteString) -> k)@@ -26,14 +25,16 @@  makeFree ''HandsyF +-- | Main monad type Handsy = FreeT HandsyF IO  data Options =   Options { debug :: Bool -- ^ Log commands to stderr before running           } +-- | Default options options :: Options-options = Options True+options = Options False  interpret :: IO r         -- ^ Acquire resource           -> (r -> IO ()) -- ^ Release resource@@ -42,14 +43,14 @@           -> Options           -> Handsy a           -> IO a-interpret acquire destroy f opts handsy = bracket acquire destroy (flip go handsy)+interpret acquire destroy f opts handsy = bracket acquire destroy (`go` handsy)   where go res h = do           x <- runFreeT h           case x of             Pure r -> return r             Free (Command prg args stdin next)               -> when (debug opts) (hPutStrLn stderr $ prg ++ ' ' : show args)-              >> f res prg args stdin >>= (go res) . next+              >> f res prg args stdin >>= go res . next  interpretSimple :: (String -> [String] -> B.ByteString                 -> IO (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode'

@@ -1,24 +1,23 @@ {-# LANGUAGE OverloadedStrings #-}+ module System.Handsy.Remote where -import           Prelude                  hiding (appendFile, readFile,-                                           writeFile)+import           Prelude                hiding (appendFile, readFile, writeFile)  import           System.Handsy-import           System.Handsy.Core       (interpretSimple)+import           System.Handsy.Core     (interpretSimple) -import qualified Data.ByteString.Char8    as C8-import qualified Data.ByteString.Lazy     as B-import           System.Exit+import qualified Data.ByteString.Char8  as C8+import qualified Data.ByteString.Lazy   as B  import           Control.Monad.IO.Class-import           Control.Monad.Trans.Free  import           Text.ShellEscape  data RemoteOptions =   RemoteOptions {-    sshCommand :: (String, [String])+    -- | Path of `ssh` command and command line arguments+    sshCommand :: (FilePath, [String])   }  -- | Executes the actions at a remote host

@@ -3,36 +3,65 @@ module Main where  import           System.Handsy              as H+import           System.Handsy.Remote       as H  import           Control.Applicative-import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Lazy       as B+import qualified Data.ByteString.Lazy.Char8 as C import           Data.Char import           Data.List+import           System.Exit  import           Test.Tasty import           Test.Tasty.HUnit +arbitraryBinary :: B.ByteString+arbitraryBinary = B.pack [1..255]++createTempFile :: Handsy String+createTempFile = dropWhileEnd isSpace . C.unpack . fst <$> command_ "mktemp" [] ""+ test1 = testCase "writeFile . readFile == id" $ do-  (h1, h2) <- H.run options{debug=True} $ do-    bin <- H.readFile "/bin/sh"-    tmp <- dropWhileEnd isSpace . B.unpack . fst <$> command_ "mktemp" [] ""+  ret <- H.run options{debug=True} $ do+    tmp <- createTempFile -    H.writeFile tmp bin+    H.writeFile tmp arbitraryBinary+    H.readFile tmp -    h1 <- takeWhile isHexDigit . B.unpack . fst <$> H.command_ "md5sum" ["/bin/sh"] ""-    h2 <- takeWhile isHexDigit . B.unpack . fst <$> H.command_ "md5sum" [tmp] ""+  assertEqual "" arbitraryBinary ret -    return (h1, h2)+test2 = testCase "appendFile" $ do+  ret <- H.run options{debug=True} $ do+    tmp <- createTempFile -  assertEqual "" h1 h2+    H.writeFile tmp "ut"+    H.appendFile tmp "demir" -test2 = testCase "shell" $ do+    H.readFile tmp++  assertEqual "" "utdemir" ret++test3 = testCase "shell" $ do   (h1, h2) <- H.run options{debug=True} $ do-    h1 <- takeWhile isHexDigit . B.unpack . fst <$> command_ "md5sum" ["/bin/sh"] ""-    h2 <- takeWhile isHexDigit . B.unpack . fst <$> shell_ "cat /bin/sh | md5sum -" ""+    tmp <- createTempFile++    H.writeFile tmp (B.pack [1..255])++    h1 <- takeWhile isHexDigit . C.unpack . fst <$> command_ "md5sum" [tmp] ""+    h2 <- takeWhile isHexDigit . C.unpack . fst <$> shell_ ("cat " ++ tmp ++ " | md5sum -") ""     return (h1, h2)    assertEqual "" h1 h2 +test4 = testCase "exit" $ do+  (e1, e2) <- H.run options{debug=True} $ do+    (e1, _, _) <- command "grep" [] ""+    (e2, _, _) <- command "id" [] ""+    return (e1, e2)++  case (e1, e2) of+   (ExitFailure _, ExitSuccess) -> return ()+   _ -> assertFailure $ "Invalid return values: " ++ show (e1, e2)+ main :: IO ()-main = defaultMain (testGroup "handsy" [test1, test2])+main = defaultMain (testGroup "handsy" [test1, test2, test3, test4])