packages feed

handsy 0.0.13.1 → 0.0.14

raw patch · 9 files changed

+266/−305 lines, 9 filesdep −errorsdep −lifted-basedep ~base

Dependencies removed: errors, lifted-base

Dependency ranges changed: base

Files

handsy.cabal view
@@ -1,8 +1,8 @@ name:          handsy-version:       0.0.13.1+version:       0.0.14 synopsis:      A DSL to describe common shell operations and interpeters for running them locally and remotely. description:-    DEPRECATED. @handsy@ is a small library mainly for applications which should make some+    @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,10 @@  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.9                   , bytestring                   , transformers@@ -43,8 +42,6 @@                   , retry                   , data-default-class                   , split-                  , errors-                  , lifted-base   hs-source-dirs:   src   default-language: Haskell2010 @@ -55,7 +52,7 @@   main-is:          Test.hs   default-language: Haskell2010   hs-source-dirs:   test-  build-depends:    base >=4.6 && <4.9+  build-depends:    base >=4.6 && < 4.8                   , handsy                   , bytestring                   , tasty
src/System/Handsy.hs view
@@ -3,59 +3,108 @@  module System.Handsy   ( Handsy-  , handsyIO-  , handsyLeft--  -- * Interpreters-  , Options (..)--  -- ** Local   , run -  -- ** Remote-  , runRemote-  , Host-  , SSHOptions (..)--  -- * Actions-  , CommandOptions (..)-  , command+  -- * Commands   , shell-  , command_-  , shell_+  , command   , readFile   , writeFile   , appendFile-  , sleep-  , mkTemp-  , mkTempDir-  , isRunning-  , os -  -- ** For remote actions-  , pushFile-  , pullFile+  -- * Helpers+  , shell_+  , command_ -  -- * Utils-  , IsReturnValue-  , stdout-  , stderr-  , exitCode-  , isSuccessful-  , isExitSuccess-  , strLines+  -- * Options+  , CommandOptions (..)+  , Options (..)    -- * Re-exports   , ExitCode (..)   , def   ) where -import           Prelude                hiding (appendFile, readFile, writeFile)+import           Prelude                        hiding (appendFile, readFile,+                                                 writeFile) -import           System.Handsy.Actions-import           System.Handsy.Internal-import           System.Handsy.Local-import           System.Handsy.Remote+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           Data.Default.Class-import           System.Exit+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])+
− src/System/Handsy/Actions.hs 
@@ -1,147 +0,0 @@-{-# 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
@@ -2,14 +2,18 @@ {-# LANGUAGE LambdaCase          #-} {-# LANGUAGE ScopedTypeVariables #-} -module System.Handsy.Internal where+module System.Handsy.Internal+  ( Handsy+  , interpret+  , interpretSimple+  , shell+  , Options (..)+  )+  where -import           Control.Error-import           Control.Exception.Lifted  (bracket)+import           Control.Exception         (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)@@ -21,10 +25,10 @@ data HandsyInstruction a where  Shell :: String -> B.ByteString -> HandsyInstruction (ExitCode, StdOut, StdErr) -type Handsy a = ProgramT HandsyInstruction Script a+type Handsy a = ProgramT HandsyInstruction IO a -shellF :: FilePath -> B.ByteString -> Handsy (ExitCode, B.ByteString, B.ByteString)-shellF cmd stdin = singleton $ Shell cmd stdin+shell :: FilePath -> B.ByteString -> Handsy (ExitCode, B.ByteString, B.ByteString)+shell cmd stdin = singleton $ Shell cmd stdin  data Options =   Options { debug :: Bool -- ^ Log commands to stderr before running@@ -34,27 +38,23 @@   def = Options False  interpret :: forall r . forall a-           . Script r         -- ^ Acquire resource-          -> (r -> Script ()) -- ^ Release resource-          -> (r -> String -> B.ByteString -> Script (ExitCode, B.ByteString, B.ByteString))+           . IO r         -- ^ Acquire resource+          -> (r -> IO ()) -- ^ Release resource+          -> (r -> String -> B.ByteString+              -> IO (ExitCode, B.ByteString, B.ByteString))           -> Options           -> Handsy a-          -> EitherT String IO a+          -> IO a interpret acquire destroy f opts handsy = bracket acquire destroy (`go` handsy)-  where go :: r -> Handsy a -> Script a+  where go :: r -> Handsy a -> IO a         go res h = viewT h >>= \case-          Return x                   -> right x-          Shell cmdline stdin :>>= k -> when (debug opts) (liftIO $ hPutStrLn stderr cmdline)+          Return x                   -> return x+          Shell cmdline stdin :>>= k -> when (debug opts) (hPutStrLn stderr cmdline)                                         >> f res cmdline stdin >>= go res . k -interpretSimple :: (FilePath -> B.ByteString -> Script (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode'+interpretSimple :: (FilePath -> B.ByteString+                    -> IO (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode'                 -> Options                 -> Handsy a-                -> Script a+                -> IO 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 
@@ -1,12 +0,0 @@-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,62 +1,67 @@ {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} -module System.Handsy.Remote where+module System.Handsy.Remote+  ( runRemote+  , Host +  -- * Options+  , SSHOptions (..)++  -- * Helpers+  , pushFile+  , pullFile++  -- * Re-exports+  , def+  ) 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,--    -- | User-    sshUser        :: Maybe String,+    sshPath       :: FilePath,      -- | Port to connect-    sshPort        :: Int,--    -- | Identity file to use-    identityFile   :: Maybe FilePath,--    -- | Connect timeout-    connectTimeout :: Int,+    sshPort       :: 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" Nothing 22 Nothing 30 True+  def = SSHOptions "ssh" 22 True -acquireCM :: Host -> SSHOptions -> Script FilePath+acquireCM :: Host -> SSHOptions -> IO FilePath acquireCM host opts = do-  cm <- scriptIO (run def $ head . strLines . fst <$> command_ "mktemp" ["-u", "--suffix=.handsy"] def) >>= hoistEither+  cm <- run def $ head . strLines . fst <$> command_ "mktemp" ["-u", "--suffix=.handsy"] def    let (ssh, params) = genSsh opts (Just cm)-  _ <- scriptIO . forkIO . void . run def . void $ command_ ssh (params ++ ["-M", "-N", host]) def-  scriptIO (waitForCM cm) >>= bool (left "Error establishing ControlMaster connection") (right ())+  _ <- forkIO . run def . void $ command_ ssh (params ++ ["-M", "-N", host]) def+  bool (error "Error establishing ControlMaster connection") () <$> waitForCM cm    return cm   where     checkCM :: FilePath -> IO Bool-    checkCM p = fmap (either (const False) id) . run def $ do+    checkCM p = run def $ do       let args = snd (genSsh opts Nothing) ++ ["-o", "ControlPath=" ++ p, "-O", "check"]       command (sshPath opts) args def >>= return . \case         (ExitSuccess, _, _) -> True@@ -64,30 +69,24 @@     waitForCM p = retrying (limitRetries 30) (\_ n -> return (not n)) (checkCM p)  -releaseCM :: FilePath -> Script ()-releaseCM p = (scriptIO . run def{debug=False} $ void $ command_ "rm" ["-f", p] def) >>= hoistEither+releaseCM :: FilePath -> IO ()+releaseCM p = run def{debug=False} $ void $ command_ "rm" ["-f", p] def  genSsh :: SSHOptions -> Maybe FilePath -> (FilePath, [String])-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-                 )+genSsh opts cm = (sshPath opts, ["-p", show $ sshPort opts] ++ maybe [] (\i->["-S", i]) cm)  runSsh :: Host -> SSHOptions -> Maybe FilePath -> String -> B.ByteString-       -> Script (ExitCode, B.ByteString, B.ByteString)+       -> IO (ExitCode, B.ByteString, B.ByteString) runSsh host opts cm cmdline stdin' =   let (ssh, params) = genSsh opts cm-  in  runS def{debug=False} $ command ssh (params ++ [host] ++ [cmdline]) def{stdin=stdin'}+  in  run 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 (Either String a)-runRemote opts host sshOpts = runEitherT .+runRemote :: Options -> Host -> SSHOptions -> Handsy a -> IO a+runRemote opts host sshOpts =   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@@ -96,10 +95,10 @@ pushFile :: FilePath -- ^ Local path of source          -> FilePath -- ^ Remote path of destination          -> Handsy ()-pushFile local remote = handsyIO (B.readFile local) >>= 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 = readFile remote >>= handsyIO . B.writeFile local+pullFile remote local = readFile remote >>= liftIO . B.writeFile local
src/System/Handsy/Tutorial.hs view
@@ -9,6 +9,8 @@     ) 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 view
@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase        #-}++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,14 +1,15 @@-{-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell   #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}  module Main where -import           Prelude                    hiding (appendFile, readFile,-                                             writeFile)+import           System.Handsy              as H -import           System.Handsy+{- 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           Control.Applicative import qualified Data.ByteString.Lazy       as B@@ -22,67 +23,58 @@ arbitraryBinary = B.pack [1..255]  case_writeFile = do-  f <- run def $ do+  f <- H.run def $ do     tmp <- mkTemp ""-    writeFile tmp arbitraryBinary+    H.writeFile tmp arbitraryBinary     return tmp-  case f of-    Right fname -> B.readFile fname >>= assertEqual "" arbitraryBinary-    Left  err   -> assertFailure err+  ret <- B.readFile f+  assertEqual "" arbitraryBinary ret  case_readFile = do-  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+  tmp <- H.run def $ mkTemp ""+  B.writeFile tmp arbitraryBinary+  ret <- H.run def $ H.readFile tmp+  assertEqual "" arbitraryBinary ret  case_appendFile = do-  ret <- run def $ do+  ret <- H.run def $ do     tmp <- mkTemp "" -    writeFile tmp "ut"-    appendFile tmp "demir"+    H.writeFile tmp "ut"+    H.appendFile tmp "demir" -    readFile tmp+    H.readFile tmp -  either assertFailure (assertEqual "" "utdemir") ret+  assertEqual "" "utdemir" ret  case_shell = do-  ret <- run def $ do+  (h1, h2) <- H.run def $ do     tmp <- mkTemp "" -    writeFile tmp (B.pack [1..255])+    H.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) -  case ret of-    Left err       -> assertFailure err-    Right (h1, h2) -> assertEqual "" h1 h2+  assertEqual "" h1 h2  case_exit = do-  ret <- run def $ do+  (e1, e2) <- H.run def $ do     (e1, _, _) <- command "grep" [] def     (e2, _, _) <- command "id" [] def     return (e1, e2) -  case ret of-    Right (ExitFailure _, ExitSuccess) -> return ()-    other -> assertFailure $ "Invalid return values: " ++ show other+  case (e1, e2) of+    (ExitFailure _, ExitSuccess) -> return ()+    _ -> assertFailure $ "Invalid return values: " ++ show (e1, e2)  case_cwd = do-  ret <- run def $ do+  (temp, pwd) <- H.run def $ do     temp <- mkTempDir ""     pwd:[] <- strLines . stdout <$> command_ "pwd" [] def{cwd=temp}     return (temp, pwd)--  case ret of-    Right (temp, pwd) -> assertEqual "" temp pwd-    other -> assertFailure $ "Invalid paths: " ++ show other+  assertEqual "" temp pwd  main :: IO () main = $(defaultMainGenerator)