handsy 0.0.7 → 0.0.8

raw patch · 6 files changed

+148/−67 lines, 6 filesdep +tastydep +tasty-hunitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: tasty, tasty-hunit

API changes (from Hackage documentation)

Files

• handsy.cabal +17/−2
• src/System/Handsy.hs +23/−26
• src/System/Handsy/Core.hs +59/−0
• src/System/Handsy/Internal.hs +0/−19
• src/System/Handsy/Remote.hs +11/−20
• test/Test.hs +38/−0

@@ -1,5 +1,5 @@ name:          handsy-version:       0.0.7+version:       0.0.8 synopsis:      A DSL to describe common shell operations and interpeters for running them locally and remotely. -- description:    Homepage:      https://github.com/utdemir/handsy@@ -18,7 +18,7 @@ library   exposed-modules:  System.Handsy                     System.Handsy.Remote-                    System.Handsy.Internal+                    System.Handsy.Core   build-depends:    base >=4.6 && <4.8                   , bytestring                   , process@@ -29,3 +29,18 @@   hs-source-dirs:   src   default-language: Haskell2010   ghc-options: -Wall++test-suite tests+    type:             exitcode-stdio-1.0+    main-is:          Test.hs+    default-language: Haskell2010+    hs-source-dirs:   src test+    build-depends: base >=4.6 && < 4.8+                 , bytestring+                 , process+                 , transformers+                 , free+                 , process-extras+                 , shell-escape+                 , tasty+                 , tasty-hunit

@@ -1,7 +1,13 @@ {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} -module System.Handsy where+module System.Handsy+  ( module System.Handsy+  , Handsy+  , Options+  , options+  , debug+  ) where  import qualified Data.ByteString.Lazy           as B import qualified Data.ByteString.Lazy.Char8     as C@@ -10,10 +16,8 @@ import           Control.Monad.Trans.Free import           System.Process.ByteString.Lazy -import           System.Handsy.Internal         (HandsyF (..))-import qualified System.Handsy.Internal         as T--type Handsy = FreeT T.HandsyF IO+import           System.Handsy.Core             hiding (command)+import qualified System.Handsy.Core             as I  -- * Actions @@ -22,19 +26,25 @@         -> [String]     -- ^ Arguments         -> B.ByteString -- ^ Standart Input         -> Handsy (ExitCode, B.ByteString, B.ByteString) -- ^ (status, stdout, stderr)-command = T.command+command = I.command  -- | Reads a file and returns the contents of the file. readFile :: FilePath -> Handsy B.ByteString-readFile = T.readFile+readFile fp = command "cat" [fp] "" >>= \case+  (ExitSuccess, stdin, _) -> return stdin+  _                       -> error $ "Error reading " ++ fp --- | 'writeFile' @file str@ function writes the bytestring @str@, to the file @file@.+-- | @writeFile file str@ function writes the bytestring @str@, to the file @file@. writeFile :: FilePath -> B.ByteString -> Handsy ()-writeFile = T.writeFile+writeFile fp s = command "dd" ["of=" ++ fp] s >>= \case+  (ExitSuccess, stdin, _) -> return ()+  _                       -> error $ "Error writing to " ++ fp --- | 'appendFile' @file str@ function appends the bytestring @str@, to the file @file@.+-- | @appendFile file str@ function appends the bytestring @str@, to the file @file@. appendFile :: FilePath -> B.ByteString -> Handsy ()-appendFile = T.appendFile+appendFile fp s = command "dd" ["of=" ++ fp, "conv=notrunc", "oflag=append"] s >>= \case+  (ExitSuccess, stdin, _) -> return ()+  _                       -> error $ "Error appending to " ++ fp  -- * Helpers @@ -63,18 +73,5 @@  -- * Interpreter --- | Executes the actions locally-run :: Handsy a -> IO a-run h = do-  x <- runFreeT h-  case x of-    Pure r -> return r-    Free (ReadFile fp next)-      -> B.readFile fp >>= run . next-    Free (WriteFile fp str next)-      -> B.writeFile fp str >>= run . next-    Free (AppendFile fp str next)-      -> B.appendFile fp str >>= run . next-    Free (Command prg args stdin next)-      -> readProcessWithExitCode prg args stdin >>= run . next-+run :: Options -> Handsy a -> IO a+run = interpretSimple readProcessWithExitCode

@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveFunctor    #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell  #-}++module System.Handsy.Core+  ( Handsy+  , interpret+  , interpretSimple+  , command+  , Options+  , options+  , debug+  ) where++import           Control.Exception        (bracket)+import           Control.Monad+import           Control.Monad.Free.TH+import           Control.Monad.Trans.Free+import qualified Data.ByteString.Lazy     as B+import           System.Exit+import           System.IO++data HandsyF k =+    Command      FilePath [String] B.ByteString ((ExitCode, B.ByteString, B.ByteString) -> k)+  deriving (Functor)++makeFree ''HandsyF++type Handsy = FreeT HandsyF IO++data Options =+  Options { debug :: Bool -- ^ Log commands to stderr before running+          }++options :: Options+options = Options True++interpret :: IO r         -- ^ Acquire resource+          -> (r -> IO ()) -- ^ Release resource+          -> (r -> String -> [String] -> B.ByteString+              -> IO (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode' + resource+          -> Options+          -> Handsy a+          -> IO a+interpret acquire destroy f opts handsy = bracket acquire destroy (flip 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++interpretSimple :: (String -> [String] -> B.ByteString+                -> IO (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode'+                -> Options+                -> Handsy a+                -> IO a+interpretSimple f = interpret (return ()) (const (return ())) (const f)

@@ -1,19 +0,0 @@-{-# LANGUAGE DeriveFunctor    #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TemplateHaskell  #-}--module System.Handsy.Internal where--import           Control.Monad.Free-import           Control.Monad.Free.TH-import qualified Data.ByteString.Lazy  as B-import           System.Exit--data HandsyF k =-    Command      FilePath [String] B.ByteString ((ExitCode, B.ByteString, B.ByteString) -> k)-  | ReadFile     FilePath                       (B.ByteString -> k)-  | WriteFile    FilePath B.ByteString          (() -> k)-  | AppendFile   FilePath B.ByteString          (() -> k)-  deriving (Functor)--makeFree ''HandsyF

@@ -1,9 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module System.Handsy.Remote where -import           System.Handsy            as H-import           System.Handsy.Internal   (HandsyF (..))+import           Prelude                  hiding (appendFile, readFile,+                                           writeFile) +import           System.Handsy+import           System.Handsy.Core       (interpretSimple)+ import qualified Data.ByteString.Char8    as C8 import qualified Data.ByteString.Lazy     as B import           System.Exit@@ -19,34 +22,22 @@   }  -- | Executes the actions at a remote host-runRemote :: RemoteOptions -> Handsy a -> IO a-runRemote opts h = do-  x <- runFreeT h-  case x of-    Pure r -> return r-    Free (ReadFile fp next)-      -> runSsh "cat" [fp] "" >>= \(_, stdin, _) -> runRemote opts (next stdin)-    Free (WriteFile fp str next)-      -> runSsh "dd" ["of=" ++ fp] str >> runRemote opts (next ())-    Free (AppendFile fp str next)-      -> runSsh "dd" ["of=" ++ fp, "conv=notrunc", "oflag=append"] str >> runRemote opts (next ())-    Free (Command prg args stdin next)-      -> runSsh prg args stdin >>= runRemote opts . next-+runRemote :: Options -> RemoteOptions -> Handsy a -> IO a+runRemote opts remote = interpretSimple runSsh opts   where     runSsh :: String -> [String] -> B.ByteString -> IO (ExitCode, B.ByteString, B.ByteString)     runSsh prg args stdin = let c = C8.unpack . C8.intercalate " " . map (bytes . bash . C8.pack) $ (prg:args)-                                (ssh, sshOpts) = sshCommand opts-                            in run $ command ssh (sshOpts ++ [c]) stdin+                                (ssh, sshOpts) = sshCommand remote+                            in run options $ command ssh (sshOpts ++ [c]) stdin  -- | Copies a local file to remote host pushFile :: FilePath -- ^ Local path of source          -> FilePath -- ^ Remote path of destination          -> Handsy ()-pushFile local remote = liftIO (B.readFile local) >>= H.writeFile remote+pushFile local remote = liftIO (B.readFile local) >>= writeFile remote  -- | Fetches a file from remote host pullFile :: FilePath -- ^ Remote path of source          -> FilePath -- ^ Local path of destination          -> Handsy ()-pullFile remote local = H.readFile remote >>= liftIO . B.writeFile local+pullFile remote local = readFile remote >>= liftIO . B.writeFile local

@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           System.Handsy              as H++import           Control.Applicative+import qualified Data.ByteString.Lazy.Char8 as B+import           Data.Char+import           Data.List++import           Test.Tasty+import           Test.Tasty.HUnit++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" [] ""++    H.writeFile tmp bin++    h1 <- takeWhile isHexDigit . B.unpack . fst <$> H.command_ "md5sum" ["/bin/sh"] ""+    h2 <- takeWhile isHexDigit . B.unpack . fst <$> H.command_ "md5sum" [tmp] ""++    return (h1, h2)++  assertEqual "" h1 h2++test2 = 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 -" ""+    return (h1, h2)++  assertEqual "" h1 h2++main :: IO ()+main = defaultMain (testGroup "handsy" [test1, test2])