module Control.Shell (
Shell, ExitReason (..),
shell, shell_, exitString,
(|>),
try, orElse, exit,
Guard (..), guard, when, unless,
setEnv, getEnv, withEnv, lookupEnv, cmdline,
MonadIO (..),
run, run_, genericRun, runInteractive, sudo,
cd, cpdir, pwd, ls, mkdir, rmdir, inDirectory, isDirectory,
withHomeDirectory, inHomeDirectory, withAppDirectory, inAppDirectory,
forEachFile, forEachFile_, forEachDirectory, forEachDirectory_,
isFile, rm, mv, cp, input, output,
withTempFile, withCustomTempFile,
withTempDirectory, withCustomTempDirectory, inTempDirectory,
Handle, IOMode (..),
stdin, stdout, stderr,
hFlush, hClose, withFile, withBinaryFile, openFile, openBinaryFile,
hPutStr, hPutStrLn, echo, ask,
hGetLine, hGetContents,
hGetBytes, hPutBytes, hGetByteLine, hGetByteContents,
module System.FilePath,
module Control.Monad
) where
#if __GLASGOW_HASKELL__ <= 708
import Control.Applicative
#endif
import Control.Monad hiding (guard, when, unless)
import System.FilePath
import qualified System.Directory as Dir
import qualified System.Environment as Env
import System.IO.Unsafe
import Control.Shell.Handle
import Control.Shell.Internal
exitString :: ExitReason -> String
exitString Success = ""
exitString (Failure "") = "abnormal termination"
exitString (Failure s) = s
input :: FilePath -> Shell String
input = liftIO . readFile
output :: MonadIO m => FilePath -> String -> m ()
output f = liftIO . writeFile f
cmdline :: [String]
cmdline = unsafePerformIO Env.getArgs
setEnv :: MonadIO m => String -> String -> m ()
setEnv k v = liftIO $ Env.setEnv k v
lookupEnv :: String -> Shell (Maybe String)
lookupEnv = liftIO . Env.lookupEnv
withEnv :: String -> (String -> String) -> Shell a -> Shell a
withEnv key f act = do
v <- lookupEnv key
setEnv key $ f (maybe "" id v)
x <- act
setEnv key $ maybe "" id v
return x
getEnv :: String -> Shell String
getEnv key = maybe "" id `fmap` lookupEnv key
sudo :: FilePath -> [String] -> String -> Shell String
sudo cmd as = run "sudo" (cmd:as)
cd :: MonadIO m => FilePath -> m ()
cd = liftIO . Dir.setCurrentDirectory
pwd :: MonadIO m => m FilePath
pwd = liftIO $ Dir.getCurrentDirectory
rm :: MonadIO m => FilePath -> m ()
rm = liftIO . Dir.removeFile
mv :: MonadIO m => FilePath -> FilePath -> m ()
mv from to = liftIO $ Dir.renameFile from to
cpdir :: FilePath -> FilePath -> Shell ()
cpdir fromdir todir = do
assert ("`" ++ fromdir ++ "' is not a directory") (isDirectory fromdir)
exists <- isDirectory todir
if exists
then do
mkdir True (todir </> takeFileName fromdir)
go fromdir (todir </> takeFileName fromdir)
else mkdir True todir >> go fromdir todir
where
go from to = do
forEachDirectory_ from (\dir -> mkdir True (to </> dir))
forEachFile_ from $ \file -> do
let file' = to </> file
assert (errOverwrite file') (not <$> isDirectory file')
cp (from </> file) file'
errOverwrite f = "cannot overwrite directory `" ++ f
++ "' with non-directory"
forEachDirectory :: FilePath -> (FilePath -> Shell a) -> Shell [a]
forEachDirectory root f = go ""
where
dir = if null root then "." else root
go subdir = do
let dir' = dir </> subdir
files <- ls dir'
fromdirs <- filterM (\d -> isDirectory (dir' </> d)) files
xs <- forM fromdirs $ \d -> do
let d' = subdir </> d
x <- f d'
(x:) <$> go d'
return (concat xs)
forEachDirectory_ :: FilePath -> (FilePath -> Shell ()) -> Shell ()
forEachDirectory_ root f = go ""
where
dir = if null root then "." else root
go subdir = do
let dir' = dir </> subdir
files <- ls dir'
fromdirs <- filterM (\d -> isDirectory (dir' </> d)) files
forM_ fromdirs $ \d -> let d' = subdir </> d in f d' >> go d'
forEachFile :: FilePath -> (FilePath -> Shell a) -> Shell [a]
forEachFile root f = go ""
where
dir = if null root then "." else root
go subdir = do
let dir' = dir </> subdir
files <- ls dir'
onlyfiles <- filterM (\fl -> isFile (dir' </> fl)) files
xs <- mapM (\x -> f (subdir </> x)) onlyfiles
fromdirs <- filterM (\fl -> isDirectory (dir' </> fl)) files
xss <- forM fromdirs $ \d -> do
go (subdir </> d)
return $ concat (xs:xss)
forEachFile_ :: FilePath -> (FilePath -> Shell ()) -> Shell ()
forEachFile_ root f = go ""
where
dir = if null root then "." else root
go subdir = do
let dir' = dir </> subdir
files <- ls dir'
filterM (\fl -> isFile (dir' </> fl)) files >>= mapM_ (f . (subdir </>))
fromdirs <- filterM (\fl -> isDirectory (dir' </> fl)) files
forM_ fromdirs $ \d -> go (subdir </> d)
cp :: FilePath -> FilePath -> Shell ()
cp from to = do
todir <- isDirectory to
if todir
then cp from (to </> takeFileName from)
else liftIO $ Dir.copyFile from to
ls :: FilePath -> Shell [FilePath]
ls dir = do
contents <- liftIO $ Dir.getDirectoryContents dir
return [f | f <- contents, f /= ".", f /= ".."]
mkdir :: MonadIO m => Bool -> FilePath -> m ()
mkdir True = liftIO . Dir.createDirectoryIfMissing True
mkdir _ = liftIO . Dir.createDirectory
rmdir :: MonadIO m => FilePath -> m ()
rmdir = liftIO . Dir.removeDirectoryRecursive
withHomeDirectory :: (FilePath -> Shell a) -> Shell a
withHomeDirectory act = liftIO Dir.getHomeDirectory >>= act
inHomeDirectory :: Shell a -> Shell a
inHomeDirectory act = withHomeDirectory $ flip inDirectory act
withAppDirectory :: String -> (FilePath -> Shell a) -> Shell a
withAppDirectory app act = liftIO (Dir.getAppUserDataDirectory app) >>= act
inAppDirectory :: FilePath -> Shell a -> Shell a
inAppDirectory app act = withAppDirectory app $ flip inDirectory act
inDirectory :: FilePath -> Shell a -> Shell a
inDirectory dir act = do
curDir <- pwd
cd dir
x <- act
cd curDir
return x
isDirectory :: FilePath -> Shell Bool
isDirectory = liftIO . Dir.doesDirectoryExist
isFile :: FilePath -> Shell Bool
isFile = liftIO . Dir.doesFileExist
inTempDirectory :: Shell a -> Shell a
inTempDirectory = withTempDirectory "shellmate" . flip inDirectory
orElse :: Shell a -> Shell a -> Shell a
orElse a b = do
ex <- try a
case ex of
Right x -> return x
_ -> b
echo :: MonadIO m => String -> m ()
echo = liftIO . putStrLn
ask :: Shell String
ask = liftIO getLine
class Guard guard where
type Result guard
assert :: String -> guard -> Shell (Result guard)
instance Guard (Maybe a) where
type Result (Maybe a) = a
assert _ (Just x) = return x
assert "" _ = fail $ "Guard failed!"
assert desc _ = fail desc
instance Guard Bool where
type Result Bool = ()
assert _ True = return ()
assert "" _ = fail $ "Guard failed!"
assert desc _ = fail desc
instance Guard a => Guard (Shell a) where
type Result (Shell a) = Result a
assert desc m = m >>= \x -> assert desc x
guard :: Guard g => g -> Shell (Result g)
guard = assert ""
when :: Guard g => g -> Shell a -> Shell ()
when g m = do
res <- try (guard g)
case res of
Right _ -> void m
_ -> pure ()
unless :: Guard g => g -> Shell a -> Shell ()
unless g m = void (guard g) `orElse` void m