packages feed

handsy 0.0.13 → 0.0.13.1

raw patch · 9 files changed

+310/−270 lines, 9 filesdep +errorsdep +lifted-basedep ~base

Dependencies added: errors, lifted-base

Dependency ranges changed: base

Files

handsy.cabal view
@@ -1,8 +1,8 @@ name:          handsy-version:       0.0.13+version:       0.0.13.1 synopsis:      A DSL to describe common shell operations and interpeters for running them locally and remotely. description:-    @handsy@ is a small library mainly for applications which should make some+    DEPRECATED. @handsy@ is a small library mainly for applications which should make some     operations on remote machines by SSH. It currently provides you:     .     * A DSL describing basic system operations('command', 'readFile', 'writeFile' etc.)@@ -29,11 +29,12 @@  library   exposed-modules:  System.Handsy+                    System.Handsy.Tutorial+  other-modules:    System.Handsy.Actions+                    System.Handsy.Local                     System.Handsy.Remote-                    System.Handsy.Util                     System.Handsy.Internal-                    System.Handsy.Tutorial-  build-depends:    base >=4.6 && <4.8+  build-depends:    base >=4.6 && <4.9                   , bytestring                   , transformers                   , operational@@ -42,6 +43,8 @@                   , retry                   , data-default-class                   , split+                  , errors+                  , lifted-base   hs-source-dirs:   src   default-language: Haskell2010 @@ -52,7 +55,7 @@   main-is:          Test.hs   default-language: Haskell2010   hs-source-dirs:   test-  build-depends:    base >=4.6 && < 4.8+  build-depends:    base >=4.6 && <4.9                   , handsy                   , bytestring                   , tasty
src/System/Handsy.hs view
@@ -3,108 +3,59 @@  module System.Handsy   ( Handsy+  , handsyIO+  , handsyLeft++  -- * Interpreters+  , Options (..)++  -- ** Local   , run -  -- * Commands-  , shell+  -- ** Remote+  , runRemote+  , Host+  , SSHOptions (..)++  -- * Actions+  , CommandOptions (..)   , command+  , shell+  , command_+  , shell_   , readFile   , writeFile   , appendFile+  , sleep+  , mkTemp+  , mkTempDir+  , isRunning+  , os -  -- * Helpers-  , shell_-  , command_+  -- ** For remote actions+  , pushFile+  , pullFile -  -- * Options-  , CommandOptions (..)-  , Options (..)+  -- * Utils+  , IsReturnValue+  , stdout+  , stderr+  , exitCode+  , isSuccessful+  , isExitSuccess+  , strLines    -- * Re-exports   , ExitCode (..)   , def   ) where -import           Prelude                        hiding (appendFile, readFile,-                                                 writeFile)+import           Prelude                hiding (appendFile, readFile, writeFile) -import           Data.Bool-import qualified Data.ByteString.Char8          as C8-import qualified Data.ByteString.Lazy           as B-import qualified Data.ByteString.Lazy.Char8     as C-import           System.Exit+import           System.Handsy.Actions+import           System.Handsy.Internal+import           System.Handsy.Local+import           System.Handsy.Remote  import           Data.Default.Class-import           System.Process.ByteString.Lazy--import           Text.ShellEscape--import           System.Handsy.Internal         hiding (shell)-import qualified System.Handsy.Internal         as I---- * Commands---- | Runs a command-command :: FilePath     -- ^ Command to run-        -> [String]     -- ^ Arguments-        -> CommandOptions-        -> Handsy (ExitCode, B.ByteString, B.ByteString) -- ^ (status, stdout, stderr)-command cmd args opts = let cmd' = C8.unpack . C8.intercalate " " . map (bytes . bash . C8.pack) $ (cmd:args)-                        in  shell cmd' opts--{-| Executes the given string in shell. Example:--  > shell "ls" $~ def{cwd="/var/www"}--}-shell :: String       -- ^ String to execute-      -> CommandOptions-      -> Handsy (ExitCode, B.ByteString, B.ByteString) -- ^ (ExitCode, Stdout, Stderr)-shell cmd opts = let esc = C8.unpack . bytes . bash . C8.pack-                     CommandOptions stdin' cwd' = opts-                 in  I.shell (bool ("cd " ++ esc cwd' ++ "; ") "" (null cwd') ++ cmd) stdin'--data CommandOptions =-  CommandOptions { stdin :: B.ByteString-                 , cwd   :: String-                 }-  deriving Show--instance Default CommandOptions where-  def = CommandOptions "" ""---- | Reads a file and returns the contents of the file.-readFile :: FilePath -> Handsy B.ByteString-readFile fp = command "cat" [fp] def >>= \case-  (ExitSuccess, stdout, _) -> return stdout-  (_, _, stderr)           -> error $ "Error reading " ++ fp ++ "\nStderr was: " ++ C.unpack stderr---- | @writeFile file str@ function writes the bytestring @str@, to the file @file@.-writeFile :: FilePath -> B.ByteString -> Handsy ()-writeFile fp s = command "dd" ["of=" ++ fp] def{stdin=s} >>= \case-  (ExitSuccess, _, _) -> return ()-  (_, _, stderr)      -> error $ "Error writing to " ++ fp  ++ "\nStderr was: " ++ C.unpack stderr---- | @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"] def{stdin=s} >>= \case-  (ExitSuccess, _, _) -> return ()-  (_, _, stderr)      -> error $ "Error appending to " ++ fp ++ "\nStderr was: " ++ C.unpack stderr---- | Same as 'command', but ExitFailure is a runtime error.-command_ :: FilePath -> [String] -> CommandOptions -> Handsy (B.ByteString, B.ByteString)-command_ path args opts = command path args opts >>= \case-  (ExitFailure code, _, stderr) -> error ('`':path ++ ' ' : show args ++ "` returned " ++ show code-                                       ++ "\nStderr was: " ++ C.unpack stderr)-  (ExitSuccess, stdout, stderr) -> return (stdout, stderr)---- | Same as 'shell', but ExitFailure is a runtime error.-shell_ :: String -> CommandOptions -> Handsy (B.ByteString, B.ByteString)-shell_ cmd opts = shell cmd opts >>= \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 (\cmdline -> readProcessWithExitCode "bash" ["-c", cmdline])-+import           System.Exit
+ src/System/Handsy/Actions.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++module System.Handsy.Actions where++import           Control.Applicative+import           Control.Concurrent+import           Control.Error+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import qualified Data.ByteString.Char8      as B8+import qualified Data.ByteString.Lazy       as BL+import qualified Data.ByteString.Lazy.Char8 as BL8+import           Data.Default.Class+import           Data.List.Split+import           Prelude                    hiding (appendFile, readFile,+                                             writeFile)+import           System.Exit+import           System.Handsy.Internal+import           Text.ShellEscape++-- | Runs a command+command :: FilePath     -- ^ Command to run+        -> [String]     -- ^ Arguments+        -> CommandOptions+        -> Handsy (ExitCode, BL.ByteString, BL.ByteString) -- ^ (status, stdout, stderr)+command cmd args opts = let cmd' = B8.unpack . B8.intercalate " " . map (bytes . bash . B8.pack) $ (cmd:args)+                        in  shell cmd' opts++{-| Executes the given string in shell. Example:++  > shell "ls" $~ def{cwd="/var/www"}+-}+shell :: String       -- ^ String to execute+      -> CommandOptions+      -> Handsy (ExitCode, BL.ByteString, BL.ByteString) -- ^ (ExitCode, Stdout, Stderr)+shell cmd opts = let esc = B8.unpack . bytes . bash . B8.pack+                     CommandOptions stdin' cwd' = opts+                 in  shellF ((if null cwd' then "" else ("cd " ++ esc cwd' ++ "; ")) ++ cmd) stdin'++data CommandOptions =+  CommandOptions { stdin :: BL.ByteString+                 , cwd   :: String+                 }++instance Default CommandOptions where+  def = CommandOptions "" ""++-- | Reads a file and returns the contents of the file.+readFile :: FilePath -> Handsy BL.ByteString+readFile fp = command "cat" [fp] def >>= \case+  (ExitSuccess, sout, _) -> return sout+  (_, _, serr)           -> lift . left $ "Serror reading " ++ fp ++ "\nSerr was: " ++ BL8.unpack serr++-- | @writeFile file str@ function writes the bytestring @str@, to the file @file@.+writeFile :: FilePath -> BL.ByteString -> Handsy ()+writeFile fp s = command "dd" ["of=" ++ fp] def{stdin=s} >>= \case+  (ExitSuccess, _, _) -> return ()+  (_, _, serr)      -> lift . left $ "Serror writing to " ++ fp  ++ "\nSerr was: " ++ BL8.unpack serr++-- | @appendFile file str@ function appends the bytestring @str@, to the file @file@.+appendFile :: FilePath -> BL.ByteString -> Handsy ()+appendFile fp s = command "dd" ["of=" ++ fp, "conv=notrunc", "oflag=append"] def{stdin=s} >>= \case+  (ExitSuccess, _, _) -> return ()+  (_, _, serr)      -> lift . left $ "Serror appending to " ++ fp ++ "\nSerr was: " ++ BL8.unpack serr++-- | Same as 'command', but ExitFailure ends the computation.+command_ :: FilePath -> [String] -> CommandOptions -> Handsy (BL.ByteString, BL.ByteString)+command_ path args opts = command path args opts >>= \case+  (ExitFailure code, _, serr) -> lift $ left ('`':path ++ ' ' : show args ++ "` returned " ++ show code+                                                ++ "\nSerr was: " ++ BL8.unpack serr)+  (ExitSuccess, sout, serr) -> return (sout, serr)++-- | Same as 'shell', but ExitFailure ends the computation.+shell_ :: String -> CommandOptions -> Handsy (BL.ByteString, BL.ByteString)+shell_ cmd opts = shell cmd opts >>= \case+  (ExitFailure code, _, serr) -> lift $ left ('`':cmd ++ "` returned " ++ show code+                                                ++ "\nSerr was: " ++ BL8.unpack serr)+  (ExitSuccess, sout, serr) -> return (sout, serr)++-- * Helpers for parsing return values of 'command' and 'shell'++class IsReturnValue a where+  stdout   :: a -> BL.ByteString+  stderr   :: a -> BL.ByteString+  exitCode :: a -> ExitCode++instance IsReturnValue (BL.ByteString, BL.ByteString) where+  stdout   = fst+  stderr   = snd+  exitCode = const ExitSuccess++instance IsReturnValue (ExitCode, BL.ByteString, BL.ByteString) where+  stdout   = \case (_, a, _) -> a+  stderr   = \case (_, _, a) -> a+  exitCode = \case (a, _, _) -> a++isSuccessful :: IsReturnValue a => a -> Bool+isSuccessful = isExitSuccess . exitCode++isExitSuccess :: ExitCode -> Bool+isExitSuccess = \case+  ExitSuccess   -> True+  ExitFailure _ -> False++-- | Extract lines from a ByteString. Useful for parsing unix commands.+strLines :: BL.ByteString -> [String]+strLines = lines . BL8.unpack++-- | Waits specified number of seconds+sleep :: Int -> Handsy ()+sleep = liftIO . threadDelay . (* 1000000)++-- | Creates a temporary file+mkTemp :: String -> Handsy String+mkTemp suffix = do+  out <- strLines .stdout <$> command_ "mktemp" (bool ["--suffix=" ++ suffix] [] (null suffix)) def+  lift $ tryHead ("weird output from mktemp: " ++ show out) out++-- | Creates a temporary directory+mkTempDir :: String -> Handsy String+mkTempDir suffix+  = command_ "mktemp" ("-d" : bool ["--suffix" ++ suffix] [] (null suffix)) def+    >>= lift . tryHead "weird output from mktemp" . strLines . stdout++-- | Returns if the specified process is running. Uses `pidof`+isRunning :: String -> Handsy Bool+isRunning p = isSuccessful <$> command "pidof" ["-s", "-x", p] def++data OS = NixOS | Debian | Ubuntu | RHEL | CentOS | Fedora | ArchLinux+  deriving (Show, Eq)++{-| Guesses the os using `/etc/os-release`. This currently only supports Linux distributions+    abiding systemd standards. -}+os :: Handsy (Maybe OS)+os = parseOsRelease <$> readFile "/etc/os-release" >>= return . \case+    Just "ubuntu" -> Just Ubuntu+    Just "debian" -> Just Debian+    Just "nixos"  -> Just NixOS+    Just "rhel"   -> Just RHEL+    Just "centos" -> Just CentOS+    Just "fedora" -> Just Fedora+    Just "arch"   -> Just ArchLinux+    _             -> Nothing+  where parseOsRelease = fmap (filter $ not . flip elem ['\'', '"']) -- Hack to unquote+          <$> lookup "ID" . map ((\(x:xs) -> (x, concat xs)) . splitOn "=") . strLines
src/System/Handsy/Internal.hs view
@@ -1,18 +1,15 @@-{-# LANGUAGE GADTs      #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE ScopedTypeVariables #-} -module System.Handsy.Internal-  ( Handsy-  , interpret-  , interpretSimple-  , shell-  , Options (..)-  )-  where+module System.Handsy.Internal where -import           Control.Exception         (bracket)+import           Control.Error+import           Control.Exception.Lifted  (bracket) import           Control.Monad+import           Control.Monad.IO.Class import           Control.Monad.Operational+import           Control.Monad.Trans.Class import qualified Data.ByteString.Lazy      as B import           Data.Default.Class import           System.Exit               (ExitCode)@@ -24,10 +21,10 @@ data HandsyInstruction a where  Shell :: String -> B.ByteString -> HandsyInstruction (ExitCode, StdOut, StdErr) -type Handsy a = ProgramT HandsyInstruction IO a+type Handsy a = ProgramT HandsyInstruction Script a -shell :: FilePath -> B.ByteString -> Handsy (ExitCode, B.ByteString, B.ByteString)-shell cmd stdin = singleton $ Shell cmd stdin+shellF :: FilePath -> B.ByteString -> Handsy (ExitCode, B.ByteString, B.ByteString)+shellF cmd stdin = singleton $ Shell cmd stdin  data Options =   Options { debug :: Bool -- ^ Log commands to stderr before running@@ -36,23 +33,28 @@ instance Default Options where   def = Options False -interpret :: IO r         -- ^ Acquire resource-          -> (r -> IO ()) -- ^ Release resource-          -> (r -> String -> B.ByteString-              -> IO (ExitCode, B.ByteString, B.ByteString))+interpret :: forall r . forall a+           . Script r         -- ^ Acquire resource+          -> (r -> Script ()) -- ^ Release resource+          -> (r -> String -> B.ByteString -> Script (ExitCode, B.ByteString, B.ByteString))           -> Options           -> Handsy a-          -> IO a+          -> EitherT String IO a interpret acquire destroy f opts handsy = bracket acquire destroy (`go` handsy)-  where -- go :: r -> Handsy a -> IO a+  where go :: r -> Handsy a -> Script a         go res h = viewT h >>= \case-          Return x                   -> return x-          Shell cmdline stdin :>>= k -> when (debug opts) (hPutStrLn stderr cmdline)+          Return x                   -> right x+          Shell cmdline stdin :>>= k -> when (debug opts) (liftIO $ hPutStrLn stderr cmdline)                                         >> f res cmdline stdin >>= go res . k -interpretSimple :: (FilePath -> B.ByteString-                    -> IO (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode'+interpretSimple :: (FilePath -> B.ByteString -> Script (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode'                 -> Options                 -> Handsy a-                -> IO a+                -> Script a interpretSimple f = interpret (return ()) (const (return ())) (const f)++handsyIO :: IO a -> Handsy a+handsyIO = lift . scriptIO++handsyLeft :: String -> Handsy a+handsyLeft = lift . left
+ src/System/Handsy/Local.hs view
@@ -0,0 +1,12 @@+module System.Handsy.Local where++import           Control.Error+import           System.Handsy.Internal+import           System.Process.ByteString.Lazy++runS :: Options -> Handsy a -> Script a+runS opts = interpretSimple (\cmdline -> scriptIO . readProcessWithExitCode "bash" ["-c", cmdline]) opts++-- | Executes the actions locally+run :: Options -> Handsy a -> IO (Either String a)+run opts = runEitherT . runS opts
src/System/Handsy/Remote.hs view
@@ -1,67 +1,62 @@ {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} -module System.Handsy.Remote-  ( runRemote-  , Host--  -- * Options-  , SSHOptions (..)--  -- * Helpers-  , pushFile-  , pullFile--  -- * Re-exports-  , def-  ) where+module System.Handsy.Remote where  import           Prelude                hiding (appendFile, readFile, writeFile) -import           System.Handsy-import           System.Handsy.Internal (interpret, interpretSimple)-import           System.Handsy.Util- import           Control.Applicative import           Control.Concurrent+import           Control.Error import           Control.Monad import           Control.Retry-import           Data.Bool import qualified Data.ByteString.Lazy   as B--import           Control.Monad.IO.Class import           Data.Default.Class+import           Data.Monoid+import           System.Exit+import           System.Handsy.Actions+import           System.Handsy.Internal+import           System.Handsy.Local  type Host = String data SSHOptions =   SSHOptions {     -- | Path of `ssh` command-    sshPath       :: FilePath,+    sshPath        :: FilePath, +    -- | User+    sshUser        :: Maybe String,+     -- | Port to connect-    sshPort       :: Int,+    sshPort        :: Int, +    -- | Identity file to use+    identityFile   :: Maybe FilePath,++    -- | Connect timeout+    connectTimeout :: Int,+     {-| Whether to use control master for SSH connections.         This significantly reduces execution time.     -}-    controlMaster :: Bool+    controlMaster  :: Bool   }  instance Default SSHOptions where-  def = SSHOptions "ssh" 22 True+  def = SSHOptions "ssh" Nothing 22 Nothing 30 True -acquireCM :: Host -> SSHOptions -> IO FilePath+acquireCM :: Host -> SSHOptions -> Script FilePath acquireCM host opts = do-  cm <- run def $ head . strLines . fst <$> command_ "mktemp" ["-u", "--suffix=.handsy"] def+  cm <- scriptIO (run def $ head . strLines . fst <$> command_ "mktemp" ["-u", "--suffix=.handsy"] def) >>= hoistEither    let (ssh, params) = genSsh opts (Just cm)-  _ <- forkIO . run def . void $ command_ ssh (params ++ ["-M", "-N", host]) def-  bool (error "Error establishing ControlMaster connection") () <$> waitForCM cm+  _ <- scriptIO . forkIO . void . run def . void $ command_ ssh (params ++ ["-M", "-N", host]) def+  scriptIO (waitForCM cm) >>= bool (left "Error establishing ControlMaster connection") (right ())    return cm   where     checkCM :: FilePath -> IO Bool-    checkCM p = run def $ do+    checkCM p = fmap (either (const False) id) . run def $ do       let args = snd (genSsh opts Nothing) ++ ["-o", "ControlPath=" ++ p, "-O", "check"]       command (sshPath opts) args def >>= return . \case         (ExitSuccess, _, _) -> True@@ -69,24 +64,30 @@     waitForCM p = retrying (limitRetries 30) (\_ n -> return (not n)) (checkCM p)  -releaseCM :: FilePath -> IO ()-releaseCM p = run def{debug=False} $ void $ command_ "rm" ["-f", p] def+releaseCM :: FilePath -> Script ()+releaseCM p = (scriptIO . run def{debug=False} $ void $ command_ "rm" ["-f", p] def) >>= hoistEither  genSsh :: SSHOptions -> Maybe FilePath -> (FilePath, [String])-genSsh opts cm = (sshPath opts, ["-p", show $ sshPort opts] ++ maybe [] (\i->["-S", i]) cm)+genSsh opts cm = (sshPath opts,+                  [ "-p", show $ sshPort opts+                  , "-o", "ConnectTimeout=" ++ show (connectTimeout opts)]+                  <> maybe mempty (("-l":) . pure) (sshUser opts)+                  <> maybe mempty (("-i":) . pure) (identityFile opts)+                  <> maybe mempty (("-S":) . pure) cm+                 )  runSsh :: Host -> SSHOptions -> Maybe FilePath -> String -> B.ByteString-       -> IO (ExitCode, B.ByteString, B.ByteString)+       -> Script (ExitCode, B.ByteString, B.ByteString) runSsh host opts cm cmdline stdin' =   let (ssh, params) = genSsh opts cm-  in  run def{debug=False} $ command ssh (params ++ [host] ++ [cmdline]) def{stdin=stdin'}+  in  runS def{debug=False} $ command ssh (params ++ [host] ++ [cmdline]) def{stdin=stdin'}  -- | Executes the actions at a remote host-runRemote :: Options -> Host -> SSHOptions -> Handsy a -> IO a-runRemote opts host sshOpts =+runRemote :: Options -> Host -> SSHOptions -> Handsy a -> IO (Either String a)+runRemote opts host sshOpts = runEitherT .   case controlMaster sshOpts of     False -> interpretSimple (runSsh host sshOpts Nothing) opts-    True  -> interpret (acquireCM host sshOpts)+    True -> interpret (acquireCM host sshOpts)                        releaseCM                        (runSsh host sshOpts . Just)                        opts@@ -95,10 +96,10 @@ pushFile :: FilePath -- ^ Local path of source          -> FilePath -- ^ Remote path of destination          -> Handsy ()-pushFile local remote = liftIO (B.readFile local) >>= writeFile remote+pushFile local remote = handsyIO (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 = readFile remote >>= liftIO . B.writeFile local+pullFile remote local = readFile remote >>= handsyIO . B.writeFile local
src/System/Handsy/Tutorial.hs view
@@ -9,8 +9,6 @@     ) where  import           System.Handsy-import           System.Handsy.Remote-import           System.Handsy.Util  {- $introduction     @handsy@ is a small library mainly for applications which should make some
− src/System/Handsy/Util.hs 
@@ -1,82 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}--module System.Handsy.Util where--import           Control.Applicative-import           Control.Concurrent-import           Control.Monad.IO.Class-import           Data.Bool-import qualified Data.ByteString.Lazy.Char8 as C-import           Data.List.Split-import           Prelude                    hiding (appendFile, readFile,-                                             writeFile)-import           System.Handsy---- * Helpers for parsing return values of 'command' and 'shell'--class IsReturnValue a where-  stdout   :: a -> C.ByteString-  stderr   :: a -> C.ByteString-  exitCode :: a -> ExitCode--instance IsReturnValue (C.ByteString, C.ByteString) where-  stdout   = fst-  stderr   = snd-  exitCode = const ExitSuccess--instance IsReturnValue (ExitCode, C.ByteString, C.ByteString) where-  stdout   = \case (_, a, _) -> a-  stderr   = \case (_, _, a) -> a-  exitCode = \case (a, _, _) -> a--isSuccessful :: IsReturnValue a => a -> Bool-isSuccessful = isExitSuccess . exitCode--isExitSuccess :: ExitCode -> Bool-isExitSuccess = \case-  ExitSuccess   -> True-  ExitFailure _ -> False---- | Extract lines from a ByteString. Useful for parsing unix commands.-strLines :: C.ByteString -> [String]-strLines = lines . C.unpack---- * Frequently used functionality---- | Waits specified number of seconds-sleep :: Int -> Handsy ()-sleep = liftIO . threadDelay . (* 1000000)---- | Creates a temporary file-mkTemp :: String -> Handsy String-mkTemp suffix = head . strLines . fst-                  <$> command_ "mktemp" (bool ["--suffix=" ++ suffix] [] (null suffix)) def---- | Creates a temporary directory-mkTempDir :: String -> Handsy String-mkTempDir suffix = head . strLines . fst-                  <$> command_ "mktemp" ("-d" : bool ["--suffix" ++ suffix] [] (null suffix)) def---- | Returns if the specified process is running. Uses `pidof`-isRunning :: String -> Handsy Bool-isRunning p = isSuccessful <$> command "pidof" ["-s", "-x", p] def--data OS = NixOS | Debian | Ubuntu | RHEL | CentOS | Fedora | ArchLinux-  deriving (Show, Eq)--{-| Guesses the os using `/etc/os-release`. This currently only supports Linux distributions-    abiding systemd standards. -}-os :: Handsy (Maybe OS)-os = parseOsRelease <$> readFile "/etc/os-release" >>= return . \case-    Just "ubuntu" -> Just Ubuntu-    Just "debian" -> Just Debian-    Just "nixos"  -> Just NixOS-    Just "rhel"   -> Just RHEL-    Just "centos" -> Just CentOS-    Just "fedora" -> Just Fedora-    Just "arch"   -> Just ArchLinux-    _             -> Nothing-  where parseOsRelease = fmap (filter $ not . flip elem "'\"") -- Hack to unquote-          <$> lookup "ID" . map ((\(x:xs) -> (x, concat xs)) . splitOn "=") . strLines
test/Test.hs view
@@ -1,15 +1,14 @@+{-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell   #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}  module Main where -import           System.Handsy              as H+import           Prelude                    hiding (appendFile, readFile,+                                             writeFile) -{- These aren't currently used in tests, but I-   import them for coverage reports. -}-import           System.Handsy.Remote       as H-import           System.Handsy.Util         as H+import           System.Handsy  import           Control.Applicative import qualified Data.ByteString.Lazy       as B@@ -23,58 +22,67 @@ arbitraryBinary = B.pack [1..255]  case_writeFile = do-  f <- H.run def $ do+  f <- run def $ do     tmp <- mkTemp ""-    H.writeFile tmp arbitraryBinary+    writeFile tmp arbitraryBinary     return tmp-  ret <- B.readFile f-  assertEqual "" arbitraryBinary ret+  case f of+    Right fname -> B.readFile fname >>= assertEqual "" arbitraryBinary+    Left  err   -> assertFailure err  case_readFile = do-  tmp <- H.run def $ mkTemp ""-  B.writeFile tmp arbitraryBinary-  ret <- H.run def $ H.readFile tmp-  assertEqual "" arbitraryBinary ret+  run def (mkTemp "") >>= \case+    Left  err -> assertFailure err+    Right tmp -> do+      B.writeFile tmp arbitraryBinary+      run def (readFile tmp) >>= \case+        Left  err -> assertFailure err+        Right ret -> assertEqual "" arbitraryBinary ret  case_appendFile = do-  ret <- H.run def $ do+  ret <- run def $ do     tmp <- mkTemp "" -    H.writeFile tmp "ut"-    H.appendFile tmp "demir"+    writeFile tmp "ut"+    appendFile tmp "demir" -    H.readFile tmp+    readFile tmp -  assertEqual "" "utdemir" ret+  either assertFailure (assertEqual "" "utdemir") ret  case_shell = do-  (h1, h2) <- H.run def $ do+  ret <- run def $ do     tmp <- mkTemp "" -    H.writeFile tmp (B.pack [1..255])+    writeFile tmp (B.pack [1..255])      h1 <- takeWhile isHexDigit . C.unpack . fst <$> command_ "md5sum" [tmp] def     h2 <- takeWhile isHexDigit . C.unpack . fst <$> shell_ ("cat " ++ tmp ++ " | md5sum -") def     return (h1, h2) -  assertEqual "" h1 h2+  case ret of+    Left err       -> assertFailure err+    Right (h1, h2) -> assertEqual "" h1 h2  case_exit = do-  (e1, e2) <- H.run def $ do+  ret <- run def $ do     (e1, _, _) <- command "grep" [] def     (e2, _, _) <- command "id" [] def     return (e1, e2) -  case (e1, e2) of-    (ExitFailure _, ExitSuccess) -> return ()-    _ -> assertFailure $ "Invalid return values: " ++ show (e1, e2)+  case ret of+    Right (ExitFailure _, ExitSuccess) -> return ()+    other -> assertFailure $ "Invalid return values: " ++ show other  case_cwd = do-  (temp, pwd) <- H.run def $ do+  ret <- run def $ do     temp <- mkTempDir ""     pwd:[] <- strLines . stdout <$> command_ "pwd" [] def{cwd=temp}     return (temp, pwd)-  assertEqual "" temp pwd++  case ret of+    Right (temp, pwd) -> assertEqual "" temp pwd+    other -> assertFailure $ "Invalid paths: " ++ show other  main :: IO () main = $(defaultMainGenerator)