packages feed

shelly 1.3.0.3 → 1.3.0.4

raw patch · 4 files changed

+38/−58 lines, 4 files

Files

shelly.cabal view
@@ -1,6 +1,6 @@ Name:       shelly -Version:     1.3.0.3+Version:     1.3.0.4 Synopsis:    shell-like (systems) programming in Haskell  Description: Shelly provides convenient systems programming in Haskell,
src/Shelly.hs view
@@ -86,7 +86,7 @@ import Shelly.Find import Control.Monad ( when, unless, void, forM, filterM ) import Control.Monad.Trans ( MonadIO )-import Control.Monad.Reader (ask)+import Control.Monad.State (get, gets, modify, put) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding ( readFile, FilePath, catch) #else@@ -94,7 +94,6 @@ #endif import Data.Char ( isAlphaNum, isSpace ) import Data.Typeable-import Data.IORef import Data.Sequence (Seq, (|>)) import Data.Foldable (toList) import Data.Maybe@@ -287,11 +286,6 @@   trace msg   action -put :: State -> Sh ()-put newState = do-  stateVar <- ask-  liftIO (writeIORef stateVar newState)- runCommandNoEscape :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) runCommandNoEscape handles st exe args = liftIO $ shellyProcess handles st $     ShellCommand $ T.unpack $ T.intercalate " " (toTextIgnore exe : args)@@ -299,7 +293,7 @@ runCommand :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) runCommand handles st exe args = findExe exe >>= \fullExe ->   liftIO $ shellyProcess handles st $-    RawCommand (unpack fullExe) (map T.unpack args)+    RawCommand (encodeString fullExe) (map T.unpack args)   where     findExe :: FilePath -> Sh FilePath     findExe fp = do@@ -323,7 +317,7 @@ shellyProcess reusedHandles st cmdSpec =  do     (createdInH, createdOutH, createdErrorH, pHandle) <- createProcess CreateProcess {           cmdspec = cmdSpec-        , cwd = Just $ unpack $ sDirectory st+        , cwd = Just $ encodeString $ sDirectory st         , env = Just $ sEnvironment st         , std_in  = createUnless mInH         , std_out = createUnless mOutH@@ -380,13 +374,13 @@ -- | Same as a normal 'catch' but specialized for the Sh monad. catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a catch_sh action handle = do-    ref <- ask+    ref <- get     liftIO $ catch (runSh action ref) (\e -> runSh (handle e) ref)  -- | Same as a normal 'finally' but specialized for the 'Sh' monad. finally_sh :: Sh a -> Sh b -> Sh a finally_sh action handle = do-    ref <- ask+    ref <- get     liftIO $ finally (runSh action ref) (runSh handle ref)  @@ -396,7 +390,7 @@ -- | Same as a normal 'catches', but specialized for the 'Sh' monad. catches_sh :: Sh a -> [ShellyHandler a] -> Sh a catches_sh action handlers = do-    ref <- ask+    ref <- get     let runner a = runSh a ref     liftIO $ catches (runner action) $ map (toHandler runner) handlers   where@@ -461,7 +455,7 @@       ReThrownException e (extraMsg to_loc from)     )   where-    extraMsg t f = "during copy from: " ++ unpack f ++ " to: " ++ unpack t+    extraMsg t f = "during copy from: " ++ encodeString f ++ " to: " ++ encodeString t  -- | Get back [Text] instead of [FilePath] lsT :: FilePath -> Sh [Text]@@ -626,7 +620,7 @@     else       (liftIO_ $ removeTree f) `catch_sh` (\(e :: IOError) ->         when (isPermissionError e) $ do-          find f >>= mapM_ (\file -> liftIO_ $ fixPermissions (unpack file) `catchany` \_ -> return ())+          find f >>= mapM_ (\file -> liftIO_ $ fixPermissions (encodeString file) `catchany` \_ -> return ())           liftIO $ removeTree f         )   where fixPermissions file =@@ -726,10 +720,10 @@ -- The original state will be restored when the sub-Sh completes. -- Exceptions are propagated normally. sub :: Sh a -> Sh a-sub a = do+sub action = do   oldState <- get   modify $ \st -> st { sTrace = T.empty }-  a `finally_sh` restoreState oldState+  action `finally_sh` restoreState oldState   where     restoreState oldState = do       newState <- get@@ -809,7 +803,6 @@                    , sPathExecutables = Nothing                    , sErrExit = True                    }-  stref <- liftIO $ newIORef def   let caught =         action `catches_sh` [               ShellyHandler (\ex ->@@ -821,7 +814,7 @@                                      QuietExit n -> liftIO $ throwIO $ ExitFailure n)             , ShellyHandler (\(ex::SomeException) -> throwExplainedException ex)           ]-  liftIO $ runSh caught stref+  liftIO $ runSh caught def   where     throwExplainedException :: Exception exception => exception -> Sh a     throwExplainedException ex = get >>= errorMsg >>= liftIO . throwIO . ReThrownException ex@@ -844,7 +837,7 @@      nextNum :: [FilePath] -> Int     nextNum [] = 1-    nextNum fs = (+ 1) . maximum . map (readDef 1 . filter isDigit . unpack . filename) $ fs+    nextNum fs = (+ 1) . maximum . map (readDef 1 . filter isDigit . encodeString . filename) $ fs  -- from safe package readDef :: Read a => a -> String -> a@@ -889,8 +882,6 @@ -- -- > sshPairs "server-name" [("cd", "dir"), ("rm",["-r","dir2"])] ----- This interface is crude, but it works for now.--- -- Please note this sets 'escaping' to False: the commands will not be shell escaped. -- Internally the list of commands are combined with the string @&&@ before given to ssh. sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text@@ -1143,7 +1134,7 @@       ReThrownException e (extraMsg to_loc from)     )   where-    extraMsg t f = "during copy from: " ++ unpack f ++ " to: " ++ unpack t+    extraMsg t f = "during copy from: " ++ encodeString f ++ " to: " ++ encodeString t   @@ -1165,7 +1156,7 @@ writefile :: FilePath -> Text -> Sh () writefile f' bits = absPath f' >>= \f -> do   trace $ "writefile " <> toTextIgnore f-  liftIO (TIO.writeFile (unpack f) bits)+  liftIO (TIO.writeFile (encodeString f) bits)  -- | Update a file, creating (a blank file) if it does not exist. touchfile :: FilePath -> Sh ()@@ -1175,7 +1166,7 @@ appendfile :: FilePath -> Text -> Sh () appendfile f' bits = absPath f' >>= \f -> do   trace $ "appendfile " <> toTextIgnore f-  liftIO (TIO.appendFile (unpack f) bits)+  liftIO (TIO.appendFile (encodeString f) bits)  readfile :: FilePath -> Sh Text readfile = absPath >=> \fp -> do@@ -1185,7 +1176,7 @@  -- | wraps ByteSting readFile readBinary :: FilePath -> Sh ByteString-readBinary = absPath >=> liftIO . BS.readFile . unpack+readBinary = absPath >=> liftIO . BS.readFile . encodeString  -- | flipped hasExtension for Text hasExt :: Text -> FilePath -> Bool
src/Shelly/Base.hs view
@@ -6,10 +6,10 @@ -- However, Shelly went back to exposing a single module module Shelly.Base   (-    ShIO, Sh, unSh, runSh, State(..), StdHandle(..), FilePath, Text,+    Sh, ShIO, unSh, runSh, State(..), StdHandle(..), FilePath, Text,     relPath, path, absPath, canonic, canonicalize,     test_d, test_s,-    unpack, gets, get, modify, trace,+    trace,     ls, lsRelAbs,     toTextIgnore,     echo, echo_n, echo_err, echo_n_err, inspect, inspect_err,@@ -38,43 +38,47 @@ import Filesystem.Path.CurrentOS (FilePath, encodeString, relative) import qualified Filesystem.Path.CurrentOS as FP import qualified Filesystem as FS-import Data.IORef (readIORef, modifyIORef, IORef) import Data.Monoid (mappend) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Control.Exception (SomeException, catch) import Data.Maybe (fromMaybe) import Control.Monad.Trans ( MonadIO, liftIO )-import Control.Monad.Reader (MonadReader, runReaderT, ask, ReaderT)+import Control.Monad.State (MonadState, evalStateT, modify, StateT, gets) import qualified Data.Set as S  -- | ShIO is Deprecated in favor of 'Sh', which is easier to type. type ShIO a = Sh a-{- don't need to turn on deprecation. It will cause a lot of warnings while compiling existing code.- - # DEPRECATED ShIO, "Use Sh instead of ShIO" # -}+{-# DEPRECATED ShIO "Use Sh instead of ShIO" #-}  newtype Sh a = Sh {-      unSh :: ReaderT (IORef State) IO a-  } deriving (Applicative, Monad, MonadIO, MonadReader (IORef State), Functor)+      unSh :: StateT State IO a+  } deriving (Applicative, Monad, MonadIO, MonadState State, Functor) -runSh :: Sh a -> IORef State -> IO a-runSh = runReaderT . unSh+runSh :: Sh a -> State -> IO a+runSh = evalStateT . unSh -data State = State +data State = State+   -- state for the currently ran command    { sCode :: Int -- ^ exit code for command that ran    , sStdin :: Maybe Text -- ^ stdin for the command to be run    , sStderr :: Text -- ^ stderr for command that ran++   -- state for the envrionment    , sDirectory :: FilePath -- ^ working directory-   , sPrintStdout :: Bool   -- ^ print stdout of command that is executed-   , sPrintCommands :: Bool -- ^ print command that is executed-   , sRun :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) -- ^ command runner, a different runner is used when escaping, probably better to just hold the escaping flag    , sEnvironment :: [(String, String)]    , sPathExecutables :: Maybe [(FilePath, S.Set FilePath)] -- ^ cache of executables in the PATH++   -- state for the options+   , sPrintStdout :: Bool   -- ^ print stdout of command that is executed+   , sPrintCommands :: Bool -- ^ print command that is executed    , sTracing :: Bool -- ^ should we trace command execution    , sTrace :: Text -- ^ the trace of command execution    , sErrExit :: Bool -- ^ should we exit immediately on any error+   , sRun :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) -- ^ command runner, a different runner is used when escaping, probably better to just hold the escaping flag    } + data StdHandle = InHandle StdStream                | OutHandle StdStream                | ErrorHandle StdStream@@ -176,24 +180,8 @@ -- | Does a path point to a symlink? test_s :: FilePath -> Sh Bool test_s = absPath >=> liftIO . \f -> do-  stat <- getSymbolicLinkStatus (unpack f)+  stat <- getSymbolicLinkStatus (encodeString f)   return $ isSymbolicLink stat--unpack :: FilePath -> String-unpack = encodeString--gets :: (State -> a) -> Sh a-gets f = f <$> get--get :: Sh State-get = do-  stateVar <- ask -  liftIO (readIORef stateVar)--modify :: (State -> State) -> Sh ()-modify f = do-  state <- ask -  liftIO (modifyIORef state f)  -- | internally log what occurred. -- Log will be re-played on failure.
src/Shelly/Find.hs view
@@ -14,6 +14,7 @@ import Data.Monoid (mappend) import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink ) import Filesystem (isDirectory)+import Filesystem.Path.CurrentOS (encodeString)  -- | List directory recursively (like the POSIX utility "find"). -- listing is relative if the path given is relative.@@ -66,7 +67,7 @@     traverse acc (relativePath, absolutePath) = do       -- optimization: don't use Shelly API since our path is already good       isDir <- liftIO $ isDirectory absolutePath-      sym   <- liftIO $ fmap isSymbolicLink $ getSymbolicLinkStatus (unpack absolutePath)+      sym   <- liftIO $ fmap isSymbolicLink $ getSymbolicLinkStatus (encodeString absolutePath)       newAcc <- folder acc relativePath       if isDir && not sym         then findFoldDirFilter folder newAcc