module Turtle.Prelude (
proc
, shell
, echo
, err
, readline
#if MIN_VERSION_base(4,7,0)
, export
, unset
#endif
#if MIN_VERSION_base(4,6,0)
, need
#endif
, env
, cd
, pwd
, home
, realpath
, mv
, mkdir
, mktree
, cp
, rm
, rmdir
, rmtree
, du
, testfile
, testdir
, date
, datefile
, touch
, time
, sleep
, exit
, die
, readonly
, writeonly
, appendonly
, mktemp
, mktempdir
, fork
, wait
, inproc
, inshell
, stdin
, input
, inhandle
, stdout
, stderr
, output
, append
, ls
, lstree
, cat
, grep
, sed
, find
, yes
, limit
, limitWhile
) where
import Control.Applicative (Alternative(..))
import Control.Concurrent.Async (Async, withAsync, wait)
import Control.Concurrent (threadDelay)
import Control.Exception (bracket, throwIO)
import Control.Foldl (FoldM(..))
import Control.Monad (msum)
import Control.Monad.Managed (Managed, managed)
#ifdef mingw32_HOST_OS
import Data.Bits ((.&.))
#endif
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Text (Text, pack, unpack)
import Data.Time (NominalDiffTime, UTCTime, getCurrentTime)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Filesystem
import Filesystem.Path.CurrentOS (FilePath, (</>))
import qualified Filesystem.Path.CurrentOS as Filesystem
import System.Clock (Clock(..), TimeSpec(..), getTime)
import System.Environment (
#if MIN_VERSION_base(4,7,0)
setEnv,
unsetEnv,
#endif
#if MIN_VERSION_base(4,6,0)
lookupEnv,
#endif
getEnvironment )
import System.Directory (getPermissions, readable)
import System.Exit (ExitCode(..), exitWith)
import System.IO (Handle)
import qualified System.IO as IO
import System.IO.Temp (withTempDirectory, withTempFile)
import qualified System.Process as Process
#ifdef mingw32_HOST_OS
import qualified System.Win32 as Win32
#else
import System.Posix (openDirStream, readDirStream, closeDirStream, touchFile)
#endif
import Prelude hiding (FilePath)
import Turtle.Pattern (Pattern, anyChar, match)
import Turtle.Shell
proc
:: Text
-> [Text]
-> Shell Text
-> IO ExitCode
proc cmd args = system (Process.proc (unpack cmd) (map unpack args))
shell
:: Text
-> Shell Text
-> IO ExitCode
shell cmdLine = system (Process.shell (unpack cmdLine))
system
:: Process.CreateProcess
-> Shell Text
-> IO ExitCode
system p s = do
let p' = p
{ Process.std_in = Process.CreatePipe
, Process.std_out = Process.Inherit
, Process.std_err = Process.Inherit
}
(Just hIn, Nothing, Nothing, ph) <- liftIO (Process.createProcess p')
let feedIn = sh (do
txt <- s
liftIO (Text.hPutStrLn hIn txt) )
withAsync feedIn (\_ -> liftIO (Process.waitForProcess ph) )
inproc
:: Text
-> [Text]
-> Shell Text
-> Shell Text
inproc cmd args = stream (Process.proc (unpack cmd) (map unpack args))
inshell
:: Text
-> Shell Text
-> Shell Text
inshell cmd = stream (Process.shell (unpack cmd))
stream
:: Process.CreateProcess
-> Shell Text
-> Shell Text
stream p s = do
let p' = p
{ Process.std_in = Process.CreatePipe
, Process.std_out = Process.CreatePipe
, Process.std_err = Process.Inherit
}
(Just hIn, Just hOut, Nothing, _) <- liftIO (Process.createProcess p')
let feedIn = sh (do
txt <- s
liftIO (Text.hPutStrLn hIn txt) )
_ <- using (fork feedIn)
inhandle hOut
echo :: Text -> IO ()
echo = Text.putStrLn
err :: Text -> IO ()
err = Text.hPutStrLn IO.stderr
readline :: IO (Maybe Text)
readline = do
eof <- IO.isEOF
if eof
then return Nothing
else fmap (Just . pack) getLine
#if MIN_VERSION_base(4,7,0)
export :: Text -> Text -> IO ()
export key val = setEnv (unpack key) (unpack val)
unset :: Text -> IO ()
unset key = unsetEnv (unpack key)
#endif
#if MIN_VERSION_base(4,6,0)
need :: Text -> IO (Maybe Text)
need key = fmap (fmap pack) (lookupEnv (unpack key))
#endif
env :: IO [(Text, Text)]
env = fmap (fmap toTexts) getEnvironment
where
toTexts (key, val) = (pack key, pack val)
cd :: FilePath -> IO ()
cd = Filesystem.setWorkingDirectory
pwd :: IO FilePath
pwd = Filesystem.getWorkingDirectory
home :: IO FilePath
home = Filesystem.getHomeDirectory
realpath :: FilePath -> IO FilePath
realpath = Filesystem.canonicalizePath
#ifdef mingw32_HOST_OS
fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag
fILE_ATTRIBUTE_REPARSE_POINT = 1024
reparsePoint :: Win32.FileAttributeOrFlag -> Bool
reparsePoint attr = fILE_ATTRIBUTE_REPARSE_POINT .&. attr /= 0
#endif
ls :: FilePath -> Shell FilePath
ls path = Shell (\(FoldM step begin done) -> do
x0 <- begin
let path' = Filesystem.encodeString path
canRead <- fmap readable (getPermissions path')
#ifdef mingw32_HOST_OS
reparse <- fmap reparsePoint (Win32.getFileAttributes path')
if (canRead && not reparse)
then bracket
(Win32.findFirstFile (Filesystem.encodeString (path </> "*")))
(\(h, _) -> Win32.findClose h)
(\(h, fdat) -> do
let loop x = do
file' <- Win32.getFindDataFileName fdat
let file = Filesystem.decodeString file'
x' <- if (file' /= "." && file' /= "..")
then step x (path </> file)
else return x
more <- Win32.findNextFile h fdat
if more then loop $! x' else done x'
loop $! x0 )
else done x0 )
#else
if canRead
then bracket (openDirStream path') closeDirStream (\dirp -> do
let loop x = do
file' <- readDirStream dirp
case file' of
"" -> done x
_ -> do
let file = Filesystem.decodeString file'
x' <- if (file' /= "." && file' /= "..")
then step x (path </> file)
else return x
loop $! x'
loop $! x0 )
else done x0 )
#endif
lstree :: FilePath -> Shell FilePath
lstree path = do
child <- ls path
isDir <- liftIO (testdir child)
if isDir
then return child <|> lstree child
else return child
mv :: FilePath -> FilePath -> IO ()
mv = Filesystem.rename
mkdir :: FilePath -> IO ()
mkdir = Filesystem.createDirectory False
mktree :: FilePath -> IO ()
mktree = Filesystem.createTree
cp :: FilePath -> FilePath -> IO ()
cp = Filesystem.copyFile
rm :: FilePath -> IO ()
rm = Filesystem.removeFile
rmdir :: FilePath -> IO ()
rmdir = Filesystem.removeDirectory
rmtree :: FilePath -> IO ()
rmtree = Filesystem.removeTree
du :: FilePath -> IO Integer
du = Filesystem.getSize
testfile :: FilePath -> IO Bool
testfile = Filesystem.isFile
testdir :: FilePath -> IO Bool
testdir = Filesystem.isDirectory
touch :: FilePath -> IO ()
touch file = do
exists <- testfile file
if exists
#ifdef mingw32_HOST_OS
then do
handle <- Win32.createFile
(Filesystem.encodeString file)
Win32.gENERIC_WRITE
Win32.fILE_SHARE_NONE
Nothing
Win32.oPEN_EXISTING
Win32.fILE_ATTRIBUTE_NORMAL
Nothing
(creationTime, _, _) <- Win32.getFileTime handle
systemTime <- Win32.getSystemTimeAsFileTime
Win32.setFileTime handle creationTime systemTime systemTime
#else
then touchFile (Filesystem.encodeString file)
#endif
else output file empty
time :: IO a -> IO (a, NominalDiffTime)
time io = do
TimeSpec seconds1 nanoseconds1 <- getTime Monotonic
a <- io
TimeSpec seconds2 nanoseconds2 <- getTime Monotonic
let t = fromIntegral ( seconds2 seconds1)
+ fromIntegral (nanoseconds2 nanoseconds1) / 10^(9::Int)
return (a, fromRational t)
sleep :: NominalDiffTime -> IO ()
sleep n = threadDelay (truncate (n * 10^(6::Int)))
exit :: Int -> IO ()
exit 0 = exitWith ExitSuccess
exit n = exitWith (ExitFailure n)
die :: Text -> IO ()
die txt = throwIO (userError (unpack txt))
mktempdir
:: FilePath
-> Text
-> Managed FilePath
mktempdir parent prefix = do
let parent' = Filesystem.encodeString parent
let prefix' = unpack prefix
dir' <- managed (withTempDirectory parent' prefix')
return (Filesystem.decodeString dir')
mktemp
:: FilePath
-> Text
-> Managed (FilePath, Handle)
mktemp parent prefix = do
let parent' = Filesystem.encodeString parent
let prefix' = unpack prefix
(file', handle) <- managed (\k ->
withTempFile parent' prefix' (\file' handle -> k (file', handle)) )
let file = Filesystem.decodeString file'
return (file, handle)
fork :: IO a -> Managed (Async a)
fork io = managed (withAsync io)
stdin :: Shell Text
stdin = inhandle IO.stdin
input :: FilePath -> Shell Text
input file = do
handle <- using (readonly file)
inhandle handle
inhandle :: Handle -> Shell Text
inhandle handle = Shell (\(FoldM step begin done) -> do
x0 <- begin
let loop x = do
eof <- IO.hIsEOF handle
if eof
then done x
else do
txt <- Text.hGetLine handle
x' <- step x txt
loop $! x'
loop $! x0 )
stdout :: Shell Text -> IO ()
stdout s = sh (do
txt <- s
liftIO (echo txt) )
stderr :: Shell Text -> IO ()
stderr s = sh (do
txt <- s
liftIO (err txt) )
output :: FilePath -> Shell Text -> IO ()
output file s = sh (do
handle <- using (writeonly file)
txt <- s
liftIO (Text.hPutStrLn handle txt) )
append :: FilePath -> Shell Text -> IO ()
append file s = sh (do
handle <- using (appendonly file)
txt <- s
liftIO (Text.hPutStrLn handle txt) )
readonly :: FilePath -> Managed Handle
readonly file = managed (Filesystem.withFile file IO.ReadMode)
writeonly :: FilePath -> Managed Handle
writeonly file = managed (Filesystem.withFile file IO.WriteMode)
appendonly :: FilePath -> Managed Handle
appendonly file = managed (Filesystem.withFile file IO.AppendMode)
cat :: [Shell a] -> Shell a
cat = msum
grep :: Pattern a -> Shell Text -> Shell Text
grep pattern s = do
txt <- s
_:_ <- return (match pattern txt)
return txt
sed :: Pattern Text -> Shell Text -> Shell Text
sed pattern s = do
let pattern' = fmap Text.concat
(many (pattern <|> fmap Text.singleton anyChar))
txt <- s
txt':_ <- return (match pattern' txt)
return txt'
find :: Pattern a -> FilePath -> Shell FilePath
find pattern dir = do
path <- lstree dir
Right txt <- return (Filesystem.toText path)
_:_ <- return (match pattern txt)
return path
yes :: Shell Text
yes = Shell (\(FoldM step begin _) -> do
x0 <- begin
let loop x = do
x' <- step x "y"
loop $! x'
loop $! x0 )
limit :: Int -> Shell a -> Shell a
limit n s = Shell (\(FoldM step begin done) -> do
ref <- newIORef 0
let step' x a = do
n' <- readIORef ref
writeIORef ref (n' + 1)
if n' < n then step x a else return x
foldIO s (FoldM step' begin done) )
limitWhile :: (a -> Bool) -> Shell a -> Shell a
limitWhile predicate s = Shell (\(FoldM step begin done) -> do
ref <- newIORef True
let step' x a = do
b <- readIORef ref
let b' = b && predicate a
writeIORef ref b'
if b' then step x a else return x
foldIO s (FoldM step' begin done) )
date :: IO UTCTime
date = getCurrentTime
datefile :: FilePath -> IO UTCTime
datefile = Filesystem.getModified