module Turtle.Prelude (
proc
, shell
, procStrict
, shellStrict
, echo
, err
, readline
, arguments
#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
, testfile
, testdir
, date
, datefile
, touch
, time
, hostname
, sleep
, exit
, die
, (.&&.)
, (.||.)
, readonly
, writeonly
, appendonly
, mktemp
, mktempdir
, fork
, wait
, inproc
, inshell
, stdin
, input
, inhandle
, stdout
, output
, outhandle
, append
, stderr
, strict
, ls
, lstree
, cat
, grep
, sed
, find
, yes
, limit
, limitWhile
, cache
, countChars
, countWords
, countLines
, Permissions
, chmod
, getmod
, setmod
, readable, nonreadable
, writable, nonwritable
, executable, nonexecutable
, searchable, nonsearchable
, ooo,roo,owo,oox,oos,rwo,rox,ros,owx,rwx,rws
, du
, Size
, bytes
, kilobytes
, megabytes
, gigabytes
, terabytes
, kibibytes
, mebibytes
, gibibytes
, tebibytes
) where
import Control.Applicative (Alternative(..), (<*), (*>))
import Control.Concurrent.Async (Async, withAsync, wait, concurrently)
import Control.Concurrent (threadDelay)
import Control.Exception (bracket, throwIO)
import Control.Foldl (Fold, FoldM(..), genericLength, handles, list, premap)
import qualified Control.Foldl.Text
import Control.Monad (liftM, msum, when)
import Control.Monad.IO.Class (MonadIO(..))
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 Data.Traversable (traverse)
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 Network.HostName (getHostName)
import System.Clock (Clock(..), TimeSpec(..), getTime)
import System.Environment (
getArgs,
#if MIN_VERSION_base(4,7,0)
setEnv,
unsetEnv,
#endif
#if MIN_VERSION_base(4,6,0)
lookupEnv,
#endif
getEnvironment )
import System.Directory (Permissions)
import qualified System.Directory as Directory
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
import Turtle.Format (format, w, (%))
proc
:: MonadIO io
=> Text
-> [Text]
-> Shell Text
-> io ExitCode
proc cmd args = system (Process.proc (unpack cmd) (map unpack args))
shell
:: MonadIO io
=> Text
-> Shell Text
-> io ExitCode
shell cmdLine = system (Process.shell (unpack cmdLine))
procStrict
:: MonadIO io
=> Text
-> [Text]
-> Shell Text
-> io (ExitCode, Text)
procStrict cmd args =
systemStrict (Process.proc (Text.unpack cmd) (map Text.unpack args))
shellStrict
:: MonadIO io
=> Text
-> Shell Text
-> io (ExitCode, Text)
shellStrict cmdLine = systemStrict (Process.shell (Text.unpack cmdLine))
system
:: MonadIO io
=> Process.CreateProcess
-> Shell Text
-> io ExitCode
system p s = liftIO (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 (\a -> liftIO (Process.waitForProcess ph) <* wait a) )
systemStrict
:: MonadIO io
=> Process.CreateProcess
-> Shell Text
-> io (ExitCode, Text)
systemStrict p s = liftIO (do
let p' = p
{ Process.std_in = Process.CreatePipe
, Process.std_out = Process.CreatePipe
, Process.std_err = Process.Inherit
}
(Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p')
let feedIn = sh (do
txt <- s
liftIO (Text.hPutStrLn hIn txt) )
concurrently
(withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a))
(Text.hGetContents hOut) )
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) )
a <- using (fork feedIn)
inhandle hOut <|> (liftIO (wait a) *> empty)
echo :: MonadIO io => Text -> io ()
echo txt = liftIO (Text.putStrLn txt)
err :: MonadIO io => Text -> io ()
err txt = liftIO (Text.hPutStrLn IO.stderr txt)
readline :: MonadIO io => io (Maybe Text)
readline = liftIO (do
eof <- IO.isEOF
if eof
then return Nothing
else fmap (Just . pack) getLine )
arguments :: MonadIO io => io [Text]
arguments = liftIO (fmap (map pack) getArgs)
#if MIN_VERSION_base(4,7,0)
export :: MonadIO io => Text -> Text -> io ()
export key val = liftIO (setEnv (unpack key) (unpack val))
unset :: MonadIO io => Text -> io ()
unset key = liftIO (unsetEnv (unpack key))
#endif
#if MIN_VERSION_base(4,6,0)
need :: MonadIO io => Text -> io (Maybe Text)
need key = liftIO (fmap (fmap pack) (lookupEnv (unpack key)))
#endif
env :: MonadIO io => io [(Text, Text)]
env = liftIO (fmap (fmap toTexts) getEnvironment)
where
toTexts (key, val) = (pack key, pack val)
cd :: MonadIO io => FilePath -> io ()
cd path = liftIO (Filesystem.setWorkingDirectory path)
pwd :: MonadIO io => io FilePath
pwd = liftIO Filesystem.getWorkingDirectory
home :: MonadIO io => io FilePath
home = liftIO Filesystem.getHomeDirectory
realpath :: MonadIO io => FilePath -> io FilePath
realpath path = liftIO (Filesystem.canonicalizePath path)
#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
Directory.readable
(Directory.getPermissions (deslash 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
deslash :: String -> String
deslash [] = []
deslash (c0:cs0) = c0:go cs0
where
go [] = []
go ['\\'] = []
go (c:cs) = c:go cs
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 :: MonadIO io => FilePath -> FilePath -> io ()
mv oldPath newPath = liftIO (Filesystem.rename oldPath newPath)
mkdir :: MonadIO io => FilePath -> io ()
mkdir path = liftIO (Filesystem.createDirectory False path)
mktree :: MonadIO io => FilePath -> io ()
mktree path = liftIO (Filesystem.createTree path)
cp :: MonadIO io => FilePath -> FilePath -> io ()
cp oldPath newPath = liftIO (Filesystem.copyFile oldPath newPath)
rm :: MonadIO io => FilePath -> io ()
rm path = liftIO (Filesystem.removeFile path)
rmdir :: MonadIO io => FilePath -> io ()
rmdir path = liftIO (Filesystem.removeDirectory path)
rmtree :: MonadIO io => FilePath -> io ()
rmtree path = liftIO (Filesystem.removeTree path)
testfile :: MonadIO io => FilePath -> io Bool
testfile path = liftIO (Filesystem.isFile path)
testdir :: MonadIO io => FilePath -> io Bool
testdir path = liftIO (Filesystem.isDirectory path)
touch :: MonadIO io => FilePath -> io ()
touch file = do
exists <- testfile file
liftIO (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 )
chmod
:: MonadIO io
=> (Permissions -> Permissions)
-> FilePath
-> io Permissions
chmod modifyPermissions path = liftIO (do
let path' = deslash (Filesystem.encodeString path)
permissions <- Directory.getPermissions path'
let permissions' = modifyPermissions permissions
changed = permissions /= permissions'
when changed (Directory.setPermissions path' permissions')
return permissions' )
getmod :: MonadIO io => FilePath -> io Permissions
getmod path = liftIO (do
let path' = deslash (Filesystem.encodeString path)
Directory.getPermissions path' )
setmod :: MonadIO io => Permissions -> FilePath -> io ()
setmod permissions path = liftIO (do
let path' = deslash (Filesystem.encodeString path)
Directory.setPermissions path' permissions )
readable :: Permissions -> Permissions
readable = Directory.setOwnerReadable True
nonreadable :: Permissions -> Permissions
nonreadable = Directory.setOwnerReadable False
writable :: Permissions -> Permissions
writable = Directory.setOwnerWritable True
nonwritable :: Permissions -> Permissions
nonwritable = Directory.setOwnerWritable False
executable :: Permissions -> Permissions
executable = Directory.setOwnerExecutable True
nonexecutable :: Permissions -> Permissions
nonexecutable = Directory.setOwnerExecutable False
searchable :: Permissions -> Permissions
searchable = Directory.setOwnerSearchable True
nonsearchable :: Permissions -> Permissions
nonsearchable = Directory.setOwnerSearchable False
ooo :: Permissions -> Permissions
ooo = const Directory.emptyPermissions
roo :: Permissions -> Permissions
roo = readable . ooo
owo :: Permissions -> Permissions
owo = writable . ooo
oox :: Permissions -> Permissions
oox = executable . ooo
oos :: Permissions -> Permissions
oos = searchable . ooo
rwo :: Permissions -> Permissions
rwo = readable . writable . ooo
rox :: Permissions -> Permissions
rox = readable . executable . ooo
ros :: Permissions -> Permissions
ros = readable . searchable . ooo
owx :: Permissions -> Permissions
owx = writable . executable . ooo
rwx :: Permissions -> Permissions
rwx = readable . writable . executable . ooo
rws :: Permissions -> Permissions
rws = readable . writable . searchable . ooo
time :: MonadIO io => io a -> io (a, NominalDiffTime)
time io = do
TimeSpec seconds1 nanoseconds1 <- liftIO (getTime Monotonic)
a <- io
TimeSpec seconds2 nanoseconds2 <- liftIO (getTime Monotonic)
let t = fromIntegral ( seconds2 seconds1)
+ fromIntegral (nanoseconds2 nanoseconds1) / 10^(9::Int)
return (a, fromRational t)
hostname :: MonadIO io => io Text
hostname = liftIO (fmap Text.pack getHostName)
sleep :: MonadIO io => NominalDiffTime -> io ()
sleep n = liftIO (threadDelay (truncate (n * 10^(6::Int))))
exit :: MonadIO io => ExitCode -> io a
exit code = liftIO (exitWith code)
die :: MonadIO io => Text -> io a
die txt = liftIO (throwIO (userError (unpack txt)))
infixr 2 .&&., .||.
(.&&.) :: IO ExitCode -> IO ExitCode -> IO ExitCode
cmd1 .&&. cmd2 = do
r <- cmd1
case r of
ExitSuccess -> cmd2
_ -> return r
(.||.) :: IO ExitCode -> IO ExitCode -> IO ExitCode
cmd1 .||. cmd2 = do
r <- cmd1
case r of
ExitFailure _ -> cmd2
_ -> return r
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 :: MonadIO io => Shell Text -> io ()
stdout s = sh (do
txt <- s
liftIO (echo txt) )
output :: MonadIO io => FilePath -> Shell Text -> io ()
output file s = sh (do
handle <- using (writeonly file)
txt <- s
liftIO (Text.hPutStrLn handle txt) )
outhandle :: MonadIO io => Handle -> Shell Text -> io ()
outhandle handle s = sh (do
txt <- s
liftIO (Text.hPutStrLn handle txt) )
append :: MonadIO io => FilePath -> Shell Text -> io ()
append file s = sh (do
handle <- using (appendonly file)
txt <- s
liftIO (Text.hPutStrLn handle txt) )
stderr :: MonadIO io => Shell Text -> io ()
stderr s = sh (do
txt <- s
liftIO (err txt) )
strict :: MonadIO io => Shell Text -> io Text
strict s = liftM Text.unlines (fold s list)
readonly :: FilePath -> Managed Handle
readonly file = managed (Filesystem.withTextFile file IO.ReadMode)
writeonly :: FilePath -> Managed Handle
writeonly file = managed (Filesystem.withTextFile file IO.WriteMode)
appendonly :: FilePath -> Managed Handle
appendonly file = managed (Filesystem.withTextFile 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) )
cache :: (Read a, Show a) => FilePath -> Shell a -> Shell a
cache file s = do
let cached = do
txt <- input file
case reads (Text.unpack txt) of
[(ma, "")] -> return ma
_ ->
die (format ("cache: Invalid data stored in "%w) file)
exists <- testfile file
mas <- fold (if exists then cached else empty) list
case [ () | Nothing <- mas ] of
_:_ -> select [ a | Just a <- mas ]
_ -> do
handle <- using (writeonly file)
let justs = do
a <- s
liftIO (Text.hPutStrLn handle (Text.pack (show (Just a))))
return a
let nothing = do
let n = Nothing :: Maybe ()
liftIO (Text.hPutStrLn handle (Text.pack (show n)))
empty
justs <|> nothing
date :: MonadIO io => io UTCTime
date = liftIO getCurrentTime
datefile :: MonadIO io => FilePath -> io UTCTime
datefile path = liftIO (Filesystem.getModified path)
du :: MonadIO io => FilePath -> io Size
du path = liftIO (fmap Size (Filesystem.getSize path))
newtype Size = Size { _bytes :: Integer } deriving (Num)
instance Show Size where
show = show . _bytes
bytes :: Integral n => Size -> n
bytes = fromInteger . _bytes
kilobytes :: Integral n => Size -> n
kilobytes = (`div` 1000) . bytes
megabytes :: Integral n => Size -> n
megabytes = (`div` 1000) . kilobytes
gigabytes :: Integral n => Size -> n
gigabytes = (`div` 1000) . megabytes
terabytes :: Integral n => Size -> n
terabytes = (`div` 1000) . gigabytes
kibibytes :: Integral n => Size -> n
kibibytes = (`div` 1024) . bytes
mebibytes :: Integral n => Size -> n
mebibytes = (`div` 1024) . kibibytes
gibibytes :: Integral n => Size -> n
gibibytes = (`div` 1024) . mebibytes
tebibytes :: Integral n => Size -> n
tebibytes = (`div` 1024) . gibibytes
countChars :: Integral n => Fold Text n
countChars = Control.Foldl.Text.length + charsPerNewline * countLines
charsPerNewline :: Num a => a
#ifdef mingw32_HOST_OS
charsPerNewline = 2
#else
charsPerNewline = 1
#endif
countWords :: Integral n => Fold Text n
countWords = premap Text.words (handles traverse genericLength)
countLines :: Integral n => Fold Text n
countLines = genericLength